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

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.87! raeburn     4: # $Id: loncommon.pm,v 1.1075.2.86 2015/01/23 23:32:02 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.1075.2.86  raeburn  3680:     $getattempt, $regexp, $gradesub, $usec, $identifier)
1.112     bowersj2 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.1075.2.86  raeburn  3702: =item * $usec: section of the desired student
                   3703: 
                   3704: =item * $identifier: counter for student (multiple students one problem) or
                   3705:     problem (one student; whole sequence).
                   3706: 
1.112     bowersj2 3707: =back
1.14      harris41 3708: 
1.112     bowersj2 3709: The output string is a table containing all desired attempts, if any.
1.16      harris41 3710: 
1.112     bowersj2 3711: =cut
1.1       albertel 3712: 
                   3713: sub get_previous_attempt {
1.1075.2.86  raeburn  3714:   my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub,$usec,$identifier)=@_;
1.1       albertel 3715:   my $prevattempts='';
1.43      ng       3716:   no strict 'refs';
1.1       albertel 3717:   if ($symb) {
1.3       albertel 3718:     my (%returnhash)=
                   3719:       &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1       albertel 3720:     if ($returnhash{'version'}) {
                   3721:       my %lasthash=();
                   3722:       my $version;
                   3723:       for ($version=1;$version<=$returnhash{'version'};$version++) {
1.356     albertel 3724:         foreach my $key (sort(split(/\:/,$returnhash{$version.':keys'}))) {
                   3725: 	  $lasthash{$key}=$returnhash{$version.':'.$key};
1.19      harris41 3726:         }
1.1       albertel 3727:       }
1.596     albertel 3728:       $prevattempts=&start_data_table().&start_data_table_header_row();
                   3729:       $prevattempts.='<th>'.&mt('History').'</th>';
1.1075.2.86  raeburn  3730:       my (%typeparts,%lasthidden,%regraded,%hidestatus);
1.945     raeburn  3731:       my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356     albertel 3732:       foreach my $key (sort(keys(%lasthash))) {
                   3733: 	my ($ign,@parts) = split(/\./,$key);
1.41      ng       3734: 	if ($#parts > 0) {
1.31      albertel 3735: 	  my $data=$parts[-1];
1.989     raeburn  3736:           next if ($data eq 'foilorder');
1.31      albertel 3737: 	  pop(@parts);
1.1010    www      3738:           $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.'&nbsp;</th>';
1.945     raeburn  3739:           if ($data eq 'type') {
                   3740:               unless ($showsurv) {
                   3741:                   my $id = join(',',@parts);
                   3742:                   $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978     raeburn  3743:                   if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
                   3744:                       $lasthidden{$ign.'.'.$id} = 1;
                   3745:                   }
1.945     raeburn  3746:               }
1.1075.2.86  raeburn  3747:               if ($identifier ne '') {
                   3748:                   my $id = join(',',@parts);
                   3749:                   if (&Apache::lonnet::EXT("resource.$id.problemstatus",$symb,
                   3750:                                                $domain,$username,$usec,undef,$course) =~ /^no/) {
                   3751:                       $hidestatus{$ign.'.'.$id} = 1;
                   3752:                   }
                   3753:               }
                   3754:           } elsif ($data eq 'regrader') {
                   3755:               if (($identifier ne '') && (@parts)) {
                   3756:                   my $id = join(',',@parts);
                   3757:                   $regraded{$ign.'.'.$id} = 1;
                   3758:               }
1.1010    www      3759:           } 
1.31      albertel 3760: 	} else {
1.41      ng       3761: 	  if ($#parts == 0) {
                   3762: 	    $prevattempts.='<th>'.$parts[0].'</th>';
                   3763: 	  } else {
                   3764: 	    $prevattempts.='<th>'.$ign.'</th>';
                   3765: 	  }
1.31      albertel 3766: 	}
1.16      harris41 3767:       }
1.596     albertel 3768:       $prevattempts.=&end_data_table_header_row();
1.40      ng       3769:       if ($getattempt eq '') {
1.1075.2.86  raeburn  3770:         my (%solved,%resets,%probstatus);
                   3771:         if (($identifier ne '') && (keys(%regraded) > 0)) {
                   3772:             for ($version=1;$version<=$returnhash{'version'};$version++) {
                   3773:                 foreach my $id (keys(%regraded)) {
                   3774:                     if (($returnhash{$version.':'.$id.'.regrader'}) &&
                   3775:                         ($returnhash{$version.':'.$id.'.tries'} eq '') &&
                   3776:                         ($returnhash{$version.':'.$id.'.award'} eq '')) {
                   3777:                         push(@{$resets{$id}},$version);
                   3778:                     }
                   3779:                 }
                   3780:             }
                   3781:         }
1.40      ng       3782: 	for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1075.2.86  raeburn  3783:             my (@hidden,@unsolved);
1.945     raeburn  3784:             if (%typeparts) {
                   3785:                 foreach my $id (keys(%typeparts)) {
1.1075.2.86  raeburn  3786:                     if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') ||
                   3787:                         ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
1.945     raeburn  3788:                         push(@hidden,$id);
1.1075.2.86  raeburn  3789:                     } elsif ($identifier ne '') {
                   3790:                         unless (($returnhash{$version.':'.$id.'.type'} eq 'survey') ||
                   3791:                                 ($returnhash{$version.':'.$id.'.type'} eq 'surveycred') ||
                   3792:                                 ($hidestatus{$id})) {
                   3793:                             next if ((ref($resets{$id}) eq 'ARRAY') && grep(/^\Q$version\E$/,@{$resets{$id}}));
                   3794:                             if ($returnhash{$version.':'.$id.'.solved'} eq 'correct_by_student') {
                   3795:                                 push(@{$solved{$id}},$version);
                   3796:                             } elsif (($returnhash{$version.':'.$id.'.solved'} ne '') &&
                   3797:                                      (ref($solved{$id}) eq 'ARRAY')) {
                   3798:                                 my $skip;
                   3799:                                 if (ref($resets{$id}) eq 'ARRAY') {
                   3800:                                     foreach my $reset (@{$resets{$id}}) {
                   3801:                                         if ($reset > $solved{$id}[-1]) {
                   3802:                                             $skip=1;
                   3803:                                             last;
                   3804:                                         }
                   3805:                                     }
                   3806:                                 }
                   3807:                                 unless ($skip) {
                   3808:                                     my ($ign,$partslist) = split(/\./,$id,2);
                   3809:                                     push(@unsolved,$partslist);
                   3810:                                 }
                   3811:                             }
                   3812:                         }
1.945     raeburn  3813:                     }
                   3814:                 }
                   3815:             }
                   3816:             $prevattempts.=&start_data_table_row().
1.1075.2.86  raeburn  3817:                            '<td>'.&mt('Transaction [_1]',$version);
                   3818:             if (@unsolved) {
                   3819:                 $prevattempts .= '<span class="LC_nobreak"><label>'.
                   3820:                                  '<input type="checkbox" name="HIDE'.$identifier.'" value="'.$version.':'.join('_',@unsolved).'" />'.
                   3821:                                  &mt('Hide').'</label></span>';
                   3822:             }
                   3823:             $prevattempts .= '</td>';
1.945     raeburn  3824:             if (@hidden) {
                   3825:                 foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3826:                     next if ($key =~ /\.foilorder$/);
1.945     raeburn  3827:                     my $hide;
                   3828:                     foreach my $id (@hidden) {
                   3829:                         if ($key =~ /^\Q$id\E/) {
                   3830:                             $hide = 1;
                   3831:                             last;
                   3832:                         }
                   3833:                     }
                   3834:                     if ($hide) {
                   3835:                         my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   3836:                         if (($data eq 'award') || ($data eq 'awarddetail')) {
                   3837:                             my $value = &format_previous_attempt_value($key,
                   3838:                                              $returnhash{$version.':'.$key});
                   3839:                             $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3840:                         } else {
                   3841:                             $prevattempts.='<td>&nbsp;</td>';
                   3842:                         }
                   3843:                     } else {
                   3844:                         if ($key =~ /\./) {
                   3845:                             my $value = &format_previous_attempt_value($key,
                   3846:                                               $returnhash{$version.':'.$key});
                   3847:                             $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3848:                         } else {
                   3849:                             $prevattempts.='<td>&nbsp;</td>';
                   3850:                         }
                   3851:                     }
                   3852:                 }
                   3853:             } else {
                   3854: 	        foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3855:                     next if ($key =~ /\.foilorder$/);
1.945     raeburn  3856: 		    my $value = &format_previous_attempt_value($key,
                   3857: 			            $returnhash{$version.':'.$key});
                   3858: 		    $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3859: 	        }
                   3860:             }
                   3861: 	    $prevattempts.=&end_data_table_row();
1.40      ng       3862: 	 }
1.1       albertel 3863:       }
1.945     raeburn  3864:       my @currhidden = keys(%lasthidden);
1.596     albertel 3865:       $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356     albertel 3866:       foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3867:           next if ($key =~ /\.foilorder$/);
1.945     raeburn  3868:           if (%typeparts) {
                   3869:               my $hidden;
                   3870:               foreach my $id (@currhidden) {
                   3871:                   if ($key =~ /^\Q$id\E/) {
                   3872:                       $hidden = 1;
                   3873:                       last;
                   3874:                   }
                   3875:               }
                   3876:               if ($hidden) {
                   3877:                   my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   3878:                   if (($data eq 'award') || ($data eq 'awarddetail')) {
                   3879:                       my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   3880:                       if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   3881:                           $value = &$gradesub($value);
                   3882:                       }
                   3883:                       $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3884:                   } else {
                   3885:                       $prevattempts.='<td>&nbsp;</td>';
                   3886:                   }
                   3887:               } else {
                   3888:                   my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   3889:                   if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   3890:                       $value = &$gradesub($value);
                   3891:                   }
                   3892:                   $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3893:               }
                   3894:           } else {
                   3895: 	      my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   3896: 	      if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   3897:                   $value = &$gradesub($value);
                   3898:               }
                   3899: 	      $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3900:           }
1.16      harris41 3901:       }
1.596     albertel 3902:       $prevattempts.= &end_data_table_row().&end_data_table();
1.1       albertel 3903:     } else {
1.596     albertel 3904:       $prevattempts=
                   3905: 	  &start_data_table().&start_data_table_row().
                   3906: 	  '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
                   3907: 	  &end_data_table_row().&end_data_table();
1.1       albertel 3908:     }
                   3909:   } else {
1.596     albertel 3910:     $prevattempts=
                   3911: 	  &start_data_table().&start_data_table_row().
                   3912: 	  '<td>'.&mt('No data.').'</td>'.
                   3913: 	  &end_data_table_row().&end_data_table();
1.1       albertel 3914:   }
1.10      albertel 3915: }
                   3916: 
1.581     albertel 3917: sub format_previous_attempt_value {
                   3918:     my ($key,$value) = @_;
1.1011    www      3919:     if (($key =~ /timestamp/) || ($key=~/duedate/)) {
1.581     albertel 3920: 	$value = &Apache::lonlocal::locallocaltime($value);
                   3921:     } elsif (ref($value) eq 'ARRAY') {
                   3922: 	$value = '('.join(', ', @{ $value }).')';
1.988     raeburn  3923:     } elsif ($key =~ /answerstring$/) {
                   3924:         my %answers = &Apache::lonnet::str2hash($value);
                   3925:         my @anskeys = sort(keys(%answers));
                   3926:         if (@anskeys == 1) {
                   3927:             my $answer = $answers{$anskeys[0]};
1.1001    raeburn  3928:             if ($answer =~ m{\0}) {
                   3929:                 $answer =~ s{\0}{,}g;
1.988     raeburn  3930:             }
                   3931:             my $tag_internal_answer_name = 'INTERNAL';
                   3932:             if ($anskeys[0] eq $tag_internal_answer_name) {
                   3933:                 $value = $answer; 
                   3934:             } else {
                   3935:                 $value = $anskeys[0].'='.$answer;
                   3936:             }
                   3937:         } else {
                   3938:             foreach my $ans (@anskeys) {
                   3939:                 my $answer = $answers{$ans};
1.1001    raeburn  3940:                 if ($answer =~ m{\0}) {
                   3941:                     $answer =~ s{\0}{,}g;
1.988     raeburn  3942:                 }
                   3943:                 $value .=  $ans.'='.$answer.'<br />';;
                   3944:             } 
                   3945:         }
1.581     albertel 3946:     } else {
                   3947: 	$value = &unescape($value);
                   3948:     }
                   3949:     return $value;
                   3950: }
                   3951: 
                   3952: 
1.107     albertel 3953: sub relative_to_absolute {
                   3954:     my ($url,$output)=@_;
                   3955:     my $parser=HTML::TokeParser->new(\$output);
                   3956:     my $token;
                   3957:     my $thisdir=$url;
                   3958:     my @rlinks=();
                   3959:     while ($token=$parser->get_token) {
                   3960: 	if ($token->[0] eq 'S') {
                   3961: 	    if ($token->[1] eq 'a') {
                   3962: 		if ($token->[2]->{'href'}) {
                   3963: 		    $rlinks[$#rlinks+1]=$token->[2]->{'href'};
                   3964: 		}
                   3965: 	    } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
                   3966: 		$rlinks[$#rlinks+1]=$token->[2]->{'src'};
                   3967: 	    } elsif ($token->[1] eq 'base') {
                   3968: 		$thisdir=$token->[2]->{'href'};
                   3969: 	    }
                   3970: 	}
                   3971:     }
                   3972:     $thisdir=~s-/[^/]*$--;
1.356     albertel 3973:     foreach my $link (@rlinks) {
1.726     raeburn  3974: 	unless (($link=~/^https?\:\/\//i) ||
1.356     albertel 3975: 		($link=~/^\//) ||
                   3976: 		($link=~/^javascript:/i) ||
                   3977: 		($link=~/^mailto:/i) ||
                   3978: 		($link=~/^\#/)) {
                   3979: 	    my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
                   3980: 	    $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107     albertel 3981: 	}
                   3982:     }
                   3983: # -------------------------------------------------- Deal with Applet codebases
                   3984:     $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
                   3985:     return $output;
                   3986: }
                   3987: 
1.112     bowersj2 3988: =pod
                   3989: 
1.648     raeburn  3990: =item * &get_student_view()
1.112     bowersj2 3991: 
                   3992: show a snapshot of what student was looking at
                   3993: 
                   3994: =cut
                   3995: 
1.10      albertel 3996: sub get_student_view {
1.186     albertel 3997:   my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114     www      3998:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 3999:   my (%form);
1.10      albertel 4000:   my @elements=('symb','courseid','domain','username');
                   4001:   foreach my $element (@elements) {
1.186     albertel 4002:       $form{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 4003:   }
1.186     albertel 4004:   if (defined($moreenv)) {
                   4005:       %form=(%form,%{$moreenv});
                   4006:   }
1.236     albertel 4007:   if (defined($target)) { $form{'grade_target'} = $target; }
1.107     albertel 4008:   $feedurl=&Apache::lonnet::clutter($feedurl);
1.650     www      4009:   my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11      albertel 4010:   $userview=~s/\<body[^\>]*\>//gi;
                   4011:   $userview=~s/\<\/body\>//gi;
                   4012:   $userview=~s/\<html\>//gi;
                   4013:   $userview=~s/\<\/html\>//gi;
                   4014:   $userview=~s/\<head\>//gi;
                   4015:   $userview=~s/\<\/head\>//gi;
                   4016:   $userview=~s/action\s*\=/would_be_action\=/gi;
1.107     albertel 4017:   $userview=&relative_to_absolute($feedurl,$userview);
1.650     www      4018:   if (wantarray) {
                   4019:      return ($userview,$response);
                   4020:   } else {
                   4021:      return $userview;
                   4022:   }
                   4023: }
                   4024: 
                   4025: sub get_student_view_with_retries {
                   4026:   my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
                   4027: 
                   4028:     my $ok = 0;                 # True if we got a good response.
                   4029:     my $content;
                   4030:     my $response;
                   4031: 
                   4032:     # Try to get the student_view done. within the retries count:
                   4033:     
                   4034:     do {
                   4035:          ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
                   4036:          $ok      = $response->is_success;
                   4037:          if (!$ok) {
                   4038:             &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
                   4039:          }
                   4040:          $retries--;
                   4041:     } while (!$ok && ($retries > 0));
                   4042:     
                   4043:     if (!$ok) {
                   4044:        $content = '';          # On error return an empty content.
                   4045:     }
1.651     www      4046:     if (wantarray) {
                   4047:        return ($content, $response);
                   4048:     } else {
                   4049:        return $content;
                   4050:     }
1.11      albertel 4051: }
                   4052: 
1.112     bowersj2 4053: =pod
                   4054: 
1.648     raeburn  4055: =item * &get_student_answers() 
1.112     bowersj2 4056: 
                   4057: show a snapshot of how student was answering problem
                   4058: 
                   4059: =cut
                   4060: 
1.11      albertel 4061: sub get_student_answers {
1.100     sakharuk 4062:   my ($symb,$username,$domain,$courseid,%form) = @_;
1.114     www      4063:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 4064:   my (%moreenv);
1.11      albertel 4065:   my @elements=('symb','courseid','domain','username');
                   4066:   foreach my $element (@elements) {
1.186     albertel 4067:     $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 4068:   }
1.186     albertel 4069:   $moreenv{'grade_target'}='answer';
                   4070:   %moreenv=(%form,%moreenv);
1.497     raeburn  4071:   $feedurl = &Apache::lonnet::clutter($feedurl);
                   4072:   my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10      albertel 4073:   return $userview;
1.1       albertel 4074: }
1.116     albertel 4075: 
                   4076: =pod
                   4077: 
                   4078: =item * &submlink()
                   4079: 
1.242     albertel 4080: Inputs: $text $uname $udom $symb $target
1.116     albertel 4081: 
                   4082: Returns: A link to grades.pm such as to see the SUBM view of a student
                   4083: 
                   4084: =cut
                   4085: 
                   4086: ###############################################
                   4087: sub submlink {
1.242     albertel 4088:     my ($text,$uname,$udom,$symb,$target)=@_;
1.116     albertel 4089:     if (!($uname && $udom)) {
                   4090: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 4091: 	    &Apache::lonnet::whichuser($symb);
1.116     albertel 4092: 	if (!$symb) { $symb=$cursymb; }
                   4093:     }
1.254     matthew  4094:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      4095:     $symb=&escape($symb);
1.960     bisitz   4096:     if ($target) { $target=" target=\"$target\""; }
                   4097:     return
                   4098:         '<a href="/adm/grades?command=submission'.
                   4099:         '&amp;symb='.$symb.
                   4100:         '&amp;student='.$uname.
                   4101:         '&amp;userdom='.$udom.'"'.
                   4102:         $target.'>'.$text.'</a>';
1.242     albertel 4103: }
                   4104: ##############################################
                   4105: 
                   4106: =pod
                   4107: 
                   4108: =item * &pgrdlink()
                   4109: 
                   4110: Inputs: $text $uname $udom $symb $target
                   4111: 
                   4112: Returns: A link to grades.pm such as to see the PGRD view of a student
                   4113: 
                   4114: =cut
                   4115: 
                   4116: ###############################################
                   4117: sub pgrdlink {
                   4118:     my $link=&submlink(@_);
                   4119:     $link=~s/(&command=submission)/$1&showgrading=yes/;
                   4120:     return $link;
                   4121: }
                   4122: ##############################################
                   4123: 
                   4124: =pod
                   4125: 
                   4126: =item * &pprmlink()
                   4127: 
                   4128: Inputs: $text $uname $udom $symb $target
                   4129: 
                   4130: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283     albertel 4131: student and a specific resource
1.242     albertel 4132: 
                   4133: =cut
                   4134: 
                   4135: ###############################################
                   4136: sub pprmlink {
                   4137:     my ($text,$uname,$udom,$symb,$target)=@_;
                   4138:     if (!($uname && $udom)) {
                   4139: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 4140: 	    &Apache::lonnet::whichuser($symb);
1.242     albertel 4141: 	if (!$symb) { $symb=$cursymb; }
                   4142:     }
1.254     matthew  4143:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      4144:     $symb=&escape($symb);
1.242     albertel 4145:     if ($target) { $target="target=\"$target\""; }
1.595     albertel 4146:     return '<a href="/adm/parmset?command=set&amp;'.
                   4147: 	'symb='.$symb.'&amp;uname='.$uname.
                   4148: 	'&amp;udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116     albertel 4149: }
                   4150: ##############################################
1.37      matthew  4151: 
1.112     bowersj2 4152: =pod
                   4153: 
                   4154: =back
                   4155: 
                   4156: =cut
                   4157: 
1.37      matthew  4158: ###############################################
1.51      www      4159: 
                   4160: 
                   4161: sub timehash {
1.687     raeburn  4162:     my ($thistime) = @_;
                   4163:     my $timezone = &Apache::lonlocal::gettimezone();
                   4164:     my $dt = DateTime->from_epoch(epoch => $thistime)
                   4165:                      ->set_time_zone($timezone);
                   4166:     my $wday = $dt->day_of_week();
                   4167:     if ($wday == 7) { $wday = 0; }
                   4168:     return ( 'second' => $dt->second(),
                   4169:              'minute' => $dt->minute(),
                   4170:              'hour'   => $dt->hour(),
                   4171:              'day'     => $dt->day_of_month(),
                   4172:              'month'   => $dt->month(),
                   4173:              'year'    => $dt->year(),
                   4174:              'weekday' => $wday,
                   4175:              'dayyear' => $dt->day_of_year(),
                   4176:              'dlsav'   => $dt->is_dst() );
1.51      www      4177: }
                   4178: 
1.370     www      4179: sub utc_string {
                   4180:     my ($date)=@_;
1.371     www      4181:     return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370     www      4182: }
                   4183: 
1.51      www      4184: sub maketime {
                   4185:     my %th=@_;
1.687     raeburn  4186:     my ($epoch_time,$timezone,$dt);
                   4187:     $timezone = &Apache::lonlocal::gettimezone();
                   4188:     eval {
                   4189:         $dt = DateTime->new( year   => $th{'year'},
                   4190:                              month  => $th{'month'},
                   4191:                              day    => $th{'day'},
                   4192:                              hour   => $th{'hour'},
                   4193:                              minute => $th{'minute'},
                   4194:                              second => $th{'second'},
                   4195:                              time_zone => $timezone,
                   4196:                          );
                   4197:     };
                   4198:     if (!$@) {
                   4199:         $epoch_time = $dt->epoch;
                   4200:         if ($epoch_time) {
                   4201:             return $epoch_time;
                   4202:         }
                   4203:     }
1.51      www      4204:     return POSIX::mktime(
                   4205:         ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210     www      4206:          $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70      www      4207: }
                   4208: 
                   4209: #########################################
1.51      www      4210: 
                   4211: sub findallcourses {
1.482     raeburn  4212:     my ($roles,$uname,$udom) = @_;
1.355     albertel 4213:     my %roles;
                   4214:     if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348     albertel 4215:     my %courses;
1.51      www      4216:     my $now=time;
1.482     raeburn  4217:     if (!defined($uname)) {
                   4218:         $uname = $env{'user.name'};
                   4219:     }
                   4220:     if (!defined($udom)) {
                   4221:         $udom = $env{'user.domain'};
                   4222:     }
                   4223:     if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.1073    raeburn  4224:         my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
1.482     raeburn  4225:         if (!%roles) {
                   4226:             %roles = (
                   4227:                        cc => 1,
1.907     raeburn  4228:                        co => 1,
1.482     raeburn  4229:                        in => 1,
                   4230:                        ep => 1,
                   4231:                        ta => 1,
                   4232:                        cr => 1,
                   4233:                        st => 1,
                   4234:              );
                   4235:         }
                   4236:         foreach my $entry (keys(%roleshash)) {
                   4237:             my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
                   4238:             if ($trole =~ /^cr/) { 
                   4239:                 next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
                   4240:             } else {
                   4241:                 next if (!exists($roles{$trole}));
                   4242:             }
                   4243:             if ($tend) {
                   4244:                 next if ($tend < $now);
                   4245:             }
                   4246:             if ($tstart) {
                   4247:                 next if ($tstart > $now);
                   4248:             }
1.1058    raeburn  4249:             my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role);
1.482     raeburn  4250:             (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
1.1058    raeburn  4251:             my $value = $trole.'/'.$cdom.'/';
1.482     raeburn  4252:             if ($secpart eq '') {
                   4253:                 ($cnum,$role) = split(/_/,$cnumpart); 
                   4254:                 $sec = 'none';
1.1058    raeburn  4255:                 $value .= $cnum.'/';
1.482     raeburn  4256:             } else {
                   4257:                 $cnum = $cnumpart;
                   4258:                 ($sec,$role) = split(/_/,$secpart);
1.1058    raeburn  4259:                 $value .= $cnum.'/'.$sec;
                   4260:             }
                   4261:             if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
                   4262:                 unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
                   4263:                     push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
                   4264:                 }
                   4265:             } else {
                   4266:                 @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.490     raeburn  4267:             }
1.482     raeburn  4268:         }
                   4269:     } else {
                   4270:         foreach my $key (keys(%env)) {
1.483     albertel 4271: 	    if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
                   4272:                  $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482     raeburn  4273: 	        my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
                   4274: 	        next if ($role eq 'ca' || $role eq 'aa');
                   4275: 	        next if (%roles && !exists($roles{$role}));
                   4276: 	        my ($starttime,$endtime)=split(/\./,$env{$key});
                   4277:                 my $active=1;
                   4278:                 if ($starttime) {
                   4279: 		    if ($now<$starttime) { $active=0; }
                   4280:                 }
                   4281:                 if ($endtime) {
                   4282:                     if ($now>$endtime) { $active=0; }
                   4283:                 }
                   4284:                 if ($active) {
1.1058    raeburn  4285:                     my $value = $role.'/'.$cdom.'/'.$cnum.'/';
1.482     raeburn  4286:                     if ($sec eq '') {
                   4287:                         $sec = 'none';
1.1058    raeburn  4288:                     } else {
                   4289:                         $value .= $sec;
                   4290:                     }
                   4291:                     if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
                   4292:                         unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
                   4293:                             push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
                   4294:                         }
                   4295:                     } else {
                   4296:                         @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.482     raeburn  4297:                     }
1.474     raeburn  4298:                 }
                   4299:             }
1.51      www      4300:         }
                   4301:     }
1.474     raeburn  4302:     return %courses;
1.51      www      4303: }
1.37      matthew  4304: 
1.54      www      4305: ###############################################
1.474     raeburn  4306: 
                   4307: sub blockcheck {
1.1075.2.73  raeburn  4308:     my ($setters,$activity,$uname,$udom,$url,$is_course) = @_;
1.490     raeburn  4309: 
1.1075.2.73  raeburn  4310:     if (defined($udom) && defined($uname)) {
                   4311:         # If uname and udom are for a course, check for blocks in the course.
                   4312:         if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) {
                   4313:             my ($startblock,$endblock,$triggerblock) =
                   4314:                 &get_blocks($setters,$activity,$udom,$uname,$url);
                   4315:             return ($startblock,$endblock,$triggerblock);
                   4316:         }
                   4317:     } else {
1.490     raeburn  4318:         $udom = $env{'user.domain'};
                   4319:         $uname = $env{'user.name'};
                   4320:     }
                   4321: 
1.502     raeburn  4322:     my $startblock = 0;
                   4323:     my $endblock = 0;
1.1062    raeburn  4324:     my $triggerblock = '';
1.482     raeburn  4325:     my %live_courses = &findallcourses(undef,$uname,$udom);
1.474     raeburn  4326: 
1.490     raeburn  4327:     # If uname is for a user, and activity is course-specific, i.e.,
                   4328:     # boards, chat or groups, check for blocking in current course only.
1.474     raeburn  4329: 
1.490     raeburn  4330:     if (($activity eq 'boards' || $activity eq 'chat' ||
1.1075.2.73  raeburn  4331:          $activity eq 'groups' || $activity eq 'printout') &&
                   4332:         ($env{'request.course.id'})) {
1.490     raeburn  4333:         foreach my $key (keys(%live_courses)) {
                   4334:             if ($key ne $env{'request.course.id'}) {
                   4335:                 delete($live_courses{$key});
                   4336:             }
                   4337:         }
                   4338:     }
                   4339: 
                   4340:     my $otheruser = 0;
                   4341:     my %own_courses;
                   4342:     if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
                   4343:         # Resource belongs to user other than current user.
                   4344:         $otheruser = 1;
                   4345:         # Gather courses for current user
                   4346:         %own_courses = 
                   4347:             &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
                   4348:     }
                   4349: 
                   4350:     # Gather active course roles - course coordinator, instructor, 
                   4351:     # exam proctor, ta, student, or custom role.
1.474     raeburn  4352: 
                   4353:     foreach my $course (keys(%live_courses)) {
1.482     raeburn  4354:         my ($cdom,$cnum);
                   4355:         if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
                   4356:             $cdom = $env{'course.'.$course.'.domain'};
                   4357:             $cnum = $env{'course.'.$course.'.num'};
                   4358:         } else {
1.490     raeburn  4359:             ($cdom,$cnum) = split(/_/,$course); 
1.482     raeburn  4360:         }
                   4361:         my $no_ownblock = 0;
                   4362:         my $no_userblock = 0;
1.533     raeburn  4363:         if ($otheruser && $activity ne 'com') {
1.490     raeburn  4364:             # Check if current user has 'evb' priv for this
                   4365:             if (defined($own_courses{$course})) {
                   4366:                 foreach my $sec (keys(%{$own_courses{$course}})) {
                   4367:                     my $checkrole = 'cm./'.$cdom.'/'.$cnum;
                   4368:                     if ($sec ne 'none') {
                   4369:                         $checkrole .= '/'.$sec;
                   4370:                     }
                   4371:                     if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   4372:                         $no_ownblock = 1;
                   4373:                         last;
                   4374:                     }
                   4375:                 }
                   4376:             }
                   4377:             # if they have 'evb' priv and are currently not playing student
                   4378:             next if (($no_ownblock) &&
                   4379:                  ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
                   4380:         }
1.474     raeburn  4381:         foreach my $sec (keys(%{$live_courses{$course}})) {
1.482     raeburn  4382:             my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474     raeburn  4383:             if ($sec ne 'none') {
1.482     raeburn  4384:                 $checkrole .= '/'.$sec;
1.474     raeburn  4385:             }
1.490     raeburn  4386:             if ($otheruser) {
                   4387:                 # Resource belongs to user other than current user.
                   4388:                 # Assemble privs for that user, and check for 'evb' priv.
1.1058    raeburn  4389:                 my (%allroles,%userroles);
                   4390:                 if (ref($live_courses{$course}{$sec}) eq 'ARRAY') {
                   4391:                     foreach my $entry (@{$live_courses{$course}{$sec}}) { 
                   4392:                         my ($trole,$tdom,$tnum,$tsec);
                   4393:                         if ($entry =~ /^cr/) {
                   4394:                             ($trole,$tdom,$tnum,$tsec) = 
                   4395:                                 ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
                   4396:                         } else {
                   4397:                            ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
                   4398:                         }
                   4399:                         my ($spec,$area,$trest);
                   4400:                         $area = '/'.$tdom.'/'.$tnum;
                   4401:                         $trest = $tnum;
                   4402:                         if ($tsec ne '') {
                   4403:                             $area .= '/'.$tsec;
                   4404:                             $trest .= '/'.$tsec;
                   4405:                         }
                   4406:                         $spec = $trole.'.'.$area;
                   4407:                         if ($trole =~ /^cr/) {
                   4408:                             &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
                   4409:                                                               $tdom,$spec,$trest,$area);
                   4410:                         } else {
                   4411:                             &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
                   4412:                                                                 $tdom,$spec,$trest,$area);
                   4413:                         }
                   4414:                     }
                   4415:                     my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
                   4416:                     if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
                   4417:                         if ($1) {
                   4418:                             $no_userblock = 1;
                   4419:                             last;
                   4420:                         }
1.486     raeburn  4421:                     }
                   4422:                 }
1.490     raeburn  4423:             } else {
                   4424:                 # Resource belongs to current user
                   4425:                 # Check for 'evb' priv via lonnet::allowed().
1.482     raeburn  4426:                 if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   4427:                     $no_ownblock = 1;
                   4428:                     last;
                   4429:                 }
1.474     raeburn  4430:             }
                   4431:         }
                   4432:         # if they have the evb priv and are currently not playing student
1.482     raeburn  4433:         next if (($no_ownblock) &&
1.491     albertel 4434:                  ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482     raeburn  4435:         next if ($no_userblock);
1.474     raeburn  4436: 
1.866     kalberla 4437:         # Retrieve blocking times and identity of locker for course
1.490     raeburn  4438:         # of specified user, unless user has 'evb' privilege.
1.502     raeburn  4439:         
1.1062    raeburn  4440:         my ($start,$end,$trigger) = 
                   4441:             &get_blocks($setters,$activity,$cdom,$cnum,$url);
1.502     raeburn  4442:         if (($start != 0) && 
                   4443:             (($startblock == 0) || ($startblock > $start))) {
                   4444:             $startblock = $start;
1.1062    raeburn  4445:             if ($trigger ne '') {
                   4446:                 $triggerblock = $trigger;
                   4447:             }
1.502     raeburn  4448:         }
                   4449:         if (($end != 0)  &&
                   4450:             (($endblock == 0) || ($endblock < $end))) {
                   4451:             $endblock = $end;
1.1062    raeburn  4452:             if ($trigger ne '') {
                   4453:                 $triggerblock = $trigger;
                   4454:             }
1.502     raeburn  4455:         }
1.490     raeburn  4456:     }
1.1062    raeburn  4457:     return ($startblock,$endblock,$triggerblock);
1.490     raeburn  4458: }
                   4459: 
                   4460: sub get_blocks {
1.1062    raeburn  4461:     my ($setters,$activity,$cdom,$cnum,$url) = @_;
1.490     raeburn  4462:     my $startblock = 0;
                   4463:     my $endblock = 0;
1.1062    raeburn  4464:     my $triggerblock = '';
1.490     raeburn  4465:     my $course = $cdom.'_'.$cnum;
                   4466:     $setters->{$course} = {};
                   4467:     $setters->{$course}{'staff'} = [];
                   4468:     $setters->{$course}{'times'} = [];
1.1062    raeburn  4469:     $setters->{$course}{'triggers'} = [];
                   4470:     my (@blockers,%triggered);
                   4471:     my $now = time;
                   4472:     my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
                   4473:     if ($activity eq 'docs') {
                   4474:         @blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks);
                   4475:         foreach my $block (@blockers) {
                   4476:             if ($block =~ /^firstaccess____(.+)$/) {
                   4477:                 my $item = $1;
                   4478:                 my $type = 'map';
                   4479:                 my $timersymb = $item;
                   4480:                 if ($item eq 'course') {
                   4481:                     $type = 'course';
                   4482:                 } elsif ($item =~ /___\d+___/) {
                   4483:                     $type = 'resource';
                   4484:                 } else {
                   4485:                     $timersymb = &Apache::lonnet::symbread($item);
                   4486:                 }
                   4487:                 my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
                   4488:                 my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
                   4489:                 $triggered{$block} = {
                   4490:                                        start => $start,
                   4491:                                        end   => $end,
                   4492:                                        type  => $type,
                   4493:                                      };
                   4494:             }
                   4495:         }
                   4496:     } else {
                   4497:         foreach my $block (keys(%commblocks)) {
                   4498:             if ($block =~ m/^(\d+)____(\d+)$/) { 
                   4499:                 my ($start,$end) = ($1,$2);
                   4500:                 if ($start <= time && $end >= time) {
                   4501:                     if (ref($commblocks{$block}) eq 'HASH') {
                   4502:                         if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
                   4503:                             if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
                   4504:                                 unless(grep(/^\Q$block\E$/,@blockers)) {
                   4505:                                     push(@blockers,$block);
                   4506:                                 }
                   4507:                             }
                   4508:                         }
                   4509:                     }
                   4510:                 }
                   4511:             } elsif ($block =~ /^firstaccess____(.+)$/) {
                   4512:                 my $item = $1;
                   4513:                 my $timersymb = $item; 
                   4514:                 my $type = 'map';
                   4515:                 if ($item eq 'course') {
                   4516:                     $type = 'course';
                   4517:                 } elsif ($item =~ /___\d+___/) {
                   4518:                     $type = 'resource';
                   4519:                 } else {
                   4520:                     $timersymb = &Apache::lonnet::symbread($item);
                   4521:                 }
                   4522:                 my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
                   4523:                 my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb}; 
                   4524:                 if ($start && $end) {
                   4525:                     if (($start <= time) && ($end >= time)) {
                   4526:                         unless (grep(/^\Q$block\E$/,@blockers)) {
                   4527:                             push(@blockers,$block);
                   4528:                             $triggered{$block} = {
                   4529:                                                    start => $start,
                   4530:                                                    end   => $end,
                   4531:                                                    type  => $type,
                   4532:                                                  };
                   4533:                         }
                   4534:                     }
1.490     raeburn  4535:                 }
1.1062    raeburn  4536:             }
                   4537:         }
                   4538:     }
                   4539:     foreach my $blocker (@blockers) {
                   4540:         my ($staff_name,$staff_dom,$title,$blocks) =
                   4541:             &parse_block_record($commblocks{$blocker});
                   4542:         push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
                   4543:         my ($start,$end,$triggertype);
                   4544:         if ($blocker =~ m/^(\d+)____(\d+)$/) {
                   4545:             ($start,$end) = ($1,$2);
                   4546:         } elsif (ref($triggered{$blocker}) eq 'HASH') {
                   4547:             $start = $triggered{$blocker}{'start'};
                   4548:             $end = $triggered{$blocker}{'end'};
                   4549:             $triggertype = $triggered{$blocker}{'type'};
                   4550:         }
                   4551:         if ($start) {
                   4552:             push(@{$$setters{$course}{'times'}}, [$start,$end]);
                   4553:             if ($triggertype) {
                   4554:                 push(@{$$setters{$course}{'triggers'}},$triggertype);
                   4555:             } else {
                   4556:                 push(@{$$setters{$course}{'triggers'}},0);
                   4557:             }
                   4558:             if ( ($startblock == 0) || ($startblock > $start) ) {
                   4559:                 $startblock = $start;
                   4560:                 if ($triggertype) {
                   4561:                     $triggerblock = $blocker;
1.474     raeburn  4562:                 }
                   4563:             }
1.1062    raeburn  4564:             if ( ($endblock == 0) || ($endblock < $end) ) {
                   4565:                $endblock = $end;
                   4566:                if ($triggertype) {
                   4567:                    $triggerblock = $blocker;
                   4568:                }
                   4569:             }
1.474     raeburn  4570:         }
                   4571:     }
1.1062    raeburn  4572:     return ($startblock,$endblock,$triggerblock);
1.474     raeburn  4573: }
                   4574: 
                   4575: sub parse_block_record {
                   4576:     my ($record) = @_;
                   4577:     my ($setuname,$setudom,$title,$blocks);
                   4578:     if (ref($record) eq 'HASH') {
                   4579:         ($setuname,$setudom) = split(/:/,$record->{'setter'});
                   4580:         $title = &unescape($record->{'event'});
                   4581:         $blocks = $record->{'blocks'};
                   4582:     } else {
                   4583:         my @data = split(/:/,$record,3);
                   4584:         if (scalar(@data) eq 2) {
                   4585:             $title = $data[1];
                   4586:             ($setuname,$setudom) = split(/@/,$data[0]);
                   4587:         } else {
                   4588:             ($setuname,$setudom,$title) = @data;
                   4589:         }
                   4590:         $blocks = { 'com' => 'on' };
                   4591:     }
                   4592:     return ($setuname,$setudom,$title,$blocks);
                   4593: }
                   4594: 
1.854     kalberla 4595: sub blocking_status {
1.1075.2.73  raeburn  4596:     my ($activity,$uname,$udom,$url,$is_course) = @_;
1.1061    raeburn  4597:     my %setters;
1.890     droeschl 4598: 
1.1061    raeburn  4599: # check for active blocking
1.1062    raeburn  4600:     my ($startblock,$endblock,$triggerblock) = 
1.1075.2.73  raeburn  4601:         &blockcheck(\%setters,$activity,$uname,$udom,$url,$is_course);
1.1062    raeburn  4602:     my $blocked = 0;
                   4603:     if ($startblock && $endblock) {
                   4604:         $blocked = 1;
                   4605:     }
1.890     droeschl 4606: 
1.1061    raeburn  4607: # caller just wants to know whether a block is active
                   4608:     if (!wantarray) { return $blocked; }
                   4609: 
                   4610: # build a link to a popup window containing the details
                   4611:     my $querystring  = "?activity=$activity";
                   4612: # $uname and $udom decide whose portfolio the user is trying to look at
1.1062    raeburn  4613:     if ($activity eq 'port') {
                   4614:         $querystring .= "&amp;udom=$udom"      if $udom;
                   4615:         $querystring .= "&amp;uname=$uname"    if $uname;
                   4616:     } elsif ($activity eq 'docs') {
                   4617:         $querystring .= '&amp;url='.&HTML::Entities::encode($url,'&"');
                   4618:     }
1.1061    raeburn  4619: 
                   4620:     my $output .= <<'END_MYBLOCK';
                   4621: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
                   4622:     var options = "width=" + w + ",height=" + h + ",";
                   4623:     options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
                   4624:     options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
                   4625:     var newWin = window.open(url, wdwName, options);
                   4626:     newWin.focus();
                   4627: }
1.890     droeschl 4628: END_MYBLOCK
1.854     kalberla 4629: 
1.1061    raeburn  4630:     $output = Apache::lonhtmlcommon::scripttag($output);
1.890     droeschl 4631:   
1.1061    raeburn  4632:     my $popupUrl = "/adm/blockingstatus/$querystring";
1.1062    raeburn  4633:     my $text = &mt('Communication Blocked');
                   4634:     if ($activity eq 'docs') {
                   4635:         $text = &mt('Content Access Blocked');
1.1063    raeburn  4636:     } elsif ($activity eq 'printout') {
                   4637:         $text = &mt('Printing Blocked');
1.1062    raeburn  4638:     }
1.1061    raeburn  4639:     $output .= <<"END_BLOCK";
1.867     kalberla 4640: <div class='LC_comblock'>
1.869     kalberla 4641:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890     droeschl 4642:   title='$text'>
                   4643:   <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869     kalberla 4644:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring' 
1.890     droeschl 4645:   title='$text'>$text</a>
1.867     kalberla 4646: </div>
                   4647: 
                   4648: END_BLOCK
1.474     raeburn  4649: 
1.1061    raeburn  4650:     return ($blocked, $output);
1.854     kalberla 4651: }
1.490     raeburn  4652: 
1.60      matthew  4653: ###############################################
                   4654: 
1.682     raeburn  4655: sub check_ip_acc {
                   4656:     my ($acc)=@_;
                   4657:     &Apache::lonxml::debug("acc is $acc");
                   4658:     if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
                   4659:         return 1;
                   4660:     }
                   4661:     my $allowed=0;
                   4662:     my $ip=$env{'request.host'} || $ENV{'REMOTE_ADDR'};
                   4663: 
                   4664:     my $name;
                   4665:     foreach my $pattern (split(',',$acc)) {
                   4666:         $pattern =~ s/^\s*//;
                   4667:         $pattern =~ s/\s*$//;
                   4668:         if ($pattern =~ /\*$/) {
                   4669:             #35.8.*
                   4670:             $pattern=~s/\*//;
                   4671:             if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
                   4672:         } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
                   4673:             #35.8.3.[34-56]
                   4674:             my $low=$2;
                   4675:             my $high=$3;
                   4676:             $pattern=$1;
                   4677:             if ($ip =~ /^\Q$pattern\E/) {
                   4678:                 my $last=(split(/\./,$ip))[3];
                   4679:                 if ($last <=$high && $last >=$low) { $allowed=1; }
                   4680:             }
                   4681:         } elsif ($pattern =~ /^\*/) {
                   4682:             #*.msu.edu
                   4683:             $pattern=~s/\*//;
                   4684:             if (!defined($name)) {
                   4685:                 use Socket;
                   4686:                 my $netaddr=inet_aton($ip);
                   4687:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   4688:             }
                   4689:             if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
                   4690:         } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
                   4691:             #127.0.0.1
                   4692:             if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
                   4693:         } else {
                   4694:             #some.name.com
                   4695:             if (!defined($name)) {
                   4696:                 use Socket;
                   4697:                 my $netaddr=inet_aton($ip);
                   4698:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   4699:             }
                   4700:             if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
                   4701:         }
                   4702:         if ($allowed) { last; }
                   4703:     }
                   4704:     return $allowed;
                   4705: }
                   4706: 
                   4707: ###############################################
                   4708: 
1.60      matthew  4709: =pod
                   4710: 
1.112     bowersj2 4711: =head1 Domain Template Functions
                   4712: 
                   4713: =over 4
                   4714: 
                   4715: =item * &determinedomain()
1.60      matthew  4716: 
                   4717: Inputs: $domain (usually will be undef)
                   4718: 
1.63      www      4719: Returns: Determines which domain should be used for designs
1.60      matthew  4720: 
                   4721: =cut
1.54      www      4722: 
1.60      matthew  4723: ###############################################
1.63      www      4724: sub determinedomain {
                   4725:     my $domain=shift;
1.531     albertel 4726:     if (! $domain) {
1.60      matthew  4727:         # Determine domain if we have not been given one
1.893     raeburn  4728:         $domain = &Apache::lonnet::default_login_domain();
1.258     albertel 4729:         if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
                   4730:         if ($env{'request.role.domain'}) { 
                   4731:             $domain=$env{'request.role.domain'}; 
1.60      matthew  4732:         }
                   4733:     }
1.63      www      4734:     return $domain;
                   4735: }
                   4736: ###############################################
1.517     raeburn  4737: 
1.518     albertel 4738: sub devalidate_domconfig_cache {
                   4739:     my ($udom)=@_;
                   4740:     &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
                   4741: }
                   4742: 
                   4743: # ---------------------- Get domain configuration for a domain
                   4744: sub get_domainconf {
                   4745:     my ($udom) = @_;
                   4746:     my $cachetime=1800;
                   4747:     my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
                   4748:     if (defined($cached)) { return %{$result}; }
                   4749: 
                   4750:     my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948     raeburn  4751: 					     ['login','rolecolors','autoenroll'],$udom);
1.632     raeburn  4752:     my (%designhash,%legacy);
1.518     albertel 4753:     if (keys(%domconfig) > 0) {
                   4754:         if (ref($domconfig{'login'}) eq 'HASH') {
1.632     raeburn  4755:             if (keys(%{$domconfig{'login'}})) {
                   4756:                 foreach my $key (keys(%{$domconfig{'login'}})) {
1.699     raeburn  4757:                     if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.1075.2.87! raeburn  4758:                         if (($key eq 'loginvia') || ($key eq 'headtag')) {
        !          4759:                             if (ref($domconfig{'login'}{$key}) eq 'HASH') {
        !          4760:                                 foreach my $hostname (keys(%{$domconfig{'login'}{$key}})) {
        !          4761:                                     if (ref($domconfig{'login'}{$key}{$hostname}) eq 'HASH') {
        !          4762:                                         if ($key eq 'loginvia') {
        !          4763:                                             if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
        !          4764:                                                 my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
        !          4765:                                                 $designhash{$udom.'.login.loginvia'} = $server;
        !          4766:                                                 if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
        !          4767:                                                     $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
        !          4768:                                                 } else {
        !          4769:                                                     $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
        !          4770:                                                 }
1.948     raeburn  4771:                                             }
1.1075.2.87! raeburn  4772:                                         } elsif ($key eq 'headtag') {
        !          4773:                                             if ($domconfig{'login'}{'headtag'}{$hostname}{'url'}) {
        !          4774:                                                 $designhash{$udom.'.login.headtag_'.$hostname} = $domconfig{'login'}{'headtag'}{$hostname}{'url'};
1.948     raeburn  4775:                                             }
1.946     raeburn  4776:                                         }
1.1075.2.87! raeburn  4777:                                         if ($domconfig{'login'}{$key}{$hostname}{'exempt'}) {
        !          4778:                                             $designhash{$udom.'.login.'.$key.'_exempt_'.$hostname} = $domconfig{'login'}{$key}{$hostname}{'exempt'};
        !          4779:                                         }
1.946     raeburn  4780:                                     }
                   4781:                                 }
                   4782:                             }
                   4783:                         } else {
                   4784:                             foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
                   4785:                                 $designhash{$udom.'.login.'.$key.'_'.$img} = 
                   4786:                                     $domconfig{'login'}{$key}{$img};
                   4787:                             }
1.699     raeburn  4788:                         }
                   4789:                     } else {
                   4790:                         $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
                   4791:                     }
1.632     raeburn  4792:                 }
                   4793:             } else {
                   4794:                 $legacy{'login'} = 1;
1.518     albertel 4795:             }
1.632     raeburn  4796:         } else {
                   4797:             $legacy{'login'} = 1;
1.518     albertel 4798:         }
                   4799:         if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632     raeburn  4800:             if (keys(%{$domconfig{'rolecolors'}})) {
                   4801:                 foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
                   4802:                     if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
                   4803:                         foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
                   4804:                             $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
                   4805:                         }
1.518     albertel 4806:                     }
                   4807:                 }
1.632     raeburn  4808:             } else {
                   4809:                 $legacy{'rolecolors'} = 1;
1.518     albertel 4810:             }
1.632     raeburn  4811:         } else {
                   4812:             $legacy{'rolecolors'} = 1;
1.518     albertel 4813:         }
1.948     raeburn  4814:         if (ref($domconfig{'autoenroll'}) eq 'HASH') {
                   4815:             if ($domconfig{'autoenroll'}{'co-owners'}) {
                   4816:                 $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
                   4817:             }
                   4818:         }
1.632     raeburn  4819:         if (keys(%legacy) > 0) {
                   4820:             my %legacyhash = &get_legacy_domconf($udom);
                   4821:             foreach my $item (keys(%legacyhash)) {
                   4822:                 if ($item =~ /^\Q$udom\E\.login/) {
                   4823:                     if ($legacy{'login'}) { 
                   4824:                         $designhash{$item} = $legacyhash{$item};
                   4825:                     }
                   4826:                 } else {
                   4827:                     if ($legacy{'rolecolors'}) {
                   4828:                         $designhash{$item} = $legacyhash{$item};
                   4829:                     }
1.518     albertel 4830:                 }
                   4831:             }
                   4832:         }
1.632     raeburn  4833:     } else {
                   4834:         %designhash = &get_legacy_domconf($udom); 
1.518     albertel 4835:     }
                   4836:     &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
                   4837: 				  $cachetime);
                   4838:     return %designhash;
                   4839: }
                   4840: 
1.632     raeburn  4841: sub get_legacy_domconf {
                   4842:     my ($udom) = @_;
                   4843:     my %legacyhash;
                   4844:     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
                   4845:     my $designfile =  $designdir.'/'.$udom.'.tab';
                   4846:     if (-e $designfile) {
                   4847:         if ( open (my $fh,"<$designfile") ) {
                   4848:             while (my $line = <$fh>) {
                   4849:                 next if ($line =~ /^\#/);
                   4850:                 chomp($line);
                   4851:                 my ($key,$val)=(split(/\=/,$line));
                   4852:                 if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
                   4853:             }
                   4854:             close($fh);
                   4855:         }
                   4856:     }
1.1026    raeburn  4857:     if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
1.632     raeburn  4858:         $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
                   4859:     }
                   4860:     return %legacyhash;
                   4861: }
                   4862: 
1.63      www      4863: =pod
                   4864: 
1.112     bowersj2 4865: =item * &domainlogo()
1.63      www      4866: 
                   4867: Inputs: $domain (usually will be undef)
                   4868: 
                   4869: Returns: A link to a domain logo, if the domain logo exists.
                   4870: If the domain logo does not exist, a description of the domain.
                   4871: 
                   4872: =cut
1.112     bowersj2 4873: 
1.63      www      4874: ###############################################
                   4875: sub domainlogo {
1.517     raeburn  4876:     my $domain = &determinedomain(shift);
1.518     albertel 4877:     my %designhash = &get_domainconf($domain);    
1.517     raeburn  4878:     # See if there is a logo
                   4879:     if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519     raeburn  4880:         my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538     albertel 4881:         if ($imgsrc =~ m{^/(adm|res)/}) {
                   4882: 	    if ($imgsrc =~ m{^/res/}) {
                   4883: 		my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
                   4884: 		&Apache::lonnet::repcopy($local_name);
                   4885: 	    }
                   4886: 	   $imgsrc = &lonhttpdurl($imgsrc);
1.519     raeburn  4887:         } 
                   4888:         return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514     albertel 4889:     } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
                   4890:         return &Apache::lonnet::domain($domain,'description');
1.59      www      4891:     } else {
1.60      matthew  4892:         return '';
1.59      www      4893:     }
                   4894: }
1.63      www      4895: ##############################################
                   4896: 
                   4897: =pod
                   4898: 
1.112     bowersj2 4899: =item * &designparm()
1.63      www      4900: 
                   4901: Inputs: $which parameter; $domain (usually will be undef)
                   4902: 
                   4903: Returns: value of designparamter $which
                   4904: 
                   4905: =cut
1.112     bowersj2 4906: 
1.397     albertel 4907: 
1.400     albertel 4908: ##############################################
1.397     albertel 4909: sub designparm {
                   4910:     my ($which,$domain)=@_;
                   4911:     if (exists($env{'environment.color.'.$which})) {
1.817     bisitz   4912:         return $env{'environment.color.'.$which};
1.96      www      4913:     }
1.63      www      4914:     $domain=&determinedomain($domain);
1.1016    raeburn  4915:     my %domdesign;
                   4916:     unless ($domain eq 'public') {
                   4917:         %domdesign = &get_domainconf($domain);
                   4918:     }
1.520     raeburn  4919:     my $output;
1.517     raeburn  4920:     if ($domdesign{$domain.'.'.$which} ne '') {
1.817     bisitz   4921:         $output = $domdesign{$domain.'.'.$which};
1.63      www      4922:     } else {
1.520     raeburn  4923:         $output = $defaultdesign{$which};
                   4924:     }
                   4925:     if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635     raeburn  4926:         ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538     albertel 4927:         if ($output =~ m{^/(adm|res)/}) {
1.817     bisitz   4928:             if ($output =~ m{^/res/}) {
                   4929:                 my $local_name = &Apache::lonnet::filelocation('',$output);
                   4930:                 &Apache::lonnet::repcopy($local_name);
                   4931:             }
1.520     raeburn  4932:             $output = &lonhttpdurl($output);
                   4933:         }
1.63      www      4934:     }
1.520     raeburn  4935:     return $output;
1.63      www      4936: }
1.59      www      4937: 
1.822     bisitz   4938: ##############################################
                   4939: =pod
                   4940: 
1.832     bisitz   4941: =item * &authorspace()
                   4942: 
1.1028    raeburn  4943: Inputs: $url (usually will be undef).
1.832     bisitz   4944: 
1.1075.2.40  raeburn  4945: Returns: Path to Authoring Space containing the resource or 
1.1028    raeburn  4946:          directory being viewed (or for which action is being taken). 
                   4947:          If $url is provided, and begins /priv/<domain>/<uname>
                   4948:          the path will be that portion of the $context argument.
                   4949:          Otherwise the path will be for the author space of the current
                   4950:          user when the current role is author, or for that of the 
                   4951:          co-author/assistant co-author space when the current role 
                   4952:          is co-author or assistant co-author.
1.832     bisitz   4953: 
                   4954: =cut
                   4955: 
                   4956: sub authorspace {
1.1028    raeburn  4957:     my ($url) = @_;
                   4958:     if ($url ne '') {
                   4959:         if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
                   4960:            return $1;
                   4961:         }
                   4962:     }
1.832     bisitz   4963:     my $caname = '';
1.1024    www      4964:     my $cadom = '';
1.1028    raeburn  4965:     if ($env{'request.role'} =~ /^(?:ca|aa)/) {
1.1024    www      4966:         ($cadom,$caname) =
1.832     bisitz   4967:             ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
1.1028    raeburn  4968:     } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
1.832     bisitz   4969:         $caname = $env{'user.name'};
1.1024    www      4970:         $cadom = $env{'user.domain'};
1.832     bisitz   4971:     }
1.1028    raeburn  4972:     if (($caname ne '') && ($cadom ne '')) {
                   4973:         return "/priv/$cadom/$caname/";
                   4974:     }
                   4975:     return;
1.832     bisitz   4976: }
                   4977: 
                   4978: ##############################################
                   4979: =pod
                   4980: 
1.822     bisitz   4981: =item * &head_subbox()
                   4982: 
                   4983: Inputs: $content (contains HTML code with page functions, etc.)
                   4984: 
                   4985: Returns: HTML div with $content
                   4986:          To be included in page header
                   4987: 
                   4988: =cut
                   4989: 
                   4990: sub head_subbox {
                   4991:     my ($content)=@_;
                   4992:     my $output =
1.993     raeburn  4993:         '<div class="LC_head_subbox">'
1.822     bisitz   4994:        .$content
                   4995:        .'</div>'
                   4996: }
                   4997: 
                   4998: ##############################################
                   4999: =pod
                   5000: 
                   5001: =item * &CSTR_pageheader()
                   5002: 
1.1026    raeburn  5003: Input: (optional) filename from which breadcrumb trail is built.
                   5004:        In most cases no input as needed, as $env{'request.filename'}
                   5005:        is appropriate for use in building the breadcrumb trail.
1.822     bisitz   5006: 
                   5007: Returns: HTML div with CSTR path and recent box
1.1075.2.40  raeburn  5008:          To be included on Authoring Space pages
1.822     bisitz   5009: 
                   5010: =cut
                   5011: 
                   5012: sub CSTR_pageheader {
1.1026    raeburn  5013:     my ($trailfile) = @_;
                   5014:     if ($trailfile eq '') {
                   5015:         $trailfile = $env{'request.filename'};
                   5016:     }
                   5017: 
                   5018: # this is for resources; directories have customtitle, and crumbs
                   5019: # and select recent are created in lonpubdir.pm
                   5020: 
                   5021:     my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.1022    www      5022:     my ($udom,$uname,$thisdisfn)=
1.1075.2.29  raeburn  5023:         ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)(?:|/(.*))$});
1.1026    raeburn  5024:     my $formaction = "/priv/$udom/$uname/$thisdisfn";
                   5025:     $formaction =~ s{/+}{/}g;
1.822     bisitz   5026: 
                   5027:     my $parentpath = '';
                   5028:     my $lastitem = '';
                   5029:     if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
                   5030:         $parentpath = $1;
                   5031:         $lastitem = $2;
                   5032:     } else {
                   5033:         $lastitem = $thisdisfn;
                   5034:     }
1.921     bisitz   5035: 
                   5036:     my $output =
1.822     bisitz   5037:          '<div>'
                   5038:         .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
1.1075.2.40  raeburn  5039:         .'<b>'.&mt('Authoring Space:').'</b> '
1.822     bisitz   5040:         .'<form name="dirs" method="post" action="'.$formaction
1.921     bisitz   5041:         .'" target="_top">' #FIXME lonpubdir: target="_parent"
1.1024    www      5042:         .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef);
1.921     bisitz   5043: 
                   5044:     if ($lastitem) {
                   5045:         $output .=
                   5046:              '<span class="LC_filename">'
                   5047:             .$lastitem
                   5048:             .'</span>';
                   5049:     }
                   5050:     $output .=
                   5051:          '<br />'
1.822     bisitz   5052:         #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."</b></tt><br />"
                   5053:         .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
                   5054:         .'</form>'
                   5055:         .&Apache::lonmenu::constspaceform()
                   5056:         .'</div>';
1.921     bisitz   5057: 
                   5058:     return $output;
1.822     bisitz   5059: }
                   5060: 
1.60      matthew  5061: ###############################################
                   5062: ###############################################
                   5063: 
                   5064: =pod
                   5065: 
1.112     bowersj2 5066: =back
                   5067: 
1.549     albertel 5068: =head1 HTML Helpers
1.112     bowersj2 5069: 
                   5070: =over 4
                   5071: 
                   5072: =item * &bodytag()
1.60      matthew  5073: 
                   5074: Returns a uniform header for LON-CAPA web pages.
                   5075: 
                   5076: Inputs: 
                   5077: 
1.112     bowersj2 5078: =over 4
                   5079: 
                   5080: =item * $title, A title to be displayed on the page.
                   5081: 
                   5082: =item * $function, the current role (can be undef).
                   5083: 
                   5084: =item * $addentries, extra parameters for the <body> tag.
                   5085: 
                   5086: =item * $bodyonly, if defined, only return the <body> tag.
                   5087: 
                   5088: =item * $domain, if defined, force a given domain.
                   5089: 
                   5090: =item * $forcereg, if page should register as content page (relevant for 
1.86      www      5091:             text interface only)
1.60      matthew  5092: 
1.814     bisitz   5093: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
                   5094:                      navigational links
1.317     albertel 5095: 
1.338     albertel 5096: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
                   5097: 
1.1075.2.12  raeburn  5098: =item * $no_inline_link, if true and in remote mode, don't show the
                   5099:          'Switch To Inline Menu' link
                   5100: 
1.460     albertel 5101: =item * $args, optional argument valid values are
                   5102:             no_auto_mt_title -> prevents &mt()ing the title arg
1.562     albertel 5103:             inherit_jsmath -> when creating popup window in a page,
                   5104:                               should it have jsmath forced on by the
                   5105:                               current page
1.460     albertel 5106: 
1.1075.2.15  raeburn  5107: =item * $advtoolsref, optional argument, ref to an array containing
                   5108:             inlineremote items to be added in "Functions" menu below
                   5109:             breadcrumbs.
                   5110: 
1.112     bowersj2 5111: =back
                   5112: 
1.60      matthew  5113: Returns: A uniform header for LON-CAPA web pages.  
                   5114: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
                   5115: If $bodyonly is undef or zero, an html string containing a <body> tag and 
                   5116: other decorations will be returned.
                   5117: 
                   5118: =cut
                   5119: 
1.54      www      5120: sub bodytag {
1.831     bisitz   5121:     my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.1075.2.15  raeburn  5122:         $no_nav_bar,$bgcolor,$no_inline_link,$args,$advtoolsref)=@_;
1.339     albertel 5123: 
1.954     raeburn  5124:     my $public;
                   5125:     if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
                   5126:         || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
                   5127:         $public = 1;
                   5128:     }
1.460     albertel 5129:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.1075.2.52  raeburn  5130:     my $httphost = $args->{'use_absolute'};
1.339     albertel 5131: 
1.183     matthew  5132:     $function = &get_users_function() if (!$function);
1.339     albertel 5133:     my $img =    &designparm($function.'.img',$domain);
                   5134:     my $font =   &designparm($function.'.font',$domain);
                   5135:     my $pgbg   = $bgcolor || &designparm($function.'.pgbg',$domain);
                   5136: 
1.803     bisitz   5137:     my %design = ( 'style'   => 'margin-top: 0',
1.535     albertel 5138: 		   'bgcolor' => $pgbg,
1.339     albertel 5139: 		   'text'    => $font,
                   5140:                    'alink'   => &designparm($function.'.alink',$domain),
                   5141: 		   'vlink'   => &designparm($function.'.vlink',$domain),
                   5142: 		   'link'    => &designparm($function.'.link',$domain),);
1.438     albertel 5143:     @design{keys(%$addentries)} = @$addentries{keys(%$addentries)}; 
1.339     albertel 5144: 
1.63      www      5145:  # role and realm
1.1075.2.68  raeburn  5146:     my ($role,$realm) = split(m{\./},$env{'request.role'},2);
                   5147:     if ($realm) {
                   5148:         $realm = '/'.$realm;
                   5149:     }
1.378     raeburn  5150:     if ($role  eq 'ca') {
1.479     albertel 5151:         my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500     albertel 5152:         $realm = &plainname($rname,$rdom);
1.378     raeburn  5153:     } 
1.55      www      5154: # realm
1.258     albertel 5155:     if ($env{'request.course.id'}) {
1.378     raeburn  5156:         if ($env{'request.role'} !~ /^cr/) {
                   5157:             $role = &Apache::lonnet::plaintext($role,&course_type());
                   5158:         }
1.898     raeburn  5159:         if ($env{'request.course.sec'}) {
                   5160:             $role .= ('&nbsp;'x2).'-&nbsp;'.&mt('section:').'&nbsp;'.$env{'request.course.sec'};
                   5161:         }   
1.359     albertel 5162: 	$realm = $env{'course.'.$env{'request.course.id'}.'.description'};
1.378     raeburn  5163:     } else {
                   5164:         $role = &Apache::lonnet::plaintext($role);
1.54      www      5165:     }
1.433     albertel 5166: 
1.359     albertel 5167:     if (!$realm) { $realm='&nbsp;'; }
1.330     albertel 5168: 
1.438     albertel 5169:     my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329     albertel 5170: 
1.101     www      5171: # construct main body tag
1.359     albertel 5172:     my $bodytag = "<body $extra_body_attr>".
1.562     albertel 5173: 	&Apache::lontexconvert::init_math_support($args->{'inherit_jsmath'});
1.252     albertel 5174: 
1.1075.2.38  raeburn  5175:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   5176: 
                   5177:     if (($bodyonly) || ($no_nav_bar) || ($env{'form.inhibitmenu'} eq 'yes')) {
1.60      matthew  5178:         return $bodytag;
1.1075.2.38  raeburn  5179:     }
1.359     albertel 5180: 
1.954     raeburn  5181:     if ($public) {
1.433     albertel 5182: 	undef($role);
                   5183:     }
1.359     albertel 5184:     
1.762     bisitz   5185:     my $titleinfo = '<h1>'.$title.'</h1>';
1.359     albertel 5186:     #
                   5187:     # Extra info if you are the DC
                   5188:     my $dc_info = '';
                   5189:     if ($env{'user.adv'} && exists($env{'user.role.dc./'.
                   5190:                         $env{'course.'.$env{'request.course.id'}.
                   5191:                                  '.domain'}.'/'})) {
                   5192:         my $cid = $env{'request.course.id'};
1.917     raeburn  5193:         $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380     www      5194:         $dc_info =~ s/\s+$//;
1.359     albertel 5195:     }
                   5196: 
1.898     raeburn  5197:     $role = '<span class="LC_nobreak">('.$role.')</span>' if $role;
1.903     droeschl 5198: 
1.1075.2.13  raeburn  5199:     if ($env{'request.state'} eq 'construct') { $forcereg=1; }
                   5200: 
1.1075.2.38  raeburn  5201: 
                   5202: 
1.1075.2.21  raeburn  5203:     my $funclist;
                   5204:     if (($env{'environment.remote'} eq 'on') && ($env{'request.state'} ne 'construct')) {
1.1075.2.52  raeburn  5205:         $bodytag .= Apache::lonhtmlcommon::scripttag(Apache::lonmenu::utilityfunctions($httphost), 'start')."\n".
1.1075.2.21  raeburn  5206:                     Apache::lonmenu::serverform();
                   5207:         my $forbodytag;
                   5208:         &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
                   5209:                                             $forcereg,$args->{'group'},
                   5210:                                             $args->{'bread_crumbs'},
                   5211:                                             $advtoolsref,'',\$forbodytag);
                   5212:         unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {
                   5213:             $funclist = $forbodytag;
                   5214:         }
                   5215:     } else {
1.903     droeschl 5216: 
                   5217:         #    if ($env{'request.state'} eq 'construct') {
                   5218:         #        $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
                   5219:         #    }
                   5220: 
1.1075.2.38  raeburn  5221:         $bodytag .= Apache::lonhtmlcommon::scripttag(
1.1075.2.52  raeburn  5222:             Apache::lonmenu::utilityfunctions($httphost), 'start');
1.359     albertel 5223: 
1.1075.2.38  raeburn  5224:         my ($left,$right) = Apache::lonmenu::primary_menu();
1.1075.2.2  raeburn  5225: 
1.916     droeschl 5226:         if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
1.1075.2.22  raeburn  5227:             if ($dc_info) {
                   5228:                  $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
1.1075.2.1  raeburn  5229:             }
1.1075.2.38  raeburn  5230:             $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />
1.1075.2.22  raeburn  5231:                            <em>$realm</em> $dc_info</div>|;
1.903     droeschl 5232:             return $bodytag;
                   5233:         }
1.894     droeschl 5234: 
1.927     raeburn  5235:         unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
1.1075.2.38  raeburn  5236:             $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;
1.927     raeburn  5237:         }
1.916     droeschl 5238: 
1.1075.2.38  raeburn  5239:         $bodytag .= $right;
1.852     droeschl 5240: 
1.917     raeburn  5241:         if ($dc_info) {
                   5242:             $dc_info = &dc_courseid_toggle($dc_info);
                   5243:         }
                   5244:         $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.916     droeschl 5245: 
1.1075.2.61  raeburn  5246:         #if directed to not display the secondary menu, don't.
                   5247:         if ($args->{'no_secondary_menu'}) {
                   5248:             return $bodytag;
                   5249:         }
1.903     droeschl 5250:         #don't show menus for public users
1.954     raeburn  5251:         if (!$public){
1.1075.2.52  raeburn  5252:             $bodytag .= Apache::lonmenu::secondary_menu($httphost);
1.903     droeschl 5253:             $bodytag .= Apache::lonmenu::serverform();
1.920     raeburn  5254:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
                   5255:             if ($env{'request.state'} eq 'construct') {
1.962     droeschl 5256:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.920     raeburn  5257:                                 $args->{'bread_crumbs'});
                   5258:             } elsif ($forcereg) { 
1.1075.2.22  raeburn  5259:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
                   5260:                                                             $args->{'group'});
1.1075.2.15  raeburn  5261:             } else {
1.1075.2.21  raeburn  5262:                 my $forbodytag;
                   5263:                 &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
                   5264:                                                     $forcereg,$args->{'group'},
                   5265:                                                     $args->{'bread_crumbs'},
                   5266:                                                     $advtoolsref,'',\$forbodytag);
                   5267:                 unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {
                   5268:                     $bodytag .= $forbodytag;
                   5269:                 }
1.920     raeburn  5270:             }
1.903     droeschl 5271:         }else{
                   5272:             # this is to seperate menu from content when there's no secondary
                   5273:             # menu. Especially needed for public accessible ressources.
                   5274:             $bodytag .= '<hr style="clear:both" />';
                   5275:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end'); 
1.235     raeburn  5276:         }
1.903     droeschl 5277: 
1.235     raeburn  5278:         return $bodytag;
1.1075.2.12  raeburn  5279:     }
                   5280: 
                   5281: #
                   5282: # Top frame rendering, Remote is up
                   5283: #
                   5284: 
                   5285:     my $imgsrc = $img;
                   5286:     if ($img =~ /^\/adm/) {
                   5287:         $imgsrc = &lonhttpdurl($img);
                   5288:     }
                   5289:     my $upperleft='<img src="'.$imgsrc.'" alt="'.$function.'" />';
                   5290: 
1.1075.2.60  raeburn  5291:     my $help=($no_inline_link?''
                   5292:               :&Apache::loncommon::top_nav_help('Help'));
                   5293: 
1.1075.2.12  raeburn  5294:     # Explicit link to get inline menu
                   5295:     my $menu= ($no_inline_link?''
                   5296:                :'<a href="/adm/remote?action=collapse" target="_top">'.&mt('Switch to Inline Menu Mode').'</a>');
                   5297: 
                   5298:     if ($dc_info) {
                   5299:         $dc_info = qq|<span class="LC_cusr_subheading">($dc_info)</span>|;
                   5300:     }
                   5301: 
1.1075.2.38  raeburn  5302:     my $name = &plainname($env{'user.name'},$env{'user.domain'});
                   5303:     unless ($public) {
                   5304:         $name = &aboutmewrapper($name,$env{'user.name'},$env{'user.domain'},
                   5305:                                 undef,'LC_menubuttons_link');
                   5306:     }
                   5307: 
1.1075.2.12  raeburn  5308:     unless ($env{'form.inhibitmenu'}) {
                   5309:         $bodytag .= qq|<div id="LC_nav_bar">$name $role</div>
1.1075.2.38  raeburn  5310:                        <ol class="LC_primary_menu LC_floatright LC_right">
1.1075.2.60  raeburn  5311:                        <li>$help</li>
1.1075.2.12  raeburn  5312:                        <li>$menu</li>
                   5313:                        </ol><div id="LC_realm"> $realm $dc_info</div>|;
                   5314:     }
1.1075.2.13  raeburn  5315:     if ($env{'request.state'} eq 'construct') {
                   5316:         if (!$public){
                   5317:             if ($env{'request.state'} eq 'construct') {
                   5318:                 $funclist = &Apache::lonhtmlcommon::scripttag(
1.1075.2.52  raeburn  5319:                                 &Apache::lonmenu::utilityfunctions($httphost), 'start').
1.1075.2.13  raeburn  5320:                             &Apache::lonhtmlcommon::scripttag('','end').
                   5321:                             &Apache::lonmenu::innerregister($forcereg,
                   5322:                                                             $args->{'bread_crumbs'});
                   5323:             }
                   5324:         }
                   5325:     }
1.1075.2.21  raeburn  5326:     return $bodytag."\n".$funclist;
1.182     matthew  5327: }
                   5328: 
1.917     raeburn  5329: sub dc_courseid_toggle {
                   5330:     my ($dc_info) = @_;
1.980     raeburn  5331:     return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.1069    raeburn  5332:            '<a href="javascript:showCourseID();" class="LC_menubuttons_link">'.
1.917     raeburn  5333:            &mt('(More ...)').'</a></span>'.
                   5334:            '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
                   5335: }
                   5336: 
1.330     albertel 5337: sub make_attr_string {
                   5338:     my ($register,$attr_ref) = @_;
                   5339: 
                   5340:     if ($attr_ref && !ref($attr_ref)) {
                   5341: 	die("addentries Must be a hash ref ".
                   5342: 	    join(':',caller(1))." ".
                   5343: 	    join(':',caller(0))." ");
                   5344:     }
                   5345: 
                   5346:     if ($register) {
1.339     albertel 5347: 	my ($on_load,$on_unload);
                   5348: 	foreach my $key (keys(%{$attr_ref})) {
                   5349: 	    if      (lc($key) eq 'onload') {
                   5350: 		$on_load.=$attr_ref->{$key}.';';
                   5351: 		delete($attr_ref->{$key});
                   5352: 
                   5353: 	    } elsif (lc($key) eq 'onunload') {
                   5354: 		$on_unload.=$attr_ref->{$key}.';';
                   5355: 		delete($attr_ref->{$key});
                   5356: 	    }
                   5357: 	}
1.1075.2.12  raeburn  5358:         if ($env{'environment.remote'} eq 'on') {
                   5359:             $attr_ref->{'onload'}  =
                   5360:                 &Apache::lonmenu::loadevents().  $on_load;
                   5361:             $attr_ref->{'onunload'}=
                   5362:                 &Apache::lonmenu::unloadevents().$on_unload;
                   5363:         } else {  
                   5364: 	    $attr_ref->{'onload'}  = $on_load;
                   5365: 	    $attr_ref->{'onunload'}= $on_unload;
                   5366:         }
1.330     albertel 5367:     }
1.339     albertel 5368: 
1.330     albertel 5369:     my $attr_string;
1.1075.2.56  raeburn  5370:     foreach my $attr (sort(keys(%$attr_ref))) {
1.330     albertel 5371: 	$attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
                   5372:     }
                   5373:     return $attr_string;
                   5374: }
                   5375: 
                   5376: 
1.182     matthew  5377: ###############################################
1.251     albertel 5378: ###############################################
                   5379: 
                   5380: =pod
                   5381: 
                   5382: =item * &endbodytag()
                   5383: 
                   5384: Returns a uniform footer for LON-CAPA web pages.
                   5385: 
1.635     raeburn  5386: Inputs: 1 - optional reference to an args hash
                   5387: If in the hash, key for noredirectlink has a value which evaluates to true,
                   5388: a 'Continue' link is not displayed if the page contains an
                   5389: internal redirect in the <head></head> section,
                   5390: i.e., $env{'internal.head.redirect'} exists   
1.251     albertel 5391: 
                   5392: =cut
                   5393: 
                   5394: sub endbodytag {
1.635     raeburn  5395:     my ($args) = @_;
1.1075.2.6  raeburn  5396:     my $endbodytag;
                   5397:     unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
                   5398:         $endbodytag='</body>';
                   5399:     }
1.269     albertel 5400:     $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;
1.315     albertel 5401:     if ( exists( $env{'internal.head.redirect'} ) ) {
1.635     raeburn  5402:         if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
                   5403: 	    $endbodytag=
                   5404: 	        "<br /><a href=\"$env{'internal.head.redirect'}\">".
                   5405: 	        &mt('Continue').'</a>'.
                   5406: 	        $endbodytag;
                   5407:         }
1.315     albertel 5408:     }
1.251     albertel 5409:     return $endbodytag;
                   5410: }
                   5411: 
1.352     albertel 5412: =pod
                   5413: 
                   5414: =item * &standard_css()
                   5415: 
                   5416: Returns a style sheet
                   5417: 
                   5418: Inputs: (all optional)
                   5419:             domain         -> force to color decorate a page for a specific
                   5420:                                domain
                   5421:             function       -> force usage of a specific rolish color scheme
                   5422:             bgcolor        -> override the default page bgcolor
                   5423: 
                   5424: =cut
                   5425: 
1.343     albertel 5426: sub standard_css {
1.345     albertel 5427:     my ($function,$domain,$bgcolor) = @_;
1.352     albertel 5428:     $function  = &get_users_function() if (!$function);
                   5429:     my $img    = &designparm($function.'.img',   $domain);
                   5430:     my $tabbg  = &designparm($function.'.tabbg', $domain);
                   5431:     my $font   = &designparm($function.'.font',  $domain);
1.801     tempelho 5432:     my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791     tempelho 5433: #second colour for later usage
1.345     albertel 5434:     my $sidebg = &designparm($function.'.sidebg',$domain);
1.382     albertel 5435:     my $pgbg_or_bgcolor =
                   5436: 	         $bgcolor ||
1.352     albertel 5437: 	         &designparm($function.'.pgbg',  $domain);
1.382     albertel 5438:     my $pgbg   = &designparm($function.'.pgbg',  $domain);
1.352     albertel 5439:     my $alink  = &designparm($function.'.alink', $domain);
                   5440:     my $vlink  = &designparm($function.'.vlink', $domain);
                   5441:     my $link   = &designparm($function.'.link',  $domain);
                   5442: 
1.602     albertel 5443:     my $sans                 = 'Verdana,Arial,Helvetica,sans-serif';
1.395     albertel 5444:     my $mono                 = 'monospace';
1.850     bisitz   5445:     my $data_table_head      = $sidebg;
                   5446:     my $data_table_light     = '#FAFAFA';
1.1060    bisitz   5447:     my $data_table_dark      = '#E0E0E0';
1.470     banghart 5448:     my $data_table_darker    = '#CCCCCC';
1.349     albertel 5449:     my $data_table_highlight = '#FFFF00';
1.352     albertel 5450:     my $mail_new             = '#FFBB77';
                   5451:     my $mail_new_hover       = '#DD9955';
                   5452:     my $mail_read            = '#BBBB77';
                   5453:     my $mail_read_hover      = '#999944';
                   5454:     my $mail_replied         = '#AAAA88';
                   5455:     my $mail_replied_hover   = '#888855';
                   5456:     my $mail_other           = '#99BBBB';
                   5457:     my $mail_other_hover     = '#669999';
1.391     albertel 5458:     my $table_header         = '#DDDDDD';
1.489     raeburn  5459:     my $feedback_link_bg     = '#BBBBBB';
1.911     bisitz   5460:     my $lg_border_color      = '#C8C8C8';
1.952     onken    5461:     my $button_hover         = '#BF2317';
1.392     albertel 5462: 
1.608     albertel 5463:     my $border = ($env{'browser.type'} eq 'explorer' ||
1.911     bisitz   5464:       $env{'browser.type'} eq 'safari'     ) ? '0 2px 0 2px'
                   5465:                                              : '0 3px 0 4px';
1.448     albertel 5466: 
1.523     albertel 5467: 
1.343     albertel 5468:     return <<END;
1.947     droeschl 5469: 
                   5470: /* needed for iframe to allow 100% height in FF */
                   5471: body, html { 
                   5472:     margin: 0;
                   5473:     padding: 0 0.5%;
                   5474:     height: 99%; /* to avoid scrollbars */
                   5475: }
                   5476: 
1.795     www      5477: body {
1.911     bisitz   5478:   font-family: $sans;
                   5479:   line-height:130%;
                   5480:   font-size:0.83em;
                   5481:   color:$font;
1.795     www      5482: }
                   5483: 
1.959     onken    5484: a:focus,
                   5485: a:focus img {
1.795     www      5486:   color: red;
                   5487: }
1.698     harmsja  5488: 
1.911     bisitz   5489: form, .inline {
                   5490:   display: inline;
1.795     www      5491: }
1.721     harmsja  5492: 
1.795     www      5493: .LC_right {
1.911     bisitz   5494:   text-align:right;
1.795     www      5495: }
                   5496: 
                   5497: .LC_middle {
1.911     bisitz   5498:   vertical-align:middle;
1.795     www      5499: }
1.721     harmsja  5500: 
1.1075.2.38  raeburn  5501: .LC_floatleft {
                   5502:   float: left;
                   5503: }
                   5504: 
                   5505: .LC_floatright {
                   5506:   float: right;
                   5507: }
                   5508: 
1.911     bisitz   5509: .LC_400Box {
                   5510:   width:400px;
                   5511: }
1.721     harmsja  5512: 
1.947     droeschl 5513: .LC_iframecontainer {
                   5514:     width: 98%;
                   5515:     margin: 0;
                   5516:     position: fixed;
                   5517:     top: 8.5em;
                   5518:     bottom: 0;
                   5519: }
                   5520: 
                   5521: .LC_iframecontainer iframe{
                   5522:     border: none;
                   5523:     width: 100%;
                   5524:     height: 100%;
                   5525: }
                   5526: 
1.778     bisitz   5527: .LC_filename {
                   5528:   font-family: $mono;
                   5529:   white-space:pre;
1.921     bisitz   5530:   font-size: 120%;
1.778     bisitz   5531: }
                   5532: 
                   5533: .LC_fileicon {
                   5534:   border: none;
                   5535:   height: 1.3em;
                   5536:   vertical-align: text-bottom;
                   5537:   margin-right: 0.3em;
                   5538:   text-decoration:none;
                   5539: }
                   5540: 
1.1008    www      5541: .LC_setting {
                   5542:   text-decoration:underline;
                   5543: }
                   5544: 
1.350     albertel 5545: .LC_error {
                   5546:   color: red;
                   5547: }
1.795     www      5548: 
1.1075.2.15  raeburn  5549: .LC_warning {
                   5550:   color: darkorange;
                   5551: }
                   5552: 
1.457     albertel 5553: .LC_diff_removed {
1.733     bisitz   5554:   color: red;
1.394     albertel 5555: }
1.532     albertel 5556: 
                   5557: .LC_info,
1.457     albertel 5558: .LC_success,
                   5559: .LC_diff_added {
1.350     albertel 5560:   color: green;
                   5561: }
1.795     www      5562: 
1.802     bisitz   5563: div.LC_confirm_box {
                   5564:   background-color: #FAFAFA;
                   5565:   border: 1px solid $lg_border_color;
                   5566:   margin-right: 0;
                   5567:   padding: 5px;
                   5568: }
                   5569: 
                   5570: div.LC_confirm_box .LC_error img,
                   5571: div.LC_confirm_box .LC_success img {
                   5572:   vertical-align: middle;
                   5573: }
                   5574: 
1.440     albertel 5575: .LC_icon {
1.771     droeschl 5576:   border: none;
1.790     droeschl 5577:   vertical-align: middle;
1.771     droeschl 5578: }
                   5579: 
1.543     albertel 5580: .LC_docs_spacer {
                   5581:   width: 25px;
                   5582:   height: 1px;
1.771     droeschl 5583:   border: none;
1.543     albertel 5584: }
1.346     albertel 5585: 
1.532     albertel 5586: .LC_internal_info {
1.735     bisitz   5587:   color: #999999;
1.532     albertel 5588: }
                   5589: 
1.794     www      5590: .LC_discussion {
1.1050    www      5591:   background: $data_table_dark;
1.911     bisitz   5592:   border: 1px solid black;
                   5593:   margin: 2px;
1.794     www      5594: }
                   5595: 
                   5596: .LC_disc_action_left {
1.1050    www      5597:   background: $sidebg;
1.911     bisitz   5598:   text-align: left;
1.1050    www      5599:   padding: 4px;
                   5600:   margin: 2px;
1.794     www      5601: }
                   5602: 
                   5603: .LC_disc_action_right {
1.1050    www      5604:   background: $sidebg;
1.911     bisitz   5605:   text-align: right;
1.1050    www      5606:   padding: 4px;
                   5607:   margin: 2px;
1.794     www      5608: }
                   5609: 
                   5610: .LC_disc_new_item {
1.911     bisitz   5611:   background: white;
                   5612:   border: 2px solid red;
1.1050    www      5613:   margin: 4px;
                   5614:   padding: 4px;
1.794     www      5615: }
                   5616: 
                   5617: .LC_disc_old_item {
1.911     bisitz   5618:   background: white;
1.1050    www      5619:   margin: 4px;
                   5620:   padding: 4px;
1.794     www      5621: }
                   5622: 
1.458     albertel 5623: table.LC_pastsubmission {
                   5624:   border: 1px solid black;
                   5625:   margin: 2px;
                   5626: }
                   5627: 
1.924     bisitz   5628: table#LC_menubuttons {
1.345     albertel 5629:   width: 100%;
                   5630:   background: $pgbg;
1.392     albertel 5631:   border: 2px;
1.402     albertel 5632:   border-collapse: separate;
1.803     bisitz   5633:   padding: 0;
1.345     albertel 5634: }
1.392     albertel 5635: 
1.801     tempelho 5636: table#LC_title_bar a {
                   5637:   color: $fontmenu;
                   5638: }
1.836     bisitz   5639: 
1.807     droeschl 5640: table#LC_title_bar {
1.819     tempelho 5641:   clear: both;
1.836     bisitz   5642:   display: none;
1.807     droeschl 5643: }
                   5644: 
1.795     www      5645: table#LC_title_bar,
1.933     droeschl 5646: table.LC_breadcrumbs, /* obsolete? */
1.393     albertel 5647: table#LC_title_bar.LC_with_remote {
1.359     albertel 5648:   width: 100%;
1.392     albertel 5649:   border-color: $pgbg;
                   5650:   border-style: solid;
                   5651:   border-width: $border;
1.379     albertel 5652:   background: $pgbg;
1.801     tempelho 5653:   color: $fontmenu;
1.392     albertel 5654:   border-collapse: collapse;
1.803     bisitz   5655:   padding: 0;
1.819     tempelho 5656:   margin: 0;
1.359     albertel 5657: }
1.795     www      5658: 
1.933     droeschl 5659: ul.LC_breadcrumb_tools_outerlist {
1.913     droeschl 5660:     margin: 0;
                   5661:     padding: 0;
1.933     droeschl 5662:     position: relative;
                   5663:     list-style: none;
1.913     droeschl 5664: }
1.933     droeschl 5665: ul.LC_breadcrumb_tools_outerlist li {
1.913     droeschl 5666:     display: inline;
                   5667: }
1.933     droeschl 5668: 
                   5669: .LC_breadcrumb_tools_navigation {
1.913     droeschl 5670:     padding: 0;
1.933     droeschl 5671:     margin: 0;
                   5672:     float: left;
1.913     droeschl 5673: }
1.933     droeschl 5674: .LC_breadcrumb_tools_tools {
                   5675:     padding: 0;
                   5676:     margin: 0;
1.913     droeschl 5677:     float: right;
                   5678: }
                   5679: 
1.359     albertel 5680: table#LC_title_bar td {
                   5681:   background: $tabbg;
                   5682: }
1.795     www      5683: 
1.911     bisitz   5684: table#LC_menubuttons img {
1.803     bisitz   5685:   border: none;
1.346     albertel 5686: }
1.795     www      5687: 
1.842     droeschl 5688: .LC_breadcrumbs_component {
1.911     bisitz   5689:   float: right;
                   5690:   margin: 0 1em;
1.357     albertel 5691: }
1.842     droeschl 5692: .LC_breadcrumbs_component img {
1.911     bisitz   5693:   vertical-align: middle;
1.777     tempelho 5694: }
1.795     www      5695: 
1.383     albertel 5696: td.LC_table_cell_checkbox {
                   5697:   text-align: center;
                   5698: }
1.795     www      5699: 
                   5700: .LC_fontsize_small {
1.911     bisitz   5701:   font-size: 70%;
1.705     tempelho 5702: }
                   5703: 
1.844     bisitz   5704: #LC_breadcrumbs {
1.911     bisitz   5705:   clear:both;
                   5706:   background: $sidebg;
                   5707:   border-bottom: 1px solid $lg_border_color;
                   5708:   line-height: 2.5em;
1.933     droeschl 5709:   overflow: hidden;
1.911     bisitz   5710:   margin: 0;
                   5711:   padding: 0;
1.995     raeburn  5712:   text-align: left;
1.819     tempelho 5713: }
1.862     bisitz   5714: 
1.1075.2.16  raeburn  5715: .LC_head_subbox, .LC_actionbox {
1.911     bisitz   5716:   clear:both;
                   5717:   background: #F8F8F8; /* $sidebg; */
1.915     droeschl 5718:   border: 1px solid $sidebg;
1.1075.2.16  raeburn  5719:   margin: 0 0 10px 0;
1.966     bisitz   5720:   padding: 3px;
1.995     raeburn  5721:   text-align: left;
1.822     bisitz   5722: }
                   5723: 
1.795     www      5724: .LC_fontsize_medium {
1.911     bisitz   5725:   font-size: 85%;
1.705     tempelho 5726: }
                   5727: 
1.795     www      5728: .LC_fontsize_large {
1.911     bisitz   5729:   font-size: 120%;
1.705     tempelho 5730: }
                   5731: 
1.346     albertel 5732: .LC_menubuttons_inline_text {
                   5733:   color: $font;
1.698     harmsja  5734:   font-size: 90%;
1.701     harmsja  5735:   padding-left:3px;
1.346     albertel 5736: }
                   5737: 
1.934     droeschl 5738: .LC_menubuttons_inline_text img{
                   5739:   vertical-align: middle;
                   5740: }
                   5741: 
1.1051    www      5742: li.LC_menubuttons_inline_text img {
1.951     onken    5743:   cursor:pointer;
1.1002    droeschl 5744:   text-decoration: none;
1.951     onken    5745: }
                   5746: 
1.526     www      5747: .LC_menubuttons_link {
                   5748:   text-decoration: none;
                   5749: }
1.795     www      5750: 
1.522     albertel 5751: .LC_menubuttons_category {
1.521     www      5752:   color: $font;
1.526     www      5753:   background: $pgbg;
1.521     www      5754:   font-size: larger;
                   5755:   font-weight: bold;
                   5756: }
                   5757: 
1.346     albertel 5758: td.LC_menubuttons_text {
1.911     bisitz   5759:   color: $font;
1.346     albertel 5760: }
1.706     harmsja  5761: 
1.346     albertel 5762: .LC_current_location {
                   5763:   background: $tabbg;
                   5764: }
1.795     www      5765: 
1.938     bisitz   5766: table.LC_data_table {
1.347     albertel 5767:   border: 1px solid #000000;
1.402     albertel 5768:   border-collapse: separate;
1.426     albertel 5769:   border-spacing: 1px;
1.610     albertel 5770:   background: $pgbg;
1.347     albertel 5771: }
1.795     www      5772: 
1.422     albertel 5773: .LC_data_table_dense {
                   5774:   font-size: small;
                   5775: }
1.795     www      5776: 
1.507     raeburn  5777: table.LC_nested_outer {
                   5778:   border: 1px solid #000000;
1.589     raeburn  5779:   border-collapse: collapse;
1.803     bisitz   5780:   border-spacing: 0;
1.507     raeburn  5781:   width: 100%;
                   5782: }
1.795     www      5783: 
1.879     raeburn  5784: table.LC_innerpickbox,
1.507     raeburn  5785: table.LC_nested {
1.803     bisitz   5786:   border: none;
1.589     raeburn  5787:   border-collapse: collapse;
1.803     bisitz   5788:   border-spacing: 0;
1.507     raeburn  5789:   width: 100%;
                   5790: }
1.795     www      5791: 
1.911     bisitz   5792: table.LC_data_table tr th,
                   5793: table.LC_calendar tr th,
1.879     raeburn  5794: table.LC_prior_tries tr th,
                   5795: table.LC_innerpickbox tr th {
1.349     albertel 5796:   font-weight: bold;
                   5797:   background-color: $data_table_head;
1.801     tempelho 5798:   color:$fontmenu;
1.701     harmsja  5799:   font-size:90%;
1.347     albertel 5800: }
1.795     www      5801: 
1.879     raeburn  5802: table.LC_innerpickbox tr th,
                   5803: table.LC_innerpickbox tr td {
                   5804:   vertical-align: top;
                   5805: }
                   5806: 
1.711     raeburn  5807: table.LC_data_table tr.LC_info_row > td {
1.735     bisitz   5808:   background-color: #CCCCCC;
1.711     raeburn  5809:   font-weight: bold;
                   5810:   text-align: left;
                   5811: }
1.795     www      5812: 
1.912     bisitz   5813: table.LC_data_table tr.LC_odd_row > td {
                   5814:   background-color: $data_table_light;
                   5815:   padding: 2px;
                   5816:   vertical-align: top;
                   5817: }
                   5818: 
1.809     bisitz   5819: table.LC_pick_box tr > td.LC_odd_row {
1.349     albertel 5820:   background-color: $data_table_light;
1.912     bisitz   5821:   vertical-align: top;
                   5822: }
                   5823: 
                   5824: table.LC_data_table tr.LC_even_row > td {
                   5825:   background-color: $data_table_dark;
1.425     albertel 5826:   padding: 2px;
1.900     bisitz   5827:   vertical-align: top;
1.347     albertel 5828: }
1.795     www      5829: 
1.809     bisitz   5830: table.LC_pick_box tr > td.LC_even_row {
1.349     albertel 5831:   background-color: $data_table_dark;
1.900     bisitz   5832:   vertical-align: top;
1.347     albertel 5833: }
1.795     www      5834: 
1.425     albertel 5835: table.LC_data_table tr.LC_data_table_highlight td {
                   5836:   background-color: $data_table_darker;
                   5837: }
1.795     www      5838: 
1.639     raeburn  5839: table.LC_data_table tr td.LC_leftcol_header {
                   5840:   background-color: $data_table_head;
                   5841:   font-weight: bold;
                   5842: }
1.795     www      5843: 
1.451     albertel 5844: table.LC_data_table tr.LC_empty_row td,
1.507     raeburn  5845: table.LC_nested tr.LC_empty_row td {
1.421     albertel 5846:   font-weight: bold;
                   5847:   font-style: italic;
                   5848:   text-align: center;
                   5849:   padding: 8px;
1.347     albertel 5850: }
1.795     www      5851: 
1.1075.2.30  raeburn  5852: table.LC_data_table tr.LC_empty_row td,
                   5853: table.LC_data_table tr.LC_footer_row td {
1.940     bisitz   5854:   background-color: $sidebg;
                   5855: }
                   5856: 
                   5857: table.LC_nested tr.LC_empty_row td {
                   5858:   background-color: #FFFFFF;
                   5859: }
                   5860: 
1.890     droeschl 5861: table.LC_caption {
                   5862: }
                   5863: 
1.507     raeburn  5864: table.LC_nested tr.LC_empty_row td {
1.465     albertel 5865:   padding: 4ex
                   5866: }
1.795     www      5867: 
1.507     raeburn  5868: table.LC_nested_outer tr th {
                   5869:   font-weight: bold;
1.801     tempelho 5870:   color:$fontmenu;
1.507     raeburn  5871:   background-color: $data_table_head;
1.701     harmsja  5872:   font-size: small;
1.507     raeburn  5873:   border-bottom: 1px solid #000000;
                   5874: }
1.795     www      5875: 
1.507     raeburn  5876: table.LC_nested_outer tr td.LC_subheader {
                   5877:   background-color: $data_table_head;
                   5878:   font-weight: bold;
                   5879:   font-size: small;
                   5880:   border-bottom: 1px solid #000000;
                   5881:   text-align: right;
1.451     albertel 5882: }
1.795     www      5883: 
1.507     raeburn  5884: table.LC_nested tr.LC_info_row td {
1.735     bisitz   5885:   background-color: #CCCCCC;
1.451     albertel 5886:   font-weight: bold;
                   5887:   font-size: small;
1.507     raeburn  5888:   text-align: center;
                   5889: }
1.795     www      5890: 
1.589     raeburn  5891: table.LC_nested tr.LC_info_row td.LC_left_item,
                   5892: table.LC_nested_outer tr th.LC_left_item {
1.507     raeburn  5893:   text-align: left;
1.451     albertel 5894: }
1.795     www      5895: 
1.507     raeburn  5896: table.LC_nested td {
1.735     bisitz   5897:   background-color: #FFFFFF;
1.451     albertel 5898:   font-size: small;
1.507     raeburn  5899: }
1.795     www      5900: 
1.507     raeburn  5901: table.LC_nested_outer tr th.LC_right_item,
                   5902: table.LC_nested tr.LC_info_row td.LC_right_item,
                   5903: table.LC_nested tr.LC_odd_row td.LC_right_item,
                   5904: table.LC_nested tr td.LC_right_item {
1.451     albertel 5905:   text-align: right;
                   5906: }
                   5907: 
1.507     raeburn  5908: table.LC_nested tr.LC_odd_row td {
1.735     bisitz   5909:   background-color: #EEEEEE;
1.451     albertel 5910: }
                   5911: 
1.473     raeburn  5912: table.LC_createuser {
                   5913: }
                   5914: 
                   5915: table.LC_createuser tr.LC_section_row td {
1.701     harmsja  5916:   font-size: small;
1.473     raeburn  5917: }
                   5918: 
                   5919: table.LC_createuser tr.LC_info_row td  {
1.735     bisitz   5920:   background-color: #CCCCCC;
1.473     raeburn  5921:   font-weight: bold;
                   5922:   text-align: center;
                   5923: }
                   5924: 
1.349     albertel 5925: table.LC_calendar {
                   5926:   border: 1px solid #000000;
                   5927:   border-collapse: collapse;
1.917     raeburn  5928:   width: 98%;
1.349     albertel 5929: }
1.795     www      5930: 
1.349     albertel 5931: table.LC_calendar_pickdate {
                   5932:   font-size: xx-small;
                   5933: }
1.795     www      5934: 
1.349     albertel 5935: table.LC_calendar tr td {
                   5936:   border: 1px solid #000000;
                   5937:   vertical-align: top;
1.917     raeburn  5938:   width: 14%;
1.349     albertel 5939: }
1.795     www      5940: 
1.349     albertel 5941: table.LC_calendar tr td.LC_calendar_day_empty {
                   5942:   background-color: $data_table_dark;
                   5943: }
1.795     www      5944: 
1.779     bisitz   5945: table.LC_calendar tr td.LC_calendar_day_current {
                   5946:   background-color: $data_table_highlight;
1.777     tempelho 5947: }
1.795     www      5948: 
1.938     bisitz   5949: table.LC_data_table tr td.LC_mail_new {
1.349     albertel 5950:   background-color: $mail_new;
                   5951: }
1.795     www      5952: 
1.938     bisitz   5953: table.LC_data_table tr.LC_mail_new:hover {
1.349     albertel 5954:   background-color: $mail_new_hover;
                   5955: }
1.795     www      5956: 
1.938     bisitz   5957: table.LC_data_table tr td.LC_mail_read {
1.349     albertel 5958:   background-color: $mail_read;
                   5959: }
1.795     www      5960: 
1.938     bisitz   5961: /*
                   5962: table.LC_data_table tr.LC_mail_read:hover {
1.349     albertel 5963:   background-color: $mail_read_hover;
                   5964: }
1.938     bisitz   5965: */
1.795     www      5966: 
1.938     bisitz   5967: table.LC_data_table tr td.LC_mail_replied {
1.349     albertel 5968:   background-color: $mail_replied;
                   5969: }
1.795     www      5970: 
1.938     bisitz   5971: /*
                   5972: table.LC_data_table tr.LC_mail_replied:hover {
1.349     albertel 5973:   background-color: $mail_replied_hover;
                   5974: }
1.938     bisitz   5975: */
1.795     www      5976: 
1.938     bisitz   5977: table.LC_data_table tr td.LC_mail_other {
1.349     albertel 5978:   background-color: $mail_other;
                   5979: }
1.795     www      5980: 
1.938     bisitz   5981: /*
                   5982: table.LC_data_table tr.LC_mail_other:hover {
1.349     albertel 5983:   background-color: $mail_other_hover;
                   5984: }
1.938     bisitz   5985: */
1.494     raeburn  5986: 
1.777     tempelho 5987: table.LC_data_table tr > td.LC_browser_file,
                   5988: table.LC_data_table tr > td.LC_browser_file_published {
1.899     bisitz   5989:   background: #AAEE77;
1.389     albertel 5990: }
1.795     www      5991: 
1.777     tempelho 5992: table.LC_data_table tr > td.LC_browser_file_locked,
                   5993: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389     albertel 5994:   background: #FFAA99;
1.387     albertel 5995: }
1.795     www      5996: 
1.777     tempelho 5997: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899     bisitz   5998:   background: #888888;
1.779     bisitz   5999: }
1.795     www      6000: 
1.777     tempelho 6001: table.LC_data_table tr > td.LC_browser_file_modified,
1.779     bisitz   6002: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899     bisitz   6003:   background: #F8F866;
1.777     tempelho 6004: }
1.795     www      6005: 
1.696     bisitz   6006: table.LC_data_table tr.LC_browser_folder > td {
1.899     bisitz   6007:   background: #E0E8FF;
1.387     albertel 6008: }
1.696     bisitz   6009: 
1.707     bisitz   6010: table.LC_data_table tr > td.LC_roles_is {
1.911     bisitz   6011:   /* background: #77FF77; */
1.707     bisitz   6012: }
1.795     www      6013: 
1.707     bisitz   6014: table.LC_data_table tr > td.LC_roles_future {
1.939     bisitz   6015:   border-right: 8px solid #FFFF77;
1.707     bisitz   6016: }
1.795     www      6017: 
1.707     bisitz   6018: table.LC_data_table tr > td.LC_roles_will {
1.939     bisitz   6019:   border-right: 8px solid #FFAA77;
1.707     bisitz   6020: }
1.795     www      6021: 
1.707     bisitz   6022: table.LC_data_table tr > td.LC_roles_expired {
1.939     bisitz   6023:   border-right: 8px solid #FF7777;
1.707     bisitz   6024: }
1.795     www      6025: 
1.707     bisitz   6026: table.LC_data_table tr > td.LC_roles_will_not {
1.939     bisitz   6027:   border-right: 8px solid #AAFF77;
1.707     bisitz   6028: }
1.795     www      6029: 
1.707     bisitz   6030: table.LC_data_table tr > td.LC_roles_selected {
1.939     bisitz   6031:   border-right: 8px solid #11CC55;
1.707     bisitz   6032: }
                   6033: 
1.388     albertel 6034: span.LC_current_location {
1.701     harmsja  6035:   font-size:larger;
1.388     albertel 6036:   background: $pgbg;
                   6037: }
1.387     albertel 6038: 
1.1029    www      6039: span.LC_current_nav_location {
                   6040:   font-weight:bold;
                   6041:   background: $sidebg;
                   6042: }
                   6043: 
1.395     albertel 6044: span.LC_parm_menu_item {
                   6045:   font-size: larger;
                   6046: }
1.795     www      6047: 
1.395     albertel 6048: span.LC_parm_scope_all {
                   6049:   color: red;
                   6050: }
1.795     www      6051: 
1.395     albertel 6052: span.LC_parm_scope_folder {
                   6053:   color: green;
                   6054: }
1.795     www      6055: 
1.395     albertel 6056: span.LC_parm_scope_resource {
                   6057:   color: orange;
                   6058: }
1.795     www      6059: 
1.395     albertel 6060: span.LC_parm_part {
                   6061:   color: blue;
                   6062: }
1.795     www      6063: 
1.911     bisitz   6064: span.LC_parm_folder,
                   6065: span.LC_parm_symb {
1.395     albertel 6066:   font-size: x-small;
                   6067:   font-family: $mono;
                   6068:   color: #AAAAAA;
                   6069: }
                   6070: 
1.977     bisitz   6071: ul.LC_parm_parmlist li {
                   6072:   display: inline-block;
                   6073:   padding: 0.3em 0.8em;
                   6074:   vertical-align: top;
                   6075:   width: 150px;
                   6076:   border-top:1px solid $lg_border_color;
                   6077: }
                   6078: 
1.795     www      6079: td.LC_parm_overview_level_menu,
                   6080: td.LC_parm_overview_map_menu,
                   6081: td.LC_parm_overview_parm_selectors,
                   6082: td.LC_parm_overview_restrictions  {
1.396     albertel 6083:   border: 1px solid black;
                   6084:   border-collapse: collapse;
                   6085: }
1.795     www      6086: 
1.396     albertel 6087: table.LC_parm_overview_restrictions td {
                   6088:   border-width: 1px 4px 1px 4px;
                   6089:   border-style: solid;
                   6090:   border-color: $pgbg;
                   6091:   text-align: center;
                   6092: }
1.795     www      6093: 
1.396     albertel 6094: table.LC_parm_overview_restrictions th {
                   6095:   background: $tabbg;
                   6096:   border-width: 1px 4px 1px 4px;
                   6097:   border-style: solid;
                   6098:   border-color: $pgbg;
                   6099: }
1.795     www      6100: 
1.398     albertel 6101: table#LC_helpmenu {
1.803     bisitz   6102:   border: none;
1.398     albertel 6103:   height: 55px;
1.803     bisitz   6104:   border-spacing: 0;
1.398     albertel 6105: }
                   6106: 
                   6107: table#LC_helpmenu fieldset legend {
                   6108:   font-size: larger;
                   6109: }
1.795     www      6110: 
1.397     albertel 6111: table#LC_helpmenu_links {
                   6112:   width: 100%;
                   6113:   border: 1px solid black;
                   6114:   background: $pgbg;
1.803     bisitz   6115:   padding: 0;
1.397     albertel 6116:   border-spacing: 1px;
                   6117: }
1.795     www      6118: 
1.397     albertel 6119: table#LC_helpmenu_links tr td {
                   6120:   padding: 1px;
                   6121:   background: $tabbg;
1.399     albertel 6122:   text-align: center;
                   6123:   font-weight: bold;
1.397     albertel 6124: }
1.396     albertel 6125: 
1.795     www      6126: table#LC_helpmenu_links a:link,
                   6127: table#LC_helpmenu_links a:visited,
1.397     albertel 6128: table#LC_helpmenu_links a:active {
                   6129:   text-decoration: none;
                   6130:   color: $font;
                   6131: }
1.795     www      6132: 
1.397     albertel 6133: table#LC_helpmenu_links a:hover {
                   6134:   text-decoration: underline;
                   6135:   color: $vlink;
                   6136: }
1.396     albertel 6137: 
1.417     albertel 6138: .LC_chrt_popup_exists {
                   6139:   border: 1px solid #339933;
                   6140:   margin: -1px;
                   6141: }
1.795     www      6142: 
1.417     albertel 6143: .LC_chrt_popup_up {
                   6144:   border: 1px solid yellow;
                   6145:   margin: -1px;
                   6146: }
1.795     www      6147: 
1.417     albertel 6148: .LC_chrt_popup {
                   6149:   border: 1px solid #8888FF;
                   6150:   background: #CCCCFF;
                   6151: }
1.795     www      6152: 
1.421     albertel 6153: table.LC_pick_box {
                   6154:   border-collapse: separate;
                   6155:   background: white;
                   6156:   border: 1px solid black;
                   6157:   border-spacing: 1px;
                   6158: }
1.795     www      6159: 
1.421     albertel 6160: table.LC_pick_box td.LC_pick_box_title {
1.850     bisitz   6161:   background: $sidebg;
1.421     albertel 6162:   font-weight: bold;
1.900     bisitz   6163:   text-align: left;
1.740     bisitz   6164:   vertical-align: top;
1.421     albertel 6165:   width: 184px;
                   6166:   padding: 8px;
                   6167: }
1.795     www      6168: 
1.579     raeburn  6169: table.LC_pick_box td.LC_pick_box_value {
                   6170:   text-align: left;
                   6171:   padding: 8px;
                   6172: }
1.795     www      6173: 
1.579     raeburn  6174: table.LC_pick_box td.LC_pick_box_select {
                   6175:   text-align: left;
                   6176:   padding: 8px;
                   6177: }
1.795     www      6178: 
1.424     albertel 6179: table.LC_pick_box td.LC_pick_box_separator {
1.803     bisitz   6180:   padding: 0;
1.421     albertel 6181:   height: 1px;
                   6182:   background: black;
                   6183: }
1.795     www      6184: 
1.421     albertel 6185: table.LC_pick_box td.LC_pick_box_submit {
                   6186:   text-align: right;
                   6187: }
1.795     www      6188: 
1.579     raeburn  6189: table.LC_pick_box td.LC_evenrow_value {
                   6190:   text-align: left;
                   6191:   padding: 8px;
                   6192:   background-color: $data_table_light;
                   6193: }
1.795     www      6194: 
1.579     raeburn  6195: table.LC_pick_box td.LC_oddrow_value {
                   6196:   text-align: left;
                   6197:   padding: 8px;
                   6198:   background-color: $data_table_light;
                   6199: }
1.795     www      6200: 
1.579     raeburn  6201: span.LC_helpform_receipt_cat {
                   6202:   font-weight: bold;
                   6203: }
1.795     www      6204: 
1.424     albertel 6205: table.LC_group_priv_box {
                   6206:   background: white;
                   6207:   border: 1px solid black;
                   6208:   border-spacing: 1px;
                   6209: }
1.795     www      6210: 
1.424     albertel 6211: table.LC_group_priv_box td.LC_pick_box_title {
                   6212:   background: $tabbg;
                   6213:   font-weight: bold;
                   6214:   text-align: right;
                   6215:   width: 184px;
                   6216: }
1.795     www      6217: 
1.424     albertel 6218: table.LC_group_priv_box td.LC_groups_fixed {
                   6219:   background: $data_table_light;
                   6220:   text-align: center;
                   6221: }
1.795     www      6222: 
1.424     albertel 6223: table.LC_group_priv_box td.LC_groups_optional {
                   6224:   background: $data_table_dark;
                   6225:   text-align: center;
                   6226: }
1.795     www      6227: 
1.424     albertel 6228: table.LC_group_priv_box td.LC_groups_functionality {
                   6229:   background: $data_table_darker;
                   6230:   text-align: center;
                   6231:   font-weight: bold;
                   6232: }
1.795     www      6233: 
1.424     albertel 6234: table.LC_group_priv td {
                   6235:   text-align: left;
1.803     bisitz   6236:   padding: 0;
1.424     albertel 6237: }
                   6238: 
                   6239: .LC_navbuttons {
                   6240:   margin: 2ex 0ex 2ex 0ex;
                   6241: }
1.795     www      6242: 
1.423     albertel 6243: .LC_topic_bar {
                   6244:   font-weight: bold;
                   6245:   background: $tabbg;
1.918     wenzelju 6246:   margin: 1em 0em 1em 2em;
1.805     bisitz   6247:   padding: 3px;
1.918     wenzelju 6248:   font-size: 1.2em;
1.423     albertel 6249: }
1.795     www      6250: 
1.423     albertel 6251: .LC_topic_bar span {
1.918     wenzelju 6252:   left: 0.5em;
                   6253:   position: absolute;
1.423     albertel 6254:   vertical-align: middle;
1.918     wenzelju 6255:   font-size: 1.2em;
1.423     albertel 6256: }
1.795     www      6257: 
1.423     albertel 6258: table.LC_course_group_status {
                   6259:   margin: 20px;
                   6260: }
1.795     www      6261: 
1.423     albertel 6262: table.LC_status_selector td {
                   6263:   vertical-align: top;
                   6264:   text-align: center;
1.424     albertel 6265:   padding: 4px;
                   6266: }
1.795     www      6267: 
1.599     albertel 6268: div.LC_feedback_link {
1.616     albertel 6269:   clear: both;
1.829     kalberla 6270:   background: $sidebg;
1.779     bisitz   6271:   width: 100%;
1.829     kalberla 6272:   padding-bottom: 10px;
                   6273:   border: 1px $tabbg solid;
1.833     kalberla 6274:   height: 22px;
                   6275:   line-height: 22px;
                   6276:   padding-top: 5px;
                   6277: }
                   6278: 
                   6279: div.LC_feedback_link img {
                   6280:   height: 22px;
1.867     kalberla 6281:   vertical-align:middle;
1.829     kalberla 6282: }
                   6283: 
1.911     bisitz   6284: div.LC_feedback_link a {
1.829     kalberla 6285:   text-decoration: none;
1.489     raeburn  6286: }
1.795     www      6287: 
1.867     kalberla 6288: div.LC_comblock {
1.911     bisitz   6289:   display:inline;
1.867     kalberla 6290:   color:$font;
                   6291:   font-size:90%;
                   6292: }
                   6293: 
                   6294: div.LC_feedback_link div.LC_comblock {
                   6295:   padding-left:5px;
                   6296: }
                   6297: 
                   6298: div.LC_feedback_link div.LC_comblock a {
                   6299:   color:$font;
                   6300: }
                   6301: 
1.489     raeburn  6302: span.LC_feedback_link {
1.858     bisitz   6303:   /* background: $feedback_link_bg; */
1.599     albertel 6304:   font-size: larger;
                   6305: }
1.795     www      6306: 
1.599     albertel 6307: span.LC_message_link {
1.858     bisitz   6308:   /* background: $feedback_link_bg; */
1.599     albertel 6309:   font-size: larger;
                   6310:   position: absolute;
                   6311:   right: 1em;
1.489     raeburn  6312: }
1.421     albertel 6313: 
1.515     albertel 6314: table.LC_prior_tries {
1.524     albertel 6315:   border: 1px solid #000000;
                   6316:   border-collapse: separate;
                   6317:   border-spacing: 1px;
1.515     albertel 6318: }
1.523     albertel 6319: 
1.515     albertel 6320: table.LC_prior_tries td {
1.524     albertel 6321:   padding: 2px;
1.515     albertel 6322: }
1.523     albertel 6323: 
                   6324: .LC_answer_correct {
1.795     www      6325:   background: lightgreen;
                   6326:   color: darkgreen;
                   6327:   padding: 6px;
1.523     albertel 6328: }
1.795     www      6329: 
1.523     albertel 6330: .LC_answer_charged_try {
1.797     www      6331:   background: #FFAAAA;
1.795     www      6332:   color: darkred;
                   6333:   padding: 6px;
1.523     albertel 6334: }
1.795     www      6335: 
1.779     bisitz   6336: .LC_answer_not_charged_try,
1.523     albertel 6337: .LC_answer_no_grade,
                   6338: .LC_answer_late {
1.795     www      6339:   background: lightyellow;
1.523     albertel 6340:   color: black;
1.795     www      6341:   padding: 6px;
1.523     albertel 6342: }
1.795     www      6343: 
1.523     albertel 6344: .LC_answer_previous {
1.795     www      6345:   background: lightblue;
                   6346:   color: darkblue;
                   6347:   padding: 6px;
1.523     albertel 6348: }
1.795     www      6349: 
1.779     bisitz   6350: .LC_answer_no_message {
1.777     tempelho 6351:   background: #FFFFFF;
                   6352:   color: black;
1.795     www      6353:   padding: 6px;
1.779     bisitz   6354: }
1.795     www      6355: 
1.779     bisitz   6356: .LC_answer_unknown {
                   6357:   background: orange;
                   6358:   color: black;
1.795     www      6359:   padding: 6px;
1.777     tempelho 6360: }
1.795     www      6361: 
1.529     albertel 6362: span.LC_prior_numerical,
                   6363: span.LC_prior_string,
                   6364: span.LC_prior_custom,
                   6365: span.LC_prior_reaction,
                   6366: span.LC_prior_math {
1.925     bisitz   6367:   font-family: $mono;
1.523     albertel 6368:   white-space: pre;
                   6369: }
                   6370: 
1.525     albertel 6371: span.LC_prior_string {
1.925     bisitz   6372:   font-family: $mono;
1.525     albertel 6373:   white-space: pre;
                   6374: }
                   6375: 
1.523     albertel 6376: table.LC_prior_option {
                   6377:   width: 100%;
                   6378:   border-collapse: collapse;
                   6379: }
1.795     www      6380: 
1.911     bisitz   6381: table.LC_prior_rank,
1.795     www      6382: table.LC_prior_match {
1.528     albertel 6383:   border-collapse: collapse;
                   6384: }
1.795     www      6385: 
1.528     albertel 6386: table.LC_prior_option tr td,
                   6387: table.LC_prior_rank tr td,
                   6388: table.LC_prior_match tr td {
1.524     albertel 6389:   border: 1px solid #000000;
1.515     albertel 6390: }
                   6391: 
1.855     bisitz   6392: .LC_nobreak {
1.544     albertel 6393:   white-space: nowrap;
1.519     raeburn  6394: }
                   6395: 
1.576     raeburn  6396: span.LC_cusr_emph {
                   6397:   font-style: italic;
                   6398: }
                   6399: 
1.633     raeburn  6400: span.LC_cusr_subheading {
                   6401:   font-weight: normal;
                   6402:   font-size: 85%;
                   6403: }
                   6404: 
1.861     bisitz   6405: div.LC_docs_entry_move {
1.859     bisitz   6406:   border: 1px solid #BBBBBB;
1.545     albertel 6407:   background: #DDDDDD;
1.861     bisitz   6408:   width: 22px;
1.859     bisitz   6409:   padding: 1px;
                   6410:   margin: 0;
1.545     albertel 6411: }
                   6412: 
1.861     bisitz   6413: table.LC_data_table tr > td.LC_docs_entry_commands,
                   6414: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545     albertel 6415:   font-size: x-small;
                   6416: }
1.795     www      6417: 
1.861     bisitz   6418: .LC_docs_entry_parameter {
                   6419:   white-space: nowrap;
                   6420: }
                   6421: 
1.544     albertel 6422: .LC_docs_copy {
1.545     albertel 6423:   color: #000099;
1.544     albertel 6424: }
1.795     www      6425: 
1.544     albertel 6426: .LC_docs_cut {
1.545     albertel 6427:   color: #550044;
1.544     albertel 6428: }
1.795     www      6429: 
1.544     albertel 6430: .LC_docs_rename {
1.545     albertel 6431:   color: #009900;
1.544     albertel 6432: }
1.795     www      6433: 
1.544     albertel 6434: .LC_docs_remove {
1.545     albertel 6435:   color: #990000;
                   6436: }
                   6437: 
1.547     albertel 6438: .LC_docs_reinit_warn,
                   6439: .LC_docs_ext_edit {
                   6440:   font-size: x-small;
                   6441: }
                   6442: 
1.545     albertel 6443: table.LC_docs_adddocs td,
                   6444: table.LC_docs_adddocs th {
                   6445:   border: 1px solid #BBBBBB;
                   6446:   padding: 4px;
                   6447:   background: #DDDDDD;
1.543     albertel 6448: }
                   6449: 
1.584     albertel 6450: table.LC_sty_begin {
                   6451:   background: #BBFFBB;
                   6452: }
1.795     www      6453: 
1.584     albertel 6454: table.LC_sty_end {
                   6455:   background: #FFBBBB;
                   6456: }
                   6457: 
1.589     raeburn  6458: table.LC_double_column {
1.803     bisitz   6459:   border-width: 0;
1.589     raeburn  6460:   border-collapse: collapse;
                   6461:   width: 100%;
                   6462:   padding: 2px;
                   6463: }
                   6464: 
                   6465: table.LC_double_column tr td.LC_left_col {
1.590     raeburn  6466:   top: 2px;
1.589     raeburn  6467:   left: 2px;
                   6468:   width: 47%;
                   6469:   vertical-align: top;
                   6470: }
                   6471: 
                   6472: table.LC_double_column tr td.LC_right_col {
                   6473:   top: 2px;
1.779     bisitz   6474:   right: 2px;
1.589     raeburn  6475:   width: 47%;
                   6476:   vertical-align: top;
                   6477: }
                   6478: 
1.591     raeburn  6479: div.LC_left_float {
                   6480:   float: left;
                   6481:   padding-right: 5%;
1.597     albertel 6482:   padding-bottom: 4px;
1.591     raeburn  6483: }
                   6484: 
                   6485: div.LC_clear_float_header {
1.597     albertel 6486:   padding-bottom: 2px;
1.591     raeburn  6487: }
                   6488: 
                   6489: div.LC_clear_float_footer {
1.597     albertel 6490:   padding-top: 10px;
1.591     raeburn  6491:   clear: both;
                   6492: }
                   6493: 
1.597     albertel 6494: div.LC_grade_show_user {
1.941     bisitz   6495: /*  border-left: 5px solid $sidebg; */
                   6496:   border-top: 5px solid #000000;
                   6497:   margin: 50px 0 0 0;
1.936     bisitz   6498:   padding: 15px 0 5px 10px;
1.597     albertel 6499: }
1.795     www      6500: 
1.936     bisitz   6501: div.LC_grade_show_user_odd_row {
1.941     bisitz   6502: /*  border-left: 5px solid #000000; */
                   6503: }
                   6504: 
                   6505: div.LC_grade_show_user div.LC_Box {
                   6506:   margin-right: 50px;
1.597     albertel 6507: }
                   6508: 
                   6509: div.LC_grade_submissions,
                   6510: div.LC_grade_message_center,
1.936     bisitz   6511: div.LC_grade_info_links {
1.597     albertel 6512:   margin: 5px;
                   6513:   width: 99%;
                   6514:   background: #FFFFFF;
                   6515: }
1.795     www      6516: 
1.597     albertel 6517: div.LC_grade_submissions_header,
1.936     bisitz   6518: div.LC_grade_message_center_header {
1.705     tempelho 6519:   font-weight: bold;
                   6520:   font-size: large;
1.597     albertel 6521: }
1.795     www      6522: 
1.597     albertel 6523: div.LC_grade_submissions_body,
1.936     bisitz   6524: div.LC_grade_message_center_body {
1.597     albertel 6525:   border: 1px solid black;
                   6526:   width: 99%;
                   6527:   background: #FFFFFF;
                   6528: }
1.795     www      6529: 
1.613     albertel 6530: table.LC_scantron_action {
                   6531:   width: 100%;
                   6532: }
1.795     www      6533: 
1.613     albertel 6534: table.LC_scantron_action tr th {
1.698     harmsja  6535:   font-weight:bold;
                   6536:   font-style:normal;
1.613     albertel 6537: }
1.795     www      6538: 
1.779     bisitz   6539: .LC_edit_problem_header,
1.614     albertel 6540: div.LC_edit_problem_footer {
1.705     tempelho 6541:   font-weight: normal;
                   6542:   font-size:  medium;
1.602     albertel 6543:   margin: 2px;
1.1060    bisitz   6544:   background-color: $sidebg;
1.600     albertel 6545: }
1.795     www      6546: 
1.600     albertel 6547: div.LC_edit_problem_header,
1.602     albertel 6548: div.LC_edit_problem_header div,
1.614     albertel 6549: div.LC_edit_problem_footer,
                   6550: div.LC_edit_problem_footer div,
1.602     albertel 6551: div.LC_edit_problem_editxml_header,
                   6552: div.LC_edit_problem_editxml_header div {
1.600     albertel 6553:   margin-top: 5px;
                   6554: }
1.795     www      6555: 
1.600     albertel 6556: div.LC_edit_problem_header_title {
1.705     tempelho 6557:   font-weight: bold;
                   6558:   font-size: larger;
1.602     albertel 6559:   background: $tabbg;
                   6560:   padding: 3px;
1.1060    bisitz   6561:   margin: 0 0 5px 0;
1.602     albertel 6562: }
1.795     www      6563: 
1.602     albertel 6564: table.LC_edit_problem_header_title {
                   6565:   width: 100%;
1.600     albertel 6566:   background: $tabbg;
1.602     albertel 6567: }
                   6568: 
                   6569: div.LC_edit_problem_discards {
                   6570:   float: left;
                   6571:   padding-bottom: 5px;
                   6572: }
1.795     www      6573: 
1.602     albertel 6574: div.LC_edit_problem_saves {
                   6575:   float: right;
                   6576:   padding-bottom: 5px;
1.600     albertel 6577: }
1.795     www      6578: 
1.1075.2.34  raeburn  6579: .LC_edit_opt {
                   6580:   padding-left: 1em;
                   6581:   white-space: nowrap;
                   6582: }
                   6583: 
1.1075.2.57  raeburn  6584: .LC_edit_problem_latexhelper{
                   6585:     text-align: right;
                   6586: }
                   6587: 
                   6588: #LC_edit_problem_colorful div{
                   6589:     margin-left: 40px;
                   6590: }
                   6591: 
1.911     bisitz   6592: img.stift {
1.803     bisitz   6593:   border-width: 0;
                   6594:   vertical-align: middle;
1.677     riegler  6595: }
1.680     riegler  6596: 
1.923     bisitz   6597: table td.LC_mainmenu_col_fieldset {
1.680     riegler  6598:   vertical-align: top;
1.777     tempelho 6599: }
1.795     www      6600: 
1.716     raeburn  6601: div.LC_createcourse {
1.911     bisitz   6602:   margin: 10px 10px 10px 10px;
1.716     raeburn  6603: }
                   6604: 
1.917     raeburn  6605: .LC_dccid {
1.1075.2.38  raeburn  6606:   float: right;
1.917     raeburn  6607:   margin: 0.2em 0 0 0;
                   6608:   padding: 0;
                   6609:   font-size: 90%;
                   6610:   display:none;
                   6611: }
                   6612: 
1.897     wenzelju 6613: ol.LC_primary_menu a:hover,
1.721     harmsja  6614: ol#LC_MenuBreadcrumbs a:hover,
                   6615: ol#LC_PathBreadcrumbs a:hover,
1.897     wenzelju 6616: ul#LC_secondary_menu a:hover,
1.721     harmsja  6617: .LC_FormSectionClearButton input:hover
1.795     www      6618: ul.LC_TabContent   li:hover a {
1.952     onken    6619:   color:$button_hover;
1.911     bisitz   6620:   text-decoration:none;
1.693     droeschl 6621: }
                   6622: 
1.779     bisitz   6623: h1 {
1.911     bisitz   6624:   padding: 0;
                   6625:   line-height:130%;
1.693     droeschl 6626: }
1.698     harmsja  6627: 
1.911     bisitz   6628: h2,
                   6629: h3,
                   6630: h4,
                   6631: h5,
                   6632: h6 {
                   6633:   margin: 5px 0 5px 0;
                   6634:   padding: 0;
                   6635:   line-height:130%;
1.693     droeschl 6636: }
1.795     www      6637: 
                   6638: .LC_hcell {
1.911     bisitz   6639:   padding:3px 15px 3px 15px;
                   6640:   margin: 0;
                   6641:   background-color:$tabbg;
                   6642:   color:$fontmenu;
                   6643:   border-bottom:solid 1px $lg_border_color;
1.693     droeschl 6644: }
1.795     www      6645: 
1.840     bisitz   6646: .LC_Box > .LC_hcell {
1.911     bisitz   6647:   margin: 0 -10px 10px -10px;
1.835     bisitz   6648: }
                   6649: 
1.721     harmsja  6650: .LC_noBorder {
1.911     bisitz   6651:   border: 0;
1.698     harmsja  6652: }
1.693     droeschl 6653: 
1.721     harmsja  6654: .LC_FormSectionClearButton input {
1.911     bisitz   6655:   background-color:transparent;
                   6656:   border: none;
                   6657:   cursor:pointer;
                   6658:   text-decoration:underline;
1.693     droeschl 6659: }
1.763     bisitz   6660: 
                   6661: .LC_help_open_topic {
1.911     bisitz   6662:   color: #FFFFFF;
                   6663:   background-color: #EEEEFF;
                   6664:   margin: 1px;
                   6665:   padding: 4px;
                   6666:   border: 1px solid #000033;
                   6667:   white-space: nowrap;
                   6668:   /* vertical-align: middle; */
1.759     neumanie 6669: }
1.693     droeschl 6670: 
1.911     bisitz   6671: dl,
                   6672: ul,
                   6673: div,
                   6674: fieldset {
                   6675:   margin: 10px 10px 10px 0;
                   6676:   /* overflow: hidden; */
1.693     droeschl 6677: }
1.795     www      6678: 
1.838     bisitz   6679: fieldset > legend {
1.911     bisitz   6680:   font-weight: bold;
                   6681:   padding: 0 5px 0 5px;
1.838     bisitz   6682: }
                   6683: 
1.813     bisitz   6684: #LC_nav_bar {
1.911     bisitz   6685:   float: left;
1.995     raeburn  6686:   background-color: $pgbg_or_bgcolor;
1.966     bisitz   6687:   margin: 0 0 2px 0;
1.807     droeschl 6688: }
                   6689: 
1.916     droeschl 6690: #LC_realm {
                   6691:   margin: 0.2em 0 0 0;
                   6692:   padding: 0;
                   6693:   font-weight: bold;
                   6694:   text-align: center;
1.995     raeburn  6695:   background-color: $pgbg_or_bgcolor;
1.916     droeschl 6696: }
                   6697: 
1.911     bisitz   6698: #LC_nav_bar em {
                   6699:   font-weight: bold;
                   6700:   font-style: normal;
1.807     droeschl 6701: }
                   6702: 
1.897     wenzelju 6703: ol.LC_primary_menu {
1.934     droeschl 6704:   margin: 0;
1.1075.2.2  raeburn  6705:   padding: 0;
1.995     raeburn  6706:   background-color: $pgbg_or_bgcolor;
1.807     droeschl 6707: }
                   6708: 
1.852     droeschl 6709: ol#LC_PathBreadcrumbs {
1.911     bisitz   6710:   margin: 0;
1.693     droeschl 6711: }
                   6712: 
1.897     wenzelju 6713: ol.LC_primary_menu li {
1.1075.2.2  raeburn  6714:   color: RGB(80, 80, 80);
                   6715:   vertical-align: middle;
                   6716:   text-align: left;
                   6717:   list-style: none;
                   6718:   float: left;
                   6719: }
                   6720: 
                   6721: ol.LC_primary_menu li a {
                   6722:   display: block;
                   6723:   margin: 0;
                   6724:   padding: 0 5px 0 10px;
                   6725:   text-decoration: none;
                   6726: }
                   6727: 
                   6728: ol.LC_primary_menu li ul {
                   6729:   display: none;
                   6730:   width: 10em;
                   6731:   background-color: $data_table_light;
                   6732: }
                   6733: 
                   6734: ol.LC_primary_menu li:hover ul, ol.LC_primary_menu li.hover ul {
                   6735:   display: block;
                   6736:   position: absolute;
                   6737:   margin: 0;
                   6738:   padding: 0;
1.1075.2.5  raeburn  6739:   z-index: 2;
1.1075.2.2  raeburn  6740: }
                   6741: 
                   6742: ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
                   6743:   font-size: 90%;
1.911     bisitz   6744:   vertical-align: top;
1.1075.2.2  raeburn  6745:   float: none;
1.1075.2.5  raeburn  6746:   border-left: 1px solid black;
                   6747:   border-right: 1px solid black;
1.1075.2.2  raeburn  6748: }
                   6749: 
                   6750: ol.LC_primary_menu li:hover li a, ol.LC_primary_menu li.hover li a {
1.1075.2.5  raeburn  6751:   background-color:$data_table_light;
1.1075.2.2  raeburn  6752: }
                   6753: 
                   6754: ol.LC_primary_menu li li a:hover {
                   6755:    color:$button_hover;
                   6756:    background-color:$data_table_dark;
1.693     droeschl 6757: }
                   6758: 
1.897     wenzelju 6759: ol.LC_primary_menu li img {
1.911     bisitz   6760:   vertical-align: bottom;
1.934     droeschl 6761:   height: 1.1em;
1.1075.2.3  raeburn  6762:   margin: 0.2em 0 0 0;
1.693     droeschl 6763: }
                   6764: 
1.897     wenzelju 6765: ol.LC_primary_menu a {
1.911     bisitz   6766:   color: RGB(80, 80, 80);
                   6767:   text-decoration: none;
1.693     droeschl 6768: }
1.795     www      6769: 
1.949     droeschl 6770: ol.LC_primary_menu a.LC_new_message {
                   6771:   font-weight:bold;
                   6772:   color: darkred;
                   6773: }
                   6774: 
1.975     raeburn  6775: ol.LC_docs_parameters {
                   6776:   margin-left: 0;
                   6777:   padding: 0;
                   6778:   list-style: none;
                   6779: }
                   6780: 
                   6781: ol.LC_docs_parameters li {
                   6782:   margin: 0;
                   6783:   padding-right: 20px;
                   6784:   display: inline;
                   6785: }
                   6786: 
1.976     raeburn  6787: ol.LC_docs_parameters li:before {
                   6788:   content: "\\002022 \\0020";
                   6789: }
                   6790: 
                   6791: li.LC_docs_parameters_title {
                   6792:   font-weight: bold;
                   6793: }
                   6794: 
                   6795: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
                   6796:   content: "";
                   6797: }
                   6798: 
1.897     wenzelju 6799: ul#LC_secondary_menu {
1.1075.2.23  raeburn  6800:   clear: right;
1.911     bisitz   6801:   color: $fontmenu;
                   6802:   background: $tabbg;
                   6803:   list-style: none;
                   6804:   padding: 0;
                   6805:   margin: 0;
                   6806:   width: 100%;
1.995     raeburn  6807:   text-align: left;
1.1075.2.4  raeburn  6808:   float: left;
1.808     droeschl 6809: }
                   6810: 
1.897     wenzelju 6811: ul#LC_secondary_menu li {
1.911     bisitz   6812:   font-weight: bold;
                   6813:   line-height: 1.8em;
                   6814:   border-right: 1px solid black;
                   6815:   vertical-align: middle;
1.1075.2.4  raeburn  6816:   float: left;
                   6817: }
                   6818: 
                   6819: ul#LC_secondary_menu li.LC_hoverable:hover, ul#LC_secondary_menu li.hover {
                   6820:   background-color: $data_table_light;
                   6821: }
                   6822: 
                   6823: ul#LC_secondary_menu li a {
                   6824:   padding: 0 0.8em;
                   6825: }
                   6826: 
                   6827: ul#LC_secondary_menu li ul {
                   6828:   display: none;
                   6829: }
                   6830: 
                   6831: ul#LC_secondary_menu li:hover ul, ul#LC_secondary_menu li.hover ul {
                   6832:   display: block;
                   6833:   position: absolute;
                   6834:   margin: 0;
                   6835:   padding: 0;
                   6836:   list-style:none;
                   6837:   float: none;
                   6838:   background-color: $data_table_light;
1.1075.2.5  raeburn  6839:   z-index: 2;
1.1075.2.10  raeburn  6840:   margin-left: -1px;
1.1075.2.4  raeburn  6841: }
                   6842: 
                   6843: ul#LC_secondary_menu li ul li {
                   6844:   font-size: 90%;
                   6845:   vertical-align: top;
                   6846:   border-left: 1px solid black;
                   6847:   border-right: 1px solid black;
1.1075.2.33  raeburn  6848:   background-color: $data_table_light;
1.1075.2.4  raeburn  6849:   list-style:none;
                   6850:   float: none;
                   6851: }
                   6852: 
                   6853: ul#LC_secondary_menu li ul li:hover, ul#LC_secondary_menu li ul li.hover {
                   6854:   background-color: $data_table_dark;
1.807     droeschl 6855: }
                   6856: 
1.847     tempelho 6857: ul.LC_TabContent {
1.911     bisitz   6858:   display:block;
                   6859:   background: $sidebg;
                   6860:   border-bottom: solid 1px $lg_border_color;
                   6861:   list-style:none;
1.1020    raeburn  6862:   margin: -1px -10px 0 -10px;
1.911     bisitz   6863:   padding: 0;
1.693     droeschl 6864: }
                   6865: 
1.795     www      6866: ul.LC_TabContent li,
                   6867: ul.LC_TabContentBigger li {
1.911     bisitz   6868:   float:left;
1.741     harmsja  6869: }
1.795     www      6870: 
1.897     wenzelju 6871: ul#LC_secondary_menu li a {
1.911     bisitz   6872:   color: $fontmenu;
                   6873:   text-decoration: none;
1.693     droeschl 6874: }
1.795     www      6875: 
1.721     harmsja  6876: ul.LC_TabContent {
1.952     onken    6877:   min-height:20px;
1.721     harmsja  6878: }
1.795     www      6879: 
                   6880: ul.LC_TabContent li {
1.911     bisitz   6881:   vertical-align:middle;
1.959     onken    6882:   padding: 0 16px 0 10px;
1.911     bisitz   6883:   background-color:$tabbg;
                   6884:   border-bottom:solid 1px $lg_border_color;
1.1020    raeburn  6885:   border-left: solid 1px $font;
1.721     harmsja  6886: }
1.795     www      6887: 
1.847     tempelho 6888: ul.LC_TabContent .right {
1.911     bisitz   6889:   float:right;
1.847     tempelho 6890: }
                   6891: 
1.911     bisitz   6892: ul.LC_TabContent li a,
                   6893: ul.LC_TabContent li {
                   6894:   color:rgb(47,47,47);
                   6895:   text-decoration:none;
                   6896:   font-size:95%;
                   6897:   font-weight:bold;
1.952     onken    6898:   min-height:20px;
                   6899: }
                   6900: 
1.959     onken    6901: ul.LC_TabContent li a:hover,
                   6902: ul.LC_TabContent li a:focus {
1.952     onken    6903:   color: $button_hover;
1.959     onken    6904:   background:none;
                   6905:   outline:none;
1.952     onken    6906: }
                   6907: 
                   6908: ul.LC_TabContent li:hover {
                   6909:   color: $button_hover;
                   6910:   cursor:pointer;
1.721     harmsja  6911: }
1.795     www      6912: 
1.911     bisitz   6913: ul.LC_TabContent li.active {
1.952     onken    6914:   color: $font;
1.911     bisitz   6915:   background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952     onken    6916:   border-bottom:solid 1px #FFFFFF;
                   6917:   cursor: default;
1.744     ehlerst  6918: }
1.795     www      6919: 
1.959     onken    6920: ul.LC_TabContent li.active a {
                   6921:   color:$font;
                   6922:   background:#FFFFFF;
                   6923:   outline: none;
                   6924: }
1.1047    raeburn  6925: 
                   6926: ul.LC_TabContent li.goback {
                   6927:   float: left;
                   6928:   border-left: none;
                   6929: }
                   6930: 
1.870     tempelho 6931: #maincoursedoc {
1.911     bisitz   6932:   clear:both;
1.870     tempelho 6933: }
                   6934: 
                   6935: ul.LC_TabContentBigger {
1.911     bisitz   6936:   display:block;
                   6937:   list-style:none;
                   6938:   padding: 0;
1.870     tempelho 6939: }
                   6940: 
1.795     www      6941: ul.LC_TabContentBigger li {
1.911     bisitz   6942:   vertical-align:bottom;
                   6943:   height: 30px;
                   6944:   font-size:110%;
                   6945:   font-weight:bold;
                   6946:   color: #737373;
1.841     tempelho 6947: }
                   6948: 
1.957     onken    6949: ul.LC_TabContentBigger li.active {
                   6950:   position: relative;
                   6951:   top: 1px;
                   6952: }
                   6953: 
1.870     tempelho 6954: ul.LC_TabContentBigger li a {
1.911     bisitz   6955:   background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
                   6956:   height: 30px;
                   6957:   line-height: 30px;
                   6958:   text-align: center;
                   6959:   display: block;
                   6960:   text-decoration: none;
1.958     onken    6961:   outline: none;  
1.741     harmsja  6962: }
1.795     www      6963: 
1.870     tempelho 6964: ul.LC_TabContentBigger li.active a {
1.911     bisitz   6965:   background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
                   6966:   color:$font;
1.744     ehlerst  6967: }
1.795     www      6968: 
1.870     tempelho 6969: ul.LC_TabContentBigger li b {
1.911     bisitz   6970:   background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
                   6971:   display: block;
                   6972:   float: left;
                   6973:   padding: 0 30px;
1.957     onken    6974:   border-bottom: 1px solid $lg_border_color;
1.870     tempelho 6975: }
                   6976: 
1.956     onken    6977: ul.LC_TabContentBigger li:hover b {
                   6978:   color:$button_hover;
                   6979: }
                   6980: 
1.870     tempelho 6981: ul.LC_TabContentBigger li.active b {
1.911     bisitz   6982:   background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
                   6983:   color:$font;
1.957     onken    6984:   border: 0;
1.741     harmsja  6985: }
1.693     droeschl 6986: 
1.870     tempelho 6987: 
1.862     bisitz   6988: ul.LC_CourseBreadcrumbs {
                   6989:   background: $sidebg;
1.1020    raeburn  6990:   height: 2em;
1.862     bisitz   6991:   padding-left: 10px;
1.1020    raeburn  6992:   margin: 0;
1.862     bisitz   6993:   list-style-position: inside;
                   6994: }
                   6995: 
1.911     bisitz   6996: ol#LC_MenuBreadcrumbs,
1.862     bisitz   6997: ol#LC_PathBreadcrumbs {
1.911     bisitz   6998:   padding-left: 10px;
                   6999:   margin: 0;
1.933     droeschl 7000:   height: 2.5em;  /* equal to #LC_breadcrumbs line-height */
1.693     droeschl 7001: }
                   7002: 
1.911     bisitz   7003: ol#LC_MenuBreadcrumbs li,
                   7004: ol#LC_PathBreadcrumbs li,
1.862     bisitz   7005: ul.LC_CourseBreadcrumbs li {
1.911     bisitz   7006:   display: inline;
1.933     droeschl 7007:   white-space: normal;  
1.693     droeschl 7008: }
                   7009: 
1.823     bisitz   7010: ol#LC_MenuBreadcrumbs li a,
1.862     bisitz   7011: ul.LC_CourseBreadcrumbs li a {
1.911     bisitz   7012:   text-decoration: none;
                   7013:   font-size:90%;
1.693     droeschl 7014: }
1.795     www      7015: 
1.969     droeschl 7016: ol#LC_MenuBreadcrumbs h1 {
                   7017:   display: inline;
                   7018:   font-size: 90%;
                   7019:   line-height: 2.5em;
                   7020:   margin: 0;
                   7021:   padding: 0;
                   7022: }
                   7023: 
1.795     www      7024: ol#LC_PathBreadcrumbs li a {
1.911     bisitz   7025:   text-decoration:none;
                   7026:   font-size:100%;
                   7027:   font-weight:bold;
1.693     droeschl 7028: }
1.795     www      7029: 
1.840     bisitz   7030: .LC_Box {
1.911     bisitz   7031:   border: solid 1px $lg_border_color;
                   7032:   padding: 0 10px 10px 10px;
1.746     neumanie 7033: }
1.795     www      7034: 
1.1020    raeburn  7035: .LC_DocsBox {
                   7036:   border: solid 1px $lg_border_color;
                   7037:   padding: 0 0 10px 10px;
                   7038: }
                   7039: 
1.795     www      7040: .LC_AboutMe_Image {
1.911     bisitz   7041:   float:left;
                   7042:   margin-right:10px;
1.747     neumanie 7043: }
1.795     www      7044: 
                   7045: .LC_Clear_AboutMe_Image {
1.911     bisitz   7046:   clear:left;
1.747     neumanie 7047: }
1.795     www      7048: 
1.721     harmsja  7049: dl.LC_ListStyleClean dt {
1.911     bisitz   7050:   padding-right: 5px;
                   7051:   display: table-header-group;
1.693     droeschl 7052: }
                   7053: 
1.721     harmsja  7054: dl.LC_ListStyleClean dd {
1.911     bisitz   7055:   display: table-row;
1.693     droeschl 7056: }
                   7057: 
1.721     harmsja  7058: .LC_ListStyleClean,
                   7059: .LC_ListStyleSimple,
                   7060: .LC_ListStyleNormal,
1.795     www      7061: .LC_ListStyleSpecial {
1.911     bisitz   7062:   /* display:block; */
                   7063:   list-style-position: inside;
                   7064:   list-style-type: none;
                   7065:   overflow: hidden;
                   7066:   padding: 0;
1.693     droeschl 7067: }
                   7068: 
1.721     harmsja  7069: .LC_ListStyleSimple li,
                   7070: .LC_ListStyleSimple dd,
                   7071: .LC_ListStyleNormal li,
                   7072: .LC_ListStyleNormal dd,
                   7073: .LC_ListStyleSpecial li,
1.795     www      7074: .LC_ListStyleSpecial dd {
1.911     bisitz   7075:   margin: 0;
                   7076:   padding: 5px 5px 5px 10px;
                   7077:   clear: both;
1.693     droeschl 7078: }
                   7079: 
1.721     harmsja  7080: .LC_ListStyleClean li,
                   7081: .LC_ListStyleClean dd {
1.911     bisitz   7082:   padding-top: 0;
                   7083:   padding-bottom: 0;
1.693     droeschl 7084: }
                   7085: 
1.721     harmsja  7086: .LC_ListStyleSimple dd,
1.795     www      7087: .LC_ListStyleSimple li {
1.911     bisitz   7088:   border-bottom: solid 1px $lg_border_color;
1.693     droeschl 7089: }
                   7090: 
1.721     harmsja  7091: .LC_ListStyleSpecial li,
                   7092: .LC_ListStyleSpecial dd {
1.911     bisitz   7093:   list-style-type: none;
                   7094:   background-color: RGB(220, 220, 220);
                   7095:   margin-bottom: 4px;
1.693     droeschl 7096: }
                   7097: 
1.721     harmsja  7098: table.LC_SimpleTable {
1.911     bisitz   7099:   margin:5px;
                   7100:   border:solid 1px $lg_border_color;
1.795     www      7101: }
1.693     droeschl 7102: 
1.721     harmsja  7103: table.LC_SimpleTable tr {
1.911     bisitz   7104:   padding: 0;
                   7105:   border:solid 1px $lg_border_color;
1.693     droeschl 7106: }
1.795     www      7107: 
                   7108: table.LC_SimpleTable thead {
1.911     bisitz   7109:   background:rgb(220,220,220);
1.693     droeschl 7110: }
                   7111: 
1.721     harmsja  7112: div.LC_columnSection {
1.911     bisitz   7113:   display: block;
                   7114:   clear: both;
                   7115:   overflow: hidden;
                   7116:   margin: 0;
1.693     droeschl 7117: }
                   7118: 
1.721     harmsja  7119: div.LC_columnSection>* {
1.911     bisitz   7120:   float: left;
                   7121:   margin: 10px 20px 10px 0;
                   7122:   overflow:hidden;
1.693     droeschl 7123: }
1.721     harmsja  7124: 
1.795     www      7125: table em {
1.911     bisitz   7126:   font-weight: bold;
                   7127:   font-style: normal;
1.748     schulted 7128: }
1.795     www      7129: 
1.779     bisitz   7130: table.LC_tableBrowseRes,
1.795     www      7131: table.LC_tableOfContent {
1.911     bisitz   7132:   border:none;
                   7133:   border-spacing: 1px;
                   7134:   padding: 3px;
                   7135:   background-color: #FFFFFF;
                   7136:   font-size: 90%;
1.753     droeschl 7137: }
1.789     droeschl 7138: 
1.911     bisitz   7139: table.LC_tableOfContent {
                   7140:   border-collapse: collapse;
1.789     droeschl 7141: }
                   7142: 
1.771     droeschl 7143: table.LC_tableBrowseRes a,
1.768     schulted 7144: table.LC_tableOfContent a {
1.911     bisitz   7145:   background-color: transparent;
                   7146:   text-decoration: none;
1.753     droeschl 7147: }
                   7148: 
1.795     www      7149: table.LC_tableOfContent img {
1.911     bisitz   7150:   border: none;
                   7151:   height: 1.3em;
                   7152:   vertical-align: text-bottom;
                   7153:   margin-right: 0.3em;
1.753     droeschl 7154: }
1.757     schulted 7155: 
1.795     www      7156: a#LC_content_toolbar_firsthomework {
1.911     bisitz   7157:   background-image:url(/res/adm/pages/open-first-problem.gif);
1.774     ehlerst  7158: }
                   7159: 
1.795     www      7160: a#LC_content_toolbar_everything {
1.911     bisitz   7161:   background-image:url(/res/adm/pages/show-all.gif);
1.774     ehlerst  7162: }
                   7163: 
1.795     www      7164: a#LC_content_toolbar_uncompleted {
1.911     bisitz   7165:   background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774     ehlerst  7166: }
                   7167: 
1.795     www      7168: #LC_content_toolbar_clearbubbles {
1.911     bisitz   7169:   background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774     ehlerst  7170: }
                   7171: 
1.795     www      7172: a#LC_content_toolbar_changefolder {
1.911     bisitz   7173:   background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757     schulted 7174: }
                   7175: 
1.795     www      7176: a#LC_content_toolbar_changefolder_toggled {
1.911     bisitz   7177:   background-image:url(/res/adm/pages/open-all-folders.gif);
1.757     schulted 7178: }
                   7179: 
1.1043    raeburn  7180: a#LC_content_toolbar_edittoplevel {
                   7181:   background-image:url(/res/adm/pages/edittoplevel.gif);
                   7182: }
                   7183: 
1.795     www      7184: ul#LC_toolbar li a:hover {
1.911     bisitz   7185:   background-position: bottom center;
1.757     schulted 7186: }
                   7187: 
1.795     www      7188: ul#LC_toolbar {
1.911     bisitz   7189:   padding: 0;
                   7190:   margin: 2px;
                   7191:   list-style:none;
                   7192:   position:relative;
                   7193:   background-color:white;
1.1075.2.9  raeburn  7194:   overflow: auto;
1.757     schulted 7195: }
                   7196: 
1.795     www      7197: ul#LC_toolbar li {
1.911     bisitz   7198:   border:1px solid white;
                   7199:   padding: 0;
                   7200:   margin: 0;
                   7201:   float: left;
                   7202:   display:inline;
                   7203:   vertical-align:middle;
1.1075.2.9  raeburn  7204:   white-space: nowrap;
1.911     bisitz   7205: }
1.757     schulted 7206: 
1.783     amueller 7207: 
1.795     www      7208: a.LC_toolbarItem {
1.911     bisitz   7209:   display:block;
                   7210:   padding: 0;
                   7211:   margin: 0;
                   7212:   height: 32px;
                   7213:   width: 32px;
                   7214:   color:white;
                   7215:   border: none;
                   7216:   background-repeat:no-repeat;
                   7217:   background-color:transparent;
1.757     schulted 7218: }
                   7219: 
1.915     droeschl 7220: ul.LC_funclist {
                   7221:     margin: 0;
                   7222:     padding: 0.5em 1em 0.5em 0;
                   7223: }
                   7224: 
1.933     droeschl 7225: ul.LC_funclist > li:first-child {
                   7226:     font-weight:bold; 
                   7227:     margin-left:0.8em;
                   7228: }
                   7229: 
1.915     droeschl 7230: ul.LC_funclist + ul.LC_funclist {
                   7231:     /* 
                   7232:        left border as a seperator if we have more than
                   7233:        one list 
                   7234:     */
                   7235:     border-left: 1px solid $sidebg;
                   7236:     /* 
                   7237:        this hides the left border behind the border of the 
                   7238:        outer box if element is wrapped to the next 'line' 
                   7239:     */
                   7240:     margin-left: -1px;
                   7241: }
                   7242: 
1.843     bisitz   7243: ul.LC_funclist li {
1.915     droeschl 7244:   display: inline;
1.782     bisitz   7245:   white-space: nowrap;
1.915     droeschl 7246:   margin: 0 0 0 25px;
                   7247:   line-height: 150%;
1.782     bisitz   7248: }
                   7249: 
1.974     wenzelju 7250: .LC_hidden {
                   7251:   display: none;
                   7252: }
                   7253: 
1.1030    www      7254: .LCmodal-overlay {
                   7255: 		position:fixed;
                   7256: 		top:0;
                   7257: 		right:0;
                   7258: 		bottom:0;
                   7259: 		left:0;
                   7260: 		height:100%;
                   7261: 		width:100%;
                   7262: 		margin:0;
                   7263: 		padding:0;
                   7264: 		background:#999;
                   7265: 		opacity:.75;
                   7266: 		filter: alpha(opacity=75);
                   7267: 		-moz-opacity: 0.75;
                   7268: 		z-index:101;
                   7269: }
                   7270: 
                   7271: * html .LCmodal-overlay {   
                   7272: 		position: absolute;
                   7273: 		height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
                   7274: }
                   7275: 
                   7276: .LCmodal-window {
                   7277: 		position:fixed;
                   7278: 		top:50%;
                   7279: 		left:50%;
                   7280: 		margin:0;
                   7281: 		padding:0;
                   7282: 		z-index:102;
                   7283: 	}
                   7284: 
                   7285: * html .LCmodal-window {
                   7286: 		position:absolute;
                   7287: }
                   7288: 
                   7289: .LCclose-window {
                   7290: 		position:absolute;
                   7291: 		width:32px;
                   7292: 		height:32px;
                   7293: 		right:8px;
                   7294: 		top:8px;
                   7295: 		background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
                   7296: 		text-indent:-99999px;
                   7297: 		overflow:hidden;
                   7298: 		cursor:pointer;
                   7299: }
                   7300: 
1.1075.2.17  raeburn  7301: /*
                   7302:   styles used by TTH when "Default set of options to pass to tth/m
                   7303:   when converting TeX" in course settings has been set
                   7304: 
                   7305:   option passed: -t
                   7306: 
                   7307: */
                   7308: 
                   7309: td div.comp { margin-top: -0.6ex; margin-bottom: -1ex;}
                   7310: td div.comb { margin-top: -0.6ex; margin-bottom: -.6ex;}
                   7311: td div.hrcomp { line-height: 0.9; margin-top: -0.8ex; margin-bottom: -1ex;}
                   7312: td div.norm {line-height:normal;}
                   7313: 
                   7314: /*
                   7315:   option passed -y3
                   7316: */
                   7317: 
                   7318: span.roman {font-family: serif; font-style: normal; font-weight: normal;}
                   7319: span.overacc2 {position: relative;  left: .8em; top: -1.2ex;}
                   7320: span.overacc1 {position: relative;  left: .6em; top: -1.2ex;}
                   7321: 
1.343     albertel 7322: END
                   7323: }
                   7324: 
1.306     albertel 7325: =pod
                   7326: 
                   7327: =item * &headtag()
                   7328: 
                   7329: Returns a uniform footer for LON-CAPA web pages.
                   7330: 
1.307     albertel 7331: Inputs: $title - optional title for the head
                   7332:         $head_extra - optional extra HTML to put inside the <head>
1.315     albertel 7333:         $args - optional arguments
1.319     albertel 7334:             force_register - if is true call registerurl so the remote is 
                   7335:                              informed
1.415     albertel 7336:             redirect       -> array ref of
                   7337:                                    1- seconds before redirect occurs
                   7338:                                    2- url to redirect to
                   7339:                                    3- whether the side effect should occur
1.315     albertel 7340:                            (side effect of setting 
                   7341:                                $env{'internal.head.redirect'} to the url 
                   7342:                                redirected too)
1.352     albertel 7343:             domain         -> force to color decorate a page for a specific
                   7344:                                domain
                   7345:             function       -> force usage of a specific rolish color scheme
                   7346:             bgcolor        -> override the default page bgcolor
1.460     albertel 7347:             no_auto_mt_title
                   7348:                            -> prevent &mt()ing the title arg
1.464     albertel 7349: 
1.306     albertel 7350: =cut
                   7351: 
                   7352: sub headtag {
1.313     albertel 7353:     my ($title,$head_extra,$args) = @_;
1.306     albertel 7354:     
1.363     albertel 7355:     my $function = $args->{'function'} || &get_users_function();
                   7356:     my $domain   = $args->{'domain'}   || &determinedomain();
                   7357:     my $bgcolor  = $args->{'bgcolor'}  || &designparm($function.'.pgbg',$domain);
1.1075.2.52  raeburn  7358:     my $httphost = $args->{'use_absolute'};
1.418     albertel 7359:     my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458     albertel 7360: 		   $Apache::lonnet::perlvar{'lonVersion'},
1.531     albertel 7361: 		   #time(),
1.418     albertel 7362: 		   $env{'environment.color.timestamp'},
1.363     albertel 7363: 		   $function,$domain,$bgcolor);
                   7364: 
1.369     www      7365:     $url = '/adm/css/'.&escape($url).'.css';
1.363     albertel 7366: 
1.308     albertel 7367:     my $result =
                   7368: 	'<head>'.
1.1075.2.56  raeburn  7369: 	&font_settings($args);
1.319     albertel 7370: 
1.1075.2.72  raeburn  7371:     my $inhibitprint;
                   7372:     if ($args->{'print_suppress'}) {
                   7373:         $inhibitprint = &print_suppression();
                   7374:     }
1.1064    raeburn  7375: 
1.461     albertel 7376:     if (!$args->{'frameset'}) {
                   7377: 	$result .= &Apache::lonhtmlcommon::htmlareaheaders();
                   7378:     }
1.1075.2.12  raeburn  7379:     if ($args->{'force_register'}) {
                   7380:         $result .= &Apache::lonmenu::registerurl(1);
1.319     albertel 7381:     }
1.436     albertel 7382:     if (!$args->{'no_nav_bar'} 
                   7383: 	&& !$args->{'only_body'}
                   7384: 	&& !$args->{'frameset'}) {
1.1075.2.52  raeburn  7385: 	$result .= &help_menu_js($httphost);
1.1032    www      7386:         $result.=&modal_window();
1.1038    www      7387:         $result.=&togglebox_script();
1.1034    www      7388:         $result.=&wishlist_window();
1.1041    www      7389:         $result.=&LCprogressbarUpdate_script();
1.1034    www      7390:     } else {
                   7391:         if ($args->{'add_modal'}) {
                   7392:            $result.=&modal_window();
                   7393:         }
                   7394:         if ($args->{'add_wishlist'}) {
                   7395:            $result.=&wishlist_window();
                   7396:         }
1.1038    www      7397:         if ($args->{'add_togglebox'}) {
                   7398:            $result.=&togglebox_script();
                   7399:         }
1.1041    www      7400:         if ($args->{'add_progressbar'}) {
                   7401:            $result.=&LCprogressbarUpdate_script();
                   7402:         }
1.436     albertel 7403:     }
1.314     albertel 7404:     if (ref($args->{'redirect'})) {
1.414     albertel 7405: 	my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315     albertel 7406: 	$url = &Apache::lonenc::check_encrypt($url);
1.414     albertel 7407: 	if (!$inhibit_continue) {
                   7408: 	    $env{'internal.head.redirect'} = $url;
                   7409: 	}
1.313     albertel 7410: 	$result.=<<ADDMETA
                   7411: <meta http-equiv="pragma" content="no-cache" />
1.344     albertel 7412: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313     albertel 7413: ADDMETA
                   7414:     }
1.306     albertel 7415:     if (!defined($title)) {
                   7416: 	$title = 'The LearningOnline Network with CAPA';
                   7417:     }
1.460     albertel 7418:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
                   7419:     $result .= '<title> LON-CAPA '.$title.'</title>'
1.1075.2.61  raeburn  7420: 	.'<link rel="stylesheet" type="text/css" href="'.$url.'"';
                   7421:     if (!$args->{'frameset'}) {
                   7422:         $result .= ' /';
                   7423:     }
                   7424:     $result .= '>'
1.1064    raeburn  7425:         .$inhibitprint
1.414     albertel 7426: 	.$head_extra;
1.1075.2.42  raeburn  7427:     if ($env{'browser.mobile'}) {
                   7428:         $result .= '
                   7429: <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0">
                   7430: <meta name="apple-mobile-web-app-capable" content="yes" />';
                   7431:     }
1.962     droeschl 7432:     return $result.'</head>';
1.306     albertel 7433: }
                   7434: 
                   7435: =pod
                   7436: 
1.340     albertel 7437: =item * &font_settings()
                   7438: 
                   7439: Returns neccessary <meta> to set the proper encoding
                   7440: 
1.1075.2.56  raeburn  7441: Inputs: optional reference to HASH -- $args passed to &headtag()
1.340     albertel 7442: 
                   7443: =cut
                   7444: 
                   7445: sub font_settings {
1.1075.2.56  raeburn  7446:     my ($args) = @_;
1.340     albertel 7447:     my $headerstring='';
1.1075.2.56  raeburn  7448:     if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) ||
                   7449:         ((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) {
1.340     albertel 7450: 	$headerstring.=
1.1075.2.61  raeburn  7451: 	    '<meta http-equiv="Content-Type" content="text/html; charset=utf-8"';
                   7452:         if (!$args->{'frameset'}) {
                   7453:             $headerstring.= ' /';
                   7454:         }
                   7455:         $headerstring .= '>'."\n";
1.340     albertel 7456:     }
                   7457:     return $headerstring;
                   7458: }
                   7459: 
1.341     albertel 7460: =pod
                   7461: 
1.1064    raeburn  7462: =item * &print_suppression()
                   7463: 
                   7464: In course context returns css which causes the body to be blank when media="print",
                   7465: if printout generation is unavailable for the current resource.
                   7466: 
                   7467: This could be because:
                   7468: 
                   7469: (a) printstartdate is in the future
                   7470: 
                   7471: (b) printenddate is in the past
                   7472: 
                   7473: (c) there is an active exam block with "printout"
                   7474: functionality blocked
                   7475: 
                   7476: Users with pav, pfo or evb privileges are exempt.
                   7477: 
                   7478: Inputs: none
                   7479: 
                   7480: =cut
                   7481: 
                   7482: 
                   7483: sub print_suppression {
                   7484:     my $noprint;
                   7485:     if ($env{'request.course.id'}) {
                   7486:         my $scope = $env{'request.course.id'};
                   7487:         if ((&Apache::lonnet::allowed('pav',$scope)) ||
                   7488:             (&Apache::lonnet::allowed('pfo',$scope))) {
                   7489:             return;
                   7490:         }
                   7491:         if ($env{'request.course.sec'} ne '') {
                   7492:             $scope .= "/$env{'request.course.sec'}";
                   7493:             if ((&Apache::lonnet::allowed('pav',$scope)) ||
                   7494:                 (&Apache::lonnet::allowed('pfo',$scope))) {
1.1065    raeburn  7495:                 return;
1.1064    raeburn  7496:             }
                   7497:         }
                   7498:         my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   7499:         my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1075.2.73  raeburn  7500:         my $blocked = &blocking_status('printout',$cnum,$cdom,undef,1);
1.1064    raeburn  7501:         if ($blocked) {
                   7502:             my $checkrole = "cm./$cdom/$cnum";
                   7503:             if ($env{'request.course.sec'} ne '') {
                   7504:                 $checkrole .= "/$env{'request.course.sec'}";
                   7505:             }
                   7506:             unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
                   7507:                     ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
                   7508:                 $noprint = 1;
                   7509:             }
                   7510:         }
                   7511:         unless ($noprint) {
                   7512:             my $symb = &Apache::lonnet::symbread();
                   7513:             if ($symb ne '') {
                   7514:                 my $navmap = Apache::lonnavmaps::navmap->new();
                   7515:                 if (ref($navmap)) {
                   7516:                     my $res = $navmap->getBySymb($symb);
                   7517:                     if (ref($res)) {
                   7518:                         if (!$res->resprintable()) {
                   7519:                             $noprint = 1;
                   7520:                         }
                   7521:                     }
                   7522:                 }
                   7523:             }
                   7524:         }
                   7525:         if ($noprint) {
                   7526:             return <<"ENDSTYLE";
                   7527: <style type="text/css" media="print">
                   7528:     body { display:none }
                   7529: </style>
                   7530: ENDSTYLE
                   7531:         }
                   7532:     }
                   7533:     return;
                   7534: }
                   7535: 
                   7536: =pod
                   7537: 
1.341     albertel 7538: =item * &xml_begin()
                   7539: 
                   7540: Returns the needed doctype and <html>
                   7541: 
                   7542: Inputs: none
                   7543: 
                   7544: =cut
                   7545: 
                   7546: sub xml_begin {
1.1075.2.61  raeburn  7547:     my ($is_frameset) = @_;
1.341     albertel 7548:     my $output='';
                   7549: 
                   7550:     if ($env{'browser.mathml'}) {
                   7551: 	$output='<?xml version="1.0"?>'
                   7552:             #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
                   7553: #            .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
                   7554:             
                   7555: #	    .'<!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">] >'
                   7556: 	    .'<!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">'
                   7557:             .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" ' 
                   7558: 	    .'xmlns="http://www.w3.org/1999/xhtml">';
1.1075.2.61  raeburn  7559:     } elsif ($is_frameset) {
                   7560:         $output='<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">'."\n".
                   7561:                 '<html>'."\n";
1.341     albertel 7562:     } else {
1.1075.2.61  raeburn  7563: 	$output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'."\n".
                   7564:                 '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'."\n";
1.341     albertel 7565:     }
                   7566:     return $output;
                   7567: }
1.340     albertel 7568: 
                   7569: =pod
                   7570: 
1.306     albertel 7571: =item * &start_page()
                   7572: 
                   7573: Returns a complete <html> .. <body> section for LON-CAPA web pages.
                   7574: 
1.648     raeburn  7575: Inputs:
                   7576: 
                   7577: =over 4
                   7578: 
                   7579: $title - optional title for the page
                   7580: 
                   7581: $head_extra - optional extra HTML to incude inside the <head>
                   7582: 
                   7583: $args - additional optional args supported are:
                   7584: 
                   7585: =over 8
                   7586: 
                   7587:              only_body      -> is true will set &bodytag() onlybodytag
1.317     albertel 7588:                                     arg on
1.814     bisitz   7589:              no_nav_bar     -> is true will set &bodytag() no_nav_bar arg on
1.648     raeburn  7590:              add_entries    -> additional attributes to add to the  <body>
                   7591:              domain         -> force to color decorate a page for a 
1.317     albertel 7592:                                     specific domain
1.648     raeburn  7593:              function       -> force usage of a specific rolish color
1.317     albertel 7594:                                     scheme
1.648     raeburn  7595:              redirect       -> see &headtag()
                   7596:              bgcolor        -> override the default page bg color
                   7597:              js_ready       -> return a string ready for being used in 
1.317     albertel 7598:                                     a javascript writeln
1.648     raeburn  7599:              html_encode    -> return a string ready for being used in 
1.320     albertel 7600:                                     a html attribute
1.648     raeburn  7601:              force_register -> if is true will turn on the &bodytag()
1.317     albertel 7602:                                     $forcereg arg
1.648     raeburn  7603:              frameset       -> if true will start with a <frameset>
1.330     albertel 7604:                                     rather than <body>
1.648     raeburn  7605:              skip_phases    -> hash ref of 
1.338     albertel 7606:                                     head -> skip the <html><head> generation
                   7607:                                     body -> skip all <body> generation
1.1075.2.12  raeburn  7608:              no_inline_link -> if true and in remote mode, don't show the
                   7609:                                     'Switch To Inline Menu' link
1.648     raeburn  7610:              no_auto_mt_title -> prevent &mt()ing the title arg
                   7611:              inherit_jsmath -> when creating popup window in a page,
                   7612:                                     should it have jsmath forced on by the
                   7613:                                     current page
1.867     kalberla 7614:              bread_crumbs ->             Array containing breadcrumbs
1.983     raeburn  7615:              bread_crumbs_component ->  if exists show it as headline else show only the breadcrumbs
1.1075.2.15  raeburn  7616:              group          -> includes the current group, if page is for a
                   7617:                                specific group
1.361     albertel 7618: 
1.648     raeburn  7619: =back
1.460     albertel 7620: 
1.648     raeburn  7621: =back
1.562     albertel 7622: 
1.306     albertel 7623: =cut
                   7624: 
                   7625: sub start_page {
1.309     albertel 7626:     my ($title,$head_extra,$args) = @_;
1.318     albertel 7627:     #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319     albertel 7628: 
1.315     albertel 7629:     $env{'internal.start_page'}++;
1.1075.2.15  raeburn  7630:     my ($result,@advtools);
1.964     droeschl 7631: 
1.338     albertel 7632:     if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1075.2.62  raeburn  7633:         $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);
1.338     albertel 7634:     }
                   7635:     
                   7636:     if (! exists($args->{'skip_phases'}{'body'}) ) {
                   7637: 	if ($args->{'frameset'}) {
                   7638: 	    my $attr_string = &make_attr_string($args->{'force_register'},
                   7639: 						$args->{'add_entries'});
                   7640: 	    $result .= "\n<frameset $attr_string>\n";
1.831     bisitz   7641:         } else {
                   7642:             $result .=
                   7643:                 &bodytag($title, 
                   7644:                          $args->{'function'},       $args->{'add_entries'},
                   7645:                          $args->{'only_body'},      $args->{'domain'},
                   7646:                          $args->{'force_register'}, $args->{'no_nav_bar'},
1.1075.2.12  raeburn  7647:                          $args->{'bgcolor'},        $args->{'no_inline_link'},
1.1075.2.15  raeburn  7648:                          $args,                     \@advtools);
1.831     bisitz   7649:         }
1.330     albertel 7650:     }
1.338     albertel 7651: 
1.315     albertel 7652:     if ($args->{'js_ready'}) {
1.713     kaisler  7653: 		$result = &js_ready($result);
1.315     albertel 7654:     }
1.320     albertel 7655:     if ($args->{'html_encode'}) {
1.713     kaisler  7656: 		$result = &html_encode($result);
                   7657:     }
                   7658: 
1.813     bisitz   7659:     # Preparation for new and consistent functionlist at top of screen
                   7660:     # if ($args->{'functionlist'}) {
                   7661:     #            $result .= &build_functionlist();
                   7662:     #}
                   7663: 
1.964     droeschl 7664:     # Don't add anything more if only_body wanted or in const space
                   7665:     return $result if    $args->{'only_body'} 
                   7666:                       || $env{'request.state'} eq 'construct';
1.813     bisitz   7667: 
                   7668:     #Breadcrumbs
1.758     kaisler  7669:     if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
                   7670: 		&Apache::lonhtmlcommon::clear_breadcrumbs();
                   7671: 		#if any br links exists, add them to the breadcrumbs
                   7672: 		if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {         
                   7673: 			foreach my $crumb (@{$args->{'bread_crumbs'}}){
                   7674: 				&Apache::lonhtmlcommon::add_breadcrumb($crumb);
                   7675: 			}
                   7676: 		}
1.1075.2.19  raeburn  7677:                 # if @advtools array contains items add then to the breadcrumbs
                   7678:                 if (@advtools > 0) {
                   7679:                     &Apache::lonmenu::advtools_crumbs(@advtools);
                   7680:                 }
1.758     kaisler  7681: 
                   7682: 		#if bread_crumbs_component exists show it as headline else show only the breadcrumbs
                   7683: 		if(exists($args->{'bread_crumbs_component'})){
                   7684: 			$result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'});
                   7685: 		}else{
                   7686: 			$result .= &Apache::lonhtmlcommon::breadcrumbs();
                   7687: 		}
1.1075.2.24  raeburn  7688:     } elsif (($env{'environment.remote'} eq 'on') &&
                   7689:              ($env{'form.inhibitmenu'} ne 'yes') &&
                   7690:              ($env{'request.noversionuri'} =~ m{^/res/}) &&
                   7691:              ($env{'request.noversionuri'} !~ m{^/res/adm/pages/})) {
1.1075.2.21  raeburn  7692:         $result .= '<div style="padding:0;margin:0;clear:both"><hr /></div>';
1.320     albertel 7693:     }
1.315     albertel 7694:     return $result;
1.306     albertel 7695: }
                   7696: 
                   7697: sub end_page {
1.315     albertel 7698:     my ($args) = @_;
                   7699:     $env{'internal.end_page'}++;
1.330     albertel 7700:     my $result;
1.335     albertel 7701:     if ($args->{'discussion'}) {
                   7702: 	my ($target,$parser);
                   7703: 	if (ref($args->{'discussion'})) {
                   7704: 	    ($target,$parser) =($args->{'discussion'}{'target'},
                   7705: 				$args->{'discussion'}{'parser'});
                   7706: 	}
                   7707: 	$result .= &Apache::lonxml::xmlend($target,$parser);
                   7708:     }
1.330     albertel 7709:     if ($args->{'frameset'}) {
                   7710: 	$result .= '</frameset>';
                   7711:     } else {
1.635     raeburn  7712: 	$result .= &endbodytag($args);
1.330     albertel 7713:     }
1.1075.2.6  raeburn  7714:     unless ($args->{'notbody'}) {
                   7715:         $result .= "\n</html>";
                   7716:     }
1.330     albertel 7717: 
1.315     albertel 7718:     if ($args->{'js_ready'}) {
1.317     albertel 7719: 	$result = &js_ready($result);
1.315     albertel 7720:     }
1.335     albertel 7721: 
1.320     albertel 7722:     if ($args->{'html_encode'}) {
                   7723: 	$result = &html_encode($result);
                   7724:     }
1.335     albertel 7725: 
1.315     albertel 7726:     return $result;
                   7727: }
                   7728: 
1.1034    www      7729: sub wishlist_window {
                   7730:     return(<<'ENDWISHLIST');
1.1046    raeburn  7731: <script type="text/javascript">
1.1034    www      7732: // <![CDATA[
                   7733: // <!-- BEGIN LON-CAPA Internal
                   7734: function set_wishlistlink(title, path) {
                   7735:     if (!title) {
                   7736:         title = document.title;
                   7737:         title = title.replace(/^LON-CAPA /,'');
                   7738:     }
1.1075.2.65  raeburn  7739:     title = encodeURIComponent(title);
1.1075.2.83  raeburn  7740:     title = title.replace("'","\\\'");
1.1034    www      7741:     if (!path) {
                   7742:         path = location.pathname;
                   7743:     }
1.1075.2.65  raeburn  7744:     path = encodeURIComponent(path);
1.1075.2.83  raeburn  7745:     path = path.replace("'","\\\'");
1.1034    www      7746:     Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
                   7747:                       'wishlistNewLink','width=560,height=350,scrollbars=0');
                   7748: }
                   7749: // END LON-CAPA Internal -->
                   7750: // ]]>
                   7751: </script>
                   7752: ENDWISHLIST
                   7753: }
                   7754: 
1.1030    www      7755: sub modal_window {
                   7756:     return(<<'ENDMODAL');
1.1046    raeburn  7757: <script type="text/javascript">
1.1030    www      7758: // <![CDATA[
                   7759: // <!-- BEGIN LON-CAPA Internal
                   7760: var modalWindow = {
                   7761: 	parent:"body",
                   7762: 	windowId:null,
                   7763: 	content:null,
                   7764: 	width:null,
                   7765: 	height:null,
                   7766: 	close:function()
                   7767: 	{
                   7768: 	        $(".LCmodal-window").remove();
                   7769: 	        $(".LCmodal-overlay").remove();
                   7770: 	},
                   7771: 	open:function()
                   7772: 	{
                   7773: 		var modal = "";
                   7774: 		modal += "<div class=\"LCmodal-overlay\"></div>";
                   7775: 		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;\">";
                   7776: 		modal += this.content;
                   7777: 		modal += "</div>";	
                   7778: 
                   7779: 		$(this.parent).append(modal);
                   7780: 
                   7781: 		$(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
                   7782: 		$(".LCclose-window").click(function(){modalWindow.close();});
                   7783: 		$(".LCmodal-overlay").click(function(){modalWindow.close();});
                   7784: 	}
                   7785: };
1.1075.2.42  raeburn  7786: 	var openMyModal = function(source,width,height,scrolling,transparency,style)
1.1030    www      7787: 	{
1.1075.2.83  raeburn  7788:                 source = source.replace("'","&#39;");
1.1030    www      7789: 		modalWindow.windowId = "myModal";
                   7790: 		modalWindow.width = width;
                   7791: 		modalWindow.height = height;
1.1075.2.80  raeburn  7792: 		modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='"+transparency+"' src='" + source + "' style='"+style+"'></iframe>";
1.1030    www      7793: 		modalWindow.open();
1.1075.2.87! raeburn  7794: 	};
1.1030    www      7795: // END LON-CAPA Internal -->
                   7796: // ]]>
                   7797: </script>
                   7798: ENDMODAL
                   7799: }
                   7800: 
                   7801: sub modal_link {
1.1075.2.42  raeburn  7802:     my ($link,$linktext,$width,$height,$target,$scrolling,$title,$transparency,$style)=@_;
1.1030    www      7803:     unless ($width) { $width=480; }
                   7804:     unless ($height) { $height=400; }
1.1031    www      7805:     unless ($scrolling) { $scrolling='yes'; }
1.1075.2.42  raeburn  7806:     unless ($transparency) { $transparency='true'; }
                   7807: 
1.1074    raeburn  7808:     my $target_attr;
                   7809:     if (defined($target)) {
                   7810:         $target_attr = 'target="'.$target.'"';
                   7811:     }
                   7812:     return <<"ENDLINK";
1.1075.2.42  raeburn  7813: <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">
1.1074    raeburn  7814:            $linktext</a>
                   7815: ENDLINK
1.1030    www      7816: }
                   7817: 
1.1032    www      7818: sub modal_adhoc_script {
                   7819:     my ($funcname,$width,$height,$content)=@_;
                   7820:     return (<<ENDADHOC);
1.1046    raeburn  7821: <script type="text/javascript">
1.1032    www      7822: // <![CDATA[
                   7823:         var $funcname = function()
                   7824:         {
                   7825:                 modalWindow.windowId = "myModal";
                   7826:                 modalWindow.width = $width;
                   7827:                 modalWindow.height = $height;
                   7828:                 modalWindow.content = '$content';
                   7829:                 modalWindow.open();
                   7830:         };  
                   7831: // ]]>
                   7832: </script>
                   7833: ENDADHOC
                   7834: }
                   7835: 
1.1041    www      7836: sub modal_adhoc_inner {
                   7837:     my ($funcname,$width,$height,$content)=@_;
                   7838:     my $innerwidth=$width-20;
                   7839:     $content=&js_ready(
1.1042    www      7840:                &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
1.1075.2.42  raeburn  7841:                  &start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1).
                   7842:                  $content.
1.1041    www      7843:                  &end_scrollbox().
1.1075.2.42  raeburn  7844:                  &end_page()
1.1041    www      7845:              );
                   7846:     return &modal_adhoc_script($funcname,$width,$height,$content);
                   7847: }
                   7848: 
                   7849: sub modal_adhoc_window {
                   7850:     my ($funcname,$width,$height,$content,$linktext)=@_;
                   7851:     return &modal_adhoc_inner($funcname,$width,$height,$content).
                   7852:            "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
                   7853: }
                   7854: 
                   7855: sub modal_adhoc_launch {
                   7856:     my ($funcname,$width,$height,$content)=@_;
                   7857:     return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
                   7858: <script type="text/javascript">
                   7859: // <![CDATA[
                   7860: $funcname();
                   7861: // ]]>
                   7862: </script>
                   7863: ENDLAUNCH
                   7864: }
                   7865: 
                   7866: sub modal_adhoc_close {
                   7867:     return (<<ENDCLOSE);
                   7868: <script type="text/javascript">
                   7869: // <![CDATA[
                   7870: modalWindow.close();
                   7871: // ]]>
                   7872: </script>
                   7873: ENDCLOSE
                   7874: }
                   7875: 
1.1038    www      7876: sub togglebox_script {
                   7877:    return(<<ENDTOGGLE);
                   7878: <script type="text/javascript"> 
                   7879: // <![CDATA[
                   7880: function LCtoggleDisplay(id,hidetext,showtext) {
                   7881:    link = document.getElementById(id + "link").childNodes[0];
                   7882:    with (document.getElementById(id).style) {
                   7883:       if (display == "none" ) {
                   7884:           display = "inline";
                   7885:           link.nodeValue = hidetext;
                   7886:         } else {
                   7887:           display = "none";
                   7888:           link.nodeValue = showtext;
                   7889:        }
                   7890:    }
                   7891: }
                   7892: // ]]>
                   7893: </script>
                   7894: ENDTOGGLE
                   7895: }
                   7896: 
1.1039    www      7897: sub start_togglebox {
                   7898:     my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
                   7899:     unless ($heading) { $heading=''; } else { $heading.=' '; }
                   7900:     unless ($showtext) { $showtext=&mt('show'); }
                   7901:     unless ($hidetext) { $hidetext=&mt('hide'); }
                   7902:     unless ($headerbg) { $headerbg='#FFFFFF'; }
                   7903:     return &start_data_table().
                   7904:            &start_data_table_header_row().
                   7905:            '<td bgcolor="'.$headerbg.'">'.$heading.
                   7906:            '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
                   7907:            $showtext.'\')">'.$showtext.'</a>]</td>'.
                   7908:            &end_data_table_header_row().
                   7909:            '<tr id="'.$id.'" style="display:none""><td>';
                   7910: }
                   7911: 
                   7912: sub end_togglebox {
                   7913:     return '</td></tr>'.&end_data_table();
                   7914: }
                   7915: 
1.1041    www      7916: sub LCprogressbar_script {
1.1045    www      7917:    my ($id)=@_;
1.1041    www      7918:    return(<<ENDPROGRESS);
                   7919: <script type="text/javascript">
                   7920: // <![CDATA[
1.1045    www      7921: \$('#progressbar$id').progressbar({
1.1041    www      7922:   value: 0,
                   7923:   change: function(event, ui) {
                   7924:     var newVal = \$(this).progressbar('option', 'value');
                   7925:     \$('.pblabel', this).text(LCprogressTxt);
                   7926:   }
                   7927: });
                   7928: // ]]>
                   7929: </script>
                   7930: ENDPROGRESS
                   7931: }
                   7932: 
                   7933: sub LCprogressbarUpdate_script {
                   7934:    return(<<ENDPROGRESSUPDATE);
                   7935: <style type="text/css">
                   7936: .ui-progressbar { position:relative; }
                   7937: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
                   7938: </style>
                   7939: <script type="text/javascript">
                   7940: // <![CDATA[
1.1045    www      7941: var LCprogressTxt='---';
                   7942: 
                   7943: function LCupdateProgress(percent,progresstext,id) {
1.1041    www      7944:    LCprogressTxt=progresstext;
1.1045    www      7945:    \$('#progressbar'+id).progressbar('value',percent);
1.1041    www      7946: }
                   7947: // ]]>
                   7948: </script>
                   7949: ENDPROGRESSUPDATE
                   7950: }
                   7951: 
1.1042    www      7952: my $LClastpercent;
1.1045    www      7953: my $LCidcnt;
                   7954: my $LCcurrentid;
1.1042    www      7955: 
1.1041    www      7956: sub LCprogressbar {
1.1042    www      7957:     my ($r)=(@_);
                   7958:     $LClastpercent=0;
1.1045    www      7959:     $LCidcnt++;
                   7960:     $LCcurrentid=$$.'_'.$LCidcnt;
1.1041    www      7961:     my $starting=&mt('Starting');
                   7962:     my $content=(<<ENDPROGBAR);
1.1045    www      7963:   <div id="progressbar$LCcurrentid">
1.1041    www      7964:     <span class="pblabel">$starting</span>
                   7965:   </div>
                   7966: ENDPROGBAR
1.1045    www      7967:     &r_print($r,$content.&LCprogressbar_script($LCcurrentid));
1.1041    www      7968: }
                   7969: 
                   7970: sub LCprogressbarUpdate {
1.1042    www      7971:     my ($r,$val,$text)=@_;
                   7972:     unless ($val) { 
                   7973:        if ($LClastpercent) {
                   7974:            $val=$LClastpercent;
                   7975:        } else {
                   7976:            $val=0;
                   7977:        }
                   7978:     }
1.1041    www      7979:     if ($val<0) { $val=0; }
                   7980:     if ($val>100) { $val=0; }
1.1042    www      7981:     $LClastpercent=$val;
1.1041    www      7982:     unless ($text) { $text=$val.'%'; }
                   7983:     $text=&js_ready($text);
1.1044    www      7984:     &r_print($r,<<ENDUPDATE);
1.1041    www      7985: <script type="text/javascript">
                   7986: // <![CDATA[
1.1045    www      7987: LCupdateProgress($val,'$text','$LCcurrentid');
1.1041    www      7988: // ]]>
                   7989: </script>
                   7990: ENDUPDATE
1.1035    www      7991: }
                   7992: 
1.1042    www      7993: sub LCprogressbarClose {
                   7994:     my ($r)=@_;
                   7995:     $LClastpercent=0;
1.1044    www      7996:     &r_print($r,<<ENDCLOSE);
1.1042    www      7997: <script type="text/javascript">
                   7998: // <![CDATA[
1.1045    www      7999: \$("#progressbar$LCcurrentid").hide('slow'); 
1.1042    www      8000: // ]]>
                   8001: </script>
                   8002: ENDCLOSE
1.1044    www      8003: }
                   8004: 
                   8005: sub r_print {
                   8006:     my ($r,$to_print)=@_;
                   8007:     if ($r) {
                   8008:       $r->print($to_print);
                   8009:       $r->rflush();
                   8010:     } else {
                   8011:       print($to_print);
                   8012:     }
1.1042    www      8013: }
                   8014: 
1.320     albertel 8015: sub html_encode {
                   8016:     my ($result) = @_;
                   8017: 
1.322     albertel 8018:     $result = &HTML::Entities::encode($result,'<>&"');
1.320     albertel 8019:     
                   8020:     return $result;
                   8021: }
1.1044    www      8022: 
1.317     albertel 8023: sub js_ready {
                   8024:     my ($result) = @_;
                   8025: 
1.323     albertel 8026:     $result =~ s/[\n\r]/ /xmsg;
                   8027:     $result =~ s/\\/\\\\/xmsg;
                   8028:     $result =~ s/'/\\'/xmsg;
1.372     albertel 8029:     $result =~ s{</}{<\\/}xmsg;
1.317     albertel 8030:     
                   8031:     return $result;
                   8032: }
                   8033: 
1.315     albertel 8034: sub validate_page {
                   8035:     if (  exists($env{'internal.start_page'})
1.316     albertel 8036: 	  &&     $env{'internal.start_page'} > 1) {
                   8037: 	&Apache::lonnet::logthis('start_page called multiple times '.
1.318     albertel 8038: 				 $env{'internal.start_page'}.' '.
1.316     albertel 8039: 				 $ENV{'request.filename'});
1.315     albertel 8040:     }
                   8041:     if (  exists($env{'internal.end_page'})
1.316     albertel 8042: 	  &&     $env{'internal.end_page'} > 1) {
                   8043: 	&Apache::lonnet::logthis('end_page called multiple times '.
1.318     albertel 8044: 				 $env{'internal.end_page'}.' '.
1.316     albertel 8045: 				 $env{'request.filename'});
1.315     albertel 8046:     }
                   8047:     if (     exists($env{'internal.start_page'})
                   8048: 	&& ! exists($env{'internal.end_page'})) {
1.316     albertel 8049: 	&Apache::lonnet::logthis('start_page called without end_page '.
                   8050: 				 $env{'request.filename'});
1.315     albertel 8051:     }
                   8052:     if (   ! exists($env{'internal.start_page'})
                   8053: 	&&   exists($env{'internal.end_page'})) {
1.316     albertel 8054: 	&Apache::lonnet::logthis('end_page called without start_page'.
                   8055: 				 $env{'request.filename'});
1.315     albertel 8056:     }
1.306     albertel 8057: }
1.315     albertel 8058: 
1.996     www      8059: 
                   8060: sub start_scrollbox {
1.1075.2.56  raeburn  8061:     my ($outerwidth,$width,$height,$id,$bgcolor,$cursor,$needjsready) = @_;
1.998     raeburn  8062:     unless ($outerwidth) { $outerwidth='520px'; }
                   8063:     unless ($width) { $width='500px'; }
                   8064:     unless ($height) { $height='200px'; }
1.1075    raeburn  8065:     my ($table_id,$div_id,$tdcol);
1.1018    raeburn  8066:     if ($id ne '') {
1.1075.2.42  raeburn  8067:         $table_id = ' id="table_'.$id.'"';
                   8068:         $div_id = ' id="div_'.$id.'"';
1.1018    raeburn  8069:     }
1.1075    raeburn  8070:     if ($bgcolor ne '') {
                   8071:         $tdcol = "background-color: $bgcolor;";
                   8072:     }
1.1075.2.42  raeburn  8073:     my $nicescroll_js;
                   8074:     if ($env{'browser.mobile'}) {
                   8075:         $nicescroll_js = &nicescroll_javascript('div_'.$id,$cursor,$needjsready);
                   8076:     }
1.1075    raeburn  8077:     return <<"END";
1.1075.2.42  raeburn  8078: $nicescroll_js
                   8079: 
                   8080: <table style="width: $outerwidth; border: 1px solid none;"$table_id><tr><td style="width: $width;$tdcol">
1.1075.2.56  raeburn  8081: <div style="overflow:auto; width:$width; height:$height;"$div_id>
1.1075    raeburn  8082: END
1.996     www      8083: }
                   8084: 
                   8085: sub end_scrollbox {
1.1036    www      8086:     return '</div></td></tr></table>';
1.996     www      8087: }
                   8088: 
1.1075.2.42  raeburn  8089: sub nicescroll_javascript {
                   8090:     my ($id,$cursor,$needjsready,$framecheck,$location) = @_;
                   8091:     my %options;
                   8092:     if (ref($cursor) eq 'HASH') {
                   8093:         %options = %{$cursor};
                   8094:     }
                   8095:     unless ($options{'railalign'} =~ /^left|right$/) {
                   8096:         $options{'railalign'} = 'left';
                   8097:     }
                   8098:     unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
                   8099:         my $function  = &get_users_function();
                   8100:         $options{'cursorcolor'} = &designparm($function.'.sidebg',$env{'request.role.domain'});
                   8101:         unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
                   8102:             $options{'cursorcolor'} = '#00F';
                   8103:         }
                   8104:     }
                   8105:     if ($options{'cursoropacity'} =~ /^[\d.]+$/) {
                   8106:         unless ($options{'cursoropacity'} >= 0.0 && $options{'cursoropacity'} <=1.0) {
                   8107:             $options{'cursoropacity'}='1.0';
                   8108:         }
                   8109:     } else {
                   8110:         $options{'cursoropacity'}='1.0';
                   8111:     }
                   8112:     if ($options{'cursorfixedheight'} eq 'none') {
                   8113:         delete($options{'cursorfixedheight'});
                   8114:     } else {
                   8115:         unless ($options{'cursorfixedheight'} =~ /^\d+$/) { $options{'cursorfixedheight'}='50'; }
                   8116:     }
                   8117:     unless ($options{'railoffset'} =~ /^{[\w\:\d\-,]+}$/) {
                   8118:         delete($options{'railoffset'});
                   8119:     }
                   8120:     my @niceoptions;
                   8121:     while (my($key,$value) = each(%options)) {
                   8122:         if ($value =~ /^\{.+\}$/) {
                   8123:             push(@niceoptions,$key.':'.$value);
                   8124:         } else {
                   8125:             push(@niceoptions,$key.':"'.$value.'"');
                   8126:         }
                   8127:     }
                   8128:     my $nicescroll_js = '
                   8129: $(document).ready(
                   8130:       function() {
                   8131:           $("#'.$id.'").niceScroll({'.join(',',@niceoptions).'});
                   8132:       }
                   8133: );
                   8134: ';
                   8135:     if ($framecheck) {
                   8136:         $nicescroll_js .= '
                   8137: function expand_div(caller) {
                   8138:     if (top === self) {
                   8139:         document.getElementById("'.$id.'").style.width = "auto";
                   8140:         document.getElementById("'.$id.'").style.height = "auto";
                   8141:     } else {
                   8142:         try {
                   8143:             if (parent.frames) {
                   8144:                 if (parent.frames.length > 1) {
                   8145:                     var framesrc = parent.frames[1].location.href;
                   8146:                     var currsrc = framesrc.replace(/\#.*$/,"");
                   8147:                     if ((caller == "search") || (currsrc == "'.$location.'")) {
                   8148:                         document.getElementById("'.$id.'").style.width = "auto";
                   8149:                         document.getElementById("'.$id.'").style.height = "auto";
                   8150:                     }
                   8151:                 }
                   8152:             }
                   8153:         } catch (e) {
                   8154:             return;
                   8155:         }
                   8156:     }
                   8157:     return;
                   8158: }
                   8159: ';
                   8160:     }
                   8161:     if ($needjsready) {
                   8162:         $nicescroll_js = '
                   8163: <script type="text/javascript">'."\n".$nicescroll_js."\n</script>\n";
                   8164:     } else {
                   8165:         $nicescroll_js = &Apache::lonhtmlcommon::scripttag($nicescroll_js);
                   8166:     }
                   8167:     return $nicescroll_js;
                   8168: }
                   8169: 
1.318     albertel 8170: sub simple_error_page {
1.1075.2.49  raeburn  8171:     my ($r,$title,$msg,$args) = @_;
                   8172:     if (ref($args) eq 'HASH') {
                   8173:         if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); }
                   8174:     } else {
                   8175:         $msg = &mt($msg);
                   8176:     }
                   8177: 
1.318     albertel 8178:     my $page =
                   8179: 	&Apache::loncommon::start_page($title).
1.1075.2.49  raeburn  8180: 	'<p class="LC_error">'.$msg.'</p>'.
1.318     albertel 8181: 	&Apache::loncommon::end_page();
                   8182:     if (ref($r)) {
                   8183: 	$r->print($page);
1.327     albertel 8184: 	return;
1.318     albertel 8185:     }
                   8186:     return $page;
                   8187: }
1.347     albertel 8188: 
                   8189: {
1.610     albertel 8190:     my @row_count;
1.961     onken    8191: 
                   8192:     sub start_data_table_count {
                   8193:         unshift(@row_count, 0);
                   8194:         return;
                   8195:     }
                   8196: 
                   8197:     sub end_data_table_count {
                   8198:         shift(@row_count);
                   8199:         return;
                   8200:     }
                   8201: 
1.347     albertel 8202:     sub start_data_table {
1.1018    raeburn  8203: 	my ($add_class,$id) = @_;
1.422     albertel 8204: 	my $css_class = (join(' ','LC_data_table',$add_class));
1.1018    raeburn  8205:         my $table_id;
                   8206:         if (defined($id)) {
                   8207:             $table_id = ' id="'.$id.'"';
                   8208:         }
1.961     onken    8209: 	&start_data_table_count();
1.1018    raeburn  8210: 	return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347     albertel 8211:     }
                   8212: 
                   8213:     sub end_data_table {
1.961     onken    8214: 	&end_data_table_count();
1.389     albertel 8215: 	return '</table>'."\n";;
1.347     albertel 8216:     }
                   8217: 
                   8218:     sub start_data_table_row {
1.974     wenzelju 8219: 	my ($add_class, $id) = @_;
1.610     albertel 8220: 	$row_count[0]++;
                   8221: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900     bisitz   8222: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974     wenzelju 8223:         $id = (' id="'.$id.'"') unless ($id eq '');
                   8224:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347     albertel 8225:     }
1.471     banghart 8226:     
                   8227:     sub continue_data_table_row {
1.974     wenzelju 8228: 	my ($add_class, $id) = @_;
1.610     albertel 8229: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974     wenzelju 8230: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
                   8231:         $id = (' id="'.$id.'"') unless ($id eq '');
                   8232:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471     banghart 8233:     }
1.347     albertel 8234: 
                   8235:     sub end_data_table_row {
1.389     albertel 8236: 	return '</tr>'."\n";;
1.347     albertel 8237:     }
1.367     www      8238: 
1.421     albertel 8239:     sub start_data_table_empty_row {
1.707     bisitz   8240: #	$row_count[0]++;
1.421     albertel 8241: 	return  '<tr class="LC_empty_row" >'."\n";;
                   8242:     }
                   8243: 
                   8244:     sub end_data_table_empty_row {
                   8245: 	return '</tr>'."\n";;
                   8246:     }
                   8247: 
1.367     www      8248:     sub start_data_table_header_row {
1.389     albertel 8249: 	return  '<tr class="LC_header_row">'."\n";;
1.367     www      8250:     }
                   8251: 
                   8252:     sub end_data_table_header_row {
1.389     albertel 8253: 	return '</tr>'."\n";;
1.367     www      8254:     }
1.890     droeschl 8255: 
                   8256:     sub data_table_caption {
                   8257:         my $caption = shift;
                   8258:         return "<caption class=\"LC_caption\">$caption</caption>";
                   8259:     }
1.347     albertel 8260: }
                   8261: 
1.548     albertel 8262: =pod
                   8263: 
                   8264: =item * &inhibit_menu_check($arg)
                   8265: 
                   8266: Checks for a inhibitmenu state and generates output to preserve it
                   8267: 
                   8268: Inputs:         $arg - can be any of
                   8269:                      - undef - in which case the return value is a string 
                   8270:                                to add  into arguments list of a uri
                   8271:                      - 'input' - in which case the return value is a HTML
                   8272:                                  <form> <input> field of type hidden to
                   8273:                                  preserve the value
                   8274:                      - a url - in which case the return value is the url with
                   8275:                                the neccesary cgi args added to preserve the
                   8276:                                inhibitmenu state
                   8277:                      - a ref to a url - no return value, but the string is
                   8278:                                         updated to include the neccessary cgi
                   8279:                                         args to preserve the inhibitmenu state
                   8280: 
                   8281: =cut
                   8282: 
                   8283: sub inhibit_menu_check {
                   8284:     my ($arg) = @_;
                   8285:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   8286:     if ($arg eq 'input') {
                   8287: 	if ($env{'form.inhibitmenu'}) {
                   8288: 	    return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
                   8289: 	} else {
                   8290: 	    return
                   8291: 	}
                   8292:     }
                   8293:     if ($env{'form.inhibitmenu'}) {
                   8294: 	if (ref($arg)) {
                   8295: 	    $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   8296: 	} elsif ($arg eq '') {
                   8297: 	    $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
                   8298: 	} else {
                   8299: 	    $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   8300: 	}
                   8301:     }
                   8302:     if (!ref($arg)) {
                   8303: 	return $arg;
                   8304:     }
                   8305: }
                   8306: 
1.251     albertel 8307: ###############################################
1.182     matthew  8308: 
                   8309: =pod
                   8310: 
1.549     albertel 8311: =back
                   8312: 
                   8313: =head1 User Information Routines
                   8314: 
                   8315: =over 4
                   8316: 
1.405     albertel 8317: =item * &get_users_function()
1.182     matthew  8318: 
                   8319: Used by &bodytag to determine the current users primary role.
                   8320: Returns either 'student','coordinator','admin', or 'author'.
                   8321: 
                   8322: =cut
                   8323: 
                   8324: ###############################################
                   8325: sub get_users_function {
1.815     tempelho 8326:     my $function = 'norole';
1.818     tempelho 8327:     if ($env{'request.role'}=~/^(st)/) {
                   8328:         $function='student';
                   8329:     }
1.907     raeburn  8330:     if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182     matthew  8331:         $function='coordinator';
                   8332:     }
1.258     albertel 8333:     if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182     matthew  8334:         $function='admin';
                   8335:     }
1.826     bisitz   8336:     if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025    raeburn  8337:         ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182     matthew  8338:         $function='author';
                   8339:     }
                   8340:     return $function;
1.54      www      8341: }
1.99      www      8342: 
                   8343: ###############################################
                   8344: 
1.233     raeburn  8345: =pod
                   8346: 
1.821     raeburn  8347: =item * &show_course()
                   8348: 
                   8349: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
                   8350: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
                   8351: 
                   8352: Inputs:
                   8353: None
                   8354: 
                   8355: Outputs:
                   8356: Scalar: 1 if 'Course' to be used, 0 otherwise.
                   8357: 
                   8358: =cut
                   8359: 
                   8360: ###############################################
                   8361: sub show_course {
                   8362:     my $course = !$env{'user.adv'};
                   8363:     if (!$env{'user.adv'}) {
                   8364:         foreach my $env (keys(%env)) {
                   8365:             next if ($env !~ m/^user\.priv\./);
                   8366:             if ($env !~ m/^user\.priv\.(?:st|cm)/) {
                   8367:                 $course = 0;
                   8368:                 last;
                   8369:             }
                   8370:         }
                   8371:     }
                   8372:     return $course;
                   8373: }
                   8374: 
                   8375: ###############################################
                   8376: 
                   8377: =pod
                   8378: 
1.542     raeburn  8379: =item * &check_user_status()
1.274     raeburn  8380: 
                   8381: Determines current status of supplied role for a
                   8382: specific user. Roles can be active, previous or future.
                   8383: 
                   8384: Inputs: 
                   8385: user's domain, user's username, course's domain,
1.375     raeburn  8386: course's number, optional section ID.
1.274     raeburn  8387: 
                   8388: Outputs:
                   8389: role status: active, previous or future. 
                   8390: 
                   8391: =cut
                   8392: 
                   8393: sub check_user_status {
1.412     raeburn  8394:     my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.1073    raeburn  8395:     my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
1.1075.2.85  raeburn  8396:     my @uroles = keys(%userinfo);
1.274     raeburn  8397:     my $srchstr;
                   8398:     my $active_chk = 'none';
1.412     raeburn  8399:     my $now = time;
1.274     raeburn  8400:     if (@uroles > 0) {
1.908     raeburn  8401:         if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274     raeburn  8402:             $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
                   8403:         } else {
1.412     raeburn  8404:             $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
                   8405:         }
                   8406:         if (grep/^\Q$srchstr\E$/,@uroles) {
1.274     raeburn  8407:             my $role_end = 0;
                   8408:             my $role_start = 0;
                   8409:             $active_chk = 'active';
1.412     raeburn  8410:             if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
                   8411:                 $role_end = $1;
                   8412:                 if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
                   8413:                     $role_start = $1;
1.274     raeburn  8414:                 }
                   8415:             }
                   8416:             if ($role_start > 0) {
1.412     raeburn  8417:                 if ($now < $role_start) {
1.274     raeburn  8418:                     $active_chk = 'future';
                   8419:                 }
                   8420:             }
                   8421:             if ($role_end > 0) {
1.412     raeburn  8422:                 if ($now > $role_end) {
1.274     raeburn  8423:                     $active_chk = 'previous';
                   8424:                 }
                   8425:             }
                   8426:         }
                   8427:     }
                   8428:     return $active_chk;
                   8429: }
                   8430: 
                   8431: ###############################################
                   8432: 
                   8433: =pod
                   8434: 
1.405     albertel 8435: =item * &get_sections()
1.233     raeburn  8436: 
                   8437: Determines all the sections for a course including
                   8438: sections with students and sections containing other roles.
1.419     raeburn  8439: Incoming parameters: 
                   8440: 
                   8441: 1. domain
                   8442: 2. course number 
                   8443: 3. reference to array containing roles for which sections should 
                   8444: be gathered (optional).
                   8445: 4. reference to array containing status types for which sections 
                   8446: should be gathered (optional).
                   8447: 
                   8448: If the third argument is undefined, sections are gathered for any role. 
                   8449: If the fourth argument is undefined, sections are gathered for any status.
                   8450: Permissible values are 'active' or 'future' or 'previous'.
1.233     raeburn  8451:  
1.374     raeburn  8452: Returns section hash (keys are section IDs, values are
                   8453: number of users in each section), subject to the
1.419     raeburn  8454: optional roles filter, optional status filter 
1.233     raeburn  8455: 
                   8456: =cut
                   8457: 
                   8458: ###############################################
                   8459: sub get_sections {
1.419     raeburn  8460:     my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366     albertel 8461:     if (!defined($cdom) || !defined($cnum)) {
                   8462:         my $cid =  $env{'request.course.id'};
                   8463: 
                   8464: 	return if (!defined($cid));
                   8465: 
                   8466:         $cdom = $env{'course.'.$cid.'.domain'};
                   8467:         $cnum = $env{'course.'.$cid.'.num'};
                   8468:     }
                   8469: 
                   8470:     my %sectioncount;
1.419     raeburn  8471:     my $now = time;
1.240     albertel 8472: 
1.1075.2.33  raeburn  8473:     my $check_students = 1;
                   8474:     my $only_students = 0;
                   8475:     if (ref($possible_roles) eq 'ARRAY') {
                   8476:         if (grep(/^st$/,@{$possible_roles})) {
                   8477:             if (@{$possible_roles} == 1) {
                   8478:                 $only_students = 1;
                   8479:             }
                   8480:         } else {
                   8481:             $check_students = 0;
                   8482:         }
                   8483:     }
                   8484: 
                   8485:     if ($check_students) {
1.276     albertel 8486: 	my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240     albertel 8487: 	my $sec_index = &Apache::loncoursedata::CL_SECTION();
                   8488: 	my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419     raeburn  8489:         my $start_index = &Apache::loncoursedata::CL_START();
                   8490:         my $end_index = &Apache::loncoursedata::CL_END();
                   8491:         my $status;
1.366     albertel 8492: 	while (my ($student,$data) = each(%$classlist)) {
1.419     raeburn  8493: 	    my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
                   8494: 				                     $data->[$status_index],
                   8495:                                                      $data->[$start_index],
                   8496:                                                      $data->[$end_index]);
                   8497:             if ($stu_status eq 'Active') {
                   8498:                 $status = 'active';
                   8499:             } elsif ($end < $now) {
                   8500:                 $status = 'previous';
                   8501:             } elsif ($start > $now) {
                   8502:                 $status = 'future';
                   8503:             } 
                   8504: 	    if ($section ne '-1' && $section !~ /^\s*$/) {
                   8505:                 if ((!defined($possible_status)) || (($status ne '') && 
                   8506:                     (grep/^\Q$status\E$/,@{$possible_status}))) { 
                   8507: 		    $sectioncount{$section}++;
                   8508:                 }
1.240     albertel 8509: 	    }
                   8510: 	}
                   8511:     }
1.1075.2.33  raeburn  8512:     if ($only_students) {
                   8513:         return %sectioncount;
                   8514:     }
1.240     albertel 8515:     my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   8516:     foreach my $user (sort(keys(%courseroles))) {
                   8517: 	if ($user !~ /^(\w{2})/) { next; }
                   8518: 	my ($role) = ($user =~ /^(\w{2})/);
                   8519: 	if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419     raeburn  8520: 	my ($section,$status);
1.240     albertel 8521: 	if ($role eq 'cr' &&
                   8522: 	    $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
                   8523: 	    $section=$1;
                   8524: 	}
                   8525: 	if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
                   8526: 	if (!defined($section) || $section eq '-1') { next; }
1.419     raeburn  8527:         my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
                   8528:         if ($end == -1 && $start == -1) {
                   8529:             next; #deleted role
                   8530:         }
                   8531:         if (!defined($possible_status)) { 
                   8532:             $sectioncount{$section}++;
                   8533:         } else {
                   8534:             if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
                   8535:                 $status = 'active';
                   8536:             } elsif ($end < $now) {
                   8537:                 $status = 'future';
                   8538:             } elsif ($start > $now) {
                   8539:                 $status = 'previous';
                   8540:             }
                   8541:             if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
                   8542:                 $sectioncount{$section}++;
                   8543:             }
                   8544:         }
1.233     raeburn  8545:     }
1.366     albertel 8546:     return %sectioncount;
1.233     raeburn  8547: }
                   8548: 
1.274     raeburn  8549: ###############################################
1.294     raeburn  8550: 
                   8551: =pod
1.405     albertel 8552: 
                   8553: =item * &get_course_users()
                   8554: 
1.275     raeburn  8555: Retrieves usernames:domains for users in the specified course
                   8556: with specific role(s), and access status. 
                   8557: 
                   8558: Incoming parameters:
1.277     albertel 8559: 1. course domain
                   8560: 2. course number
                   8561: 3. access status: users must have - either active, 
1.275     raeburn  8562: previous, future, or all.
1.277     albertel 8563: 4. reference to array of permissible roles
1.288     raeburn  8564: 5. reference to array of section restrictions (optional)
                   8565: 6. reference to results object (hash of hashes).
                   8566: 7. reference to optional userdata hash
1.609     raeburn  8567: 8. reference to optional statushash
1.630     raeburn  8568: 9. flag if privileged users (except those set to unhide in
                   8569:    course settings) should be excluded    
1.609     raeburn  8570: Keys of top level results hash are roles.
1.275     raeburn  8571: Keys of inner hashes are username:domain, with 
                   8572: values set to access type.
1.288     raeburn  8573: Optional userdata hash returns an array with arguments in the 
                   8574: same order as loncoursedata::get_classlist() for student data.
                   8575: 
1.609     raeburn  8576: Optional statushash returns
                   8577: 
1.288     raeburn  8578: Entries for end, start, section and status are blank because
                   8579: of the possibility of multiple values for non-student roles.
                   8580: 
1.275     raeburn  8581: =cut
1.405     albertel 8582: 
1.275     raeburn  8583: ###############################################
1.405     albertel 8584: 
1.275     raeburn  8585: sub get_course_users {
1.630     raeburn  8586:     my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288     raeburn  8587:     my %idx = ();
1.419     raeburn  8588:     my %seclists;
1.288     raeburn  8589: 
                   8590:     $idx{udom} = &Apache::loncoursedata::CL_SDOM();
                   8591:     $idx{uname} =  &Apache::loncoursedata::CL_SNAME();
                   8592:     $idx{end} = &Apache::loncoursedata::CL_END();
                   8593:     $idx{start} = &Apache::loncoursedata::CL_START();
                   8594:     $idx{id} = &Apache::loncoursedata::CL_ID();
                   8595:     $idx{section} = &Apache::loncoursedata::CL_SECTION();
                   8596:     $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
                   8597:     $idx{status} = &Apache::loncoursedata::CL_STATUS();
                   8598: 
1.290     albertel 8599:     if (grep(/^st$/,@{$roles})) {
1.276     albertel 8600:         my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278     raeburn  8601:         my $now = time;
1.277     albertel 8602:         foreach my $student (keys(%{$classlist})) {
1.288     raeburn  8603:             my $match = 0;
1.412     raeburn  8604:             my $secmatch = 0;
1.419     raeburn  8605:             my $section = $$classlist{$student}[$idx{section}];
1.609     raeburn  8606:             my $status = $$classlist{$student}[$idx{status}];
1.419     raeburn  8607:             if ($section eq '') {
                   8608:                 $section = 'none';
                   8609:             }
1.291     albertel 8610:             if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 8611:                 if (grep(/^all$/,@{$sections})) {
1.412     raeburn  8612:                     $secmatch = 1;
                   8613:                 } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420     albertel 8614:                     if (grep(/^none$/,@{$sections})) {
1.412     raeburn  8615:                         $secmatch = 1;
                   8616:                     }
                   8617:                 } else {  
1.419     raeburn  8618: 		    if (grep(/^\Q$section\E$/,@{$sections})) {
1.412     raeburn  8619: 		        $secmatch = 1;
                   8620:                     }
1.290     albertel 8621: 		}
1.412     raeburn  8622:                 if (!$secmatch) {
                   8623:                     next;
                   8624:                 }
1.419     raeburn  8625:             }
1.275     raeburn  8626:             if (defined($$types{'active'})) {
1.288     raeburn  8627:                 if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275     raeburn  8628:                     push(@{$$users{st}{$student}},'active');
1.288     raeburn  8629:                     $match = 1;
1.275     raeburn  8630:                 }
                   8631:             }
                   8632:             if (defined($$types{'previous'})) {
1.609     raeburn  8633:                 if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275     raeburn  8634:                     push(@{$$users{st}{$student}},'previous');
1.288     raeburn  8635:                     $match = 1;
1.275     raeburn  8636:                 }
                   8637:             }
                   8638:             if (defined($$types{'future'})) {
1.609     raeburn  8639:                 if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275     raeburn  8640:                     push(@{$$users{st}{$student}},'future');
1.288     raeburn  8641:                     $match = 1;
1.275     raeburn  8642:                 }
                   8643:             }
1.609     raeburn  8644:             if ($match) {
                   8645:                 push(@{$seclists{$student}},$section);
                   8646:                 if (ref($userdata) eq 'HASH') {
                   8647:                     $$userdata{$student} = $$classlist{$student};
                   8648:                 }
                   8649:                 if (ref($statushash) eq 'HASH') {
                   8650:                     $statushash->{$student}{'st'}{$section} = $status;
                   8651:                 }
1.288     raeburn  8652:             }
1.275     raeburn  8653:         }
                   8654:     }
1.412     raeburn  8655:     if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439     raeburn  8656:         my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   8657:         my $now = time;
1.609     raeburn  8658:         my %displaystatus = ( previous => 'Expired',
                   8659:                               active   => 'Active',
                   8660:                               future   => 'Future',
                   8661:                             );
1.1075.2.36  raeburn  8662:         my (%nothide,@possdoms);
1.630     raeburn  8663:         if ($hidepriv) {
                   8664:             my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
                   8665:             foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
                   8666:                 if ($user !~ /:/) {
                   8667:                     $nothide{join(':',split(/[\@]/,$user))}=1;
                   8668:                 } else {
                   8669:                     $nothide{$user} = 1;
                   8670:                 }
                   8671:             }
1.1075.2.36  raeburn  8672:             my @possdoms = ($cdom);
                   8673:             if ($coursehash{'checkforpriv'}) {
                   8674:                 push(@possdoms,split(/,/,$coursehash{'checkforpriv'}));
                   8675:             }
1.630     raeburn  8676:         }
1.439     raeburn  8677:         foreach my $person (sort(keys(%coursepersonnel))) {
1.288     raeburn  8678:             my $match = 0;
1.412     raeburn  8679:             my $secmatch = 0;
1.439     raeburn  8680:             my $status;
1.412     raeburn  8681:             my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275     raeburn  8682:             $user =~ s/:$//;
1.439     raeburn  8683:             my ($end,$start) = split(/:/,$coursepersonnel{$person});
                   8684:             if ($end == -1 || $start == -1) {
                   8685:                 next;
                   8686:             }
                   8687:             if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
                   8688:                 (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412     raeburn  8689:                 my ($uname,$udom) = split(/:/,$user);
                   8690:                 if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 8691:                     if (grep(/^all$/,@{$sections})) {
1.412     raeburn  8692:                         $secmatch = 1;
                   8693:                     } elsif ($usec eq '') {
1.420     albertel 8694:                         if (grep(/^none$/,@{$sections})) {
1.412     raeburn  8695:                             $secmatch = 1;
                   8696:                         }
                   8697:                     } else {
                   8698:                         if (grep(/^\Q$usec\E$/,@{$sections})) {
                   8699:                             $secmatch = 1;
                   8700:                         }
                   8701:                     }
                   8702:                     if (!$secmatch) {
                   8703:                         next;
                   8704:                     }
1.288     raeburn  8705:                 }
1.419     raeburn  8706:                 if ($usec eq '') {
                   8707:                     $usec = 'none';
                   8708:                 }
1.275     raeburn  8709:                 if ($uname ne '' && $udom ne '') {
1.630     raeburn  8710:                     if ($hidepriv) {
1.1075.2.36  raeburn  8711:                         if ((&Apache::lonnet::privileged($uname,$udom,\@possdoms)) &&
1.630     raeburn  8712:                             (!$nothide{$uname.':'.$udom})) {
                   8713:                             next;
                   8714:                         }
                   8715:                     }
1.503     raeburn  8716:                     if ($end > 0 && $end < $now) {
1.439     raeburn  8717:                         $status = 'previous';
                   8718:                     } elsif ($start > $now) {
                   8719:                         $status = 'future';
                   8720:                     } else {
                   8721:                         $status = 'active';
                   8722:                     }
1.277     albertel 8723:                     foreach my $type (keys(%{$types})) { 
1.275     raeburn  8724:                         if ($status eq $type) {
1.420     albertel 8725:                             if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419     raeburn  8726:                                 push(@{$$users{$role}{$user}},$type);
                   8727:                             }
1.288     raeburn  8728:                             $match = 1;
                   8729:                         }
                   8730:                     }
1.419     raeburn  8731:                     if (($match) && (ref($userdata) eq 'HASH')) {
                   8732:                         if (!exists($$userdata{$uname.':'.$udom})) {
                   8733: 			    &get_user_info($udom,$uname,\%idx,$userdata);
                   8734:                         }
1.420     albertel 8735:                         if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419     raeburn  8736:                             push(@{$seclists{$uname.':'.$udom}},$usec);
                   8737:                         }
1.609     raeburn  8738:                         if (ref($statushash) eq 'HASH') {
                   8739:                             $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
                   8740:                         }
1.275     raeburn  8741:                     }
                   8742:                 }
                   8743:             }
                   8744:         }
1.290     albertel 8745:         if (grep(/^ow$/,@{$roles})) {
1.279     raeburn  8746:             if ((defined($cdom)) && (defined($cnum))) {
                   8747:                 my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
                   8748:                 if ( defined($csettings{'internal.courseowner'}) ) {
                   8749:                     my $owner = $csettings{'internal.courseowner'};
1.609     raeburn  8750:                     next if ($owner eq '');
                   8751:                     my ($ownername,$ownerdom);
                   8752:                     if ($owner =~ /^([^:]+):([^:]+)$/) {
                   8753:                         $ownername = $1;
                   8754:                         $ownerdom = $2;
                   8755:                     } else {
                   8756:                         $ownername = $owner;
                   8757:                         $ownerdom = $cdom;
                   8758:                         $owner = $ownername.':'.$ownerdom;
1.439     raeburn  8759:                     }
                   8760:                     @{$$users{'ow'}{$owner}} = 'any';
1.290     albertel 8761:                     if (defined($userdata) && 
1.609     raeburn  8762: 			!exists($$userdata{$owner})) {
                   8763: 			&get_user_info($ownerdom,$ownername,\%idx,$userdata);
                   8764:                         if (!grep(/^none$/,@{$seclists{$owner}})) {
                   8765:                             push(@{$seclists{$owner}},'none');
                   8766:                         }
                   8767:                         if (ref($statushash) eq 'HASH') {
                   8768:                             $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419     raeburn  8769:                         }
1.290     albertel 8770: 		    }
1.279     raeburn  8771:                 }
                   8772:             }
                   8773:         }
1.419     raeburn  8774:         foreach my $user (keys(%seclists)) {
                   8775:             @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
                   8776:             $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
                   8777:         }
1.275     raeburn  8778:     }
                   8779:     return;
                   8780: }
                   8781: 
1.288     raeburn  8782: sub get_user_info {
                   8783:     my ($udom,$uname,$idx,$userdata) = @_;
1.289     albertel 8784:     $$userdata{$uname.':'.$udom}[$$idx{fullname}] = 
                   8785: 	&plainname($uname,$udom,'lastname');
1.291     albertel 8786:     $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297     raeburn  8787:     $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609     raeburn  8788:     my %idhash =  &Apache::lonnet::idrget($udom,($uname));
                   8789:     $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname}; 
1.288     raeburn  8790:     return;
                   8791: }
1.275     raeburn  8792: 
1.472     raeburn  8793: ###############################################
                   8794: 
                   8795: =pod
                   8796: 
                   8797: =item * &get_user_quota()
                   8798: 
1.1075.2.41  raeburn  8799: Retrieves quota assigned for storage of user files.
                   8800: Default is to report quota for portfolio files.
1.472     raeburn  8801: 
                   8802: Incoming parameters:
                   8803: 1. user's username
                   8804: 2. user's domain
1.1075.2.41  raeburn  8805: 3. quota name - portfolio, author, or course
                   8806:    (if no quota name provided, defaults to portfolio).
1.1075.2.59  raeburn  8807: 4. crstype - official, unofficial, textbook or community, if quota name is
1.1075.2.42  raeburn  8808:    course
1.472     raeburn  8809: 
                   8810: Returns:
1.1075.2.58  raeburn  8811: 1. Disk quota (in MB) assigned to student.
1.536     raeburn  8812: 2. (Optional) Type of setting: custom or default
                   8813:    (individually assigned or default for user's 
                   8814:    institutional status).
                   8815: 3. (Optional) - User's institutional status (e.g., faculty, staff
                   8816:    or student - types as defined in localenroll::inst_usertypes 
                   8817:    for user's domain, which determines default quota for user.
                   8818: 4. (Optional) - Default quota which would apply to the user.
1.472     raeburn  8819: 
                   8820: If a value has been stored in the user's environment, 
1.536     raeburn  8821: it will return that, otherwise it returns the maximal default
1.1075.2.41  raeburn  8822: defined for the user's institutional status(es) in the domain.
1.472     raeburn  8823: 
                   8824: =cut
                   8825: 
                   8826: ###############################################
                   8827: 
                   8828: 
                   8829: sub get_user_quota {
1.1075.2.42  raeburn  8830:     my ($uname,$udom,$quotaname,$crstype) = @_;
1.536     raeburn  8831:     my ($quota,$quotatype,$settingstatus,$defquota);
1.472     raeburn  8832:     if (!defined($udom)) {
                   8833:         $udom = $env{'user.domain'};
                   8834:     }
                   8835:     if (!defined($uname)) {
                   8836:         $uname = $env{'user.name'};
                   8837:     }
                   8838:     if (($udom eq '' || $uname eq '') ||
                   8839:         ($udom eq 'public') && ($uname eq 'public')) {
                   8840:         $quota = 0;
1.536     raeburn  8841:         $quotatype = 'default';
                   8842:         $defquota = 0; 
1.472     raeburn  8843:     } else {
1.536     raeburn  8844:         my $inststatus;
1.1075.2.41  raeburn  8845:         if ($quotaname eq 'course') {
                   8846:             if (($env{'course.'.$udom.'_'.$uname.'.num'} eq $uname) &&
                   8847:                 ($env{'course.'.$udom.'_'.$uname.'.domain'} eq $udom)) {
                   8848:                 $quota = $env{'course.'.$udom.'_'.$uname.'.internal.uploadquota'};
                   8849:             } else {
                   8850:                 my %cenv = &Apache::lonnet::coursedescription("$udom/$uname");
                   8851:                 $quota = $cenv{'internal.uploadquota'};
                   8852:             }
1.536     raeburn  8853:         } else {
1.1075.2.41  raeburn  8854:             if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
                   8855:                 if ($quotaname eq 'author') {
                   8856:                     $quota = $env{'environment.authorquota'};
                   8857:                 } else {
                   8858:                     $quota = $env{'environment.portfolioquota'};
                   8859:                 }
                   8860:                 $inststatus = $env{'environment.inststatus'};
                   8861:             } else {
                   8862:                 my %userenv = 
                   8863:                     &Apache::lonnet::get('environment',['portfolioquota',
                   8864:                                          'authorquota','inststatus'],$udom,$uname);
                   8865:                 my ($tmp) = keys(%userenv);
                   8866:                 if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   8867:                     if ($quotaname eq 'author') {
                   8868:                         $quota = $userenv{'authorquota'};
                   8869:                     } else {
                   8870:                         $quota = $userenv{'portfolioquota'};
                   8871:                     }
                   8872:                     $inststatus = $userenv{'inststatus'};
                   8873:                 } else {
                   8874:                     undef(%userenv);
                   8875:                 }
                   8876:             }
                   8877:         }
                   8878:         if ($quota eq '' || wantarray) {
                   8879:             if ($quotaname eq 'course') {
                   8880:                 my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
1.1075.2.59  raeburn  8881:                 if (($crstype eq 'official') || ($crstype eq 'unofficial') ||
                   8882:                     ($crstype eq 'community') || ($crstype eq 'textbook')) {
1.1075.2.42  raeburn  8883:                     $defquota = $domdefs{$crstype.'quota'};
                   8884:                 }
                   8885:                 if ($defquota eq '') {
                   8886:                     $defquota = 500;
                   8887:                 }
1.1075.2.41  raeburn  8888:             } else {
                   8889:                 ($defquota,$settingstatus) = &default_quota($udom,$inststatus,$quotaname);
                   8890:             }
                   8891:             if ($quota eq '') {
                   8892:                 $quota = $defquota;
                   8893:                 $quotatype = 'default';
                   8894:             } else {
                   8895:                 $quotatype = 'custom';
                   8896:             }
1.472     raeburn  8897:         }
                   8898:     }
1.536     raeburn  8899:     if (wantarray) {
                   8900:         return ($quota,$quotatype,$settingstatus,$defquota);
                   8901:     } else {
                   8902:         return $quota;
                   8903:     }
1.472     raeburn  8904: }
                   8905: 
                   8906: ###############################################
                   8907: 
                   8908: =pod
                   8909: 
                   8910: =item * &default_quota()
                   8911: 
1.536     raeburn  8912: Retrieves default quota assigned for storage of user portfolio files,
                   8913: given an (optional) user's institutional status.
1.472     raeburn  8914: 
                   8915: Incoming parameters:
1.1075.2.42  raeburn  8916: 
1.472     raeburn  8917: 1. domain
1.536     raeburn  8918: 2. (Optional) institutional status(es).  This is a : separated list of 
                   8919:    status types (e.g., faculty, staff, student etc.)
                   8920:    which apply to the user for whom the default is being retrieved.
                   8921:    If the institutional status string in undefined, the domain
1.1075.2.41  raeburn  8922:    default quota will be returned.
                   8923: 3.  quota name - portfolio, author, or course
                   8924:    (if no quota name provided, defaults to portfolio).
1.472     raeburn  8925: 
                   8926: Returns:
1.1075.2.42  raeburn  8927: 
1.1075.2.58  raeburn  8928: 1. Default disk quota (in MB) for user portfolios in the domain.
1.536     raeburn  8929: 2. (Optional) institutional type which determined the value of the
                   8930:    default quota.
1.472     raeburn  8931: 
                   8932: If a value has been stored in the domain's configuration db,
                   8933: it will return that, otherwise it returns 20 (for backwards 
                   8934: compatibility with domains which have not set up a configuration
1.1075.2.58  raeburn  8935: db file; the original statically defined portfolio quota was 20 MB). 
1.472     raeburn  8936: 
1.536     raeburn  8937: If the user's status includes multiple types (e.g., staff and student),
                   8938: the largest default quota which applies to the user determines the
                   8939: default quota returned.
                   8940: 
1.472     raeburn  8941: =cut
                   8942: 
                   8943: ###############################################
                   8944: 
                   8945: 
                   8946: sub default_quota {
1.1075.2.41  raeburn  8947:     my ($udom,$inststatus,$quotaname) = @_;
1.536     raeburn  8948:     my ($defquota,$settingstatus);
                   8949:     my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622     raeburn  8950:                                             ['quotas'],$udom);
1.1075.2.41  raeburn  8951:     my $key = 'defaultquota';
                   8952:     if ($quotaname eq 'author') {
                   8953:         $key = 'authorquota';
                   8954:     }
1.622     raeburn  8955:     if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536     raeburn  8956:         if ($inststatus ne '') {
1.765     raeburn  8957:             my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536     raeburn  8958:             foreach my $item (@statuses) {
1.1075.2.41  raeburn  8959:                 if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
                   8960:                     if ($quotahash{'quotas'}{$key}{$item} ne '') {
1.711     raeburn  8961:                         if ($defquota eq '') {
1.1075.2.41  raeburn  8962:                             $defquota = $quotahash{'quotas'}{$key}{$item};
1.711     raeburn  8963:                             $settingstatus = $item;
1.1075.2.41  raeburn  8964:                         } elsif ($quotahash{'quotas'}{$key}{$item} > $defquota) {
                   8965:                             $defquota = $quotahash{'quotas'}{$key}{$item};
1.711     raeburn  8966:                             $settingstatus = $item;
                   8967:                         }
                   8968:                     }
1.1075.2.41  raeburn  8969:                 } elsif ($key eq 'defaultquota') {
1.711     raeburn  8970:                     if ($quotahash{'quotas'}{$item} ne '') {
                   8971:                         if ($defquota eq '') {
                   8972:                             $defquota = $quotahash{'quotas'}{$item};
                   8973:                             $settingstatus = $item;
                   8974:                         } elsif ($quotahash{'quotas'}{$item} > $defquota) {
                   8975:                             $defquota = $quotahash{'quotas'}{$item};
                   8976:                             $settingstatus = $item;
                   8977:                         }
1.536     raeburn  8978:                     }
                   8979:                 }
                   8980:             }
                   8981:         }
                   8982:         if ($defquota eq '') {
1.1075.2.41  raeburn  8983:             if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
                   8984:                 $defquota = $quotahash{'quotas'}{$key}{'default'};
                   8985:             } elsif ($key eq 'defaultquota') {
1.711     raeburn  8986:                 $defquota = $quotahash{'quotas'}{'default'};
                   8987:             }
1.536     raeburn  8988:             $settingstatus = 'default';
1.1075.2.42  raeburn  8989:             if ($defquota eq '') {
                   8990:                 if ($quotaname eq 'author') {
                   8991:                     $defquota = 500;
                   8992:                 }
                   8993:             }
1.536     raeburn  8994:         }
                   8995:     } else {
                   8996:         $settingstatus = 'default';
1.1075.2.41  raeburn  8997:         if ($quotaname eq 'author') {
                   8998:             $defquota = 500;
                   8999:         } else {
                   9000:             $defquota = 20;
                   9001:         }
1.536     raeburn  9002:     }
                   9003:     if (wantarray) {
                   9004:         return ($defquota,$settingstatus);
1.472     raeburn  9005:     } else {
1.536     raeburn  9006:         return $defquota;
1.472     raeburn  9007:     }
                   9008: }
                   9009: 
1.1075.2.41  raeburn  9010: ###############################################
                   9011: 
                   9012: =pod
                   9013: 
1.1075.2.42  raeburn  9014: =item * &excess_filesize_warning()
1.1075.2.41  raeburn  9015: 
                   9016: Returns warning message if upload of file to authoring space, or copying
1.1075.2.42  raeburn  9017: of existing file within authoring space will cause quota for the authoring
                   9018: space to be exceeded.
                   9019: 
                   9020: Same, if upload of a file directly to a course/community via Course Editor
                   9021: will cause quota for uploaded content for the course to be exceeded.
1.1075.2.41  raeburn  9022: 
1.1075.2.61  raeburn  9023: Inputs: 7 
1.1075.2.42  raeburn  9024: 1. username or coursenum
1.1075.2.41  raeburn  9025: 2. domain
1.1075.2.42  raeburn  9026: 3. context ('author' or 'course')
1.1075.2.41  raeburn  9027: 4. filename of file for which action is being requested
                   9028: 5. filesize (kB) of file
                   9029: 6. action being taken: copy or upload.
1.1075.2.59  raeburn  9030: 7. quotatype (in course context -- official, unofficial, community or textbook).
1.1075.2.41  raeburn  9031: 
                   9032: Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,
                   9033:          otherwise return null.
                   9034: 
1.1075.2.42  raeburn  9035: =back
                   9036: 
1.1075.2.41  raeburn  9037: =cut
                   9038: 
1.1075.2.42  raeburn  9039: sub excess_filesize_warning {
1.1075.2.59  raeburn  9040:     my ($uname,$udom,$context,$filename,$filesize,$action,$quotatype) = @_;
1.1075.2.42  raeburn  9041:     my $current_disk_usage = 0;
1.1075.2.59  raeburn  9042:     my $disk_quota = &get_user_quota($uname,$udom,$context,$quotatype); #expressed in MB
1.1075.2.42  raeburn  9043:     if ($context eq 'author') {
                   9044:         my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname";
                   9045:         $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$authorspace);
                   9046:     } else {
                   9047:         foreach my $subdir ('docs','supplemental') {
                   9048:             $current_disk_usage += &Apache::lonnet::diskusage($udom,$uname,"userfiles/$subdir",1);
                   9049:         }
                   9050:     }
1.1075.2.41  raeburn  9051:     $disk_quota = int($disk_quota * 1000);
                   9052:     if (($current_disk_usage + $filesize) > $disk_quota) {
1.1075.2.69  raeburn  9053:         return '<p class="LC_warning">'.
1.1075.2.41  raeburn  9054:                 &mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.",
1.1075.2.69  raeburn  9055:                     '<span class="LC_filename">'.$filename.'</span>',$filesize).'</p>'.
                   9056:                '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
1.1075.2.41  raeburn  9057:                             $disk_quota,$current_disk_usage).
                   9058:                '</p>';
                   9059:     }
                   9060:     return;
                   9061: }
                   9062: 
                   9063: ###############################################
                   9064: 
                   9065: 
1.384     raeburn  9066: sub get_secgrprole_info {
                   9067:     my ($cdom,$cnum,$needroles,$type)  = @_;
                   9068:     my %sections_count = &get_sections($cdom,$cnum);
                   9069:     my @sections =  (sort {$a <=> $b} keys(%sections_count));
                   9070:     my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
                   9071:     my @groups = sort(keys(%curr_groups));
                   9072:     my $allroles = [];
                   9073:     my $rolehash;
                   9074:     my $accesshash = {
                   9075:                      active => 'Currently has access',
                   9076:                      future => 'Will have future access',
                   9077:                      previous => 'Previously had access',
                   9078:                   };
                   9079:     if ($needroles) {
                   9080:         $rolehash = {'all' => 'all'};
1.385     albertel 9081:         my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   9082: 	if (&Apache::lonnet::error(%user_roles)) {
                   9083: 	    undef(%user_roles);
                   9084: 	}
                   9085:         foreach my $item (keys(%user_roles)) {
1.384     raeburn  9086:             my ($role)=split(/\:/,$item,2);
                   9087:             if ($role eq 'cr') { next; }
                   9088:             if ($role =~ /^cr/) {
                   9089:                 $$rolehash{$role} = (split('/',$role))[3];
                   9090:             } else {
                   9091:                 $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
                   9092:             }
                   9093:         }
                   9094:         foreach my $key (sort(keys(%{$rolehash}))) {
                   9095:             push(@{$allroles},$key);
                   9096:         }
                   9097:         push (@{$allroles},'st');
                   9098:         $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
                   9099:     }
                   9100:     return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
                   9101: }
                   9102: 
1.555     raeburn  9103: sub user_picker {
1.994     raeburn  9104:     my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context) = @_;
1.555     raeburn  9105:     my $currdom = $dom;
                   9106:     my %curr_selected = (
                   9107:                         srchin => 'dom',
1.580     raeburn  9108:                         srchby => 'lastname',
1.555     raeburn  9109:                       );
                   9110:     my $srchterm;
1.625     raeburn  9111:     if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555     raeburn  9112:         if ($srch->{'srchby'} ne '') {
                   9113:             $curr_selected{'srchby'} = $srch->{'srchby'};
                   9114:         }
                   9115:         if ($srch->{'srchin'} ne '') {
                   9116:             $curr_selected{'srchin'} = $srch->{'srchin'};
                   9117:         }
                   9118:         if ($srch->{'srchtype'} ne '') {
                   9119:             $curr_selected{'srchtype'} = $srch->{'srchtype'};
                   9120:         }
                   9121:         if ($srch->{'srchdomain'} ne '') {
                   9122:             $currdom = $srch->{'srchdomain'};
                   9123:         }
                   9124:         $srchterm = $srch->{'srchterm'};
                   9125:     }
                   9126:     my %lt=&Apache::lonlocal::texthash(
1.573     raeburn  9127:                     'usr'       => 'Search criteria',
1.563     raeburn  9128:                     'doma'      => 'Domain/institution to search',
1.558     albertel 9129:                     'uname'     => 'username',
                   9130:                     'lastname'  => 'last name',
1.555     raeburn  9131:                     'lastfirst' => 'last name, first name',
1.558     albertel 9132:                     'crs'       => 'in this course',
1.576     raeburn  9133:                     'dom'       => 'in selected LON-CAPA domain', 
1.558     albertel 9134:                     'alc'       => 'all LON-CAPA',
1.573     raeburn  9135:                     'instd'     => 'in institutional directory for selected domain',
1.558     albertel 9136:                     'exact'     => 'is',
                   9137:                     'contains'  => 'contains',
1.569     raeburn  9138:                     'begins'    => 'begins with',
1.571     raeburn  9139:                     'youm'      => "You must include some text to search for.",
                   9140:                     'thte'      => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
                   9141:                     'thet'      => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
                   9142:                     'yomc'      => "You must choose a domain when using an institutional directory search.",
                   9143:                     'ymcd'      => "You must choose a domain when using a domain search.",
                   9144:                     'whus'      => "When using searching by last,first you must include a comma as separator between last name and first name.",
                   9145:                     'whse'      => "When searching by last,first you must include at least one character in the first name.",
                   9146:                      'thfo'     => "The following need to be corrected before the search can be run:",
1.555     raeburn  9147:                                        );
1.563     raeburn  9148:     my $domform = &select_dom_form($currdom,'srchdomain',1,1);
                   9149:     my $srchinsel = ' <select name="srchin">';
1.555     raeburn  9150: 
                   9151:     my @srchins = ('crs','dom','alc','instd');
                   9152: 
                   9153:     foreach my $option (@srchins) {
                   9154:         # FIXME 'alc' option unavailable until 
                   9155:         #       loncreateuser::print_user_query_page()
                   9156:         #       has been completed.
                   9157:         next if ($option eq 'alc');
1.880     raeburn  9158:         next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));  
1.555     raeburn  9159:         next if ($option eq 'crs' && !$env{'request.course.id'});
1.563     raeburn  9160:         if ($curr_selected{'srchin'} eq $option) {
                   9161:             $srchinsel .= ' 
                   9162:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   9163:         } else {
                   9164:             $srchinsel .= '
                   9165:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   9166:         }
1.555     raeburn  9167:     }
1.563     raeburn  9168:     $srchinsel .= "\n  </select>\n";
1.555     raeburn  9169: 
                   9170:     my $srchbysel =  ' <select name="srchby">';
1.580     raeburn  9171:     foreach my $option ('lastname','lastfirst','uname') {
1.555     raeburn  9172:         if ($curr_selected{'srchby'} eq $option) {
                   9173:             $srchbysel .= '
                   9174:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   9175:         } else {
                   9176:             $srchbysel .= '
                   9177:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   9178:          }
                   9179:     }
                   9180:     $srchbysel .= "\n  </select>\n";
                   9181: 
                   9182:     my $srchtypesel = ' <select name="srchtype">';
1.580     raeburn  9183:     foreach my $option ('begins','contains','exact') {
1.555     raeburn  9184:         if ($curr_selected{'srchtype'} eq $option) {
                   9185:             $srchtypesel .= '
                   9186:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   9187:         } else {
                   9188:             $srchtypesel .= '
                   9189:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   9190:         }
                   9191:     }
                   9192:     $srchtypesel .= "\n  </select>\n";
                   9193: 
1.558     albertel 9194:     my ($newuserscript,$new_user_create);
1.994     raeburn  9195:     my $context_dom = $env{'request.role.domain'};
                   9196:     if ($context eq 'requestcrs') {
                   9197:         if ($env{'form.coursedom'} ne '') { 
                   9198:             $context_dom = $env{'form.coursedom'};
                   9199:         }
                   9200:     }
1.556     raeburn  9201:     if ($forcenewuser) {
1.576     raeburn  9202:         if (ref($srch) eq 'HASH') {
1.994     raeburn  9203:             if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627     raeburn  9204:                 if ($cancreate) {
                   9205:                     $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>';
                   9206:                 } else {
1.799     bisitz   9207:                     my $helplink = 'javascript:helpMenu('."'display'".')';
1.627     raeburn  9208:                     my %usertypetext = (
                   9209:                         official   => 'institutional',
                   9210:                         unofficial => 'non-institutional',
                   9211:                     );
1.799     bisitz   9212:                     $new_user_create = '<p class="LC_warning">'
                   9213:                                       .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
                   9214:                                       .' '
                   9215:                                       .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
                   9216:                                           ,'<a href="'.$helplink.'">','</a>')
                   9217:                                       .'</p><br />';
1.627     raeburn  9218:                 }
1.576     raeburn  9219:             }
                   9220:         }
                   9221: 
1.556     raeburn  9222:         $newuserscript = <<"ENDSCRIPT";
                   9223: 
1.570     raeburn  9224: function setSearch(createnew,callingForm) {
1.556     raeburn  9225:     if (createnew == 1) {
1.570     raeburn  9226:         for (var i=0; i<callingForm.srchby.length; i++) {
                   9227:             if (callingForm.srchby.options[i].value == 'uname') {
                   9228:                 callingForm.srchby.selectedIndex = i;
1.556     raeburn  9229:             }
                   9230:         }
1.570     raeburn  9231:         for (var i=0; i<callingForm.srchin.length; i++) {
                   9232:             if ( callingForm.srchin.options[i].value == 'dom') {
                   9233: 		callingForm.srchin.selectedIndex = i;
1.556     raeburn  9234:             }
                   9235:         }
1.570     raeburn  9236:         for (var i=0; i<callingForm.srchtype.length; i++) {
                   9237:             if (callingForm.srchtype.options[i].value == 'exact') {
                   9238:                 callingForm.srchtype.selectedIndex = i;
1.556     raeburn  9239:             }
                   9240:         }
1.570     raeburn  9241:         for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994     raeburn  9242:             if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570     raeburn  9243:                 callingForm.srchdomain.selectedIndex = i;
1.556     raeburn  9244:             }
                   9245:         }
                   9246:     }
                   9247: }
                   9248: ENDSCRIPT
1.558     albertel 9249: 
1.556     raeburn  9250:     }
                   9251: 
1.555     raeburn  9252:     my $output = <<"END_BLOCK";
1.556     raeburn  9253: <script type="text/javascript">
1.824     bisitz   9254: // <![CDATA[
1.570     raeburn  9255: function validateEntry(callingForm) {
1.558     albertel 9256: 
1.556     raeburn  9257:     var checkok = 1;
1.558     albertel 9258:     var srchin;
1.570     raeburn  9259:     for (var i=0; i<callingForm.srchin.length; i++) {
                   9260: 	if ( callingForm.srchin[i].checked ) {
                   9261: 	    srchin = callingForm.srchin[i].value;
1.558     albertel 9262: 	}
                   9263:     }
                   9264: 
1.570     raeburn  9265:     var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
                   9266:     var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
                   9267:     var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
                   9268:     var srchterm =  callingForm.srchterm.value;
                   9269:     var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556     raeburn  9270:     var msg = "";
                   9271: 
                   9272:     if (srchterm == "") {
                   9273:         checkok = 0;
1.571     raeburn  9274:         msg += "$lt{'youm'}\\n";
1.556     raeburn  9275:     }
                   9276: 
1.569     raeburn  9277:     if (srchtype== 'begins') {
                   9278:         if (srchterm.length < 2) {
                   9279:             checkok = 0;
1.571     raeburn  9280:             msg += "$lt{'thte'}\\n";
1.569     raeburn  9281:         }
                   9282:     }
                   9283: 
1.556     raeburn  9284:     if (srchtype== 'contains') {
                   9285:         if (srchterm.length < 3) {
                   9286:             checkok = 0;
1.571     raeburn  9287:             msg += "$lt{'thet'}\\n";
1.556     raeburn  9288:         }
                   9289:     }
                   9290:     if (srchin == 'instd') {
                   9291:         if (srchdomain == '') {
                   9292:             checkok = 0;
1.571     raeburn  9293:             msg += "$lt{'yomc'}\\n";
1.556     raeburn  9294:         }
                   9295:     }
                   9296:     if (srchin == 'dom') {
                   9297:         if (srchdomain == '') {
                   9298:             checkok = 0;
1.571     raeburn  9299:             msg += "$lt{'ymcd'}\\n";
1.556     raeburn  9300:         }
                   9301:     }
                   9302:     if (srchby == 'lastfirst') {
                   9303:         if (srchterm.indexOf(",") == -1) {
                   9304:             checkok = 0;
1.571     raeburn  9305:             msg += "$lt{'whus'}\\n";
1.556     raeburn  9306:         }
                   9307:         if (srchterm.indexOf(",") == srchterm.length -1) {
                   9308:             checkok = 0;
1.571     raeburn  9309:             msg += "$lt{'whse'}\\n";
1.556     raeburn  9310:         }
                   9311:     }
                   9312:     if (checkok == 0) {
1.571     raeburn  9313:         alert("$lt{'thfo'}\\n"+msg);
1.556     raeburn  9314:         return;
                   9315:     }
                   9316:     if (checkok == 1) {
1.570     raeburn  9317:         callingForm.submit();
1.556     raeburn  9318:     }
                   9319: }
                   9320: 
                   9321: $newuserscript
                   9322: 
1.824     bisitz   9323: // ]]>
1.556     raeburn  9324: </script>
1.558     albertel 9325: 
                   9326: $new_user_create
                   9327: 
1.555     raeburn  9328: END_BLOCK
1.558     albertel 9329: 
1.876     raeburn  9330:     $output .= &Apache::lonhtmlcommon::start_pick_box().
                   9331:                &Apache::lonhtmlcommon::row_title($lt{'doma'}).
                   9332:                $domform.
                   9333:                &Apache::lonhtmlcommon::row_closure().
                   9334:                &Apache::lonhtmlcommon::row_title($lt{'usr'}).
                   9335:                $srchbysel.
                   9336:                $srchtypesel. 
                   9337:                '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
                   9338:                $srchinsel.
                   9339:                &Apache::lonhtmlcommon::row_closure(1). 
                   9340:                &Apache::lonhtmlcommon::end_pick_box().
                   9341:                '<br />';
1.555     raeburn  9342:     return $output;
                   9343: }
                   9344: 
1.612     raeburn  9345: sub user_rule_check {
1.615     raeburn  9346:     my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.612     raeburn  9347:     my $response;
                   9348:     if (ref($usershash) eq 'HASH') {
                   9349:         foreach my $user (keys(%{$usershash})) {
                   9350:             my ($uname,$udom) = split(/:/,$user);
                   9351:             next if ($udom eq '' || $uname eq '');
1.615     raeburn  9352:             my ($id,$newuser);
1.612     raeburn  9353:             if (ref($usershash->{$user}) eq 'HASH') {
1.615     raeburn  9354:                 $newuser = $usershash->{$user}->{'newuser'};
1.612     raeburn  9355:                 $id = $usershash->{$user}->{'id'};
                   9356:             }
                   9357:             my $inst_response;
                   9358:             if (ref($checks) eq 'HASH') {
                   9359:                 if (defined($checks->{'username'})) {
1.615     raeburn  9360:                     ($inst_response,%{$inst_results->{$user}}) = 
1.612     raeburn  9361:                         &Apache::lonnet::get_instuser($udom,$uname);
                   9362:                 } elsif (defined($checks->{'id'})) {
1.615     raeburn  9363:                     ($inst_response,%{$inst_results->{$user}}) =
1.612     raeburn  9364:                         &Apache::lonnet::get_instuser($udom,undef,$id);
                   9365:                 }
1.615     raeburn  9366:             } else {
                   9367:                 ($inst_response,%{$inst_results->{$user}}) =
                   9368:                     &Apache::lonnet::get_instuser($udom,$uname);
                   9369:                 return;
1.612     raeburn  9370:             }
1.615     raeburn  9371:             if (!$got_rules->{$udom}) {
1.612     raeburn  9372:                 my %domconfig = &Apache::lonnet::get_dom('configuration',
                   9373:                                                   ['usercreation'],$udom);
                   9374:                 if (ref($domconfig{'usercreation'}) eq 'HASH') {
1.615     raeburn  9375:                     foreach my $item ('username','id') {
1.612     raeburn  9376:                         if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
                   9377:                             $$curr_rules{$udom}{$item} = 
                   9378:                                 $domconfig{'usercreation'}{$item.'_rule'};
1.585     raeburn  9379:                         }
                   9380:                     }
                   9381:                 }
1.615     raeburn  9382:                 $got_rules->{$udom} = 1;  
1.585     raeburn  9383:             }
1.612     raeburn  9384:             foreach my $item (keys(%{$checks})) {
                   9385:                 if (ref($$curr_rules{$udom}) eq 'HASH') {
                   9386:                     if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
                   9387:                         if (@{$$curr_rules{$udom}{$item}} > 0) {
                   9388:                             my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,$$curr_rules{$udom}{$item});
                   9389:                             foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
                   9390:                                 if ($rule_check{$rule}) {
                   9391:                                     $$rulematch{$user}{$item} = $rule;
                   9392:                                     if ($inst_response eq 'ok') {
1.615     raeburn  9393:                                         if (ref($inst_results) eq 'HASH') {
                   9394:                                             if (ref($inst_results->{$user}) eq 'HASH') {
                   9395:                                                 if (keys(%{$inst_results->{$user}}) == 0) {
                   9396:                                                     $$alerts{$item}{$udom}{$uname} = 1;
                   9397:                                                 }
1.612     raeburn  9398:                                             }
                   9399:                                         }
1.615     raeburn  9400:                                     }
                   9401:                                     last;
1.585     raeburn  9402:                                 }
                   9403:                             }
                   9404:                         }
                   9405:                     }
                   9406:                 }
                   9407:             }
                   9408:         }
                   9409:     }
1.612     raeburn  9410:     return;
                   9411: }
                   9412: 
                   9413: sub user_rule_formats {
                   9414:     my ($domain,$domdesc,$curr_rules,$check) = @_;
                   9415:     my %text = ( 
                   9416:                  'username' => 'Usernames',
                   9417:                  'id'       => 'IDs',
                   9418:                );
                   9419:     my $output;
                   9420:     my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
                   9421:     if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
                   9422:         if (@{$ruleorder} > 0) {
1.1075.2.20  raeburn  9423:             $output = '<br />'.
                   9424:                       &mt($text{$check}.' with the following format(s) may [_1]only[_2] be used for verified users at [_3]:',
                   9425:                           '<span class="LC_cusr_emph">','</span>',$domdesc).
                   9426:                       ' <ul>';
1.612     raeburn  9427:             foreach my $rule (@{$ruleorder}) {
                   9428:                 if (ref($curr_rules) eq 'ARRAY') {
                   9429:                     if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
                   9430:                         if (ref($rules->{$rule}) eq 'HASH') {
                   9431:                             $output .= '<li>'.$rules->{$rule}{'name'}.': '.
                   9432:                                         $rules->{$rule}{'desc'}.'</li>';
                   9433:                         }
                   9434:                     }
                   9435:                 }
                   9436:             }
                   9437:             $output .= '</ul>';
                   9438:         }
                   9439:     }
                   9440:     return $output;
                   9441: }
                   9442: 
                   9443: sub instrule_disallow_msg {
1.615     raeburn  9444:     my ($checkitem,$domdesc,$count,$mode) = @_;
1.612     raeburn  9445:     my $response;
                   9446:     my %text = (
                   9447:                   item   => 'username',
                   9448:                   items  => 'usernames',
                   9449:                   match  => 'matches',
                   9450:                   do     => 'does',
                   9451:                   action => 'a username',
                   9452:                   one    => 'one',
                   9453:                );
                   9454:     if ($count > 1) {
                   9455:         $text{'item'} = 'usernames';
                   9456:         $text{'match'} ='match';
                   9457:         $text{'do'} = 'do';
                   9458:         $text{'action'} = 'usernames',
                   9459:         $text{'one'} = 'ones';
                   9460:     }
                   9461:     if ($checkitem eq 'id') {
                   9462:         $text{'items'} = 'IDs';
                   9463:         $text{'item'} = 'ID';
                   9464:         $text{'action'} = 'an ID';
1.615     raeburn  9465:         if ($count > 1) {
                   9466:             $text{'item'} = 'IDs';
                   9467:             $text{'action'} = 'IDs';
                   9468:         }
1.612     raeburn  9469:     }
1.674     bisitz   9470:     $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  9471:     if ($mode eq 'upload') {
                   9472:         if ($checkitem eq 'username') {
                   9473:             $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'}.");
                   9474:         } elsif ($checkitem eq 'id') {
1.674     bisitz   9475:             $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  9476:         }
1.669     raeburn  9477:     } elsif ($mode eq 'selfcreate') {
                   9478:         if ($checkitem eq 'id') {
                   9479:             $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.");
                   9480:         }
1.615     raeburn  9481:     } else {
                   9482:         if ($checkitem eq 'username') {
                   9483:             $response .= &mt("You must choose $text{'action'} with a different format --  $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
                   9484:         } elsif ($checkitem eq 'id') {
                   9485:             $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.");
                   9486:         }
1.612     raeburn  9487:     }
                   9488:     return $response;
1.585     raeburn  9489: }
                   9490: 
1.624     raeburn  9491: sub personal_data_fieldtitles {
                   9492:     my %fieldtitles = &Apache::lonlocal::texthash (
                   9493:                         id => 'Student/Employee ID',
                   9494:                         permanentemail => 'E-mail address',
                   9495:                         lastname => 'Last Name',
                   9496:                         firstname => 'First Name',
                   9497:                         middlename => 'Middle Name',
                   9498:                         generation => 'Generation',
                   9499:                         gen => 'Generation',
1.765     raeburn  9500:                         inststatus => 'Affiliation',
1.624     raeburn  9501:                    );
                   9502:     return %fieldtitles;
                   9503: }
                   9504: 
1.642     raeburn  9505: sub sorted_inst_types {
                   9506:     my ($dom) = @_;
1.1075.2.70  raeburn  9507:     my ($usertypes,$order);
                   9508:     my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
                   9509:     if (ref($domdefaults{'inststatus'}) eq 'HASH') {
                   9510:         $usertypes = $domdefaults{'inststatus'}{'inststatustypes'};
                   9511:         $order = $domdefaults{'inststatus'}{'inststatusorder'};
                   9512:     } else {
                   9513:         ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
                   9514:     }
1.642     raeburn  9515:     my $othertitle = &mt('All users');
                   9516:     if ($env{'request.course.id'}) {
1.668     raeburn  9517:         $othertitle  = &mt('Any users');
1.642     raeburn  9518:     }
                   9519:     my @types;
                   9520:     if (ref($order) eq 'ARRAY') {
                   9521:         @types = @{$order};
                   9522:     }
                   9523:     if (@types == 0) {
                   9524:         if (ref($usertypes) eq 'HASH') {
                   9525:             @types = sort(keys(%{$usertypes}));
                   9526:         }
                   9527:     }
                   9528:     if (keys(%{$usertypes}) > 0) {
                   9529:         $othertitle = &mt('Other users');
                   9530:     }
                   9531:     return ($othertitle,$usertypes,\@types);
                   9532: }
                   9533: 
1.645     raeburn  9534: sub get_institutional_codes {
                   9535:     my ($settings,$allcourses,$LC_code) = @_;
                   9536: # Get complete list of course sections to update
                   9537:     my @currsections = ();
                   9538:     my @currxlists = ();
                   9539:     my $coursecode = $$settings{'internal.coursecode'};
                   9540: 
                   9541:     if ($$settings{'internal.sectionnums'} ne '') {
                   9542:         @currsections = split(/,/,$$settings{'internal.sectionnums'});
                   9543:     }
                   9544: 
                   9545:     if ($$settings{'internal.crosslistings'} ne '') {
                   9546:         @currxlists = split(/,/,$$settings{'internal.crosslistings'});
                   9547:     }
                   9548: 
                   9549:     if (@currxlists > 0) {
                   9550:         foreach (@currxlists) {
                   9551:             if (m/^([^:]+):(\w*)$/) {
                   9552:                 unless (grep/^$1$/,@{$allcourses}) {
                   9553:                     push @{$allcourses},$1;
                   9554:                     $$LC_code{$1} = $2;
                   9555:                 }
                   9556:             }
                   9557:         }
                   9558:     }
                   9559:  
                   9560:     if (@currsections > 0) {
                   9561:         foreach (@currsections) {
                   9562:             if (m/^(\w+):(\w*)$/) {
                   9563:                 my $sec = $coursecode.$1;
                   9564:                 my $lc_sec = $2;
                   9565:                 unless (grep/^$sec$/,@{$allcourses}) {
                   9566:                     push @{$allcourses},$sec;
                   9567:                     $$LC_code{$sec} = $lc_sec;
                   9568:                 }
                   9569:             }
                   9570:         }
                   9571:     }
                   9572:     return;
                   9573: }
                   9574: 
1.971     raeburn  9575: sub get_standard_codeitems {
                   9576:     return ('Year','Semester','Department','Number','Section');
                   9577: }
                   9578: 
1.112     bowersj2 9579: =pod
                   9580: 
1.780     raeburn  9581: =head1 Slot Helpers
                   9582: 
                   9583: =over 4
                   9584: 
                   9585: =item * sorted_slots()
                   9586: 
1.1040    raeburn  9587: Sorts an array of slot names in order of an optional sort key,
                   9588: default sort is by slot start time (earliest first). 
1.780     raeburn  9589: 
                   9590: Inputs:
                   9591: 
                   9592: =over 4
                   9593: 
                   9594: slotsarr  - Reference to array of unsorted slot names.
                   9595: 
                   9596: slots     - Reference to hash of hash, where outer hash keys are slot names.
                   9597: 
1.1040    raeburn  9598: sortkey   - Name of key in inner hash to be sorted on (e.g., starttime).
                   9599: 
1.549     albertel 9600: =back
                   9601: 
1.780     raeburn  9602: Returns:
                   9603: 
                   9604: =over 4
                   9605: 
1.1040    raeburn  9606: sorted   - An array of slot names sorted by a specified sort key 
                   9607:            (default sort key is start time of the slot).
1.780     raeburn  9608: 
                   9609: =back
                   9610: 
                   9611: =cut
                   9612: 
                   9613: 
                   9614: sub sorted_slots {
1.1040    raeburn  9615:     my ($slotsarr,$slots,$sortkey) = @_;
                   9616:     if ($sortkey eq '') {
                   9617:         $sortkey = 'starttime';
                   9618:     }
1.780     raeburn  9619:     my @sorted;
                   9620:     if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
                   9621:         @sorted =
                   9622:             sort {
                   9623:                      if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040    raeburn  9624:                          return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780     raeburn  9625:                      }
                   9626:                      if (ref($slots->{$a})) { return -1;}
                   9627:                      if (ref($slots->{$b})) { return 1;}
                   9628:                      return 0;
                   9629:                  } @{$slotsarr};
                   9630:     }
                   9631:     return @sorted;
                   9632: }
                   9633: 
1.1040    raeburn  9634: =pod
                   9635: 
                   9636: =item * get_future_slots()
                   9637: 
                   9638: Inputs:
                   9639: 
                   9640: =over 4
                   9641: 
                   9642: cnum - course number
                   9643: 
                   9644: cdom - course domain
                   9645: 
                   9646: now - current UNIX time
                   9647: 
                   9648: symb - optional symb
                   9649: 
                   9650: =back
                   9651: 
                   9652: Returns:
                   9653: 
                   9654: =over 4
                   9655: 
                   9656: sorted_reservable - ref to array of student_schedulable slots currently 
                   9657:                     reservable, ordered by end date of reservation period.
                   9658: 
                   9659: reservable_now - ref to hash of student_schedulable slots currently
                   9660:                  reservable.
                   9661: 
                   9662:     Keys in inner hash are:
                   9663:     (a) symb: either blank or symb to which slot use is restricted.
                   9664:     (b) endreserve: end date of reservation period. 
                   9665: 
                   9666: sorted_future - ref to array of student_schedulable slots reservable in
                   9667:                 the future, ordered by start date of reservation period.
                   9668: 
                   9669: future_reservable - ref to hash of student_schedulable slots reservable
                   9670:                     in the future.
                   9671: 
                   9672:     Keys in inner hash are:
                   9673:     (a) symb: either blank or symb to which slot use is restricted.
                   9674:     (b) startreserve:  start date of reservation period.
                   9675: 
                   9676: =back
                   9677: 
                   9678: =cut
                   9679: 
                   9680: sub get_future_slots {
                   9681:     my ($cnum,$cdom,$now,$symb) = @_;
                   9682:     my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
                   9683:     my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
                   9684:     foreach my $slot (keys(%slots)) {
                   9685:         next unless($slots{$slot}->{'type'} eq 'schedulable_student');
                   9686:         if ($symb) {
                   9687:             next if (($slots{$slot}->{'symb'} ne '') && 
                   9688:                      ($slots{$slot}->{'symb'} ne $symb));
                   9689:         }
                   9690:         if (($slots{$slot}->{'starttime'} > $now) &&
                   9691:             ($slots{$slot}->{'endtime'} > $now)) {
                   9692:             if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
                   9693:                 my $userallowed = 0;
                   9694:                 if ($slots{$slot}->{'allowedsections'}) {
                   9695:                     my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
                   9696:                     if (!defined($env{'request.role.sec'})
                   9697:                         && grep(/^No section assigned$/,@allowed_sec)) {
                   9698:                         $userallowed=1;
                   9699:                     } else {
                   9700:                         if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
                   9701:                             $userallowed=1;
                   9702:                         }
                   9703:                     }
                   9704:                     unless ($userallowed) {
                   9705:                         if (defined($env{'request.course.groups'})) {
                   9706:                             my @groups = split(/:/,$env{'request.course.groups'});
                   9707:                             foreach my $group (@groups) {
                   9708:                                 if (grep(/^\Q$group\E$/,@allowed_sec)) {
                   9709:                                     $userallowed=1;
                   9710:                                     last;
                   9711:                                 }
                   9712:                             }
                   9713:                         }
                   9714:                     }
                   9715:                 }
                   9716:                 if ($slots{$slot}->{'allowedusers'}) {
                   9717:                     my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
                   9718:                     my $user = $env{'user.name'}.':'.$env{'user.domain'};
                   9719:                     if (grep(/^\Q$user\E$/,@allowed_users)) {
                   9720:                         $userallowed = 1;
                   9721:                     }
                   9722:                 }
                   9723:                 next unless($userallowed);
                   9724:             }
                   9725:             my $startreserve = $slots{$slot}->{'startreserve'};
                   9726:             my $endreserve = $slots{$slot}->{'endreserve'};
                   9727:             my $symb = $slots{$slot}->{'symb'};
                   9728:             if (($startreserve < $now) &&
                   9729:                 (!$endreserve || $endreserve > $now)) {
                   9730:                 my $lastres = $endreserve;
                   9731:                 if (!$lastres) {
                   9732:                     $lastres = $slots{$slot}->{'starttime'};
                   9733:                 }
                   9734:                 $reservable_now{$slot} = {
                   9735:                                            symb       => $symb,
                   9736:                                            endreserve => $lastres
                   9737:                                          };
                   9738:             } elsif (($startreserve > $now) &&
                   9739:                      (!$endreserve || $endreserve > $startreserve)) {
                   9740:                 $future_reservable{$slot} = {
                   9741:                                               symb         => $symb,
                   9742:                                               startreserve => $startreserve
                   9743:                                             };
                   9744:             }
                   9745:         }
                   9746:     }
                   9747:     my @unsorted_reservable = keys(%reservable_now);
                   9748:     if (@unsorted_reservable > 0) {
                   9749:         @sorted_reservable = 
                   9750:             &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
                   9751:     }
                   9752:     my @unsorted_future = keys(%future_reservable);
                   9753:     if (@unsorted_future > 0) {
                   9754:         @sorted_future =
                   9755:             &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
                   9756:     }
                   9757:     return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
                   9758: }
1.780     raeburn  9759: 
                   9760: =pod
                   9761: 
1.1057    foxr     9762: =back
                   9763: 
1.549     albertel 9764: =head1 HTTP Helpers
                   9765: 
                   9766: =over 4
                   9767: 
1.648     raeburn  9768: =item * &get_unprocessed_cgi($query,$possible_names)
1.112     bowersj2 9769: 
1.258     albertel 9770: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112     bowersj2 9771: $query.  The parameters listed in $possible_names (an array reference),
1.258     albertel 9772: will be set in $env{'form.name'} if they do not already exist.
1.112     bowersj2 9773: 
                   9774: Typically called with $ENV{'QUERY_STRING'} as the first parameter.  
                   9775: $possible_names is an ref to an array of form element names.  As an example:
                   9776: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258     albertel 9777: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112     bowersj2 9778: 
                   9779: =cut
1.1       albertel 9780: 
1.6       albertel 9781: sub get_unprocessed_cgi {
1.25      albertel 9782:   my ($query,$possible_names)= @_;
1.26      matthew  9783:   # $Apache::lonxml::debug=1;
1.356     albertel 9784:   foreach my $pair (split(/&/,$query)) {
                   9785:     my ($name, $value) = split(/=/,$pair);
1.369     www      9786:     $name = &unescape($name);
1.25      albertel 9787:     if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
                   9788:       $value =~ tr/+/ /;
                   9789:       $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258     albertel 9790:       unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25      albertel 9791:     }
1.16      harris41 9792:   }
1.6       albertel 9793: }
                   9794: 
1.112     bowersj2 9795: =pod
                   9796: 
1.648     raeburn  9797: =item * &cacheheader() 
1.112     bowersj2 9798: 
                   9799: returns cache-controlling header code
                   9800: 
                   9801: =cut
                   9802: 
1.7       albertel 9803: sub cacheheader {
1.258     albertel 9804:     unless ($env{'request.method'} eq 'GET') { return ''; }
1.216     albertel 9805:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
                   9806:     my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7       albertel 9807:                 <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
                   9808:                 <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216     albertel 9809:     return $output;
1.7       albertel 9810: }
                   9811: 
1.112     bowersj2 9812: =pod
                   9813: 
1.648     raeburn  9814: =item * &no_cache($r) 
1.112     bowersj2 9815: 
                   9816: specifies header code to not have cache
                   9817: 
                   9818: =cut
                   9819: 
1.9       albertel 9820: sub no_cache {
1.216     albertel 9821:     my ($r) = @_;
                   9822:     if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258     albertel 9823: 	$env{'request.method'} ne 'GET') { return ''; }
1.216     albertel 9824:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
                   9825:     $r->no_cache(1);
                   9826:     $r->header_out("Expires" => $date);
                   9827:     $r->header_out("Pragma" => "no-cache");
1.123     www      9828: }
                   9829: 
                   9830: sub content_type {
1.181     albertel 9831:     my ($r,$type,$charset) = @_;
1.299     foxr     9832:     if ($r) {
                   9833: 	#  Note that printout.pl calls this with undef for $r.
                   9834: 	&no_cache($r);
                   9835:     }
1.258     albertel 9836:     if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181     albertel 9837:     unless ($charset) {
                   9838: 	$charset=&Apache::lonlocal::current_encoding;
                   9839:     }
                   9840:     if ($charset) { $type.='; charset='.$charset; }
                   9841:     if ($r) {
                   9842: 	$r->content_type($type);
                   9843:     } else {
                   9844: 	print("Content-type: $type\n\n");
                   9845:     }
1.9       albertel 9846: }
1.25      albertel 9847: 
1.112     bowersj2 9848: =pod
                   9849: 
1.648     raeburn  9850: =item * &add_to_env($name,$value) 
1.112     bowersj2 9851: 
1.258     albertel 9852: adds $name to the %env hash with value
1.112     bowersj2 9853: $value, if $name already exists, the entry is converted to an array
                   9854: reference and $value is added to the array.
                   9855: 
                   9856: =cut
                   9857: 
1.25      albertel 9858: sub add_to_env {
                   9859:   my ($name,$value)=@_;
1.258     albertel 9860:   if (defined($env{$name})) {
                   9861:     if (ref($env{$name})) {
1.25      albertel 9862:       #already have multiple values
1.258     albertel 9863:       push(@{ $env{$name} },$value);
1.25      albertel 9864:     } else {
                   9865:       #first time seeing multiple values, convert hash entry to an arrayref
1.258     albertel 9866:       my $first=$env{$name};
                   9867:       undef($env{$name});
                   9868:       push(@{ $env{$name} },$first,$value);
1.25      albertel 9869:     }
                   9870:   } else {
1.258     albertel 9871:     $env{$name}=$value;
1.25      albertel 9872:   }
1.31      albertel 9873: }
1.149     albertel 9874: 
                   9875: =pod
                   9876: 
1.648     raeburn  9877: =item * &get_env_multiple($name) 
1.149     albertel 9878: 
1.258     albertel 9879: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149     albertel 9880: values may be defined and end up as an array ref.
                   9881: 
                   9882: returns an array of values
                   9883: 
                   9884: =cut
                   9885: 
                   9886: sub get_env_multiple {
                   9887:     my ($name) = @_;
                   9888:     my @values;
1.258     albertel 9889:     if (defined($env{$name})) {
1.149     albertel 9890:         # exists is it an array
1.258     albertel 9891:         if (ref($env{$name})) {
                   9892:             @values=@{ $env{$name} };
1.149     albertel 9893:         } else {
1.258     albertel 9894:             $values[0]=$env{$name};
1.149     albertel 9895:         }
                   9896:     }
                   9897:     return(@values);
                   9898: }
                   9899: 
1.660     raeburn  9900: sub ask_for_embedded_content {
                   9901:     my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071    raeburn  9902:     my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
1.1075.2.11  raeburn  9903:         %currsubfile,%unused,$rem);
1.1071    raeburn  9904:     my $counter = 0;
                   9905:     my $numnew = 0;
1.987     raeburn  9906:     my $numremref = 0;
                   9907:     my $numinvalid = 0;
                   9908:     my $numpathchg = 0;
                   9909:     my $numexisting = 0;
1.1071    raeburn  9910:     my $numunused = 0;
                   9911:     my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
1.1075.2.53  raeburn  9912:         $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path,$navmap);
1.1071    raeburn  9913:     my $heading = &mt('Upload embedded files');
                   9914:     my $buttontext = &mt('Upload');
                   9915: 
1.1075.2.11  raeburn  9916:     if ($env{'request.course.id'}) {
1.1075.2.35  raeburn  9917:         if ($actionurl eq '/adm/dependencies') {
                   9918:             $navmap = Apache::lonnavmaps::navmap->new();
                   9919:         }
                   9920:         $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   9921:         $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1075.2.11  raeburn  9922:     }
1.1075.2.35  raeburn  9923:     if (($actionurl eq '/adm/portfolio') ||
                   9924:         ($actionurl eq '/adm/coursegrp_portfolio')) {
1.984     raeburn  9925:         my $current_path='/';
                   9926:         if ($env{'form.currentpath'}) {
                   9927:             $current_path = $env{'form.currentpath'};
                   9928:         }
                   9929:         if ($actionurl eq '/adm/coursegrp_portfolio') {
1.1075.2.35  raeburn  9930:             $udom = $cdom;
                   9931:             $uname = $cnum;
1.984     raeburn  9932:             $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
                   9933:         } else {
                   9934:             $udom = $env{'user.domain'};
                   9935:             $uname = $env{'user.name'};
                   9936:             $url = '/userfiles/portfolio';
                   9937:         }
1.987     raeburn  9938:         $toplevel = $url.'/';
1.984     raeburn  9939:         $url .= $current_path;
                   9940:         $getpropath = 1;
1.987     raeburn  9941:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
                   9942:              ($actionurl eq '/adm/imsimport')) { 
1.1022    www      9943:         my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026    raeburn  9944:         $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987     raeburn  9945:         $toplevel = $url;
1.984     raeburn  9946:         if ($rest ne '') {
1.987     raeburn  9947:             $url .= $rest;
                   9948:         }
                   9949:     } elsif ($actionurl eq '/adm/coursedocs') {
                   9950:         if (ref($args) eq 'HASH') {
1.1071    raeburn  9951:             $url = $args->{'docs_url'};
                   9952:             $toplevel = $url;
1.1075.2.11  raeburn  9953:             if ($args->{'context'} eq 'paste') {
                   9954:                 ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
                   9955:                 ($path) =
                   9956:                     ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
                   9957:                 $fileloc = &Apache::lonnet::filelocation('',$toplevel);
                   9958:                 $fileloc =~ s{^/}{};
                   9959:             }
1.1071    raeburn  9960:         }
                   9961:     } elsif ($actionurl eq '/adm/dependencies') {
                   9962:         if ($env{'request.course.id'} ne '') {
                   9963:             if (ref($args) eq 'HASH') {
                   9964:                 $url = $args->{'docs_url'};
                   9965:                 $title = $args->{'docs_title'};
1.1075.2.35  raeburn  9966:                 $toplevel = $url;
                   9967:                 unless ($toplevel =~ m{^/}) {
                   9968:                     $toplevel = "/$url";
                   9969:                 }
1.1075.2.11  raeburn  9970:                 ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
1.1075.2.35  raeburn  9971:                 if ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E)}) {
                   9972:                     $path = $1;
                   9973:                 } else {
                   9974:                     ($path) =
                   9975:                         ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
                   9976:                 }
1.1075.2.79  raeburn  9977:                 if ($toplevel=~/^\/*(uploaded|editupload)/) {
                   9978:                     $fileloc = $toplevel;
                   9979:                     $fileloc=~ s/^\s*(\S+)\s*$/$1/;
                   9980:                     my ($udom,$uname,$fname) =
                   9981:                         ($fileloc=~ m{^/+(?:uploaded|editupload)/+($match_domain)/+($match_name)/+(.*)$});
                   9982:                     $fileloc = propath($udom,$uname).'/userfiles/'.$fname;
                   9983:                 } else {
                   9984:                     $fileloc = &Apache::lonnet::filelocation('',$toplevel);
                   9985:                 }
1.1071    raeburn  9986:                 $fileloc =~ s{^/}{};
                   9987:                 ($filename) = ($fileloc =~ m{.+/([^/]+)$});
                   9988:                 $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
                   9989:             }
1.987     raeburn  9990:         }
1.1075.2.35  raeburn  9991:     } elsif ($actionurl eq "/public/$cdom/$cnum/syllabus") {
                   9992:         $udom = $cdom;
                   9993:         $uname = $cnum;
                   9994:         $url = "/uploaded/$cdom/$cnum/portfolio/syllabus";
                   9995:         $toplevel = $url;
                   9996:         $path = $url;
                   9997:         $fileloc = &Apache::lonnet::filelocation('',$toplevel).'/';
                   9998:         $fileloc =~ s{^/}{};
                   9999:     }
                   10000:     foreach my $file (keys(%{$allfiles})) {
                   10001:         my $embed_file;
                   10002:         if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) {
                   10003:             $embed_file = $1;
                   10004:         } else {
                   10005:             $embed_file = $file;
                   10006:         }
1.1075.2.55  raeburn  10007:         my ($absolutepath,$cleaned_file);
                   10008:         if ($embed_file =~ m{^\w+://}) {
                   10009:             $cleaned_file = $embed_file;
1.1075.2.47  raeburn  10010:             $newfiles{$cleaned_file} = 1;
                   10011:             $mapping{$cleaned_file} = $embed_file;
1.987     raeburn  10012:         } else {
1.1075.2.55  raeburn  10013:             $cleaned_file = &clean_path($embed_file);
1.987     raeburn  10014:             if ($embed_file =~ m{^/}) {
                   10015:                 $absolutepath = $embed_file;
                   10016:             }
1.1075.2.47  raeburn  10017:             if ($cleaned_file =~ m{/}) {
                   10018:                 my ($path,$fname) = ($cleaned_file =~ m{^(.+)/([^/]*)$});
1.987     raeburn  10019:                 $path = &check_for_traversal($path,$url,$toplevel);
                   10020:                 my $item = $fname;
                   10021:                 if ($path ne '') {
                   10022:                     $item = $path.'/'.$fname;
                   10023:                     $subdependencies{$path}{$fname} = 1;
                   10024:                 } else {
                   10025:                     $dependencies{$item} = 1;
                   10026:                 }
                   10027:                 if ($absolutepath) {
                   10028:                     $mapping{$item} = $absolutepath;
                   10029:                 } else {
                   10030:                     $mapping{$item} = $embed_file;
                   10031:                 }
                   10032:             } else {
                   10033:                 $dependencies{$embed_file} = 1;
                   10034:                 if ($absolutepath) {
1.1075.2.47  raeburn  10035:                     $mapping{$cleaned_file} = $absolutepath;
1.987     raeburn  10036:                 } else {
1.1075.2.47  raeburn  10037:                     $mapping{$cleaned_file} = $embed_file;
1.987     raeburn  10038:                 }
                   10039:             }
1.984     raeburn  10040:         }
                   10041:     }
1.1071    raeburn  10042:     my $dirptr = 16384;
1.984     raeburn  10043:     foreach my $path (keys(%subdependencies)) {
1.1071    raeburn  10044:         $currsubfile{$path} = {};
1.1075.2.35  raeburn  10045:         if (($actionurl eq '/adm/portfolio') ||
                   10046:             ($actionurl eq '/adm/coursegrp_portfolio')) { 
1.1021    raeburn  10047:             my ($sublistref,$listerror) =
                   10048:                 &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
                   10049:             if (ref($sublistref) eq 'ARRAY') {
                   10050:                 foreach my $line (@{$sublistref}) {
                   10051:                     my ($file_name,$rest) = split(/\&/,$line,2);
1.1071    raeburn  10052:                     $currsubfile{$path}{$file_name} = 1;
1.1021    raeburn  10053:                 }
1.984     raeburn  10054:             }
1.987     raeburn  10055:         } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  10056:             if (opendir(my $dir,$url.'/'.$path)) {
                   10057:                 my @subdir_list = grep(!/^\./,readdir($dir));
1.1071    raeburn  10058:                 map {$currsubfile{$path}{$_} = 1;} @subdir_list;
                   10059:             }
1.1075.2.11  raeburn  10060:         } elsif (($actionurl eq '/adm/dependencies') ||
                   10061:                  (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1075.2.35  raeburn  10062:                   ($args->{'context'} eq 'paste')) ||
                   10063:                  ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071    raeburn  10064:             if ($env{'request.course.id'} ne '') {
1.1075.2.35  raeburn  10065:                 my $dir;
                   10066:                 if ($actionurl eq "/public/$cdom/$cnum/syllabus") {
                   10067:                     $dir = $fileloc;
                   10068:                 } else {
                   10069:                     ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
                   10070:                 }
1.1071    raeburn  10071:                 if ($dir ne '') {
                   10072:                     my ($sublistref,$listerror) =
                   10073:                         &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
                   10074:                     if (ref($sublistref) eq 'ARRAY') {
                   10075:                         foreach my $line (@{$sublistref}) {
                   10076:                             my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
                   10077:                                 undef,$mtime)=split(/\&/,$line,12);
                   10078:                             unless (($testdir&$dirptr) ||
                   10079:                                     ($file_name =~ /^\.\.?$/)) {
                   10080:                                 $currsubfile{$path}{$file_name} = [$size,$mtime];
                   10081:                             }
                   10082:                         }
                   10083:                     }
                   10084:                 }
1.984     raeburn  10085:             }
                   10086:         }
                   10087:         foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071    raeburn  10088:             if (exists($currsubfile{$path}{$file})) {
1.987     raeburn  10089:                 my $item = $path.'/'.$file;
                   10090:                 unless ($mapping{$item} eq $item) {
                   10091:                     $pathchanges{$item} = 1;
                   10092:                 }
                   10093:                 $existing{$item} = 1;
                   10094:                 $numexisting ++;
                   10095:             } else {
                   10096:                 $newfiles{$path.'/'.$file} = 1;
1.984     raeburn  10097:             }
                   10098:         }
1.1071    raeburn  10099:         if ($actionurl eq '/adm/dependencies') {
                   10100:             foreach my $path (keys(%currsubfile)) {
                   10101:                 if (ref($currsubfile{$path}) eq 'HASH') {
                   10102:                     foreach my $file (keys(%{$currsubfile{$path}})) {
                   10103:                          unless ($subdependencies{$path}{$file}) {
1.1075.2.11  raeburn  10104:                              next if (($rem ne '') &&
                   10105:                                       (($env{"httpref.$rem"."$path/$file"} ne '') ||
                   10106:                                        (ref($navmap) &&
                   10107:                                        (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
                   10108:                                         (($file =~ /^(.*\.s?html?)\.bak$/i) &&
                   10109:                                          ($navmap->getResourceByUrl($rem."$path/$1")))))));
1.1071    raeburn  10110:                              $unused{$path.'/'.$file} = 1; 
                   10111:                          }
                   10112:                     }
                   10113:                 }
                   10114:             }
                   10115:         }
1.984     raeburn  10116:     }
1.987     raeburn  10117:     my %currfile;
1.1075.2.35  raeburn  10118:     if (($actionurl eq '/adm/portfolio') ||
                   10119:         ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021    raeburn  10120:         my ($dirlistref,$listerror) =
                   10121:             &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
                   10122:         if (ref($dirlistref) eq 'ARRAY') {
                   10123:             foreach my $line (@{$dirlistref}) {
                   10124:                 my ($file_name,$rest) = split(/\&/,$line,2);
                   10125:                 $currfile{$file_name} = 1;
                   10126:             }
1.984     raeburn  10127:         }
1.987     raeburn  10128:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  10129:         if (opendir(my $dir,$url)) {
1.987     raeburn  10130:             my @dir_list = grep(!/^\./,readdir($dir));
1.984     raeburn  10131:             map {$currfile{$_} = 1;} @dir_list;
                   10132:         }
1.1075.2.11  raeburn  10133:     } elsif (($actionurl eq '/adm/dependencies') ||
                   10134:              (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1075.2.35  raeburn  10135:               ($args->{'context'} eq 'paste')) ||
                   10136:              ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071    raeburn  10137:         if ($env{'request.course.id'} ne '') {
                   10138:             my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
                   10139:             if ($dir ne '') {
                   10140:                 my ($dirlistref,$listerror) =
                   10141:                     &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
                   10142:                 if (ref($dirlistref) eq 'ARRAY') {
                   10143:                     foreach my $line (@{$dirlistref}) {
                   10144:                         my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
                   10145:                             $size,undef,$mtime)=split(/\&/,$line,12);
                   10146:                         unless (($testdir&$dirptr) ||
                   10147:                                 ($file_name =~ /^\.\.?$/)) {
                   10148:                             $currfile{$file_name} = [$size,$mtime];
                   10149:                         }
                   10150:                     }
                   10151:                 }
                   10152:             }
                   10153:         }
1.984     raeburn  10154:     }
                   10155:     foreach my $file (keys(%dependencies)) {
1.1071    raeburn  10156:         if (exists($currfile{$file})) {
1.987     raeburn  10157:             unless ($mapping{$file} eq $file) {
                   10158:                 $pathchanges{$file} = 1;
                   10159:             }
                   10160:             $existing{$file} = 1;
                   10161:             $numexisting ++;
                   10162:         } else {
1.984     raeburn  10163:             $newfiles{$file} = 1;
                   10164:         }
                   10165:     }
1.1071    raeburn  10166:     foreach my $file (keys(%currfile)) {
                   10167:         unless (($file eq $filename) ||
                   10168:                 ($file eq $filename.'.bak') ||
                   10169:                 ($dependencies{$file})) {
1.1075.2.11  raeburn  10170:             if ($actionurl eq '/adm/dependencies') {
1.1075.2.35  raeburn  10171:                 unless ($toplevel =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E}) {
                   10172:                     next if (($rem ne '') &&
                   10173:                              (($env{"httpref.$rem".$file} ne '') ||
                   10174:                               (ref($navmap) &&
                   10175:                               (($navmap->getResourceByUrl($rem.$file) ne '') ||
                   10176:                                (($file =~ /^(.*\.s?html?)\.bak$/i) &&
                   10177:                                 ($navmap->getResourceByUrl($rem.$1)))))));
                   10178:                 }
1.1075.2.11  raeburn  10179:             }
1.1071    raeburn  10180:             $unused{$file} = 1;
                   10181:         }
                   10182:     }
1.1075.2.11  raeburn  10183:     if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
                   10184:         ($args->{'context'} eq 'paste')) {
                   10185:         $counter = scalar(keys(%existing));
                   10186:         $numpathchg = scalar(keys(%pathchanges));
                   10187:         return ($output,$counter,$numpathchg,\%existing);
1.1075.2.35  raeburn  10188:     } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") &&
                   10189:              (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {
                   10190:         $counter = scalar(keys(%existing));
                   10191:         $numpathchg = scalar(keys(%pathchanges));
                   10192:         return ($output,$counter,$numpathchg,\%existing,\%mapping);
1.1075.2.11  raeburn  10193:     }
1.984     raeburn  10194:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071    raeburn  10195:         if ($actionurl eq '/adm/dependencies') {
                   10196:             next if ($embed_file =~ m{^\w+://});
                   10197:         }
1.660     raeburn  10198:         $upload_output .= &start_data_table_row().
1.1075.2.35  raeburn  10199:                           '<td valign="top"><img src="'.&icon($embed_file).'" />&nbsp;'.
1.1071    raeburn  10200:                           '<span class="LC_filename">'.$embed_file.'</span>';
1.987     raeburn  10201:         unless ($mapping{$embed_file} eq $embed_file) {
1.1075.2.35  raeburn  10202:             $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.
                   10203:                               &mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
1.987     raeburn  10204:         }
1.1075.2.35  raeburn  10205:         $upload_output .= '</td>';
1.1071    raeburn  10206:         if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) { 
1.1075.2.35  raeburn  10207:             $upload_output.='<td align="right">'.
                   10208:                             '<span class="LC_info LC_fontsize_medium">'.
                   10209:                             &mt("URL points to web address").'</span>';
1.987     raeburn  10210:             $numremref++;
1.660     raeburn  10211:         } elsif ($args->{'error_on_invalid_names'}
                   10212:             && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
1.1075.2.35  raeburn  10213:             $upload_output.='<td align="right"><span class="LC_warning">'.
                   10214:                             &mt('Invalid characters').'</span>';
1.987     raeburn  10215:             $numinvalid++;
1.660     raeburn  10216:         } else {
1.1075.2.35  raeburn  10217:             $upload_output .= '<td>'.
                   10218:                               &embedded_file_element('upload_embedded',$counter,
1.987     raeburn  10219:                                                      $embed_file,\%mapping,
1.1071    raeburn  10220:                                                      $allfiles,$codebase,'upload');
                   10221:             $counter ++;
                   10222:             $numnew ++;
1.987     raeburn  10223:         }
                   10224:         $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
                   10225:     }
                   10226:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071    raeburn  10227:         if ($actionurl eq '/adm/dependencies') {
                   10228:             my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
                   10229:             $modify_output .= &start_data_table_row().
                   10230:                               '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
                   10231:                               '<img src="'.&icon($embed_file).'" border="0" />'.
                   10232:                               '&nbsp;<span class="LC_filename">'.$embed_file.'</span></a></td>'.
                   10233:                               '<td>'.$size.'</td>'.
                   10234:                               '<td>'.$mtime.'</td>'.
                   10235:                               '<td><label><input type="checkbox" name="mod_upload_dep" '.
                   10236:                               'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
                   10237:                               $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
                   10238:                               '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
                   10239:                               &embedded_file_element('upload_embedded',$counter,
                   10240:                                                      $embed_file,\%mapping,
                   10241:                                                      $allfiles,$codebase,'modify').
                   10242:                               '</div></td>'.
                   10243:                               &end_data_table_row()."\n";
                   10244:             $counter ++;
                   10245:         } else {
                   10246:             $upload_output .= &start_data_table_row().
1.1075.2.35  raeburn  10247:                               '<td valign="top"><img src="'.&icon($embed_file).'" />&nbsp;'.
                   10248:                               '<span class="LC_filename">'.$embed_file.'</span></td>'.
                   10249:                               '<td align="right"><span class="LC_info LC_fontsize_medium">'.&mt('Already exists').'</span></td>'.
1.1071    raeburn  10250:                               &Apache::loncommon::end_data_table_row()."\n";
                   10251:         }
                   10252:     }
                   10253:     my $delidx = $counter;
                   10254:     foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
                   10255:         my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
                   10256:         $delete_output .= &start_data_table_row().
                   10257:                           '<td><img src="'.&icon($oldfile).'" />'.
                   10258:                           '&nbsp;<span class="LC_filename">'.$oldfile.'</span></td>'.
                   10259:                           '<td>'.$size.'</td>'.
                   10260:                           '<td>'.$mtime.'</td>'.
                   10261:                           '<td><label><input type="checkbox" name="del_upload_dep" '.
                   10262:                           ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
                   10263:                           &embedded_file_element('upload_embedded',$delidx,
                   10264:                                                  $oldfile,\%mapping,$allfiles,
                   10265:                                                  $codebase,'delete').'</td>'.
                   10266:                           &end_data_table_row()."\n"; 
                   10267:         $numunused ++;
                   10268:         $delidx ++;
1.987     raeburn  10269:     }
                   10270:     if ($upload_output) {
                   10271:         $upload_output = &start_data_table().
                   10272:                          $upload_output.
                   10273:                          &end_data_table()."\n";
                   10274:     }
1.1071    raeburn  10275:     if ($modify_output) {
                   10276:         $modify_output = &start_data_table().
                   10277:                          &start_data_table_header_row().
                   10278:                          '<th>'.&mt('File').'</th>'.
                   10279:                          '<th>'.&mt('Size (KB)').'</th>'.
                   10280:                          '<th>'.&mt('Modified').'</th>'.
                   10281:                          '<th>'.&mt('Upload replacement?').'</th>'.
                   10282:                          &end_data_table_header_row().
                   10283:                          $modify_output.
                   10284:                          &end_data_table()."\n";
                   10285:     }
                   10286:     if ($delete_output) {
                   10287:         $delete_output = &start_data_table().
                   10288:                          &start_data_table_header_row().
                   10289:                          '<th>'.&mt('File').'</th>'.
                   10290:                          '<th>'.&mt('Size (KB)').'</th>'.
                   10291:                          '<th>'.&mt('Modified').'</th>'.
                   10292:                          '<th>'.&mt('Delete?').'</th>'.
                   10293:                          &end_data_table_header_row().
                   10294:                          $delete_output.
                   10295:                          &end_data_table()."\n";
                   10296:     }
1.987     raeburn  10297:     my $applies = 0;
                   10298:     if ($numremref) {
                   10299:         $applies ++;
                   10300:     }
                   10301:     if ($numinvalid) {
                   10302:         $applies ++;
                   10303:     }
                   10304:     if ($numexisting) {
                   10305:         $applies ++;
                   10306:     }
1.1071    raeburn  10307:     if ($counter || $numunused) {
1.987     raeburn  10308:         $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
                   10309:                   ' method="post" enctype="multipart/form-data">'."\n".
1.1071    raeburn  10310:                   $state.'<h3>'.$heading.'</h3>'; 
                   10311:         if ($actionurl eq '/adm/dependencies') {
                   10312:             if ($numnew) {
                   10313:                 $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
                   10314:                            '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
                   10315:                            $upload_output.'<br />'."\n";
                   10316:             }
                   10317:             if ($numexisting) {
                   10318:                 $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
                   10319:                            '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
                   10320:                            $modify_output.'<br />'."\n";
                   10321:                            $buttontext = &mt('Save changes');
                   10322:             }
                   10323:             if ($numunused) {
                   10324:                 $output .= '<h4>'.&mt('Unused files').'</h4>'.
                   10325:                            '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
                   10326:                            $delete_output.'<br />'."\n";
                   10327:                            $buttontext = &mt('Save changes');
                   10328:             }
                   10329:         } else {
                   10330:             $output .= $upload_output.'<br />'."\n";
                   10331:         }
                   10332:         $output .= '<input type ="hidden" name="number_embedded_items" value="'.
                   10333:                    $counter.'" />'."\n";
                   10334:         if ($actionurl eq '/adm/dependencies') { 
                   10335:             $output .= '<input type ="hidden" name="number_newemb_items" value="'.
                   10336:                        $numnew.'" />'."\n";
                   10337:         } elsif ($actionurl eq '') {
1.987     raeburn  10338:             $output .=  '<input type="hidden" name="phase" value="three" />';
                   10339:         }
                   10340:     } elsif ($applies) {
                   10341:         $output = '<b>'.&mt('Referenced files').'</b>:<br />';
                   10342:         if ($applies > 1) {
                   10343:             $output .=  
1.1075.2.35  raeburn  10344:                 &mt('No dependencies need to be uploaded, as one of the following applies to each reference:').'<ul>';
1.987     raeburn  10345:             if ($numremref) {
                   10346:                 $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
                   10347:             }
                   10348:             if ($numinvalid) {
                   10349:                 $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
                   10350:             }
                   10351:             if ($numexisting) {
                   10352:                 $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
                   10353:             }
                   10354:             $output .= '</ul><br />';
                   10355:         } elsif ($numremref) {
                   10356:             $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
                   10357:         } elsif ($numinvalid) {
                   10358:             $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
                   10359:         } elsif ($numexisting) {
                   10360:             $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
                   10361:         }
                   10362:         $output .= $upload_output.'<br />';
                   10363:     }
                   10364:     my ($pathchange_output,$chgcount);
1.1071    raeburn  10365:     $chgcount = $counter;
1.987     raeburn  10366:     if (keys(%pathchanges) > 0) {
                   10367:         foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071    raeburn  10368:             if ($counter) {
1.987     raeburn  10369:                 $output .= &embedded_file_element('pathchange',$chgcount,
                   10370:                                                   $embed_file,\%mapping,
1.1071    raeburn  10371:                                                   $allfiles,$codebase,'change');
1.987     raeburn  10372:             } else {
                   10373:                 $pathchange_output .= 
                   10374:                     &start_data_table_row().
                   10375:                     '<td><input type ="checkbox" name="namechange" value="'.
                   10376:                     $chgcount.'" checked="checked" /></td>'.
                   10377:                     '<td>'.$mapping{$embed_file}.'</td>'.
                   10378:                     '<td>'.$embed_file.
                   10379:                     &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071    raeburn  10380:                                            \%mapping,$allfiles,$codebase,'change').
1.987     raeburn  10381:                     '</td>'.&end_data_table_row();
1.660     raeburn  10382:             }
1.987     raeburn  10383:             $numpathchg ++;
                   10384:             $chgcount ++;
1.660     raeburn  10385:         }
                   10386:     }
1.1075.2.35  raeburn  10387:     if (($counter) || ($numunused)) {
1.987     raeburn  10388:         if ($numpathchg) {
                   10389:             $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
                   10390:                        $numpathchg.'" />'."\n";
                   10391:         }
                   10392:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') || 
                   10393:             ($actionurl eq '/adm/imsimport')) {
                   10394:             $output .= '<input type="hidden" name="phase" value="three" />'."\n";
                   10395:         } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
                   10396:             $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071    raeburn  10397:         } elsif ($actionurl eq '/adm/dependencies') {
                   10398:             $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987     raeburn  10399:         }
1.1075.2.35  raeburn  10400:         $output .= '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987     raeburn  10401:     } elsif ($numpathchg) {
                   10402:         my %pathchange = ();
                   10403:         $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
                   10404:         if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   10405:             $output .= '<p>'.&mt('or').'</p>'; 
1.1075.2.35  raeburn  10406:         }
1.987     raeburn  10407:     }
1.1071    raeburn  10408:     return ($output,$counter,$numpathchg);
1.987     raeburn  10409: }
                   10410: 
1.1075.2.47  raeburn  10411: =pod
                   10412: 
                   10413: =item * clean_path($name)
                   10414: 
                   10415: Performs clean-up of directories, subdirectories and filename in an
                   10416: embedded object, referenced in an HTML file which is being uploaded
                   10417: to a course or portfolio, where
                   10418: "Upload embedded images/multimedia files if HTML file" checkbox was
                   10419: checked.
                   10420: 
                   10421: Clean-up is similar to replacements in lonnet::clean_filename()
                   10422: except each / between sub-directory and next level is preserved.
                   10423: 
                   10424: =cut
                   10425: 
                   10426: sub clean_path {
                   10427:     my ($embed_file) = @_;
                   10428:     $embed_file =~s{^/+}{};
                   10429:     my @contents;
                   10430:     if ($embed_file =~ m{/}) {
                   10431:         @contents = split(/\//,$embed_file);
                   10432:     } else {
                   10433:         @contents = ($embed_file);
                   10434:     }
                   10435:     my $lastidx = scalar(@contents)-1;
                   10436:     for (my $i=0; $i<=$lastidx; $i++) {
                   10437:         $contents[$i]=~s{\\}{/}g;
                   10438:         $contents[$i]=~s/\s+/\_/g;
                   10439:         $contents[$i]=~s{[^/\w\.\-]}{}g;
                   10440:         if ($i == $lastidx) {
                   10441:             $contents[$i]=~s/\.(\d+)(?=\.)/_$1/g;
                   10442:         }
                   10443:     }
                   10444:     if ($lastidx > 0) {
                   10445:         return join('/',@contents);
                   10446:     } else {
                   10447:         return $contents[0];
                   10448:     }
                   10449: }
                   10450: 
1.987     raeburn  10451: sub embedded_file_element {
1.1071    raeburn  10452:     my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987     raeburn  10453:     return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
                   10454:                    (ref($codebase) eq 'HASH'));
                   10455:     my $output;
1.1071    raeburn  10456:     if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987     raeburn  10457:        $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
                   10458:     }
                   10459:     $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
                   10460:                &escape($embed_file).'" />';
                   10461:     unless (($context eq 'upload_embedded') && 
                   10462:             ($mapping->{$embed_file} eq $embed_file)) {
                   10463:         $output .='
                   10464:         <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
                   10465:     }
                   10466:     my $attrib;
                   10467:     if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
                   10468:         $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
                   10469:     }
                   10470:     $output .=
                   10471:         "\n\t\t".
                   10472:         '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
                   10473:         $attrib.'" />';
                   10474:     if (exists($codebase->{$mapping->{$embed_file}})) {
                   10475:         $output .=
                   10476:             "\n\t\t".
                   10477:             '<input name="codebase_'.$num.'" type="hidden" value="'.
                   10478:             &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984     raeburn  10479:     }
1.987     raeburn  10480:     return $output;
1.660     raeburn  10481: }
                   10482: 
1.1071    raeburn  10483: sub get_dependency_details {
                   10484:     my ($currfile,$currsubfile,$embed_file) = @_;
                   10485:     my ($size,$mtime,$showsize,$showmtime);
                   10486:     if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
                   10487:         if ($embed_file =~ m{/}) {
                   10488:             my ($path,$fname) = split(/\//,$embed_file);
                   10489:             if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
                   10490:                 ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
                   10491:             }
                   10492:         } else {
                   10493:             if (ref($currfile->{$embed_file}) eq 'ARRAY') {
                   10494:                 ($size,$mtime) = @{$currfile->{$embed_file}};
                   10495:             }
                   10496:         }
                   10497:         $showsize = $size/1024.0;
                   10498:         $showsize = sprintf("%.1f",$showsize);
                   10499:         if ($mtime > 0) {
                   10500:             $showmtime = &Apache::lonlocal::locallocaltime($mtime);
                   10501:         }
                   10502:     }
                   10503:     return ($showsize,$showmtime);
                   10504: }
                   10505: 
                   10506: sub ask_embedded_js {
                   10507:     return <<"END";
                   10508: <script type="text/javascript"">
                   10509: // <![CDATA[
                   10510: function toggleBrowse(counter) {
                   10511:     var chkboxid = document.getElementById('mod_upload_dep_'+counter);
                   10512:     var fileid = document.getElementById('embedded_item_'+counter);
                   10513:     var uploaddivid = document.getElementById('moduploaddep_'+counter);
                   10514:     if (chkboxid.checked == true) {
                   10515:         uploaddivid.style.display='block';
                   10516:     } else {
                   10517:         uploaddivid.style.display='none';
                   10518:         fileid.value = '';
                   10519:     }
                   10520: }
                   10521: // ]]>
                   10522: </script>
                   10523: 
                   10524: END
                   10525: }
                   10526: 
1.661     raeburn  10527: sub upload_embedded {
                   10528:     my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987     raeburn  10529:         $current_disk_usage,$hiddenstate,$actionurl) = @_;
                   10530:     my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661     raeburn  10531:     for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
                   10532:         next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
                   10533:         my $orig_uploaded_filename =
                   10534:             $env{'form.embedded_item_'.$i.'.filename'};
1.987     raeburn  10535:         foreach my $type ('orig','ref','attrib','codebase') {
                   10536:             if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
                   10537:                 $env{'form.embedded_'.$type.'_'.$i} =
                   10538:                     &unescape($env{'form.embedded_'.$type.'_'.$i});
                   10539:             }
                   10540:         }
1.661     raeburn  10541:         my ($path,$fname) =
                   10542:             ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
                   10543:         # no path, whole string is fname
                   10544:         if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
                   10545:         $fname = &Apache::lonnet::clean_filename($fname);
                   10546:         # See if there is anything left
                   10547:         next if ($fname eq '');
                   10548: 
                   10549:         # Check if file already exists as a file or directory.
                   10550:         my ($state,$msg);
                   10551:         if ($context eq 'portfolio') {
                   10552:             my $port_path = $dirpath;
                   10553:             if ($group ne '') {
                   10554:                 $port_path = "groups/$group/$port_path";
                   10555:             }
1.987     raeburn  10556:             ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
                   10557:                                               $fname,$group,'embedded_item_'.$i,
1.661     raeburn  10558:                                               $dir_root,$port_path,$disk_quota,
                   10559:                                               $current_disk_usage,$uname,$udom);
                   10560:             if ($state eq 'will_exceed_quota'
1.984     raeburn  10561:                 || $state eq 'file_locked') {
1.661     raeburn  10562:                 $output .= $msg;
                   10563:                 next;
                   10564:             }
                   10565:         } elsif (($context eq 'author') || ($context eq 'testbank')) {
                   10566:             ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
                   10567:             if ($state eq 'exists') {
                   10568:                 $output .= $msg;
                   10569:                 next;
                   10570:             }
                   10571:         }
                   10572:         # Check if extension is valid
                   10573:         if (($fname =~ /\.(\w+)$/) &&
                   10574:             (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.1075.2.53  raeburn  10575:             $output .= &mt('Invalid file extension ([_1]) - reserved for internal use.',$1)
                   10576:                       .' '.&mt('Rename the file with a different extension and re-upload.').'<br />';
1.661     raeburn  10577:             next;
                   10578:         } elsif (($fname =~ /\.(\w+)$/) &&
                   10579:                  (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987     raeburn  10580:             $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661     raeburn  10581:             next;
                   10582:         } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.1075.2.34  raeburn  10583:             $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  10584:             next;
                   10585:         }
                   10586:         $env{'form.embedded_item_'.$i.'.filename'}=$fname;
1.1075.2.35  raeburn  10587:         my $subdir = $path;
                   10588:         $subdir =~ s{/+$}{};
1.661     raeburn  10589:         if ($context eq 'portfolio') {
1.984     raeburn  10590:             my $result;
                   10591:             if ($state eq 'existingfile') {
                   10592:                 $result=
                   10593:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.1075.2.35  raeburn  10594:                                                     $dirpath.$env{'form.currentpath'}.$subdir);
1.661     raeburn  10595:             } else {
1.984     raeburn  10596:                 $result=
                   10597:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987     raeburn  10598:                                                     $dirpath.
1.1075.2.35  raeburn  10599:                                                     $env{'form.currentpath'}.$subdir);
1.984     raeburn  10600:                 if ($result !~ m|^/uploaded/|) {
                   10601:                     $output .= '<span class="LC_error">'
                   10602:                                .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   10603:                                ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   10604:                                .'</span><br />';
                   10605:                     next;
                   10606:                 } else {
1.987     raeburn  10607:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   10608:                                $path.$fname.'</span>').'<br />';     
1.984     raeburn  10609:                 }
1.661     raeburn  10610:             }
1.1075.2.35  raeburn  10611:         } elsif (($context eq 'coursedoc') || ($context eq 'syllabus')) {
                   10612:             my $extendedsubdir = $dirpath.'/'.$subdir;
                   10613:             $extendedsubdir =~ s{/+$}{};
1.987     raeburn  10614:             my $result =
1.1075.2.35  raeburn  10615:                 &Apache::lonnet::userfileupload('embedded_item_'.$i,$context,$extendedsubdir);
1.987     raeburn  10616:             if ($result !~ m|^/uploaded/|) {
                   10617:                 $output .= '<span class="LC_error">'
                   10618:                            .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   10619:                            ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   10620:                            .'</span><br />';
                   10621:                     next;
                   10622:             } else {
                   10623:                 $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   10624:                            $path.$fname.'</span>').'<br />';
1.1075.2.35  raeburn  10625:                 if ($context eq 'syllabus') {
                   10626:                     &Apache::lonnet::make_public_indefinitely($result);
                   10627:                 }
1.987     raeburn  10628:             }
1.661     raeburn  10629:         } else {
                   10630: # Save the file
                   10631:             my $target = $env{'form.embedded_item_'.$i};
                   10632:             my $fullpath = $dir_root.$dirpath.'/'.$path;
                   10633:             my $dest = $fullpath.$fname;
                   10634:             my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027    raeburn  10635:             my @parts=split(/\//,"$dirpath/$path");
1.661     raeburn  10636:             my $count;
                   10637:             my $filepath = $dir_root;
1.1027    raeburn  10638:             foreach my $subdir (@parts) {
                   10639:                 $filepath .= "/$subdir";
                   10640:                 if (!-e $filepath) {
1.661     raeburn  10641:                     mkdir($filepath,0770);
                   10642:                 }
                   10643:             }
                   10644:             my $fh;
                   10645:             if (!open($fh,'>'.$dest)) {
                   10646:                 &Apache::lonnet::logthis('Failed to create '.$dest);
                   10647:                 $output .= '<span class="LC_error">'.
1.1071    raeburn  10648:                            &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
                   10649:                                $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661     raeburn  10650:                            '</span><br />';
                   10651:             } else {
                   10652:                 if (!print $fh $env{'form.embedded_item_'.$i}) {
                   10653:                     &Apache::lonnet::logthis('Failed to write to '.$dest);
                   10654:                     $output .= '<span class="LC_error">'.
1.1071    raeburn  10655:                               &mt('An error occurred while writing the file [_1] for embedded element [_2].',
                   10656:                                   $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661     raeburn  10657:                               '</span><br />';
                   10658:                 } else {
1.987     raeburn  10659:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   10660:                                $url.'</span>').'<br />';
                   10661:                     unless ($context eq 'testbank') {
                   10662:                         $footer .= &mt('View embedded file: [_1]',
                   10663:                                        '<a href="'.$url.'">'.$fname.'</a>').'<br />';
                   10664:                     }
                   10665:                 }
                   10666:                 close($fh);
                   10667:             }
                   10668:         }
                   10669:         if ($env{'form.embedded_ref_'.$i}) {
                   10670:             $pathchange{$i} = 1;
                   10671:         }
                   10672:     }
                   10673:     if ($output) {
                   10674:         $output = '<p>'.$output.'</p>';
                   10675:     }
                   10676:     $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
                   10677:     $returnflag = 'ok';
1.1071    raeburn  10678:     my $numpathchgs = scalar(keys(%pathchange));
                   10679:     if ($numpathchgs > 0) {
1.987     raeburn  10680:         if ($context eq 'portfolio') {
                   10681:             $output .= '<p>'.&mt('or').'</p>';
                   10682:         } elsif ($context eq 'testbank') {
1.1071    raeburn  10683:             $output .=  '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
                   10684:                                   '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987     raeburn  10685:             $returnflag = 'modify_orightml';
                   10686:         }
                   10687:     }
1.1071    raeburn  10688:     return ($output.$footer,$returnflag,$numpathchgs);
1.987     raeburn  10689: }
                   10690: 
                   10691: sub modify_html_form {
                   10692:     my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
                   10693:     my $end = 0;
                   10694:     my $modifyform;
                   10695:     if ($context eq 'upload_embedded') {
                   10696:         return unless (ref($pathchange) eq 'HASH');
                   10697:         if ($env{'form.number_embedded_items'}) {
                   10698:             $end += $env{'form.number_embedded_items'};
                   10699:         }
                   10700:         if ($env{'form.number_pathchange_items'}) {
                   10701:             $end += $env{'form.number_pathchange_items'};
                   10702:         }
                   10703:         if ($end) {
                   10704:             for (my $i=0; $i<$end; $i++) {
                   10705:                 if ($i < $env{'form.number_embedded_items'}) {
                   10706:                     next unless($pathchange->{$i});
                   10707:                 }
                   10708:                 $modifyform .=
                   10709:                     &start_data_table_row().
                   10710:                     '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
                   10711:                     'checked="checked" /></td>'.
                   10712:                     '<td>'.$env{'form.embedded_ref_'.$i}.
                   10713:                     '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
                   10714:                     &escape($env{'form.embedded_ref_'.$i}).'" />'.
                   10715:                     '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
                   10716:                     &escape($env{'form.embedded_codebase_'.$i}).'" />'.
                   10717:                     '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
                   10718:                     &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
                   10719:                     '<td>'.$env{'form.embedded_orig_'.$i}.
                   10720:                     '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
                   10721:                     &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
                   10722:                     &end_data_table_row();
1.1071    raeburn  10723:             }
1.987     raeburn  10724:         }
                   10725:     } else {
                   10726:         $modifyform = $pathchgtable;
                   10727:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
                   10728:             $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
                   10729:         } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   10730:             $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
                   10731:         }
                   10732:     }
                   10733:     if ($modifyform) {
1.1071    raeburn  10734:         if ($actionurl eq '/adm/dependencies') {
                   10735:             $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
                   10736:         }
1.987     raeburn  10737:         return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
                   10738:                '<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".
                   10739:                '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
                   10740:                '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
                   10741:                '</ol></p>'."\n".'<p>'.
                   10742:                &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
                   10743:                '<form method="post" name="refchanger" action="'.$actionurl.'">'.
                   10744:                &start_data_table()."\n".
                   10745:                &start_data_table_header_row().
                   10746:                '<th>'.&mt('Change?').'</th>'.
                   10747:                '<th>'.&mt('Current reference').'</th>'.
                   10748:                '<th>'.&mt('Required reference').'</th>'.
                   10749:                &end_data_table_header_row()."\n".
                   10750:                $modifyform.
                   10751:                &end_data_table().'<br />'."\n".$hiddenstate.
                   10752:                '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
                   10753:                '</form>'."\n";
                   10754:     }
                   10755:     return;
                   10756: }
                   10757: 
                   10758: sub modify_html_refs {
1.1075.2.35  raeburn  10759:     my ($context,$dirpath,$uname,$udom,$dir_root,$url) = @_;
1.987     raeburn  10760:     my $container;
                   10761:     if ($context eq 'portfolio') {
                   10762:         $container = $env{'form.container'};
                   10763:     } elsif ($context eq 'coursedoc') {
                   10764:         $container = $env{'form.primaryurl'};
1.1071    raeburn  10765:     } elsif ($context eq 'manage_dependencies') {
                   10766:         (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
                   10767:         $container = "/$container";
1.1075.2.35  raeburn  10768:     } elsif ($context eq 'syllabus') {
                   10769:         $container = $url;
1.987     raeburn  10770:     } else {
1.1027    raeburn  10771:         $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987     raeburn  10772:     }
                   10773:     my (%allfiles,%codebase,$output,$content);
                   10774:     my @changes = &get_env_multiple('form.namechange');
1.1075.2.35  raeburn  10775:     unless ((@changes > 0)  || ($context eq 'syllabus')) {
1.1071    raeburn  10776:         if (wantarray) {
                   10777:             return ('',0,0); 
                   10778:         } else {
                   10779:             return;
                   10780:         }
                   10781:     }
                   10782:     if (($context eq 'portfolio') || ($context eq 'coursedoc') || 
1.1075.2.35  raeburn  10783:         ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.1071    raeburn  10784:         unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
                   10785:             if (wantarray) {
                   10786:                 return ('',0,0);
                   10787:             } else {
                   10788:                 return;
                   10789:             }
                   10790:         } 
1.987     raeburn  10791:         $content = &Apache::lonnet::getfile($container);
1.1071    raeburn  10792:         if ($content eq '-1') {
                   10793:             if (wantarray) {
                   10794:                 return ('',0,0);
                   10795:             } else {
                   10796:                 return;
                   10797:             }
                   10798:         }
1.987     raeburn  10799:     } else {
1.1071    raeburn  10800:         unless ($container =~ /^\Q$dir_root\E/) {
                   10801:             if (wantarray) {
                   10802:                 return ('',0,0);
                   10803:             } else {
                   10804:                 return;
                   10805:             }
                   10806:         } 
1.987     raeburn  10807:         if (open(my $fh,"<$container")) {
                   10808:             $content = join('', <$fh>);
                   10809:             close($fh);
                   10810:         } else {
1.1071    raeburn  10811:             if (wantarray) {
                   10812:                 return ('',0,0);
                   10813:             } else {
                   10814:                 return;
                   10815:             }
1.987     raeburn  10816:         }
                   10817:     }
                   10818:     my ($count,$codebasecount) = (0,0);
                   10819:     my $mm = new File::MMagic;
                   10820:     my $mime_type = $mm->checktype_contents($content);
                   10821:     if ($mime_type eq 'text/html') {
                   10822:         my $parse_result = 
                   10823:             &Apache::lonnet::extract_embedded_items($container,\%allfiles,
                   10824:                                                     \%codebase,\$content);
                   10825:         if ($parse_result eq 'ok') {
                   10826:             foreach my $i (@changes) {
                   10827:                 my $orig = &unescape($env{'form.embedded_orig_'.$i});
                   10828:                 my $ref = &unescape($env{'form.embedded_ref_'.$i});
                   10829:                 if ($allfiles{$ref}) {
                   10830:                     my $newname =  $orig;
                   10831:                     my ($attrib_regexp,$codebase);
1.1006    raeburn  10832:                     $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987     raeburn  10833:                     if ($attrib_regexp =~ /:/) {
                   10834:                         $attrib_regexp =~ s/\:/|/g;
                   10835:                     }
                   10836:                     if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
                   10837:                         my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
                   10838:                         $count += $numchg;
1.1075.2.35  raeburn  10839:                         $allfiles{$newname} = $allfiles{$ref};
1.1075.2.48  raeburn  10840:                         delete($allfiles{$ref});
1.987     raeburn  10841:                     }
                   10842:                     if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006    raeburn  10843:                         $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987     raeburn  10844:                         my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
                   10845:                         $codebasecount ++;
                   10846:                     }
                   10847:                 }
                   10848:             }
1.1075.2.35  raeburn  10849:             my $skiprewrites;
1.987     raeburn  10850:             if ($count || $codebasecount) {
                   10851:                 my $saveresult;
1.1071    raeburn  10852:                 if (($context eq 'portfolio') || ($context eq 'coursedoc') || 
1.1075.2.35  raeburn  10853:                     ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.987     raeburn  10854:                     my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
                   10855:                     if ($url eq $container) {
                   10856:                         my ($fname) = ($container =~ m{/([^/]+)$});
                   10857:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   10858:                                             $count,'<span class="LC_filename">'.
1.1071    raeburn  10859:                                             $fname.'</span>').'</p>';
1.987     raeburn  10860:                     } else {
                   10861:                          $output = '<p class="LC_error">'.
                   10862:                                    &mt('Error: update failed for: [_1].',
                   10863:                                    '<span class="LC_filename">'.
                   10864:                                    $container.'</span>').'</p>';
                   10865:                     }
1.1075.2.35  raeburn  10866:                     if ($context eq 'syllabus') {
                   10867:                         unless ($saveresult eq 'ok') {
                   10868:                             $skiprewrites = 1;
                   10869:                         }
                   10870:                     }
1.987     raeburn  10871:                 } else {
                   10872:                     if (open(my $fh,">$container")) {
                   10873:                         print $fh $content;
                   10874:                         close($fh);
                   10875:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   10876:                                   $count,'<span class="LC_filename">'.
                   10877:                                   $container.'</span>').'</p>';
1.661     raeburn  10878:                     } else {
1.987     raeburn  10879:                          $output = '<p class="LC_error">'.
                   10880:                                    &mt('Error: could not update [_1].',
                   10881:                                    '<span class="LC_filename">'.
                   10882:                                    $container.'</span>').'</p>';
1.661     raeburn  10883:                     }
                   10884:                 }
                   10885:             }
1.1075.2.35  raeburn  10886:             if (($context eq 'syllabus') && (!$skiprewrites)) {
                   10887:                 my ($actionurl,$state);
                   10888:                 $actionurl = "/public/$udom/$uname/syllabus";
                   10889:                 my ($ignore,$num,$numpathchanges,$existing,$mapping) =
                   10890:                     &ask_for_embedded_content($actionurl,$state,\%allfiles,
                   10891:                                               \%codebase,
                   10892:                                               {'context' => 'rewrites',
                   10893:                                                'ignore_remote_references' => 1,});
                   10894:                 if (ref($mapping) eq 'HASH') {
                   10895:                     my $rewrites = 0;
                   10896:                     foreach my $key (keys(%{$mapping})) {
                   10897:                         next if ($key =~ m{^https?://});
                   10898:                         my $ref = $mapping->{$key};
                   10899:                         my $newname = "/uploaded/$udom/$uname/portfolio/syllabus/$key";
                   10900:                         my $attrib;
                   10901:                         if (ref($allfiles{$mapping->{$key}}) eq 'ARRAY') {
                   10902:                             $attrib = join('|',@{$allfiles{$mapping->{$key}}});
                   10903:                         }
                   10904:                         if ($content =~ m{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
                   10905:                             my $numchg = ($content =~ s{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
                   10906:                             $rewrites += $numchg;
                   10907:                         }
                   10908:                     }
                   10909:                     if ($rewrites) {
                   10910:                         my $saveresult;
                   10911:                         my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
                   10912:                         if ($url eq $container) {
                   10913:                             my ($fname) = ($container =~ m{/([^/]+)$});
                   10914:                             $output .= '<p>'.&mt('Rewrote [quant,_1,link] as [quant,_1,absolute link] in [_2].',
                   10915:                                             $count,'<span class="LC_filename">'.
                   10916:                                             $fname.'</span>').'</p>';
                   10917:                         } else {
                   10918:                             $output .= '<p class="LC_error">'.
                   10919:                                        &mt('Error: could not update links in [_1].',
                   10920:                                        '<span class="LC_filename">'.
                   10921:                                        $container.'</span>').'</p>';
                   10922: 
                   10923:                         }
                   10924:                     }
                   10925:                 }
                   10926:             }
1.987     raeburn  10927:         } else {
                   10928:             &logthis('Failed to parse '.$container.
                   10929:                      ' to modify references: '.$parse_result);
1.661     raeburn  10930:         }
                   10931:     }
1.1071    raeburn  10932:     if (wantarray) {
                   10933:         return ($output,$count,$codebasecount);
                   10934:     } else {
                   10935:         return $output;
                   10936:     }
1.661     raeburn  10937: }
                   10938: 
                   10939: sub check_for_existing {
                   10940:     my ($path,$fname,$element) = @_;
                   10941:     my ($state,$msg);
                   10942:     if (-d $path.'/'.$fname) {
                   10943:         $state = 'exists';
                   10944:         $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   10945:     } elsif (-e $path.'/'.$fname) {
                   10946:         $state = 'exists';
                   10947:         $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   10948:     }
                   10949:     if ($state eq 'exists') {
                   10950:         $msg = '<span class="LC_error">'.$msg.'</span><br />';
                   10951:     }
                   10952:     return ($state,$msg);
                   10953: }
                   10954: 
                   10955: sub check_for_upload {
                   10956:     my ($path,$fname,$group,$element,$portfolio_root,$port_path,
                   10957:         $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985     raeburn  10958:     my $filesize = length($env{'form.'.$element});
                   10959:     if (!$filesize) {
                   10960:         my $msg = '<span class="LC_error">'.
                   10961:                   &mt('Unable to upload [_1]. (size = [_2] bytes)', 
                   10962:                       '<span class="LC_filename">'.$fname.'</span>',
                   10963:                       $filesize).'<br />'.
1.1007    raeburn  10964:                   &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985     raeburn  10965:                   '</span>';
                   10966:         return ('zero_bytes',$msg);
                   10967:     }
                   10968:     $filesize =  $filesize/1000; #express in k (1024?)
1.661     raeburn  10969:     my $getpropath = 1;
1.1021    raeburn  10970:     my ($dirlistref,$listerror) =
                   10971:          &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661     raeburn  10972:     my $found_file = 0;
                   10973:     my $locked_file = 0;
1.991     raeburn  10974:     my @lockers;
                   10975:     my $navmap;
                   10976:     if ($env{'request.course.id'}) {
                   10977:         $navmap = Apache::lonnavmaps::navmap->new();
                   10978:     }
1.1021    raeburn  10979:     if (ref($dirlistref) eq 'ARRAY') {
                   10980:         foreach my $line (@{$dirlistref}) {
                   10981:             my ($file_name,$rest)=split(/\&/,$line,2);
                   10982:             if ($file_name eq $fname){
                   10983:                 $file_name = $path.$file_name;
                   10984:                 if ($group ne '') {
                   10985:                     $file_name = $group.$file_name;
                   10986:                 }
                   10987:                 $found_file = 1;
                   10988:                 if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
                   10989:                     foreach my $lock (@lockers) {
                   10990:                         if (ref($lock) eq 'ARRAY') {
                   10991:                             my ($symb,$crsid) = @{$lock};
                   10992:                             if ($crsid eq $env{'request.course.id'}) {
                   10993:                                 if (ref($navmap)) {
                   10994:                                     my $res = $navmap->getBySymb($symb);
                   10995:                                     foreach my $part (@{$res->parts()}) { 
                   10996:                                         my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
                   10997:                                         unless (($slot_status == $res->RESERVED) ||
                   10998:                                                 ($slot_status == $res->RESERVED_LOCATION)) {
                   10999:                                             $locked_file = 1;
                   11000:                                         }
1.991     raeburn  11001:                                     }
1.1021    raeburn  11002:                                 } else {
                   11003:                                     $locked_file = 1;
1.991     raeburn  11004:                                 }
                   11005:                             } else {
                   11006:                                 $locked_file = 1;
                   11007:                             }
                   11008:                         }
1.1021    raeburn  11009:                    }
                   11010:                 } else {
                   11011:                     my @info = split(/\&/,$rest);
                   11012:                     my $currsize = $info[6]/1000;
                   11013:                     if ($currsize < $filesize) {
                   11014:                         my $extra = $filesize - $currsize;
                   11015:                         if (($current_disk_usage + $extra) > $disk_quota) {
1.1075.2.69  raeburn  11016:                             my $msg = '<p class="LC_warning">'.
1.1021    raeburn  11017:                                       &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  11018:                                           '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</p>'.
                   11019:                                       '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
                   11020:                                                    $disk_quota,$current_disk_usage).'</p>';
1.1021    raeburn  11021:                             return ('will_exceed_quota',$msg);
                   11022:                         }
1.984     raeburn  11023:                     }
                   11024:                 }
1.661     raeburn  11025:             }
                   11026:         }
                   11027:     }
                   11028:     if (($current_disk_usage + $filesize) > $disk_quota){
1.1075.2.69  raeburn  11029:         my $msg = '<p class="LC_warning">'.
                   11030:                 &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</p>'.
                   11031:                   '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage).'</p>';
1.661     raeburn  11032:         return ('will_exceed_quota',$msg);
                   11033:     } elsif ($found_file) {
                   11034:         if ($locked_file) {
1.1075.2.69  raeburn  11035:             my $msg = '<p class="LC_warning">';
1.661     raeburn  11036:             $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  11037:             $msg .= '</p>';
1.661     raeburn  11038:             $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
                   11039:             return ('file_locked',$msg);
                   11040:         } else {
1.1075.2.69  raeburn  11041:             my $msg = '<p class="LC_error">';
1.984     raeburn  11042:             $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  11043:             $msg .= '</p>';
1.984     raeburn  11044:             return ('existingfile',$msg);
1.661     raeburn  11045:         }
                   11046:     }
                   11047: }
                   11048: 
1.987     raeburn  11049: sub check_for_traversal {
                   11050:     my ($path,$url,$toplevel) = @_;
                   11051:     my @parts=split(/\//,$path);
                   11052:     my $cleanpath;
                   11053:     my $fullpath = $url;
                   11054:     for (my $i=0;$i<@parts;$i++) {
                   11055:         next if ($parts[$i] eq '.');
                   11056:         if ($parts[$i] eq '..') {
                   11057:             $fullpath =~ s{([^/]+/)$}{};
                   11058:         } else {
                   11059:             $fullpath .= $parts[$i].'/';
                   11060:         }
                   11061:     }
                   11062:     if ($fullpath =~ /^\Q$url\E(.*)$/) {
                   11063:         $cleanpath = $1;
                   11064:     } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
                   11065:         my $curr_toprel = $1;
                   11066:         my @parts = split(/\//,$curr_toprel);
                   11067:         my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
                   11068:         my @urlparts = split(/\//,$url_toprel);
                   11069:         my $doubledots;
                   11070:         my $startdiff = -1;
                   11071:         for (my $i=0; $i<@urlparts; $i++) {
                   11072:             if ($startdiff == -1) {
                   11073:                 unless ($urlparts[$i] eq $parts[$i]) {
                   11074:                     $startdiff = $i;
                   11075:                     $doubledots .= '../';
                   11076:                 }
                   11077:             } else {
                   11078:                 $doubledots .= '../';
                   11079:             }
                   11080:         }
                   11081:         if ($startdiff > -1) {
                   11082:             $cleanpath = $doubledots;
                   11083:             for (my $i=$startdiff; $i<@parts; $i++) {
                   11084:                 $cleanpath .= $parts[$i].'/';
                   11085:             }
                   11086:         }
                   11087:     }
                   11088:     $cleanpath =~ s{(/)$}{};
                   11089:     return $cleanpath;
                   11090: }
1.31      albertel 11091: 
1.1053    raeburn  11092: sub is_archive_file {
                   11093:     my ($mimetype) = @_;
                   11094:     if (($mimetype eq 'application/octet-stream') ||
                   11095:         ($mimetype eq 'application/x-stuffit') ||
                   11096:         ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
                   11097:         return 1;
                   11098:     }
                   11099:     return;
                   11100: }
                   11101: 
                   11102: sub decompress_form {
1.1065    raeburn  11103:     my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053    raeburn  11104:     my %lt = &Apache::lonlocal::texthash (
                   11105:         this => 'This file is an archive file.',
1.1067    raeburn  11106:         camt => 'This file is a Camtasia archive file.',
1.1065    raeburn  11107:         itsc => 'Its contents are as follows:',
1.1053    raeburn  11108:         youm => 'You may wish to extract its contents.',
                   11109:         extr => 'Extract contents',
1.1067    raeburn  11110:         auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
                   11111:         proa => 'Process automatically?',
1.1053    raeburn  11112:         yes  => 'Yes',
                   11113:         no   => 'No',
1.1067    raeburn  11114:         fold => 'Title for folder containing movie',
                   11115:         movi => 'Title for page containing embedded movie', 
1.1053    raeburn  11116:     );
1.1065    raeburn  11117:     my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067    raeburn  11118:     my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065    raeburn  11119:     my $info = &list_archive_contents($fileloc,\@paths);
                   11120:     if (@paths) {
                   11121:         foreach my $path (@paths) {
                   11122:             $path =~ s{^/}{};
1.1067    raeburn  11123:             if ($path =~ m{^([^/]+)/$}) {
                   11124:                 $topdir = $1;
                   11125:             }
1.1065    raeburn  11126:             if ($path =~ m{^([^/]+)/}) {
                   11127:                 $toplevel{$1} = $path;
                   11128:             } else {
                   11129:                 $toplevel{$path} = $path;
                   11130:             }
                   11131:         }
                   11132:     }
1.1067    raeburn  11133:     if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
1.1075.2.59  raeburn  11134:         my @camtasia6 = ("$topdir/","$topdir/index.html",
1.1067    raeburn  11135:                         "$topdir/media/",
                   11136:                         "$topdir/media/$topdir.mp4",
                   11137:                         "$topdir/media/FirstFrame.png",
                   11138:                         "$topdir/media/player.swf",
                   11139:                         "$topdir/media/swfobject.js",
                   11140:                         "$topdir/media/expressInstall.swf");
1.1075.2.81  raeburn  11141:         my @camtasia8_1 = ("$topdir/","$topdir/$topdir.html",
1.1075.2.59  raeburn  11142:                          "$topdir/$topdir.mp4",
                   11143:                          "$topdir/$topdir\_config.xml",
                   11144:                          "$topdir/$topdir\_controller.swf",
                   11145:                          "$topdir/$topdir\_embed.css",
                   11146:                          "$topdir/$topdir\_First_Frame.png",
                   11147:                          "$topdir/$topdir\_player.html",
                   11148:                          "$topdir/$topdir\_Thumbnails.png",
                   11149:                          "$topdir/playerProductInstall.swf",
                   11150:                          "$topdir/scripts/",
                   11151:                          "$topdir/scripts/config_xml.js",
                   11152:                          "$topdir/scripts/handlebars.js",
                   11153:                          "$topdir/scripts/jquery-1.7.1.min.js",
                   11154:                          "$topdir/scripts/jquery-ui-1.8.15.custom.min.js",
                   11155:                          "$topdir/scripts/modernizr.js",
                   11156:                          "$topdir/scripts/player-min.js",
                   11157:                          "$topdir/scripts/swfobject.js",
                   11158:                          "$topdir/skins/",
                   11159:                          "$topdir/skins/configuration_express.xml",
                   11160:                          "$topdir/skins/express_show/",
                   11161:                          "$topdir/skins/express_show/player-min.css",
                   11162:                          "$topdir/skins/express_show/spritesheet.png");
1.1075.2.81  raeburn  11163:         my @camtasia8_4 = ("$topdir/","$topdir/$topdir.html",
                   11164:                          "$topdir/$topdir.mp4",
                   11165:                          "$topdir/$topdir\_config.xml",
                   11166:                          "$topdir/$topdir\_controller.swf",
                   11167:                          "$topdir/$topdir\_embed.css",
                   11168:                          "$topdir/$topdir\_First_Frame.png",
                   11169:                          "$topdir/$topdir\_player.html",
                   11170:                          "$topdir/$topdir\_Thumbnails.png",
                   11171:                          "$topdir/playerProductInstall.swf",
                   11172:                          "$topdir/scripts/",
                   11173:                          "$topdir/scripts/config_xml.js",
                   11174:                          "$topdir/scripts/techsmith-smart-player.min.js",
                   11175:                          "$topdir/skins/",
                   11176:                          "$topdir/skins/configuration_express.xml",
                   11177:                          "$topdir/skins/express_show/",
                   11178:                          "$topdir/skins/express_show/spritesheet.min.css",
                   11179:                          "$topdir/skins/express_show/spritesheet.png",
                   11180:                          "$topdir/skins/express_show/techsmith-smart-player.min.css");
1.1075.2.59  raeburn  11181:         my @diffs = &compare_arrays(\@paths,\@camtasia6);
1.1067    raeburn  11182:         if (@diffs == 0) {
1.1075.2.59  raeburn  11183:             $is_camtasia = 6;
                   11184:         } else {
1.1075.2.81  raeburn  11185:             @diffs = &compare_arrays(\@paths,\@camtasia8_1);
1.1075.2.59  raeburn  11186:             if (@diffs == 0) {
                   11187:                 $is_camtasia = 8;
1.1075.2.81  raeburn  11188:             } else {
                   11189:                 @diffs = &compare_arrays(\@paths,\@camtasia8_4);
                   11190:                 if (@diffs == 0) {
                   11191:                     $is_camtasia = 8;
                   11192:                 }
1.1075.2.59  raeburn  11193:             }
1.1067    raeburn  11194:         }
                   11195:     }
                   11196:     my $output;
                   11197:     if ($is_camtasia) {
                   11198:         $output = <<"ENDCAM";
                   11199: <script type="text/javascript" language="Javascript">
                   11200: // <![CDATA[
                   11201: 
                   11202: function camtasiaToggle() {
                   11203:     for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
                   11204:         if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
1.1075.2.59  raeburn  11205:             if (document.uploaded_decompress.autoextract_camtasia[i].value == $is_camtasia) {
1.1067    raeburn  11206:                 document.getElementById('camtasia_titles').style.display='block';
                   11207:             } else {
                   11208:                 document.getElementById('camtasia_titles').style.display='none';
                   11209:             }
                   11210:         }
                   11211:     }
                   11212:     return;
                   11213: }
                   11214: 
                   11215: // ]]>
                   11216: </script>
                   11217: <p>$lt{'camt'}</p>
                   11218: ENDCAM
1.1065    raeburn  11219:     } else {
1.1067    raeburn  11220:         $output = '<p>'.$lt{'this'};
                   11221:         if ($info eq '') {
                   11222:             $output .= ' '.$lt{'youm'}.'</p>'."\n";
                   11223:         } else {
                   11224:             $output .= ' '.$lt{'itsc'}.'</p>'."\n".
                   11225:                        '<div><pre>'.$info.'</pre></div>';
                   11226:         }
1.1065    raeburn  11227:     }
1.1067    raeburn  11228:     $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065    raeburn  11229:     my $duplicates;
                   11230:     my $num = 0;
                   11231:     if (ref($dirlist) eq 'ARRAY') {
                   11232:         foreach my $item (@{$dirlist}) {
                   11233:             if (ref($item) eq 'ARRAY') {
                   11234:                 if (exists($toplevel{$item->[0]})) {
                   11235:                     $duplicates .= 
                   11236:                         &start_data_table_row().
                   11237:                         '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
                   11238:                         'value="0" checked="checked" />'.&mt('No').'</label>'.
                   11239:                         '&nbsp;<label><input type="radio" name="archive_overwrite_'.$num.'" '.
                   11240:                         'value="1" />'.&mt('Yes').'</label>'.
                   11241:                         '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
                   11242:                         '<td>'.$item->[0].'</td>';
                   11243:                     if ($item->[2]) {
                   11244:                         $duplicates .= '<td>'.&mt('Directory').'</td>';
                   11245:                     } else {
                   11246:                         $duplicates .= '<td>'.&mt('File').'</td>';
                   11247:                     }
                   11248:                     $duplicates .= '<td>'.$item->[3].'</td>'.
                   11249:                                    '<td>'.
                   11250:                                    &Apache::lonlocal::locallocaltime($item->[4]).
                   11251:                                    '</td>'.
                   11252:                                    &end_data_table_row();
                   11253:                     $num ++;
                   11254:                 }
                   11255:             }
                   11256:         }
                   11257:     }
                   11258:     my $itemcount;
                   11259:     if (@paths > 0) {
                   11260:         $itemcount = scalar(@paths);
                   11261:     } else {
                   11262:         $itemcount = 1;
                   11263:     }
1.1067    raeburn  11264:     if ($is_camtasia) {
                   11265:         $output .= $lt{'auto'}.'<br />'.
                   11266:                    '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
1.1075.2.59  raeburn  11267:                    '<input type="radio" name="autoextract_camtasia" value="'.$is_camtasia.'" onclick="javascript:camtasiaToggle();" checked="checked" />'.
1.1067    raeburn  11268:                    $lt{'yes'}.'</label>&nbsp;<label>'.
                   11269:                    '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
                   11270:                    $lt{'no'}.'</label></span><br />'.
                   11271:                    '<div id="camtasia_titles" style="display:block">'.
                   11272:                    &Apache::lonhtmlcommon::start_pick_box().
                   11273:                    &Apache::lonhtmlcommon::row_title($lt{'fold'}).
                   11274:                    '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
                   11275:                    &Apache::lonhtmlcommon::row_closure().
                   11276:                    &Apache::lonhtmlcommon::row_title($lt{'movi'}).
                   11277:                    '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
                   11278:                    &Apache::lonhtmlcommon::row_closure(1).
                   11279:                    &Apache::lonhtmlcommon::end_pick_box().
                   11280:                    '</div>';
                   11281:     }
1.1065    raeburn  11282:     $output .= 
                   11283:         '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067    raeburn  11284:         '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
                   11285:         "\n";
1.1065    raeburn  11286:     if ($duplicates ne '') {
                   11287:         $output .= '<p><span class="LC_warning">'.
                   11288:                    &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.  
                   11289:                    &start_data_table().
                   11290:                    &start_data_table_header_row().
                   11291:                    '<th>'.&mt('Overwrite?').'</th>'.
                   11292:                    '<th>'.&mt('Name').'</th>'.
                   11293:                    '<th>'.&mt('Type').'</th>'.
                   11294:                    '<th>'.&mt('Size').'</th>'.
                   11295:                    '<th>'.&mt('Last modified').'</th>'.
                   11296:                    &end_data_table_header_row().
                   11297:                    $duplicates.
                   11298:                    &end_data_table().
                   11299:                    '</p>';
                   11300:     }
1.1067    raeburn  11301:     $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053    raeburn  11302:     if (ref($hiddenelements) eq 'HASH') {
                   11303:         foreach my $hidden (sort(keys(%{$hiddenelements}))) {
                   11304:             $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
                   11305:         }
                   11306:     }
                   11307:     $output .= <<"END";
1.1067    raeburn  11308: <br />
1.1053    raeburn  11309: <input type="submit" name="decompress" value="$lt{'extr'}" />
                   11310: </form>
                   11311: $noextract
                   11312: END
                   11313:     return $output;
                   11314: }
                   11315: 
1.1065    raeburn  11316: sub decompression_utility {
                   11317:     my ($program) = @_;
                   11318:     my @utilities = ('tar','gunzip','bunzip2','unzip'); 
                   11319:     my $location;
                   11320:     if (grep(/^\Q$program\E$/,@utilities)) { 
                   11321:         foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
                   11322:                          '/usr/sbin/') {
                   11323:             if (-x $dir.$program) {
                   11324:                 $location = $dir.$program;
                   11325:                 last;
                   11326:             }
                   11327:         }
                   11328:     }
                   11329:     return $location;
                   11330: }
                   11331: 
                   11332: sub list_archive_contents {
                   11333:     my ($file,$pathsref) = @_;
                   11334:     my (@cmd,$output);
                   11335:     my $needsregexp;
                   11336:     if ($file =~ /\.zip$/) {
                   11337:         @cmd = (&decompression_utility('unzip'),"-l");
                   11338:         $needsregexp = 1;
                   11339:     } elsif (($file =~ m/\.tar\.gz$/) ||
                   11340:              ($file =~ /\.tgz$/)) {
                   11341:         @cmd = (&decompression_utility('tar'),"-ztf");
                   11342:     } elsif ($file =~ /\.tar\.bz2$/) {
                   11343:         @cmd = (&decompression_utility('tar'),"-jtf");
                   11344:     } elsif ($file =~ m|\.tar$|) {
                   11345:         @cmd = (&decompression_utility('tar'),"-tf");
                   11346:     }
                   11347:     if (@cmd) {
                   11348:         undef($!);
                   11349:         undef($@);
                   11350:         if (open(my $fh,"-|", @cmd, $file)) {
                   11351:             while (my $line = <$fh>) {
                   11352:                 $output .= $line;
                   11353:                 chomp($line);
                   11354:                 my $item;
                   11355:                 if ($needsregexp) {
                   11356:                     ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/); 
                   11357:                 } else {
                   11358:                     $item = $line;
                   11359:                 }
                   11360:                 if ($item ne '') {
                   11361:                     unless (grep(/^\Q$item\E$/,@{$pathsref})) {
                   11362:                         push(@{$pathsref},$item);
                   11363:                     } 
                   11364:                 }
                   11365:             }
                   11366:             close($fh);
                   11367:         }
                   11368:     }
                   11369:     return $output;
                   11370: }
                   11371: 
1.1053    raeburn  11372: sub decompress_uploaded_file {
                   11373:     my ($file,$dir) = @_;
                   11374:     &Apache::lonnet::appenv({'cgi.file' => $file});
                   11375:     &Apache::lonnet::appenv({'cgi.dir' => $dir});
                   11376:     my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
                   11377:     my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
                   11378:     my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
                   11379:     &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
                   11380:     my $decompressed = $env{'cgi.decompressed'};
                   11381:     &Apache::lonnet::delenv('cgi.file');
                   11382:     &Apache::lonnet::delenv('cgi.dir');
                   11383:     &Apache::lonnet::delenv('cgi.decompressed');
                   11384:     return ($decompressed,$result);
                   11385: }
                   11386: 
1.1055    raeburn  11387: sub process_decompression {
                   11388:     my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
                   11389:     my ($dir,$error,$warning,$output);
1.1075.2.69  raeburn  11390:     if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) {
1.1075.2.34  raeburn  11391:         $error = &mt('Filename not a supported archive file type.').
                   11392:                  '<br />'.&mt('Filename should end with one of: [_1].',
1.1055    raeburn  11393:                               '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
                   11394:     } else {
                   11395:         my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
                   11396:         if ($docuhome eq 'no_host') {
                   11397:             $error = &mt('Could not determine home server for course.');
                   11398:         } else {
                   11399:             my @ids=&Apache::lonnet::current_machine_ids();
                   11400:             my $currdir = "$dir_root/$destination";
                   11401:             if (grep(/^\Q$docuhome\E$/,@ids)) {
                   11402:                 $dir = &LONCAPA::propath($docudom,$docuname).
                   11403:                        "$dir_root/$destination";
                   11404:             } else {
                   11405:                 $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
                   11406:                        "$dir_root/$docudom/$docuname/$destination";
                   11407:                 unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
                   11408:                     $error = &mt('Archive file not found.');
                   11409:                 }
                   11410:             }
1.1065    raeburn  11411:             my (@to_overwrite,@to_skip);
                   11412:             if ($env{'form.archive_overwrite_total'} > 0) {
                   11413:                 my $total = $env{'form.archive_overwrite_total'};
                   11414:                 for (my $i=0; $i<$total; $i++) {
                   11415:                     if ($env{'form.archive_overwrite_'.$i} == 1) {
                   11416:                         push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
                   11417:                     } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
                   11418:                         push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
                   11419:                     }
                   11420:                 }
                   11421:             }
                   11422:             my $numskip = scalar(@to_skip);
                   11423:             if (($numskip > 0) && 
                   11424:                 ($numskip == $env{'form.archive_itemcount'})) {
                   11425:                 $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');         
                   11426:             } elsif ($dir eq '') {
1.1055    raeburn  11427:                 $error = &mt('Directory containing archive file unavailable.');
                   11428:             } elsif (!$error) {
1.1065    raeburn  11429:                 my ($decompressed,$display);
                   11430:                 if ($numskip > 0) {
                   11431:                     my $tempdir = time.'_'.$$.int(rand(10000));
                   11432:                     mkdir("$dir/$tempdir",0755);
                   11433:                     system("mv $dir/$file $dir/$tempdir/$file");
                   11434:                     ($decompressed,$display) = 
                   11435:                         &decompress_uploaded_file($file,"$dir/$tempdir");
                   11436:                     foreach my $item (@to_skip) {
                   11437:                         if (($item ne '') && ($item !~ /\.\./)) {
                   11438:                             if (-f "$dir/$tempdir/$item") { 
                   11439:                                 unlink("$dir/$tempdir/$item");
                   11440:                             } elsif (-d "$dir/$tempdir/$item") {
                   11441:                                 system("rm -rf $dir/$tempdir/$item");
                   11442:                             }
                   11443:                         }
                   11444:                     }
                   11445:                     system("mv $dir/$tempdir/* $dir");
                   11446:                     rmdir("$dir/$tempdir");   
                   11447:                 } else {
                   11448:                     ($decompressed,$display) = 
                   11449:                         &decompress_uploaded_file($file,$dir);
                   11450:                 }
1.1055    raeburn  11451:                 if ($decompressed eq 'ok') {
1.1065    raeburn  11452:                     $output = '<p class="LC_info">'.
                   11453:                               &mt('Files extracted successfully from archive.').
                   11454:                               '</p>'."\n";
1.1055    raeburn  11455:                     my ($warning,$result,@contents);
                   11456:                     my ($newdirlistref,$newlisterror) =
                   11457:                         &Apache::lonnet::dirlist($currdir,$docudom,
                   11458:                                                  $docuname,1);
                   11459:                     my (%is_dir,%changes,@newitems);
                   11460:                     my $dirptr = 16384;
1.1065    raeburn  11461:                     if (ref($newdirlistref) eq 'ARRAY') {
1.1055    raeburn  11462:                         foreach my $dir_line (@{$newdirlistref}) {
                   11463:                             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1065    raeburn  11464:                             unless (($item =~ /^\.+$/) || ($item eq $file) || 
                   11465:                                     ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) {
1.1055    raeburn  11466:                                 push(@newitems,$item);
                   11467:                                 if ($dirptr&$testdir) {
                   11468:                                     $is_dir{$item} = 1;
                   11469:                                 }
                   11470:                                 $changes{$item} = 1;
                   11471:                             }
                   11472:                         }
                   11473:                     }
                   11474:                     if (keys(%changes) > 0) {
                   11475:                         foreach my $item (sort(@newitems)) {
                   11476:                             if ($changes{$item}) {
                   11477:                                 push(@contents,$item);
                   11478:                             }
                   11479:                         }
                   11480:                     }
                   11481:                     if (@contents > 0) {
1.1067    raeburn  11482:                         my $wantform;
                   11483:                         unless ($env{'form.autoextract_camtasia'}) {
                   11484:                             $wantform = 1;
                   11485:                         }
1.1056    raeburn  11486:                         my (%children,%parent,%dirorder,%titles);
1.1055    raeburn  11487:                         my ($count,$datatable) = &get_extracted($docudom,$docuname,
                   11488:                                                                 $currdir,\%is_dir,
                   11489:                                                                 \%children,\%parent,
1.1056    raeburn  11490:                                                                 \@contents,\%dirorder,
                   11491:                                                                 \%titles,$wantform);
1.1055    raeburn  11492:                         if ($datatable ne '') {
                   11493:                             $output .= &archive_options_form('decompressed',$datatable,
                   11494:                                                              $count,$hiddenelem);
1.1065    raeburn  11495:                             my $startcount = 6;
1.1055    raeburn  11496:                             $output .= &archive_javascript($startcount,$count,
1.1056    raeburn  11497:                                                            \%titles,\%children);
1.1055    raeburn  11498:                         }
1.1067    raeburn  11499:                         if ($env{'form.autoextract_camtasia'}) {
1.1075.2.59  raeburn  11500:                             my $version = $env{'form.autoextract_camtasia'};
1.1067    raeburn  11501:                             my %displayed;
                   11502:                             my $total = 1;
                   11503:                             $env{'form.archive_directory'} = [];
                   11504:                             foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
                   11505:                                 my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
                   11506:                                 $path =~ s{/$}{};
                   11507:                                 my $item;
                   11508:                                 if ($path ne '') {
                   11509:                                     $item = "$path/$titles{$i}";
                   11510:                                 } else {
                   11511:                                     $item = $titles{$i};
                   11512:                                 }
                   11513:                                 $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
                   11514:                                 if ($item eq $contents[0]) {
                   11515:                                     push(@{$env{'form.archive_directory'}},$i);
                   11516:                                     $env{'form.archive_'.$i} = 'display';
                   11517:                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
                   11518:                                     $displayed{'folder'} = $i;
1.1075.2.59  raeburn  11519:                                 } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) ||
                   11520:                                          (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) {
1.1067    raeburn  11521:                                     $env{'form.archive_'.$i} = 'display';
                   11522:                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
                   11523:                                     $displayed{'web'} = $i;
                   11524:                                 } else {
1.1075.2.59  raeburn  11525:                                     if ((($item eq "$contents[0]/media") && ($version == 6)) ||
                   11526:                                         ((($item eq "$contents[0]/scripts") || ($item eq "$contents[0]/skins") ||
                   11527:                                              ($item eq "$contents[0]/skins/express_show")) && ($version == 8))) {
1.1067    raeburn  11528:                                         push(@{$env{'form.archive_directory'}},$i);
                   11529:                                     }
                   11530:                                     $env{'form.archive_'.$i} = 'dependency';
                   11531:                                 }
                   11532:                                 $total ++;
                   11533:                             }
                   11534:                             for (my $i=1; $i<$total; $i++) {
                   11535:                                 next if ($i == $displayed{'web'});
                   11536:                                 next if ($i == $displayed{'folder'});
                   11537:                                 $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
                   11538:                             }
                   11539:                             $env{'form.phase'} = 'decompress_cleanup';
                   11540:                             $env{'form.archivedelete'} = 1;
                   11541:                             $env{'form.archive_count'} = $total-1;
                   11542:                             $output .=
                   11543:                                 &process_extracted_files('coursedocs',$docudom,
                   11544:                                                          $docuname,$destination,
                   11545:                                                          $dir_root,$hiddenelem);
                   11546:                         }
1.1055    raeburn  11547:                     } else {
                   11548:                         $warning = &mt('No new items extracted from archive file.');
                   11549:                     }
                   11550:                 } else {
                   11551:                     $output = $display;
                   11552:                     $error = &mt('An error occurred during extraction from the archive file.');
                   11553:                 }
                   11554:             }
                   11555:         }
                   11556:     }
                   11557:     if ($error) {
                   11558:         $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   11559:                    $error.'</p>'."\n";
                   11560:     }
                   11561:     if ($warning) {
                   11562:         $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
                   11563:     }
                   11564:     return $output;
                   11565: }
                   11566: 
                   11567: sub get_extracted {
1.1056    raeburn  11568:     my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
                   11569:         $titles,$wantform) = @_;
1.1055    raeburn  11570:     my $count = 0;
                   11571:     my $depth = 0;
                   11572:     my $datatable;
1.1056    raeburn  11573:     my @hierarchy;
1.1055    raeburn  11574:     return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056    raeburn  11575:                    (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
                   11576:                    (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055    raeburn  11577:     foreach my $item (@{$contents}) {
                   11578:         $count ++;
1.1056    raeburn  11579:         @{$dirorder->{$count}} = @hierarchy;
                   11580:         $titles->{$count} = $item;
1.1055    raeburn  11581:         &archive_hierarchy($depth,$count,$parent,$children);
                   11582:         if ($wantform) {
                   11583:             $datatable .= &archive_row($is_dir->{$item},$item,
                   11584:                                        $currdir,$depth,$count);
                   11585:         }
                   11586:         if ($is_dir->{$item}) {
                   11587:             $depth ++;
1.1056    raeburn  11588:             push(@hierarchy,$count);
                   11589:             $parent->{$depth} = $count;
1.1055    raeburn  11590:             $datatable .=
                   11591:                 &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056    raeburn  11592:                                            \$depth,\$count,\@hierarchy,$dirorder,
                   11593:                                            $children,$parent,$titles,$wantform);
1.1055    raeburn  11594:             $depth --;
1.1056    raeburn  11595:             pop(@hierarchy);
1.1055    raeburn  11596:         }
                   11597:     }
                   11598:     return ($count,$datatable);
                   11599: }
                   11600: 
                   11601: sub recurse_extracted_archive {
1.1056    raeburn  11602:     my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
                   11603:         $children,$parent,$titles,$wantform) = @_;
1.1055    raeburn  11604:     my $result='';
1.1056    raeburn  11605:     unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
                   11606:             (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
                   11607:             (ref($dirorder) eq 'HASH')) {
1.1055    raeburn  11608:         return $result;
                   11609:     }
                   11610:     my $dirptr = 16384;
                   11611:     my ($newdirlistref,$newlisterror) =
                   11612:         &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
                   11613:     if (ref($newdirlistref) eq 'ARRAY') {
                   11614:         foreach my $dir_line (@{$newdirlistref}) {
                   11615:             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
                   11616:             unless ($item =~ /^\.+$/) {
                   11617:                 $$count ++;
1.1056    raeburn  11618:                 @{$dirorder->{$$count}} = @{$hierarchy};
                   11619:                 $titles->{$$count} = $item;
1.1055    raeburn  11620:                 &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056    raeburn  11621: 
1.1055    raeburn  11622:                 my $is_dir;
                   11623:                 if ($dirptr&$testdir) {
                   11624:                     $is_dir = 1;
                   11625:                 }
                   11626:                 if ($wantform) {
                   11627:                     $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
                   11628:                 }
                   11629:                 if ($is_dir) {
                   11630:                     $$depth ++;
1.1056    raeburn  11631:                     push(@{$hierarchy},$$count);
                   11632:                     $parent->{$$depth} = $$count;
1.1055    raeburn  11633:                     $result .=
                   11634:                         &recurse_extracted_archive("$currdir/$item",$docudom,
                   11635:                                                    $docuname,$depth,$count,
1.1056    raeburn  11636:                                                    $hierarchy,$dirorder,$children,
                   11637:                                                    $parent,$titles,$wantform);
1.1055    raeburn  11638:                     $$depth --;
1.1056    raeburn  11639:                     pop(@{$hierarchy});
1.1055    raeburn  11640:                 }
                   11641:             }
                   11642:         }
                   11643:     }
                   11644:     return $result;
                   11645: }
                   11646: 
                   11647: sub archive_hierarchy {
                   11648:     my ($depth,$count,$parent,$children) =@_;
                   11649:     if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
                   11650:         if (exists($parent->{$depth})) {
                   11651:              $children->{$parent->{$depth}} .= $count.':';
                   11652:         }
                   11653:     }
                   11654:     return;
                   11655: }
                   11656: 
                   11657: sub archive_row {
                   11658:     my ($is_dir,$item,$currdir,$depth,$count) = @_;
                   11659:     my ($name) = ($item =~ m{([^/]+)$});
                   11660:     my %choices = &Apache::lonlocal::texthash (
1.1059    raeburn  11661:                                        'display'    => 'Add as file',
1.1055    raeburn  11662:                                        'dependency' => 'Include as dependency',
                   11663:                                        'discard'    => 'Discard',
                   11664:                                       );
                   11665:     if ($is_dir) {
1.1059    raeburn  11666:         $choices{'display'} = &mt('Add as folder'); 
1.1055    raeburn  11667:     }
1.1056    raeburn  11668:     my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
                   11669:     my $offset = 0;
1.1055    raeburn  11670:     foreach my $action ('display','dependency','discard') {
1.1056    raeburn  11671:         $offset ++;
1.1065    raeburn  11672:         if ($action ne 'display') {
                   11673:             $offset ++;
                   11674:         }  
1.1055    raeburn  11675:         $output .= '<td><span class="LC_nobreak">'.
                   11676:                    '<label><input type="radio" name="archive_'.$count.
                   11677:                    '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
                   11678:         my $text = $choices{$action};
                   11679:         if ($is_dir) {
                   11680:             $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
                   11681:             if ($action eq 'display') {
1.1059    raeburn  11682:                 $text = &mt('Add as folder');
1.1055    raeburn  11683:             }
1.1056    raeburn  11684:         } else {
                   11685:             $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
                   11686: 
                   11687:         }
                   11688:         $output .= ' />&nbsp;'.$choices{$action}.'</label></span>';
                   11689:         if ($action eq 'dependency') {
                   11690:             $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
                   11691:                        &mt('Used by:').'&nbsp;<select name="archive_dependent_on_'.$count.'" '.
                   11692:                        'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
                   11693:                        '<option value=""></option>'."\n".
                   11694:                        '</select>'."\n".
                   11695:                        '</div>';
1.1059    raeburn  11696:         } elsif ($action eq 'display') {
                   11697:             $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
                   11698:                        &mt('Title:').'&nbsp;<input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
                   11699:                        '</div>';
1.1055    raeburn  11700:         }
1.1056    raeburn  11701:         $output .= '</td>';
1.1055    raeburn  11702:     }
                   11703:     $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
                   11704:                &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.('&nbsp;' x 2);
                   11705:     for (my $i=0; $i<$depth; $i++) {
                   11706:         $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
                   11707:     }
                   11708:     if ($is_dir) {
                   11709:         $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" />&nbsp;'."\n".
                   11710:                    '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
                   11711:     } else {
                   11712:         $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
                   11713:     }
                   11714:     $output .= '&nbsp;'.$name.'</td>'."\n".
                   11715:                &end_data_table_row();
                   11716:     return $output;
                   11717: }
                   11718: 
                   11719: sub archive_options_form {
1.1065    raeburn  11720:     my ($form,$display,$count,$hiddenelem) = @_;
                   11721:     my %lt = &Apache::lonlocal::texthash(
                   11722:                perm => 'Permanently remove archive file?',
                   11723:                hows => 'How should each extracted item be incorporated in the course?',
                   11724:                cont => 'Content actions for all',
                   11725:                addf => 'Add as folder/file',
                   11726:                incd => 'Include as dependency for a displayed file',
                   11727:                disc => 'Discard',
                   11728:                no   => 'No',
                   11729:                yes  => 'Yes',
                   11730:                save => 'Save',
                   11731:     );
                   11732:     my $output = <<"END";
                   11733: <form name="$form" method="post" action="">
                   11734: <p><span class="LC_nobreak">$lt{'perm'}&nbsp;
                   11735: <label>
                   11736:   <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
                   11737: </label>
                   11738: &nbsp;
                   11739: <label>
                   11740:   <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
                   11741: </span>
                   11742: </p>
                   11743: <input type="hidden" name="phase" value="decompress_cleanup" />
                   11744: <br />$lt{'hows'}
                   11745: <div class="LC_columnSection">
                   11746:   <fieldset>
                   11747:     <legend>$lt{'cont'}</legend>
                   11748:     <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" /> 
                   11749:     &nbsp;&nbsp;<input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
                   11750:     &nbsp;&nbsp;<input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
                   11751:   </fieldset>
                   11752: </div>
                   11753: END
                   11754:     return $output.
1.1055    raeburn  11755:            &start_data_table()."\n".
1.1065    raeburn  11756:            $display."\n".
1.1055    raeburn  11757:            &end_data_table()."\n".
                   11758:            '<input type="hidden" name="archive_count" value="'.$count.'" />'.
                   11759:            $hiddenelem.
1.1065    raeburn  11760:            '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055    raeburn  11761:            '</form>';
                   11762: }
                   11763: 
                   11764: sub archive_javascript {
1.1056    raeburn  11765:     my ($startcount,$numitems,$titles,$children) = @_;
                   11766:     return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059    raeburn  11767:     my $maintitle = $env{'form.comment'};
1.1055    raeburn  11768:     my $scripttag = <<START;
                   11769: <script type="text/javascript">
                   11770: // <![CDATA[
                   11771: 
                   11772: function checkAll(form,prefix) {
                   11773:     var idstr =  new RegExp("^archive_"+prefix+"_\\\\d+\$");
                   11774:     for (var i=0; i < form.elements.length; i++) {
                   11775:         var id = form.elements[i].id;
                   11776:         if ((id != '') && (id != undefined)) {
                   11777:             if (idstr.test(id)) {
                   11778:                 if (form.elements[i].type == 'radio') {
                   11779:                     form.elements[i].checked = true;
1.1056    raeburn  11780:                     var nostart = i-$startcount;
1.1059    raeburn  11781:                     var offset = nostart%7;
                   11782:                     var count = (nostart-offset)/7;    
1.1056    raeburn  11783:                     dependencyCheck(form,count,offset);
1.1055    raeburn  11784:                 }
                   11785:             }
                   11786:         }
                   11787:     }
                   11788: }
                   11789: 
                   11790: function propagateCheck(form,count) {
                   11791:     if (count > 0) {
1.1059    raeburn  11792:         var startelement = $startcount + ((count-1) * 7);
                   11793:         for (var j=1; j<6; j++) {
                   11794:             if ((j != 2) && (j != 4)) {
1.1056    raeburn  11795:                 var item = startelement + j; 
                   11796:                 if (form.elements[item].type == 'radio') {
                   11797:                     if (form.elements[item].checked) {
                   11798:                         containerCheck(form,count,j);
                   11799:                         break;
                   11800:                     }
1.1055    raeburn  11801:                 }
                   11802:             }
                   11803:         }
                   11804:     }
                   11805: }
                   11806: 
                   11807: numitems = $numitems
1.1056    raeburn  11808: var titles = new Array(numitems);
                   11809: var parents = new Array(numitems);
1.1055    raeburn  11810: for (var i=0; i<numitems; i++) {
1.1056    raeburn  11811:     parents[i] = new Array;
1.1055    raeburn  11812: }
1.1059    raeburn  11813: var maintitle = '$maintitle';
1.1055    raeburn  11814: 
                   11815: START
                   11816: 
1.1056    raeburn  11817:     foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
                   11818:         my @contents = split(/:/,$children->{$container});
1.1055    raeburn  11819:         for (my $i=0; $i<@contents; $i ++) {
                   11820:             $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
                   11821:         }
                   11822:     }
                   11823: 
1.1056    raeburn  11824:     foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
                   11825:         $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
                   11826:     }
                   11827: 
1.1055    raeburn  11828:     $scripttag .= <<END;
                   11829: 
                   11830: function containerCheck(form,count,offset) {
                   11831:     if (count > 0) {
1.1056    raeburn  11832:         dependencyCheck(form,count,offset);
1.1059    raeburn  11833:         var item = (offset+$startcount)+7*(count-1);
1.1055    raeburn  11834:         form.elements[item].checked = true;
                   11835:         if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   11836:             if (parents[count].length > 0) {
                   11837:                 for (var j=0; j<parents[count].length; j++) {
1.1056    raeburn  11838:                     containerCheck(form,parents[count][j],offset);
                   11839:                 }
                   11840:             }
                   11841:         }
                   11842:     }
                   11843: }
                   11844: 
                   11845: function dependencyCheck(form,count,offset) {
                   11846:     if (count > 0) {
1.1059    raeburn  11847:         var chosen = (offset+$startcount)+7*(count-1);
                   11848:         var depitem = $startcount + ((count-1) * 7) + 4;
1.1056    raeburn  11849:         var currtype = form.elements[depitem].type;
                   11850:         if (form.elements[chosen].value == 'dependency') {
                   11851:             document.getElementById('arc_depon_'+count).style.display='block'; 
                   11852:             form.elements[depitem].options.length = 0;
                   11853:             form.elements[depitem].options[0] = new Option('Select','',true,true);
1.1075.2.11  raeburn  11854:             for (var i=1; i<=numitems; i++) {
                   11855:                 if (i == count) {
                   11856:                     continue;
                   11857:                 }
1.1059    raeburn  11858:                 var startelement = $startcount + (i-1) * 7;
                   11859:                 for (var j=1; j<6; j++) {
                   11860:                     if ((j != 2) && (j!= 4)) {
1.1056    raeburn  11861:                         var item = startelement + j;
                   11862:                         if (form.elements[item].type == 'radio') {
                   11863:                             if (form.elements[item].checked) {
                   11864:                                 if (form.elements[item].value == 'display') {
                   11865:                                     var n = form.elements[depitem].options.length;
                   11866:                                     form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
                   11867:                                 }
                   11868:                             }
                   11869:                         }
                   11870:                     }
                   11871:                 }
                   11872:             }
                   11873:         } else {
                   11874:             document.getElementById('arc_depon_'+count).style.display='none';
                   11875:             form.elements[depitem].options.length = 0;
                   11876:             form.elements[depitem].options[0] = new Option('Select','',true,true);
                   11877:         }
1.1059    raeburn  11878:         titleCheck(form,count,offset);
1.1056    raeburn  11879:     }
                   11880: }
                   11881: 
                   11882: function propagateSelect(form,count,offset) {
                   11883:     if (count > 0) {
1.1065    raeburn  11884:         var item = (1+offset+$startcount)+7*(count-1);
1.1056    raeburn  11885:         var picked = form.elements[item].options[form.elements[item].selectedIndex].value; 
                   11886:         if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   11887:             if (parents[count].length > 0) {
                   11888:                 for (var j=0; j<parents[count].length; j++) {
                   11889:                     containerSelect(form,parents[count][j],offset,picked);
1.1055    raeburn  11890:                 }
                   11891:             }
                   11892:         }
                   11893:     }
                   11894: }
1.1056    raeburn  11895: 
                   11896: function containerSelect(form,count,offset,picked) {
                   11897:     if (count > 0) {
1.1065    raeburn  11898:         var item = (offset+$startcount)+7*(count-1);
1.1056    raeburn  11899:         if (form.elements[item].type == 'radio') {
                   11900:             if (form.elements[item].value == 'dependency') {
                   11901:                 if (form.elements[item+1].type == 'select-one') {
                   11902:                     for (var i=0; i<form.elements[item+1].options.length; i++) {
                   11903:                         if (form.elements[item+1].options[i].value == picked) {
                   11904:                             form.elements[item+1].selectedIndex = i;
                   11905:                             break;
                   11906:                         }
                   11907:                     }
                   11908:                 }
                   11909:                 if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   11910:                     if (parents[count].length > 0) {
                   11911:                         for (var j=0; j<parents[count].length; j++) {
                   11912:                             containerSelect(form,parents[count][j],offset,picked);
                   11913:                         }
                   11914:                     }
                   11915:                 }
                   11916:             }
                   11917:         }
                   11918:     }
                   11919: }
                   11920: 
1.1059    raeburn  11921: function titleCheck(form,count,offset) {
                   11922:     if (count > 0) {
                   11923:         var chosen = (offset+$startcount)+7*(count-1);
                   11924:         var depitem = $startcount + ((count-1) * 7) + 2;
                   11925:         var currtype = form.elements[depitem].type;
                   11926:         if (form.elements[chosen].value == 'display') {
                   11927:             document.getElementById('arc_title_'+count).style.display='block';
                   11928:             if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
                   11929:                 document.getElementById('archive_title_'+count).value=maintitle;
                   11930:             }
                   11931:         } else {
                   11932:             document.getElementById('arc_title_'+count).style.display='none';
                   11933:             if (currtype == 'text') { 
                   11934:                 document.getElementById('archive_title_'+count).value='';
                   11935:             }
                   11936:         }
                   11937:     }
                   11938:     return;
                   11939: }
                   11940: 
1.1055    raeburn  11941: // ]]>
                   11942: </script>
                   11943: END
                   11944:     return $scripttag;
                   11945: }
                   11946: 
                   11947: sub process_extracted_files {
1.1067    raeburn  11948:     my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055    raeburn  11949:     my $numitems = $env{'form.archive_count'};
                   11950:     return unless ($numitems);
                   11951:     my @ids=&Apache::lonnet::current_machine_ids();
                   11952:     my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067    raeburn  11953:         %folders,%containers,%mapinner,%prompttofetch);
1.1055    raeburn  11954:     my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
                   11955:     if (grep(/^\Q$docuhome\E$/,@ids)) {
                   11956:         $prefix = &LONCAPA::propath($docudom,$docuname);
                   11957:         $pathtocheck = "$dir_root/$destination";
                   11958:         $dir = $dir_root;
                   11959:         $ishome = 1;
                   11960:     } else {
                   11961:         $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
                   11962:         $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
                   11963:         $dir = "$dir_root/$docudom/$docuname";    
                   11964:     }
                   11965:     my $currdir = "$dir_root/$destination";
                   11966:     (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
                   11967:     if ($env{'form.folderpath'}) {
                   11968:         my @items = split('&',$env{'form.folderpath'});
                   11969:         $folders{'0'} = $items[-2];
1.1075.2.17  raeburn  11970:         if ($env{'form.folderpath'} =~ /\:1$/) {
                   11971:             $containers{'0'}='page';
                   11972:         } else {
                   11973:             $containers{'0'}='sequence';
                   11974:         }
1.1055    raeburn  11975:     }
                   11976:     my @archdirs = &get_env_multiple('form.archive_directory');
                   11977:     if ($numitems) {
                   11978:         for (my $i=1; $i<=$numitems; $i++) {
                   11979:             my $path = $env{'form.archive_content_'.$i};
                   11980:             if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
                   11981:                 my $item = $1;
                   11982:                 $toplevelitems{$item} = $i;
                   11983:                 if (grep(/^\Q$i\E$/,@archdirs)) {
                   11984:                     $is_dir{$item} = 1;
                   11985:                 }
                   11986:             }
                   11987:         }
                   11988:     }
1.1067    raeburn  11989:     my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055    raeburn  11990:     if (keys(%toplevelitems) > 0) {
                   11991:         my @contents = sort(keys(%toplevelitems));
1.1056    raeburn  11992:         (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
                   11993:                                            \%parent,\@contents,\%dirorder,\%titles);
1.1055    raeburn  11994:     }
1.1066    raeburn  11995:     my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055    raeburn  11996:     if ($numitems) {
                   11997:         for (my $i=1; $i<=$numitems; $i++) {
1.1075.2.11  raeburn  11998:             next if ($env{'form.archive_'.$i} eq 'dependency');
1.1055    raeburn  11999:             my $path = $env{'form.archive_content_'.$i};
                   12000:             if ($path =~ /^\Q$pathtocheck\E/) {
                   12001:                 if ($env{'form.archive_'.$i} eq 'discard') {
                   12002:                     if ($prefix ne '' && $path ne '') {
                   12003:                         if (-e $prefix.$path) {
1.1066    raeburn  12004:                             if ((@archdirs > 0) && 
                   12005:                                 (grep(/^\Q$i\E$/,@archdirs))) {
                   12006:                                 $todeletedir{$prefix.$path} = 1;
                   12007:                             } else {
                   12008:                                 $todelete{$prefix.$path} = 1;
                   12009:                             }
1.1055    raeburn  12010:                         }
                   12011:                     }
                   12012:                 } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059    raeburn  12013:                     my ($docstitle,$title,$url,$outer);
1.1055    raeburn  12014:                     ($title) = ($path =~ m{/([^/]+)$});
1.1059    raeburn  12015:                     $docstitle = $env{'form.archive_title_'.$i};
                   12016:                     if ($docstitle eq '') {
                   12017:                         $docstitle = $title;
                   12018:                     }
1.1055    raeburn  12019:                     $outer = 0;
1.1056    raeburn  12020:                     if (ref($dirorder{$i}) eq 'ARRAY') {
                   12021:                         if (@{$dirorder{$i}} > 0) {
                   12022:                             foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055    raeburn  12023:                                 if ($env{'form.archive_'.$item} eq 'display') {
                   12024:                                     $outer = $item;
                   12025:                                     last;
                   12026:                                 }
                   12027:                             }
                   12028:                         }
                   12029:                     }
                   12030:                     my ($errtext,$fatal) = 
                   12031:                         &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
                   12032:                                                '/'.$folders{$outer}.'.'.
                   12033:                                                $containers{$outer});
                   12034:                     next if ($fatal);
                   12035:                     if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
                   12036:                         if ($context eq 'coursedocs') {
1.1056    raeburn  12037:                             $mapinner{$i} = time;
1.1055    raeburn  12038:                             $folders{$i} = 'default_'.$mapinner{$i};
                   12039:                             $containers{$i} = 'sequence';
                   12040:                             my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
                   12041:                                       $folders{$i}.'.'.$containers{$i};
                   12042:                             my $newidx = &LONCAPA::map::getresidx();
                   12043:                             $LONCAPA::map::resources[$newidx]=
1.1059    raeburn  12044:                                 $docstitle.':'.$url.':false:normal:res';
1.1055    raeburn  12045:                             push(@LONCAPA::map::order,$newidx);
                   12046:                             my ($outtext,$errtext) =
                   12047:                                 &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
                   12048:                                                         $docuname.'/'.$folders{$outer}.
1.1075.2.11  raeburn  12049:                                                         '.'.$containers{$outer},1,1);
1.1056    raeburn  12050:                             $newseqid{$i} = $newidx;
1.1067    raeburn  12051:                             unless ($errtext) {
                   12052:                                 $result .=  '<li>'.&mt('Folder: [_1] added to course',$docstitle).'</li>'."\n";
                   12053:                             }
1.1055    raeburn  12054:                         }
                   12055:                     } else {
                   12056:                         if ($context eq 'coursedocs') {
                   12057:                             my $newidx=&LONCAPA::map::getresidx();
                   12058:                             my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
                   12059:                                       $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
                   12060:                                       $title;
                   12061:                             if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
                   12062:                                 mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
                   12063:                             }
                   12064:                             if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                   12065:                                 mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
                   12066:                             }
                   12067:                             if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                   12068:                                 system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title");
1.1056    raeburn  12069:                                 $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
1.1067    raeburn  12070:                                 unless ($ishome) {
                   12071:                                     my $fetch = "$newdest{$i}/$title";
                   12072:                                     $fetch =~ s/^\Q$prefix$dir\E//;
                   12073:                                     $prompttofetch{$fetch} = 1;
                   12074:                                 }
1.1055    raeburn  12075:                             }
                   12076:                             $LONCAPA::map::resources[$newidx]=
1.1059    raeburn  12077:                                 $docstitle.':'.$url.':false:normal:res';
1.1055    raeburn  12078:                             push(@LONCAPA::map::order, $newidx);
                   12079:                             my ($outtext,$errtext)=
                   12080:                                 &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
                   12081:                                                         $docuname.'/'.$folders{$outer}.
1.1075.2.11  raeburn  12082:                                                         '.'.$containers{$outer},1,1);
1.1067    raeburn  12083:                             unless ($errtext) {
                   12084:                                 if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
                   12085:                                     $result .= '<li>'.&mt('File: [_1] added to course',$docstitle).'</li>'."\n";
                   12086:                                 }
                   12087:                             }
1.1055    raeburn  12088:                         }
                   12089:                     }
1.1075.2.11  raeburn  12090:                 }
                   12091:             } else {
                   12092:                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
                   12093:             }
                   12094:         }
                   12095:         for (my $i=1; $i<=$numitems; $i++) {
                   12096:             next unless ($env{'form.archive_'.$i} eq 'dependency');
                   12097:             my $path = $env{'form.archive_content_'.$i};
                   12098:             if ($path =~ /^\Q$pathtocheck\E/) {
                   12099:                 my ($title) = ($path =~ m{/([^/]+)$});
                   12100:                 $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
                   12101:                 if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
                   12102:                     if (ref($dirorder{$i}) eq 'ARRAY') {
                   12103:                         my ($itemidx,$fullpath,$relpath);
                   12104:                         if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
                   12105:                             my $container = $dirorder{$referrer{$i}}->[-1];
1.1056    raeburn  12106:                             for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
1.1075.2.11  raeburn  12107:                                 if ($dirorder{$i}->[$j] eq $container) {
                   12108:                                     $itemidx = $j;
1.1056    raeburn  12109:                                 }
                   12110:                             }
1.1075.2.11  raeburn  12111:                         }
                   12112:                         if ($itemidx eq '') {
                   12113:                             $itemidx =  0;
                   12114:                         }
                   12115:                         if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
                   12116:                             if ($mapinner{$referrer{$i}}) {
                   12117:                                 $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
                   12118:                                 for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
                   12119:                                     if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
                   12120:                                         unless (defined($newseqid{$dirorder{$i}->[$j]})) {
                   12121:                                             $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   12122:                                             $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   12123:                                             if (!-e $fullpath) {
                   12124:                                                 mkdir($fullpath,0755);
1.1056    raeburn  12125:                                             }
                   12126:                                         }
1.1075.2.11  raeburn  12127:                                     } else {
                   12128:                                         last;
1.1056    raeburn  12129:                                     }
1.1075.2.11  raeburn  12130:                                 }
                   12131:                             }
                   12132:                         } elsif ($newdest{$referrer{$i}}) {
                   12133:                             $fullpath = $newdest{$referrer{$i}};
                   12134:                             for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
                   12135:                                 if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
                   12136:                                     $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
                   12137:                                     last;
                   12138:                                 } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
                   12139:                                     unless (defined($newseqid{$dirorder{$i}->[$j]})) {
                   12140:                                         $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   12141:                                         $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   12142:                                         if (!-e $fullpath) {
                   12143:                                             mkdir($fullpath,0755);
1.1056    raeburn  12144:                                         }
                   12145:                                     }
1.1075.2.11  raeburn  12146:                                 } else {
                   12147:                                     last;
1.1056    raeburn  12148:                                 }
1.1075.2.11  raeburn  12149:                             }
                   12150:                         }
                   12151:                         if ($fullpath ne '') {
                   12152:                             if (-e "$prefix$path") {
                   12153:                                 system("mv $prefix$path $fullpath/$title");
                   12154:                             }
                   12155:                             if (-e "$fullpath/$title") {
                   12156:                                 my $showpath;
                   12157:                                 if ($relpath ne '') {
                   12158:                                     $showpath = "$relpath/$title";
                   12159:                                 } else {
                   12160:                                     $showpath = "/$title";
1.1056    raeburn  12161:                                 }
1.1075.2.11  raeburn  12162:                                 $result .= '<li>'.&mt('[_1] included as a dependency',$showpath).'</li>'."\n";
                   12163:                             }
                   12164:                             unless ($ishome) {
                   12165:                                 my $fetch = "$fullpath/$title";
                   12166:                                 $fetch =~ s/^\Q$prefix$dir\E//;
                   12167:                                 $prompttofetch{$fetch} = 1;
1.1055    raeburn  12168:                             }
                   12169:                         }
                   12170:                     }
1.1075.2.11  raeburn  12171:                 } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
                   12172:                     $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
                   12173:                                     $path,$env{'form.archive_content_'.$referrer{$i}}).'<br />';
1.1055    raeburn  12174:                 }
                   12175:             } else {
1.1075.2.11  raeburn  12176:                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
1.1055    raeburn  12177:             }
                   12178:         }
                   12179:         if (keys(%todelete)) {
                   12180:             foreach my $key (keys(%todelete)) {
                   12181:                 unlink($key);
1.1066    raeburn  12182:             }
                   12183:         }
                   12184:         if (keys(%todeletedir)) {
                   12185:             foreach my $key (keys(%todeletedir)) {
                   12186:                 rmdir($key);
                   12187:             }
                   12188:         }
                   12189:         foreach my $dir (sort(keys(%is_dir))) {
                   12190:             if (($pathtocheck ne '') && ($dir ne ''))  {
                   12191:                 &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055    raeburn  12192:             }
                   12193:         }
1.1067    raeburn  12194:         if ($result ne '') {
                   12195:             $output .= '<ul>'."\n".
                   12196:                        $result."\n".
                   12197:                        '</ul>';
                   12198:         }
                   12199:         unless ($ishome) {
                   12200:             my $replicationfail;
                   12201:             foreach my $item (keys(%prompttofetch)) {
                   12202:                 my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
                   12203:                 unless ($fetchresult eq 'ok') {
                   12204:                     $replicationfail .= '<li>'.$item.'</li>'."\n";
                   12205:                 }
                   12206:             }
                   12207:             if ($replicationfail) {
                   12208:                 $output .= '<p class="LC_error">'.
                   12209:                            &mt('Course home server failed to retrieve:').'<ul>'.
                   12210:                            $replicationfail.
                   12211:                            '</ul></p>';
                   12212:             }
                   12213:         }
1.1055    raeburn  12214:     } else {
                   12215:         $warning = &mt('No items found in archive.');
                   12216:     }
                   12217:     if ($error) {
                   12218:         $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   12219:                    $error.'</p>'."\n";
                   12220:     }
                   12221:     if ($warning) {
                   12222:         $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
                   12223:     }
                   12224:     return $output;
                   12225: }
                   12226: 
1.1066    raeburn  12227: sub cleanup_empty_dirs {
                   12228:     my ($path) = @_;
                   12229:     if (($path ne '') && (-d $path)) {
                   12230:         if (opendir(my $dirh,$path)) {
                   12231:             my @dircontents = grep(!/^\./,readdir($dirh));
                   12232:             my $numitems = 0;
                   12233:             foreach my $item (@dircontents) {
                   12234:                 if (-d "$path/$item") {
1.1075.2.28  raeburn  12235:                     &cleanup_empty_dirs("$path/$item");
1.1066    raeburn  12236:                     if (-e "$path/$item") {
                   12237:                         $numitems ++;
                   12238:                     }
                   12239:                 } else {
                   12240:                     $numitems ++;
                   12241:                 }
                   12242:             }
                   12243:             if ($numitems == 0) {
                   12244:                 rmdir($path);
                   12245:             }
                   12246:             closedir($dirh);
                   12247:         }
                   12248:     }
                   12249:     return;
                   12250: }
                   12251: 
1.41      ng       12252: =pod
1.45      matthew  12253: 
1.1075.2.56  raeburn  12254: =item * &get_folder_hierarchy()
1.1068    raeburn  12255: 
                   12256: Provides hierarchy of names of folders/sub-folders containing the current
                   12257: item,
                   12258: 
                   12259: Inputs: 3
                   12260:      - $navmap - navmaps object
                   12261: 
                   12262:      - $map - url for map (either the trigger itself, or map containing
                   12263:                            the resource, which is the trigger).
                   12264: 
                   12265:      - $showitem - 1 => show title for map itself; 0 => do not show.
                   12266: 
                   12267: Outputs: 1 @pathitems - array of folder/subfolder names.
                   12268: 
                   12269: =cut
                   12270: 
                   12271: sub get_folder_hierarchy {
                   12272:     my ($navmap,$map,$showitem) = @_;
                   12273:     my @pathitems;
                   12274:     if (ref($navmap)) {
                   12275:         my $mapres = $navmap->getResourceByUrl($map);
                   12276:         if (ref($mapres)) {
                   12277:             my $pcslist = $mapres->map_hierarchy();
                   12278:             if ($pcslist ne '') {
                   12279:                 my @pcs = split(/,/,$pcslist);
                   12280:                 foreach my $pc (@pcs) {
                   12281:                     if ($pc == 1) {
1.1075.2.38  raeburn  12282:                         push(@pathitems,&mt('Main Content'));
1.1068    raeburn  12283:                     } else {
                   12284:                         my $res = $navmap->getByMapPc($pc);
                   12285:                         if (ref($res)) {
                   12286:                             my $title = $res->compTitle();
                   12287:                             $title =~ s/\W+/_/g;
                   12288:                             if ($title ne '') {
                   12289:                                 push(@pathitems,$title);
                   12290:                             }
                   12291:                         }
                   12292:                     }
                   12293:                 }
                   12294:             }
1.1071    raeburn  12295:             if ($showitem) {
                   12296:                 if ($mapres->{ID} eq '0.0') {
1.1075.2.38  raeburn  12297:                     push(@pathitems,&mt('Main Content'));
1.1071    raeburn  12298:                 } else {
                   12299:                     my $maptitle = $mapres->compTitle();
                   12300:                     $maptitle =~ s/\W+/_/g;
                   12301:                     if ($maptitle ne '') {
                   12302:                         push(@pathitems,$maptitle);
                   12303:                     }
1.1068    raeburn  12304:                 }
                   12305:             }
                   12306:         }
                   12307:     }
                   12308:     return @pathitems;
                   12309: }
                   12310: 
                   12311: =pod
                   12312: 
1.1015    raeburn  12313: =item * &get_turnedin_filepath()
                   12314: 
                   12315: Determines path in a user's portfolio file for storage of files uploaded
                   12316: to a specific essayresponse or dropbox item.
                   12317: 
                   12318: Inputs: 3 required + 1 optional.
                   12319: $symb is symb for resource, $uname and $udom are for current user (required).
                   12320: $caller is optional (can be "submission", if routine is called when storing
                   12321: an upoaded file when "Submit Answer" button was pressed).
                   12322: 
                   12323: Returns array containing $path and $multiresp. 
                   12324: $path is path in portfolio.  $multiresp is 1 if this resource contains more
                   12325: than one file upload item.  Callers of routine should append partid as a 
                   12326: subdirectory to $path in cases where $multiresp is 1.
                   12327: 
                   12328: Called by: homework/essayresponse.pm and homework/structuretags.pm
                   12329: 
                   12330: =cut
                   12331: 
                   12332: sub get_turnedin_filepath {
                   12333:     my ($symb,$uname,$udom,$caller) = @_;
                   12334:     my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
                   12335:     my $turnindir;
                   12336:     my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
                   12337:     $turnindir = $userhash{'turnindir'};
                   12338:     my ($path,$multiresp);
                   12339:     if ($turnindir eq '') {
                   12340:         if ($caller eq 'submission') {
                   12341:             $turnindir = &mt('turned in');
                   12342:             $turnindir =~ s/\W+/_/g;
                   12343:             my %newhash = (
                   12344:                             'turnindir' => $turnindir,
                   12345:                           );
                   12346:             &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
                   12347:         }
                   12348:     }
                   12349:     if ($turnindir ne '') {
                   12350:         $path = '/'.$turnindir.'/';
                   12351:         my ($multipart,$turnin,@pathitems);
                   12352:         my $navmap = Apache::lonnavmaps::navmap->new();
                   12353:         if (defined($navmap)) {
                   12354:             my $mapres = $navmap->getResourceByUrl($map);
                   12355:             if (ref($mapres)) {
                   12356:                 my $pcslist = $mapres->map_hierarchy();
                   12357:                 if ($pcslist ne '') {
                   12358:                     foreach my $pc (split(/,/,$pcslist)) {
                   12359:                         my $res = $navmap->getByMapPc($pc);
                   12360:                         if (ref($res)) {
                   12361:                             my $title = $res->compTitle();
                   12362:                             $title =~ s/\W+/_/g;
                   12363:                             if ($title ne '') {
1.1075.2.48  raeburn  12364:                                 if (($pc > 1) && (length($title) > 12)) {
                   12365:                                     $title = substr($title,0,12);
                   12366:                                 }
1.1015    raeburn  12367:                                 push(@pathitems,$title);
                   12368:                             }
                   12369:                         }
                   12370:                     }
                   12371:                 }
                   12372:                 my $maptitle = $mapres->compTitle();
                   12373:                 $maptitle =~ s/\W+/_/g;
                   12374:                 if ($maptitle ne '') {
1.1075.2.48  raeburn  12375:                     if (length($maptitle) > 12) {
                   12376:                         $maptitle = substr($maptitle,0,12);
                   12377:                     }
1.1015    raeburn  12378:                     push(@pathitems,$maptitle);
                   12379:                 }
                   12380:                 unless ($env{'request.state'} eq 'construct') {
                   12381:                     my $res = $navmap->getBySymb($symb);
                   12382:                     if (ref($res)) {
                   12383:                         my $partlist = $res->parts();
                   12384:                         my $totaluploads = 0;
                   12385:                         if (ref($partlist) eq 'ARRAY') {
                   12386:                             foreach my $part (@{$partlist}) {
                   12387:                                 my @types = $res->responseType($part);
                   12388:                                 my @ids = $res->responseIds($part);
                   12389:                                 for (my $i=0; $i < scalar(@ids); $i++) {
                   12390:                                     if ($types[$i] eq 'essay') {
                   12391:                                         my $partid = $part.'_'.$ids[$i];
                   12392:                                         if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
                   12393:                                             $totaluploads ++;
                   12394:                                         }
                   12395:                                     }
                   12396:                                 }
                   12397:                             }
                   12398:                             if ($totaluploads > 1) {
                   12399:                                 $multiresp = 1;
                   12400:                             }
                   12401:                         }
                   12402:                     }
                   12403:                 }
                   12404:             } else {
                   12405:                 return;
                   12406:             }
                   12407:         } else {
                   12408:             return;
                   12409:         }
                   12410:         my $restitle=&Apache::lonnet::gettitle($symb);
                   12411:         $restitle =~ s/\W+/_/g;
                   12412:         if ($restitle eq '') {
                   12413:             $restitle = ($resurl =~ m{/[^/]+$});
                   12414:             if ($restitle eq '') {
                   12415:                 $restitle = time;
                   12416:             }
                   12417:         }
1.1075.2.48  raeburn  12418:         if (length($restitle) > 12) {
                   12419:             $restitle = substr($restitle,0,12);
                   12420:         }
1.1015    raeburn  12421:         push(@pathitems,$restitle);
                   12422:         $path .= join('/',@pathitems);
                   12423:     }
                   12424:     return ($path,$multiresp);
                   12425: }
                   12426: 
                   12427: =pod
                   12428: 
1.464     albertel 12429: =back
1.41      ng       12430: 
1.112     bowersj2 12431: =head1 CSV Upload/Handling functions
1.38      albertel 12432: 
1.41      ng       12433: =over 4
                   12434: 
1.648     raeburn  12435: =item * &upfile_store($r)
1.41      ng       12436: 
                   12437: Store uploaded file, $r should be the HTTP Request object,
1.258     albertel 12438: needs $env{'form.upfile'}
1.41      ng       12439: returns $datatoken to be put into hidden field
                   12440: 
                   12441: =cut
1.31      albertel 12442: 
                   12443: sub upfile_store {
                   12444:     my $r=shift;
1.258     albertel 12445:     $env{'form.upfile'}=~s/\r/\n/gs;
                   12446:     $env{'form.upfile'}=~s/\f/\n/gs;
                   12447:     $env{'form.upfile'}=~s/\n+/\n/gs;
                   12448:     $env{'form.upfile'}=~s/\n+$//gs;
1.31      albertel 12449: 
1.258     albertel 12450:     my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
                   12451: 	'_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
1.31      albertel 12452:     {
1.158     raeburn  12453:         my $datafile = $r->dir_config('lonDaemons').
                   12454:                            '/tmp/'.$datatoken.'.tmp';
                   12455:         if ( open(my $fh,">$datafile") ) {
1.258     albertel 12456:             print $fh $env{'form.upfile'};
1.158     raeburn  12457:             close($fh);
                   12458:         }
1.31      albertel 12459:     }
                   12460:     return $datatoken;
                   12461: }
                   12462: 
1.56      matthew  12463: =pod
                   12464: 
1.648     raeburn  12465: =item * &load_tmp_file($r)
1.41      ng       12466: 
                   12467: Load uploaded file from tmp, $r should be the HTTP Request object,
1.258     albertel 12468: needs $env{'form.datatoken'},
                   12469: sets $env{'form.upfile'} to the contents of the file
1.41      ng       12470: 
                   12471: =cut
1.31      albertel 12472: 
                   12473: sub load_tmp_file {
                   12474:     my $r=shift;
                   12475:     my @studentdata=();
                   12476:     {
1.158     raeburn  12477:         my $studentfile = $r->dir_config('lonDaemons').
1.258     albertel 12478:                               '/tmp/'.$env{'form.datatoken'}.'.tmp';
1.158     raeburn  12479:         if ( open(my $fh,"<$studentfile") ) {
                   12480:             @studentdata=<$fh>;
                   12481:             close($fh);
                   12482:         }
1.31      albertel 12483:     }
1.258     albertel 12484:     $env{'form.upfile'}=join('',@studentdata);
1.31      albertel 12485: }
                   12486: 
1.56      matthew  12487: =pod
                   12488: 
1.648     raeburn  12489: =item * &upfile_record_sep()
1.41      ng       12490: 
                   12491: Separate uploaded file into records
                   12492: returns array of records,
1.258     albertel 12493: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41      ng       12494: 
                   12495: =cut
1.31      albertel 12496: 
                   12497: sub upfile_record_sep {
1.258     albertel 12498:     if ($env{'form.upfiletype'} eq 'xml') {
1.31      albertel 12499:     } else {
1.248     albertel 12500: 	my @records;
1.258     albertel 12501: 	foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248     albertel 12502: 	    if ($line=~/^\s*$/) { next; }
                   12503: 	    push(@records,$line);
                   12504: 	}
                   12505: 	return @records;
1.31      albertel 12506:     }
                   12507: }
                   12508: 
1.56      matthew  12509: =pod
                   12510: 
1.648     raeburn  12511: =item * &record_sep($record)
1.41      ng       12512: 
1.258     albertel 12513: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41      ng       12514: 
                   12515: =cut
                   12516: 
1.263     www      12517: sub takeleft {
                   12518:     my $index=shift;
                   12519:     return substr('0000'.$index,-4,4);
                   12520: }
                   12521: 
1.31      albertel 12522: sub record_sep {
                   12523:     my $record=shift;
                   12524:     my %components=();
1.258     albertel 12525:     if ($env{'form.upfiletype'} eq 'xml') {
                   12526:     } elsif ($env{'form.upfiletype'} eq 'space') {
1.31      albertel 12527:         my $i=0;
1.356     albertel 12528:         foreach my $field (split(/\s+/,$record)) {
1.31      albertel 12529:             $field=~s/^(\"|\')//;
                   12530:             $field=~s/(\"|\')$//;
1.263     www      12531:             $components{&takeleft($i)}=$field;
1.31      albertel 12532:             $i++;
                   12533:         }
1.258     albertel 12534:     } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31      albertel 12535:         my $i=0;
1.356     albertel 12536:         foreach my $field (split(/\t/,$record)) {
1.31      albertel 12537:             $field=~s/^(\"|\')//;
                   12538:             $field=~s/(\"|\')$//;
1.263     www      12539:             $components{&takeleft($i)}=$field;
1.31      albertel 12540:             $i++;
                   12541:         }
                   12542:     } else {
1.561     www      12543:         my $separator=',';
1.480     banghart 12544:         if ($env{'form.upfiletype'} eq 'semisv') {
1.561     www      12545:             $separator=';';
1.480     banghart 12546:         }
1.31      albertel 12547:         my $i=0;
1.561     www      12548: # the character we are looking for to indicate the end of a quote or a record 
                   12549:         my $looking_for=$separator;
                   12550: # do not add the characters to the fields
                   12551:         my $ignore=0;
                   12552: # we just encountered a separator (or the beginning of the record)
                   12553:         my $just_found_separator=1;
                   12554: # store the field we are working on here
                   12555:         my $field='';
                   12556: # work our way through all characters in record
                   12557:         foreach my $character ($record=~/(.)/g) {
                   12558:             if ($character eq $looking_for) {
                   12559:                if ($character ne $separator) {
                   12560: # Found the end of a quote, again looking for separator
                   12561:                   $looking_for=$separator;
                   12562:                   $ignore=1;
                   12563:                } else {
                   12564: # Found a separator, store away what we got
                   12565:                   $components{&takeleft($i)}=$field;
                   12566: 	          $i++;
                   12567:                   $just_found_separator=1;
                   12568:                   $ignore=0;
                   12569:                   $field='';
                   12570:                }
                   12571:                next;
                   12572:             }
                   12573: # single or double quotation marks after a separator indicate beginning of a quote
                   12574: # we are now looking for the end of the quote and need to ignore separators
                   12575:             if ((($character eq '"') || ($character eq "'")) && ($just_found_separator))  {
                   12576:                $looking_for=$character;
                   12577:                next;
                   12578:             }
                   12579: # ignore would be true after we reached the end of a quote
                   12580:             if ($ignore) { next; }
                   12581:             if (($just_found_separator) && ($character=~/\s/)) { next; }
                   12582:             $field.=$character;
                   12583:             $just_found_separator=0; 
1.31      albertel 12584:         }
1.561     www      12585: # catch the very last entry, since we never encountered the separator
                   12586:         $components{&takeleft($i)}=$field;
1.31      albertel 12587:     }
                   12588:     return %components;
                   12589: }
                   12590: 
1.144     matthew  12591: ######################################################
                   12592: ######################################################
                   12593: 
1.56      matthew  12594: =pod
                   12595: 
1.648     raeburn  12596: =item * &upfile_select_html()
1.41      ng       12597: 
1.144     matthew  12598: Return HTML code to select a file from the users machine and specify 
                   12599: the file type.
1.41      ng       12600: 
                   12601: =cut
                   12602: 
1.144     matthew  12603: ######################################################
                   12604: ######################################################
1.31      albertel 12605: sub upfile_select_html {
1.144     matthew  12606:     my %Types = (
                   12607:                  csv   => &mt('CSV (comma separated values, spreadsheet)'),
1.480     banghart 12608:                  semisv => &mt('Semicolon separated values'),
1.144     matthew  12609:                  space => &mt('Space separated'),
                   12610:                  tab   => &mt('Tabulator separated'),
                   12611: #                 xml   => &mt('HTML/XML'),
                   12612:                  );
                   12613:     my $Str = '<input type="file" name="upfile" size="50" />'.
1.727     riegler  12614:         '<br />'.&mt('Type').': <select name="upfiletype">';
1.144     matthew  12615:     foreach my $type (sort(keys(%Types))) {
                   12616:         $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
                   12617:     }
                   12618:     $Str .= "</select>\n";
                   12619:     return $Str;
1.31      albertel 12620: }
                   12621: 
1.301     albertel 12622: sub get_samples {
                   12623:     my ($records,$toget) = @_;
                   12624:     my @samples=({});
                   12625:     my $got=0;
                   12626:     foreach my $rec (@$records) {
                   12627: 	my %temp = &record_sep($rec);
                   12628: 	if (! grep(/\S/, values(%temp))) { next; }
                   12629: 	if (%temp) {
                   12630: 	    $samples[$got]=\%temp;
                   12631: 	    $got++;
                   12632: 	    if ($got == $toget) { last; }
                   12633: 	}
                   12634:     }
                   12635:     return \@samples;
                   12636: }
                   12637: 
1.144     matthew  12638: ######################################################
                   12639: ######################################################
                   12640: 
1.56      matthew  12641: =pod
                   12642: 
1.648     raeburn  12643: =item * &csv_print_samples($r,$records)
1.41      ng       12644: 
                   12645: Prints a table of sample values from each column uploaded $r is an
                   12646: Apache Request ref, $records is an arrayref from
                   12647: &Apache::loncommon::upfile_record_sep
                   12648: 
                   12649: =cut
                   12650: 
1.144     matthew  12651: ######################################################
                   12652: ######################################################
1.31      albertel 12653: sub csv_print_samples {
                   12654:     my ($r,$records) = @_;
1.662     bisitz   12655:     my $samples = &get_samples($records,5);
1.301     albertel 12656: 
1.594     raeburn  12657:     $r->print(&mt('Samples').'<br />'.&start_data_table().
                   12658:               &start_data_table_header_row());
1.356     albertel 12659:     foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) { 
1.845     bisitz   12660:         $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594     raeburn  12661:     $r->print(&end_data_table_header_row());
1.301     albertel 12662:     foreach my $hash (@$samples) {
1.594     raeburn  12663: 	$r->print(&start_data_table_row());
1.356     albertel 12664: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31      albertel 12665: 	    $r->print('<td>');
1.356     albertel 12666: 	    if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31      albertel 12667: 	    $r->print('</td>');
                   12668: 	}
1.594     raeburn  12669: 	$r->print(&end_data_table_row());
1.31      albertel 12670:     }
1.594     raeburn  12671:     $r->print(&end_data_table().'<br />'."\n");
1.31      albertel 12672: }
                   12673: 
1.144     matthew  12674: ######################################################
                   12675: ######################################################
                   12676: 
1.56      matthew  12677: =pod
                   12678: 
1.648     raeburn  12679: =item * &csv_print_select_table($r,$records,$d)
1.41      ng       12680: 
                   12681: Prints a table to create associations between values and table columns.
1.144     matthew  12682: 
1.41      ng       12683: $r is an Apache Request ref,
                   12684: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174     matthew  12685: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41      ng       12686: 
                   12687: =cut
                   12688: 
1.144     matthew  12689: ######################################################
                   12690: ######################################################
1.31      albertel 12691: sub csv_print_select_table {
                   12692:     my ($r,$records,$d) = @_;
1.301     albertel 12693:     my $i=0;
                   12694:     my $samples = &get_samples($records,1);
1.144     matthew  12695:     $r->print(&mt('Associate columns with student attributes.')."\n".
1.594     raeburn  12696: 	      &start_data_table().&start_data_table_header_row().
1.144     matthew  12697:               '<th>'.&mt('Attribute').'</th>'.
1.594     raeburn  12698:               '<th>'.&mt('Column').'</th>'.
                   12699:               &end_data_table_header_row()."\n");
1.356     albertel 12700:     foreach my $array_ref (@$d) {
                   12701: 	my ($value,$display,$defaultcol)=@{ $array_ref };
1.729     raeburn  12702: 	$r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31      albertel 12703: 
1.875     bisitz   12704: 	$r->print('<td><select name="f'.$i.'"'.
1.32      matthew  12705: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.31      albertel 12706: 	$r->print('<option value="none"></option>');
1.356     albertel 12707: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
                   12708: 	    $r->print('<option value="'.$sample.'"'.
                   12709:                       ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662     bisitz   12710:                       '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31      albertel 12711: 	}
1.594     raeburn  12712: 	$r->print('</select></td>'.&end_data_table_row()."\n");
1.31      albertel 12713: 	$i++;
                   12714:     }
1.594     raeburn  12715:     $r->print(&end_data_table());
1.31      albertel 12716:     $i--;
                   12717:     return $i;
                   12718: }
1.56      matthew  12719: 
1.144     matthew  12720: ######################################################
                   12721: ######################################################
                   12722: 
1.56      matthew  12723: =pod
1.31      albertel 12724: 
1.648     raeburn  12725: =item * &csv_samples_select_table($r,$records,$d)
1.41      ng       12726: 
                   12727: Prints a table of sample values from the upload and can make associate samples to internal names.
                   12728: 
                   12729: $r is an Apache Request ref,
                   12730: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
                   12731: $d is an array of 2 element arrays (internal name, displayed name)
                   12732: 
                   12733: =cut
                   12734: 
1.144     matthew  12735: ######################################################
                   12736: ######################################################
1.31      albertel 12737: sub csv_samples_select_table {
                   12738:     my ($r,$records,$d) = @_;
                   12739:     my $i=0;
1.144     matthew  12740:     #
1.662     bisitz   12741:     my $max_samples = 5;
                   12742:     my $samples = &get_samples($records,$max_samples);
1.594     raeburn  12743:     $r->print(&start_data_table().
                   12744:               &start_data_table_header_row().'<th>'.
                   12745:               &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
                   12746:               &end_data_table_header_row());
1.301     albertel 12747: 
                   12748:     foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594     raeburn  12749: 	$r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32      matthew  12750: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.301     albertel 12751: 	foreach my $option (@$d) {
                   12752: 	    my ($value,$display,$defaultcol)=@{ $option };
1.174     matthew  12753: 	    $r->print('<option value="'.$value.'"'.
1.253     albertel 12754:                       ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174     matthew  12755:                       $display.'</option>');
1.31      albertel 12756: 	}
                   12757: 	$r->print('</select></td><td>');
1.662     bisitz   12758: 	foreach my $line (0..($max_samples-1)) {
1.301     albertel 12759: 	    if (defined($samples->[$line]{$key})) { 
                   12760: 		$r->print($samples->[$line]{$key}."<br />\n"); 
                   12761: 	    }
                   12762: 	}
1.594     raeburn  12763: 	$r->print('</td>'.&end_data_table_row());
1.31      albertel 12764: 	$i++;
                   12765:     }
1.594     raeburn  12766:     $r->print(&end_data_table());
1.31      albertel 12767:     $i--;
                   12768:     return($i);
1.115     matthew  12769: }
                   12770: 
1.144     matthew  12771: ######################################################
                   12772: ######################################################
                   12773: 
1.115     matthew  12774: =pod
                   12775: 
1.648     raeburn  12776: =item * &clean_excel_name($name)
1.115     matthew  12777: 
                   12778: Returns a replacement for $name which does not contain any illegal characters.
                   12779: 
                   12780: =cut
                   12781: 
1.144     matthew  12782: ######################################################
                   12783: ######################################################
1.115     matthew  12784: sub clean_excel_name {
                   12785:     my ($name) = @_;
                   12786:     $name =~ s/[:\*\?\/\\]//g;
                   12787:     if (length($name) > 31) {
                   12788:         $name = substr($name,0,31);
                   12789:     }
                   12790:     return $name;
1.25      albertel 12791: }
1.84      albertel 12792: 
1.85      albertel 12793: =pod
                   12794: 
1.648     raeburn  12795: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85      albertel 12796: 
                   12797: Returns either 1 or undef
                   12798: 
                   12799: 1 if the part is to be hidden, undef if it is to be shown
                   12800: 
                   12801: Arguments are:
                   12802: 
                   12803: $id the id of the part to be checked
                   12804: $symb, optional the symb of the resource to check
                   12805: $udom, optional the domain of the user to check for
                   12806: $uname, optional the username of the user to check for
                   12807: 
                   12808: =cut
1.84      albertel 12809: 
                   12810: sub check_if_partid_hidden {
                   12811:     my ($id,$symb,$udom,$uname) = @_;
1.133     albertel 12812:     my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84      albertel 12813: 					 $symb,$udom,$uname);
1.141     albertel 12814:     my $truth=1;
                   12815:     #if the string starts with !, then the list is the list to show not hide
                   12816:     if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84      albertel 12817:     my @hiddenlist=split(/,/,$hiddenparts);
                   12818:     foreach my $checkid (@hiddenlist) {
1.141     albertel 12819: 	if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84      albertel 12820:     }
1.141     albertel 12821:     return !$truth;
1.84      albertel 12822: }
1.127     matthew  12823: 
1.138     matthew  12824: 
                   12825: ############################################################
                   12826: ############################################################
                   12827: 
                   12828: =pod
                   12829: 
1.157     matthew  12830: =back 
                   12831: 
1.138     matthew  12832: =head1 cgi-bin script and graphing routines
                   12833: 
1.157     matthew  12834: =over 4
                   12835: 
1.648     raeburn  12836: =item * &get_cgi_id()
1.138     matthew  12837: 
                   12838: Inputs: none
                   12839: 
                   12840: Returns an id which can be used to pass environment variables
                   12841: to various cgi-bin scripts.  These environment variables will
                   12842: be removed from the users environment after a given time by
                   12843: the routine &Apache::lonnet::transfer_profile_to_env.
                   12844: 
                   12845: =cut
                   12846: 
                   12847: ############################################################
                   12848: ############################################################
1.152     albertel 12849: my $uniq=0;
1.136     matthew  12850: sub get_cgi_id {
1.154     albertel 12851:     $uniq=($uniq+1)%100000;
1.280     albertel 12852:     return (time.'_'.$$.'_'.$uniq);
1.136     matthew  12853: }
                   12854: 
1.127     matthew  12855: ############################################################
                   12856: ############################################################
                   12857: 
                   12858: =pod
                   12859: 
1.648     raeburn  12860: =item * &DrawBarGraph()
1.127     matthew  12861: 
1.138     matthew  12862: Facilitates the plotting of data in a (stacked) bar graph.
                   12863: Puts plot definition data into the users environment in order for 
                   12864: graph.png to plot it.  Returns an <img> tag for the plot.
                   12865: The bars on the plot are labeled '1','2',...,'n'.
                   12866: 
                   12867: Inputs:
                   12868: 
                   12869: =over 4
                   12870: 
                   12871: =item $Title: string, the title of the plot
                   12872: 
                   12873: =item $xlabel: string, text describing the X-axis of the plot
                   12874: 
                   12875: =item $ylabel: string, text describing the Y-axis of the plot
                   12876: 
                   12877: =item $Max: scalar, the maximum Y value to use in the plot
                   12878: If $Max is < any data point, the graph will not be rendered.
                   12879: 
1.140     matthew  12880: =item $colors: array ref holding the colors to be used for the data sets when
1.138     matthew  12881: they are plotted.  If undefined, default values will be used.
                   12882: 
1.178     matthew  12883: =item $labels: array ref holding the labels to use on the x-axis for the bars.
                   12884: 
1.138     matthew  12885: =item @Values: An array of array references.  Each array reference holds data
                   12886: to be plotted in a stacked bar chart.
                   12887: 
1.239     matthew  12888: =item If the final element of @Values is a hash reference the key/value
                   12889: pairs will be added to the graph definition.
                   12890: 
1.138     matthew  12891: =back
                   12892: 
                   12893: Returns:
                   12894: 
                   12895: An <img> tag which references graph.png and the appropriate identifying
                   12896: information for the plot.
                   12897: 
1.127     matthew  12898: =cut
                   12899: 
                   12900: ############################################################
                   12901: ############################################################
1.134     matthew  12902: sub DrawBarGraph {
1.178     matthew  12903:     my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134     matthew  12904:     #
                   12905:     if (! defined($colors)) {
                   12906:         $colors = ['#33ff00', 
                   12907:                   '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
                   12908:                   '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
                   12909:                   ]; 
                   12910:     }
1.228     matthew  12911:     my $extra_settings = {};
                   12912:     if (ref($Values[-1]) eq 'HASH') {
                   12913:         $extra_settings = pop(@Values);
                   12914:     }
1.127     matthew  12915:     #
1.136     matthew  12916:     my $identifier = &get_cgi_id();
                   12917:     my $id = 'cgi.'.$identifier;        
1.129     matthew  12918:     if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127     matthew  12919:         return '';
                   12920:     }
1.225     matthew  12921:     #
                   12922:     my @Labels;
                   12923:     if (defined($labels)) {
                   12924:         @Labels = @$labels;
                   12925:     } else {
                   12926:         for (my $i=0;$i<@{$Values[0]};$i++) {
                   12927:             push (@Labels,$i+1);
                   12928:         }
                   12929:     }
                   12930:     #
1.129     matthew  12931:     my $NumBars = scalar(@{$Values[0]});
1.225     matthew  12932:     if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129     matthew  12933:     my %ValuesHash;
                   12934:     my $NumSets=1;
                   12935:     foreach my $array (@Values) {
                   12936:         next if (! ref($array));
1.136     matthew  12937:         $ValuesHash{$id.'.data.'.$NumSets++} = 
1.132     matthew  12938:             join(',',@$array);
1.129     matthew  12939:     }
1.127     matthew  12940:     #
1.136     matthew  12941:     my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225     matthew  12942:     if ($NumBars < 3) {
                   12943:         $width = 120+$NumBars*32;
1.220     matthew  12944:         $xskip = 1;
1.225     matthew  12945:         $bar_width = 30;
                   12946:     } elsif ($NumBars < 5) {
                   12947:         $width = 120+$NumBars*20;
                   12948:         $xskip = 1;
                   12949:         $bar_width = 20;
1.220     matthew  12950:     } elsif ($NumBars < 10) {
1.136     matthew  12951:         $width = 120+$NumBars*15;
                   12952:         $xskip = 1;
                   12953:         $bar_width = 15;
                   12954:     } elsif ($NumBars <= 25) {
                   12955:         $width = 120+$NumBars*11;
                   12956:         $xskip = 5;
                   12957:         $bar_width = 8;
                   12958:     } elsif ($NumBars <= 50) {
                   12959:         $width = 120+$NumBars*8;
                   12960:         $xskip = 5;
                   12961:         $bar_width = 4;
                   12962:     } else {
                   12963:         $width = 120+$NumBars*8;
                   12964:         $xskip = 5;
                   12965:         $bar_width = 4;
                   12966:     }
                   12967:     #
1.137     matthew  12968:     $Max = 1 if ($Max < 1);
                   12969:     if ( int($Max) < $Max ) {
                   12970:         $Max++;
                   12971:         $Max = int($Max);
                   12972:     }
1.127     matthew  12973:     $Title  = '' if (! defined($Title));
                   12974:     $xlabel = '' if (! defined($xlabel));
                   12975:     $ylabel = '' if (! defined($ylabel));
1.369     www      12976:     $ValuesHash{$id.'.title'}    = &escape($Title);
                   12977:     $ValuesHash{$id.'.xlabel'}   = &escape($xlabel);
                   12978:     $ValuesHash{$id.'.ylabel'}   = &escape($ylabel);
1.137     matthew  12979:     $ValuesHash{$id.'.y_max_value'} = $Max;
1.136     matthew  12980:     $ValuesHash{$id.'.NumBars'}  = $NumBars;
                   12981:     $ValuesHash{$id.'.NumSets'}  = $NumSets;
                   12982:     $ValuesHash{$id.'.PlotType'} = 'bar';
                   12983:     $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   12984:     $ValuesHash{$id.'.height'}   = $height;
                   12985:     $ValuesHash{$id.'.width'}    = $width;
                   12986:     $ValuesHash{$id.'.xskip'}    = $xskip;
                   12987:     $ValuesHash{$id.'.bar_width'} = $bar_width;
                   12988:     $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127     matthew  12989:     #
1.228     matthew  12990:     # Deal with other parameters
                   12991:     while (my ($key,$value) = each(%$extra_settings)) {
                   12992:         $ValuesHash{$id.'.'.$key} = $value;
                   12993:     }
                   12994:     #
1.646     raeburn  12995:     &Apache::lonnet::appenv(\%ValuesHash);
1.137     matthew  12996:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   12997: }
                   12998: 
                   12999: ############################################################
                   13000: ############################################################
                   13001: 
                   13002: =pod
                   13003: 
1.648     raeburn  13004: =item * &DrawXYGraph()
1.137     matthew  13005: 
1.138     matthew  13006: Facilitates the plotting of data in an XY graph.
                   13007: Puts plot definition data into the users environment in order for 
                   13008: graph.png to plot it.  Returns an <img> tag for the plot.
                   13009: 
                   13010: Inputs:
                   13011: 
                   13012: =over 4
                   13013: 
                   13014: =item $Title: string, the title of the plot
                   13015: 
                   13016: =item $xlabel: string, text describing the X-axis of the plot
                   13017: 
                   13018: =item $ylabel: string, text describing the Y-axis of the plot
                   13019: 
                   13020: =item $Max: scalar, the maximum Y value to use in the plot
                   13021: If $Max is < any data point, the graph will not be rendered.
                   13022: 
                   13023: =item $colors: Array ref containing the hex color codes for the data to be 
                   13024: plotted in.  If undefined, default values will be used.
                   13025: 
                   13026: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   13027: 
                   13028: =item $Ydata: Array ref containing Array refs.  
1.185     www      13029: Each of the contained arrays will be plotted as a separate curve.
1.138     matthew  13030: 
                   13031: =item %Values: hash indicating or overriding any default values which are 
                   13032: passed to graph.png.  
                   13033: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   13034: 
                   13035: =back
                   13036: 
                   13037: Returns:
                   13038: 
                   13039: An <img> tag which references graph.png and the appropriate identifying
                   13040: information for the plot.
                   13041: 
1.137     matthew  13042: =cut
                   13043: 
                   13044: ############################################################
                   13045: ############################################################
                   13046: sub DrawXYGraph {
                   13047:     my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
                   13048:     #
                   13049:     # Create the identifier for the graph
                   13050:     my $identifier = &get_cgi_id();
                   13051:     my $id = 'cgi.'.$identifier;
                   13052:     #
                   13053:     $Title  = '' if (! defined($Title));
                   13054:     $xlabel = '' if (! defined($xlabel));
                   13055:     $ylabel = '' if (! defined($ylabel));
                   13056:     my %ValuesHash = 
                   13057:         (
1.369     www      13058:          $id.'.title'  => &escape($Title),
                   13059:          $id.'.xlabel' => &escape($xlabel),
                   13060:          $id.'.ylabel' => &escape($ylabel),
1.137     matthew  13061:          $id.'.y_max_value'=> $Max,
                   13062:          $id.'.labels'     => join(',',@$Xlabels),
                   13063:          $id.'.PlotType'   => 'XY',
                   13064:          );
                   13065:     #
                   13066:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   13067:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   13068:     }
                   13069:     #
                   13070:     if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
                   13071:         return '';
                   13072:     }
                   13073:     my $NumSets=1;
1.138     matthew  13074:     foreach my $array (@{$Ydata}){
1.137     matthew  13075:         next if (! ref($array));
                   13076:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
                   13077:     }
1.138     matthew  13078:     $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137     matthew  13079:     #
                   13080:     # Deal with other parameters
                   13081:     while (my ($key,$value) = each(%Values)) {
                   13082:         $ValuesHash{$id.'.'.$key} = $value;
1.127     matthew  13083:     }
                   13084:     #
1.646     raeburn  13085:     &Apache::lonnet::appenv(\%ValuesHash);
1.136     matthew  13086:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   13087: }
                   13088: 
                   13089: ############################################################
                   13090: ############################################################
                   13091: 
                   13092: =pod
                   13093: 
1.648     raeburn  13094: =item * &DrawXYYGraph()
1.138     matthew  13095: 
                   13096: Facilitates the plotting of data in an XY graph with two Y axes.
                   13097: Puts plot definition data into the users environment in order for 
                   13098: graph.png to plot it.  Returns an <img> tag for the plot.
                   13099: 
                   13100: Inputs:
                   13101: 
                   13102: =over 4
                   13103: 
                   13104: =item $Title: string, the title of the plot
                   13105: 
                   13106: =item $xlabel: string, text describing the X-axis of the plot
                   13107: 
                   13108: =item $ylabel: string, text describing the Y-axis of the plot
                   13109: 
                   13110: =item $colors: Array ref containing the hex color codes for the data to be 
                   13111: plotted in.  If undefined, default values will be used.
                   13112: 
                   13113: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   13114: 
                   13115: =item $Ydata1: The first data set
                   13116: 
                   13117: =item $Min1: The minimum value of the left Y-axis
                   13118: 
                   13119: =item $Max1: The maximum value of the left Y-axis
                   13120: 
                   13121: =item $Ydata2: The second data set
                   13122: 
                   13123: =item $Min2: The minimum value of the right Y-axis
                   13124: 
                   13125: =item $Max2: The maximum value of the left Y-axis
                   13126: 
                   13127: =item %Values: hash indicating or overriding any default values which are 
                   13128: passed to graph.png.  
                   13129: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   13130: 
                   13131: =back
                   13132: 
                   13133: Returns:
                   13134: 
                   13135: An <img> tag which references graph.png and the appropriate identifying
                   13136: information for the plot.
1.136     matthew  13137: 
                   13138: =cut
                   13139: 
                   13140: ############################################################
                   13141: ############################################################
1.137     matthew  13142: sub DrawXYYGraph {
                   13143:     my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
                   13144:                                         $Ydata2,$Min2,$Max2,%Values)=@_;
1.136     matthew  13145:     #
                   13146:     # Create the identifier for the graph
                   13147:     my $identifier = &get_cgi_id();
                   13148:     my $id = 'cgi.'.$identifier;
                   13149:     #
                   13150:     $Title  = '' if (! defined($Title));
                   13151:     $xlabel = '' if (! defined($xlabel));
                   13152:     $ylabel = '' if (! defined($ylabel));
                   13153:     my %ValuesHash = 
                   13154:         (
1.369     www      13155:          $id.'.title'  => &escape($Title),
                   13156:          $id.'.xlabel' => &escape($xlabel),
                   13157:          $id.'.ylabel' => &escape($ylabel),
1.136     matthew  13158:          $id.'.labels' => join(',',@$Xlabels),
                   13159:          $id.'.PlotType' => 'XY',
                   13160:          $id.'.NumSets' => 2,
1.137     matthew  13161:          $id.'.two_axes' => 1,
                   13162:          $id.'.y1_max_value' => $Max1,
                   13163:          $id.'.y1_min_value' => $Min1,
                   13164:          $id.'.y2_max_value' => $Max2,
                   13165:          $id.'.y2_min_value' => $Min2,
1.136     matthew  13166:          );
                   13167:     #
1.137     matthew  13168:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   13169:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   13170:     }
                   13171:     #
                   13172:     if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
                   13173:         ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136     matthew  13174:         return '';
                   13175:     }
                   13176:     my $NumSets=1;
1.137     matthew  13177:     foreach my $array ($Ydata1,$Ydata2){
1.136     matthew  13178:         next if (! ref($array));
                   13179:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137     matthew  13180:     }
                   13181:     #
                   13182:     # Deal with other parameters
                   13183:     while (my ($key,$value) = each(%Values)) {
                   13184:         $ValuesHash{$id.'.'.$key} = $value;
1.136     matthew  13185:     }
                   13186:     #
1.646     raeburn  13187:     &Apache::lonnet::appenv(\%ValuesHash);
1.130     albertel 13188:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139     matthew  13189: }
                   13190: 
                   13191: ############################################################
                   13192: ############################################################
                   13193: 
                   13194: =pod
                   13195: 
1.157     matthew  13196: =back 
                   13197: 
1.139     matthew  13198: =head1 Statistics helper routines?  
                   13199: 
                   13200: Bad place for them but what the hell.
                   13201: 
1.157     matthew  13202: =over 4
                   13203: 
1.648     raeburn  13204: =item * &chartlink()
1.139     matthew  13205: 
                   13206: Returns a link to the chart for a specific student.  
                   13207: 
                   13208: Inputs:
                   13209: 
                   13210: =over 4
                   13211: 
                   13212: =item $linktext: The text of the link
                   13213: 
                   13214: =item $sname: The students username
                   13215: 
                   13216: =item $sdomain: The students domain
                   13217: 
                   13218: =back
                   13219: 
1.157     matthew  13220: =back
                   13221: 
1.139     matthew  13222: =cut
                   13223: 
                   13224: ############################################################
                   13225: ############################################################
                   13226: sub chartlink {
                   13227:     my ($linktext, $sname, $sdomain) = @_;
                   13228:     my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369     www      13229:         '&amp;SelectedStudent='.&escape($sname.':'.$sdomain).
1.219     albertel 13230:         '&amp;chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139     matthew  13231:        '">'.$linktext.'</a>';
1.153     matthew  13232: }
                   13233: 
                   13234: #######################################################
                   13235: #######################################################
                   13236: 
                   13237: =pod
                   13238: 
                   13239: =head1 Course Environment Routines
1.157     matthew  13240: 
                   13241: =over 4
1.153     matthew  13242: 
1.648     raeburn  13243: =item * &restore_course_settings()
1.153     matthew  13244: 
1.648     raeburn  13245: =item * &store_course_settings()
1.153     matthew  13246: 
                   13247: Restores/Store indicated form parameters from the course environment.
                   13248: Will not overwrite existing values of the form parameters.
                   13249: 
                   13250: Inputs: 
                   13251: a scalar describing the data (e.g. 'chart', 'problem_analysis')
                   13252: 
                   13253: a hash ref describing the data to be stored.  For example:
                   13254:    
                   13255: %Save_Parameters = ('Status' => 'scalar',
                   13256:     'chartoutputmode' => 'scalar',
                   13257:     'chartoutputdata' => 'scalar',
                   13258:     'Section' => 'array',
1.373     raeburn  13259:     'Group' => 'array',
1.153     matthew  13260:     'StudentData' => 'array',
                   13261:     'Maps' => 'array');
                   13262: 
                   13263: Returns: both routines return nothing
                   13264: 
1.631     raeburn  13265: =back
                   13266: 
1.153     matthew  13267: =cut
                   13268: 
                   13269: #######################################################
                   13270: #######################################################
                   13271: sub store_course_settings {
1.496     albertel 13272:     return &store_settings($env{'request.course.id'},@_);
                   13273: }
                   13274: 
                   13275: sub store_settings {
1.153     matthew  13276:     # save to the environment
                   13277:     # appenv the same items, just to be safe
1.300     albertel 13278:     my $udom  = $env{'user.domain'};
                   13279:     my $uname = $env{'user.name'};
1.496     albertel 13280:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  13281:     my %SaveHash;
                   13282:     my %AppHash;
                   13283:     while (my ($setting,$type) = each(%$Settings)) {
1.496     albertel 13284:         my $basename = join('.','internal',$context,$prefix,$setting);
1.300     albertel 13285:         my $envname = 'environment.'.$basename;
1.258     albertel 13286:         if (exists($env{'form.'.$setting})) {
1.153     matthew  13287:             # Save this value away
                   13288:             if ($type eq 'scalar' &&
1.258     albertel 13289:                 (! exists($env{$envname}) || 
                   13290:                  $env{$envname} ne $env{'form.'.$setting})) {
                   13291:                 $SaveHash{$basename} = $env{'form.'.$setting};
                   13292:                 $AppHash{$envname}   = $env{'form.'.$setting};
1.153     matthew  13293:             } elsif ($type eq 'array') {
                   13294:                 my $stored_form;
1.258     albertel 13295:                 if (ref($env{'form.'.$setting})) {
1.153     matthew  13296:                     $stored_form = join(',',
                   13297:                                         map {
1.369     www      13298:                                             &escape($_);
1.258     albertel 13299:                                         } sort(@{$env{'form.'.$setting}}));
1.153     matthew  13300:                 } else {
                   13301:                     $stored_form = 
1.369     www      13302:                         &escape($env{'form.'.$setting});
1.153     matthew  13303:                 }
                   13304:                 # Determine if the array contents are the same.
1.258     albertel 13305:                 if ($stored_form ne $env{$envname}) {
1.153     matthew  13306:                     $SaveHash{$basename} = $stored_form;
                   13307:                     $AppHash{$envname}   = $stored_form;
                   13308:                 }
                   13309:             }
                   13310:         }
                   13311:     }
                   13312:     my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300     albertel 13313:                                           $udom,$uname);
1.153     matthew  13314:     if ($put_result !~ /^(ok|delayed)/) {
                   13315:         &Apache::lonnet::logthis('unable to save form parameters, '.
                   13316:                                  'got error:'.$put_result);
                   13317:     }
                   13318:     # Make sure these settings stick around in this session, too
1.646     raeburn  13319:     &Apache::lonnet::appenv(\%AppHash);
1.153     matthew  13320:     return;
                   13321: }
                   13322: 
                   13323: sub restore_course_settings {
1.499     albertel 13324:     return &restore_settings($env{'request.course.id'},@_);
1.496     albertel 13325: }
                   13326: 
                   13327: sub restore_settings {
                   13328:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  13329:     while (my ($setting,$type) = each(%$Settings)) {
1.258     albertel 13330:         next if (exists($env{'form.'.$setting}));
1.496     albertel 13331:         my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153     matthew  13332:             '.'.$setting;
1.258     albertel 13333:         if (exists($env{$envname})) {
1.153     matthew  13334:             if ($type eq 'scalar') {
1.258     albertel 13335:                 $env{'form.'.$setting} = $env{$envname};
1.153     matthew  13336:             } elsif ($type eq 'array') {
1.258     albertel 13337:                 $env{'form.'.$setting} = [ 
1.153     matthew  13338:                                            map { 
1.369     www      13339:                                                &unescape($_); 
1.258     albertel 13340:                                            } split(',',$env{$envname})
1.153     matthew  13341:                                            ];
                   13342:             }
                   13343:         }
                   13344:     }
1.127     matthew  13345: }
                   13346: 
1.618     raeburn  13347: #######################################################
                   13348: #######################################################
                   13349: 
                   13350: =pod
                   13351: 
                   13352: =head1 Domain E-mail Routines  
                   13353: 
                   13354: =over 4
                   13355: 
1.648     raeburn  13356: =item * &build_recipient_list()
1.618     raeburn  13357: 
1.1075.2.44  raeburn  13358: Build recipient lists for following types of e-mail:
1.766     raeburn  13359: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.1075.2.44  raeburn  13360: (d) Help requests, (e) Course requests needing approval, (f) loncapa
                   13361: module change checking, student/employee ID conflict checks, as
                   13362: generated by lonerrorhandler.pm, CHECKRPMS, loncron,
                   13363: lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.
1.618     raeburn  13364: 
                   13365: Inputs:
1.1075.2.44  raeburn  13366: defmail (scalar - email address of default recipient),
                   13367: mailing type (scalar: errormail, packagesmail, helpdeskmail,
                   13368: requestsmail, updatesmail, or idconflictsmail).
                   13369: 
1.619     raeburn  13370: defdom (domain for which to retrieve configuration settings),
1.1075.2.44  raeburn  13371: 
                   13372: origmail (scalar - email address of recipient from loncapa.conf,
                   13373: i.e., predates configuration by DC via domainprefs.pm
1.618     raeburn  13374: 
1.655     raeburn  13375: Returns: comma separated list of addresses to which to send e-mail.
                   13376: 
                   13377: =back
1.618     raeburn  13378: 
                   13379: =cut
                   13380: 
                   13381: ############################################################
                   13382: ############################################################
                   13383: sub build_recipient_list {
1.619     raeburn  13384:     my ($defmail,$mailing,$defdom,$origmail) = @_;
1.618     raeburn  13385:     my @recipients;
                   13386:     my $otheremails;
                   13387:     my %domconfig =
                   13388:          &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
                   13389:     if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766     raeburn  13390:         if (exists($domconfig{'contacts'}{$mailing})) {
                   13391:             if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
                   13392:                 my @contacts = ('adminemail','supportemail');
                   13393:                 foreach my $item (@contacts) {
                   13394:                     if ($domconfig{'contacts'}{$mailing}{$item}) {
                   13395:                         my $addr = $domconfig{'contacts'}{$item}; 
                   13396:                         if (!grep(/^\Q$addr\E$/,@recipients)) {
                   13397:                             push(@recipients,$addr);
                   13398:                         }
1.619     raeburn  13399:                     }
1.766     raeburn  13400:                     $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
1.618     raeburn  13401:                 }
                   13402:             }
1.766     raeburn  13403:         } elsif ($origmail ne '') {
                   13404:             push(@recipients,$origmail);
1.618     raeburn  13405:         }
1.619     raeburn  13406:     } elsif ($origmail ne '') {
                   13407:         push(@recipients,$origmail);
1.618     raeburn  13408:     }
1.688     raeburn  13409:     if (defined($defmail)) {
                   13410:         if ($defmail ne '') {
                   13411:             push(@recipients,$defmail);
                   13412:         }
1.618     raeburn  13413:     }
                   13414:     if ($otheremails) {
1.619     raeburn  13415:         my @others;
                   13416:         if ($otheremails =~ /,/) {
                   13417:             @others = split(/,/,$otheremails);
1.618     raeburn  13418:         } else {
1.619     raeburn  13419:             push(@others,$otheremails);
                   13420:         }
                   13421:         foreach my $addr (@others) {
                   13422:             if (!grep(/^\Q$addr\E$/,@recipients)) {
                   13423:                 push(@recipients,$addr);
                   13424:             }
1.618     raeburn  13425:         }
                   13426:     }
1.619     raeburn  13427:     my $recipientlist = join(',',@recipients); 
1.618     raeburn  13428:     return $recipientlist;
                   13429: }
                   13430: 
1.127     matthew  13431: ############################################################
                   13432: ############################################################
1.154     albertel 13433: 
1.655     raeburn  13434: =pod
                   13435: 
                   13436: =head1 Course Catalog Routines
                   13437: 
                   13438: =over 4
                   13439: 
                   13440: =item * &gather_categories()
                   13441: 
                   13442: Converts category definitions - keys of categories hash stored in  
                   13443: coursecategories in configuration.db on the primary library server in a 
                   13444: domain - to an array.  Also generates javascript and idx hash used to 
                   13445: generate Domain Coordinator interface for editing Course Categories.
                   13446: 
                   13447: Inputs:
1.663     raeburn  13448: 
1.655     raeburn  13449: categories (reference to hash of category definitions).
1.663     raeburn  13450: 
1.655     raeburn  13451: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   13452:       categories and subcategories).
1.663     raeburn  13453: 
1.655     raeburn  13454: idx (reference to hash of counters used in Domain Coordinator interface for 
                   13455:       editing Course Categories).
1.663     raeburn  13456: 
1.655     raeburn  13457: jsarray (reference to array of categories used to create Javascript arrays for
                   13458:          Domain Coordinator interface for editing Course Categories).
                   13459: 
                   13460: Returns: nothing
                   13461: 
                   13462: Side effects: populates cats, idx and jsarray. 
                   13463: 
                   13464: =cut
                   13465: 
                   13466: sub gather_categories {
                   13467:     my ($categories,$cats,$idx,$jsarray) = @_;
                   13468:     my %counters;
                   13469:     my $num = 0;
                   13470:     foreach my $item (keys(%{$categories})) {
                   13471:         my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
                   13472:         if ($container eq '' && $depth == 0) {
                   13473:             $cats->[$depth][$categories->{$item}] = $cat;
                   13474:         } else {
                   13475:             $cats->[$depth]{$container}[$categories->{$item}] = $cat;
                   13476:         }
                   13477:         my ($escitem,$tail) = split(/:/,$item,2);
                   13478:         if ($counters{$tail} eq '') {
                   13479:             $counters{$tail} = $num;
                   13480:             $num ++;
                   13481:         }
                   13482:         if (ref($idx) eq 'HASH') {
                   13483:             $idx->{$item} = $counters{$tail};
                   13484:         }
                   13485:         if (ref($jsarray) eq 'ARRAY') {
                   13486:             push(@{$jsarray->[$counters{$tail}]},$item);
                   13487:         }
                   13488:     }
                   13489:     return;
                   13490: }
                   13491: 
                   13492: =pod
                   13493: 
                   13494: =item * &extract_categories()
                   13495: 
                   13496: Used to generate breadcrumb trails for course categories.
                   13497: 
                   13498: Inputs:
1.663     raeburn  13499: 
1.655     raeburn  13500: categories (reference to hash of category definitions).
1.663     raeburn  13501: 
1.655     raeburn  13502: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   13503:       categories and subcategories).
1.663     raeburn  13504: 
1.655     raeburn  13505: trails (reference to array of breacrumb trails for each category).
1.663     raeburn  13506: 
1.655     raeburn  13507: allitems (reference to hash - key is category key 
                   13508:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  13509: 
1.655     raeburn  13510: idx (reference to hash of counters used in Domain Coordinator interface for
                   13511:       editing Course Categories).
1.663     raeburn  13512: 
1.655     raeburn  13513: jsarray (reference to array of categories used to create Javascript arrays for
                   13514:          Domain Coordinator interface for editing Course Categories).
                   13515: 
1.665     raeburn  13516: subcats (reference to hash of arrays containing all subcategories within each 
                   13517:          category, -recursive)
                   13518: 
1.655     raeburn  13519: Returns: nothing
                   13520: 
                   13521: Side effects: populates trails and allitems hash references.
                   13522: 
                   13523: =cut
                   13524: 
                   13525: sub extract_categories {
1.665     raeburn  13526:     my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
1.655     raeburn  13527:     if (ref($categories) eq 'HASH') {
                   13528:         &gather_categories($categories,$cats,$idx,$jsarray);
                   13529:         if (ref($cats->[0]) eq 'ARRAY') {
                   13530:             for (my $i=0; $i<@{$cats->[0]}; $i++) {
                   13531:                 my $name = $cats->[0][$i];
                   13532:                 my $item = &escape($name).'::0';
                   13533:                 my $trailstr;
                   13534:                 if ($name eq 'instcode') {
                   13535:                     $trailstr = &mt('Official courses (with institutional codes)');
1.919     raeburn  13536:                 } elsif ($name eq 'communities') {
                   13537:                     $trailstr = &mt('Communities');
1.655     raeburn  13538:                 } else {
                   13539:                     $trailstr = $name;
                   13540:                 }
                   13541:                 if ($allitems->{$item} eq '') {
                   13542:                     push(@{$trails},$trailstr);
                   13543:                     $allitems->{$item} = scalar(@{$trails})-1;
                   13544:                 }
                   13545:                 my @parents = ($name);
                   13546:                 if (ref($cats->[1]{$name}) eq 'ARRAY') {
                   13547:                     for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
                   13548:                         my $category = $cats->[1]{$name}[$j];
1.665     raeburn  13549:                         if (ref($subcats) eq 'HASH') {
                   13550:                             push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
                   13551:                         }
                   13552:                         &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
                   13553:                     }
                   13554:                 } else {
                   13555:                     if (ref($subcats) eq 'HASH') {
                   13556:                         $subcats->{$item} = [];
1.655     raeburn  13557:                     }
                   13558:                 }
                   13559:             }
                   13560:         }
                   13561:     }
                   13562:     return;
                   13563: }
                   13564: 
                   13565: =pod
                   13566: 
1.1075.2.56  raeburn  13567: =item * &recurse_categories()
1.655     raeburn  13568: 
                   13569: Recursively used to generate breadcrumb trails for course categories.
                   13570: 
                   13571: Inputs:
1.663     raeburn  13572: 
1.655     raeburn  13573: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   13574:       categories and subcategories).
1.663     raeburn  13575: 
1.655     raeburn  13576: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663     raeburn  13577: 
                   13578: category (current course category, for which breadcrumb trail is being generated).
                   13579: 
                   13580: trails (reference to array of breadcrumb trails for each category).
                   13581: 
1.655     raeburn  13582: allitems (reference to hash - key is category key
                   13583:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  13584: 
1.655     raeburn  13585: parents (array containing containers directories for current category, 
                   13586:          back to top level). 
                   13587: 
                   13588: Returns: nothing
                   13589: 
                   13590: Side effects: populates trails and allitems hash references
                   13591: 
                   13592: =cut
                   13593: 
                   13594: sub recurse_categories {
1.665     raeburn  13595:     my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
1.655     raeburn  13596:     my $shallower = $depth - 1;
                   13597:     if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
                   13598:         for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
                   13599:             my $name = $cats->[$depth]{$category}[$k];
                   13600:             my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   13601:             my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   13602:             if ($allitems->{$item} eq '') {
                   13603:                 push(@{$trails},$trailstr);
                   13604:                 $allitems->{$item} = scalar(@{$trails})-1;
                   13605:             }
                   13606:             my $deeper = $depth+1;
                   13607:             push(@{$parents},$category);
1.665     raeburn  13608:             if (ref($subcats) eq 'HASH') {
                   13609:                 my $subcat = &escape($name).':'.$category.':'.$depth;
                   13610:                 for (my $j=@{$parents}; $j>=0; $j--) {
                   13611:                     my $higher;
                   13612:                     if ($j > 0) {
                   13613:                         $higher = &escape($parents->[$j]).':'.
                   13614:                                   &escape($parents->[$j-1]).':'.$j;
                   13615:                     } else {
                   13616:                         $higher = &escape($parents->[$j]).'::'.$j;
                   13617:                     }
                   13618:                     push(@{$subcats->{$higher}},$subcat);
                   13619:                 }
                   13620:             }
                   13621:             &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
                   13622:                                 $subcats);
1.655     raeburn  13623:             pop(@{$parents});
                   13624:         }
                   13625:     } else {
                   13626:         my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   13627:         my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   13628:         if ($allitems->{$item} eq '') {
                   13629:             push(@{$trails},$trailstr);
                   13630:             $allitems->{$item} = scalar(@{$trails})-1;
                   13631:         }
                   13632:     }
                   13633:     return;
                   13634: }
                   13635: 
1.663     raeburn  13636: =pod
                   13637: 
1.1075.2.56  raeburn  13638: =item * &assign_categories_table()
1.663     raeburn  13639: 
                   13640: Create a datatable for display of hierarchical categories in a domain,
                   13641: with checkboxes to allow a course to be categorized. 
                   13642: 
                   13643: Inputs:
                   13644: 
                   13645: cathash - reference to hash of categories defined for the domain (from
                   13646:           configuration.db)
                   13647: 
                   13648: currcat - scalar with an & separated list of categories assigned to a course. 
                   13649: 
1.919     raeburn  13650: type    - scalar contains course type (Course or Community).
                   13651: 
1.663     raeburn  13652: Returns: $output (markup to be displayed) 
                   13653: 
                   13654: =cut
                   13655: 
                   13656: sub assign_categories_table {
1.919     raeburn  13657:     my ($cathash,$currcat,$type) = @_;
1.663     raeburn  13658:     my $output;
                   13659:     if (ref($cathash) eq 'HASH') {
                   13660:         my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
                   13661:         &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
                   13662:         $maxdepth = scalar(@cats);
                   13663:         if (@cats > 0) {
                   13664:             my $itemcount = 0;
                   13665:             if (ref($cats[0]) eq 'ARRAY') {
                   13666:                 my @currcategories;
                   13667:                 if ($currcat ne '') {
                   13668:                     @currcategories = split('&',$currcat);
                   13669:                 }
1.919     raeburn  13670:                 my $table;
1.663     raeburn  13671:                 for (my $i=0; $i<@{$cats[0]}; $i++) {
                   13672:                     my $parent = $cats[0][$i];
1.919     raeburn  13673:                     next if ($parent eq 'instcode');
                   13674:                     if ($type eq 'Community') {
                   13675:                         next unless ($parent eq 'communities');
                   13676:                     } else {
                   13677:                         next if ($parent eq 'communities');
                   13678:                     }
1.663     raeburn  13679:                     my $css_class = $itemcount%2?' class="LC_odd_row"':'';
                   13680:                     my $item = &escape($parent).'::0';
                   13681:                     my $checked = '';
                   13682:                     if (@currcategories > 0) {
                   13683:                         if (grep(/^\Q$item\E$/,@currcategories)) {
1.772     bisitz   13684:                             $checked = ' checked="checked"';
1.663     raeburn  13685:                         }
                   13686:                     }
1.919     raeburn  13687:                     my $parent_title = $parent;
                   13688:                     if ($parent eq 'communities') {
                   13689:                         $parent_title = &mt('Communities');
                   13690:                     }
                   13691:                     $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
                   13692:                               '<input type="checkbox" name="usecategory" value="'.
                   13693:                               $item.'"'.$checked.' />'.$parent_title.'</span>'.
                   13694:                               '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663     raeburn  13695:                     my $depth = 1;
                   13696:                     push(@path,$parent);
1.919     raeburn  13697:                     $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);
1.663     raeburn  13698:                     pop(@path);
1.919     raeburn  13699:                     $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663     raeburn  13700:                     $itemcount ++;
                   13701:                 }
1.919     raeburn  13702:                 if ($itemcount) {
                   13703:                     $output = &Apache::loncommon::start_data_table().
                   13704:                               $table.
                   13705:                               &Apache::loncommon::end_data_table();
                   13706:                 }
1.663     raeburn  13707:             }
                   13708:         }
                   13709:     }
                   13710:     return $output;
                   13711: }
                   13712: 
                   13713: =pod
                   13714: 
1.1075.2.56  raeburn  13715: =item * &assign_category_rows()
1.663     raeburn  13716: 
                   13717: Create a datatable row for display of nested categories in a domain,
                   13718: with checkboxes to allow a course to be categorized,called recursively.
                   13719: 
                   13720: Inputs:
                   13721: 
                   13722: itemcount - track row number for alternating colors
                   13723: 
                   13724: cats - reference to array of arrays/hashes which encapsulates hierarchy of
                   13725:       categories and subcategories.
                   13726: 
                   13727: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
                   13728: 
                   13729: parent - parent of current category item
                   13730: 
                   13731: path - Array containing all categories back up through the hierarchy from the
                   13732:        current category to the top level.
                   13733: 
                   13734: currcategories - reference to array of current categories assigned to the course
                   13735: 
                   13736: Returns: $output (markup to be displayed).
                   13737: 
                   13738: =cut
                   13739: 
                   13740: sub assign_category_rows {
                   13741:     my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_;
                   13742:     my ($text,$name,$item,$chgstr);
                   13743:     if (ref($cats) eq 'ARRAY') {
                   13744:         my $maxdepth = scalar(@{$cats});
                   13745:         if (ref($cats->[$depth]) eq 'HASH') {
                   13746:             if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
                   13747:                 my $numchildren = @{$cats->[$depth]{$parent}};
                   13748:                 my $css_class = $itemcount%2?' class="LC_odd_row"':'';
1.1075.2.45  raeburn  13749:                 $text .= '<td><table class="LC_data_table">';
1.663     raeburn  13750:                 for (my $j=0; $j<$numchildren; $j++) {
                   13751:                     $name = $cats->[$depth]{$parent}[$j];
                   13752:                     $item = &escape($name).':'.&escape($parent).':'.$depth;
                   13753:                     my $deeper = $depth+1;
                   13754:                     my $checked = '';
                   13755:                     if (ref($currcategories) eq 'ARRAY') {
                   13756:                         if (@{$currcategories} > 0) {
                   13757:                             if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772     bisitz   13758:                                 $checked = ' checked="checked"';
1.663     raeburn  13759:                             }
                   13760:                         }
                   13761:                     }
1.664     raeburn  13762:                     $text .= '<tr><td><span class="LC_nobreak"><label>'.
                   13763:                              '<input type="checkbox" name="usecategory" value="'.
1.675     raeburn  13764:                              $item.'"'.$checked.' />'.$name.'</label></span>'.
                   13765:                              '<input type="hidden" name="catname" value="'.$name.'" />'.
                   13766:                              '</td><td>';
1.663     raeburn  13767:                     if (ref($path) eq 'ARRAY') {
                   13768:                         push(@{$path},$name);
                   13769:                         $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);
                   13770:                         pop(@{$path});
                   13771:                     }
                   13772:                     $text .= '</td></tr>';
                   13773:                 }
                   13774:                 $text .= '</table></td>';
                   13775:             }
                   13776:         }
                   13777:     }
                   13778:     return $text;
                   13779: }
                   13780: 
1.1075.2.69  raeburn  13781: =pod
                   13782: 
                   13783: =back
                   13784: 
                   13785: =cut
                   13786: 
1.655     raeburn  13787: ############################################################
                   13788: ############################################################
                   13789: 
                   13790: 
1.443     albertel 13791: sub commit_customrole {
1.664     raeburn  13792:     my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630     raeburn  13793:     my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443     albertel 13794:                          ($start?', '.&mt('starting').' '.localtime($start):'').
                   13795:                          ($end?', ending '.localtime($end):'').': <b>'.
                   13796:               &Apache::lonnet::assigncustomrole(
1.664     raeburn  13797:                  $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443     albertel 13798:                  '</b><br />';
                   13799:     return $output;
                   13800: }
                   13801: 
                   13802: sub commit_standardrole {
1.1075.2.31  raeburn  13803:     my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits) = @_;
1.541     raeburn  13804:     my ($output,$logmsg,$linefeed);
                   13805:     if ($context eq 'auto') {
                   13806:         $linefeed = "\n";
                   13807:     } else {
                   13808:         $linefeed = "<br />\n";
                   13809:     }  
1.443     albertel 13810:     if ($three eq 'st') {
1.541     raeburn  13811:         my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
1.1075.2.31  raeburn  13812:                                          $one,$two,$sec,$context,$credits);
1.541     raeburn  13813:         if (($result =~ /^error/) || ($result eq 'not_in_class') || 
1.626     raeburn  13814:             ($result eq 'unknown_course') || ($result eq 'refused')) {
                   13815:             $output = $logmsg.' '.&mt('Error: ').$result."\n"; 
1.443     albertel 13816:         } else {
1.541     raeburn  13817:             $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443     albertel 13818:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  13819:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
                   13820:             if ($context eq 'auto') {
                   13821:                 $output .= $result.$linefeed.&mt('Add to classlist').': ok';
                   13822:             } else {
                   13823:                $output .= '<b>'.$result.'</b>'.$linefeed.
                   13824:                &mt('Add to classlist').': <b>ok</b>';
                   13825:             }
                   13826:             $output .= $linefeed;
1.443     albertel 13827:         }
                   13828:     } else {
                   13829:         $output = &mt('Assigning').' '.$three.' in '.$url.
                   13830:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  13831:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652     raeburn  13832:         my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541     raeburn  13833:         if ($context eq 'auto') {
                   13834:             $output .= $result.$linefeed;
                   13835:         } else {
                   13836:             $output .= '<b>'.$result.'</b>'.$linefeed;
                   13837:         }
1.443     albertel 13838:     }
                   13839:     return $output;
                   13840: }
                   13841: 
                   13842: sub commit_studentrole {
1.1075.2.31  raeburn  13843:     my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,
                   13844:         $credits) = @_;
1.626     raeburn  13845:     my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541     raeburn  13846:     if ($context eq 'auto') {
                   13847:         $linefeed = "\n";
                   13848:     } else {
                   13849:         $linefeed = '<br />'."\n";
                   13850:     }
1.443     albertel 13851:     if (defined($one) && defined($two)) {
                   13852:         my $cid=$one.'_'.$two;
                   13853:         my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
                   13854:         my $secchange = 0;
                   13855:         my $expire_role_result;
                   13856:         my $modify_section_result;
1.628     raeburn  13857:         if ($oldsec ne '-1') { 
                   13858:             if ($oldsec ne $sec) {
1.443     albertel 13859:                 $secchange = 1;
1.628     raeburn  13860:                 my $now = time;
1.443     albertel 13861:                 my $uurl='/'.$cid;
                   13862:                 $uurl=~s/\_/\//g;
                   13863:                 if ($oldsec) {
                   13864:                     $uurl.='/'.$oldsec;
                   13865:                 }
1.626     raeburn  13866:                 $oldsecurl = $uurl;
1.628     raeburn  13867:                 $expire_role_result = 
1.652     raeburn  13868:                     &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628     raeburn  13869:                 if ($env{'request.course.sec'} ne '') { 
                   13870:                     if ($expire_role_result eq 'refused') {
                   13871:                         my @roles = ('st');
                   13872:                         my @statuses = ('previous');
                   13873:                         my @roledoms = ($one);
                   13874:                         my $withsec = 1;
                   13875:                         my %roleshash = 
                   13876:                             &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
                   13877:                                               \@statuses,\@roles,\@roledoms,$withsec);
                   13878:                         if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
                   13879:                             my ($oldstart,$oldend) = 
                   13880:                                 split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
                   13881:                             if ($oldend > 0 && $oldend <= $now) {
                   13882:                                 $expire_role_result = 'ok';
                   13883:                             }
                   13884:                         }
                   13885:                     }
                   13886:                 }
1.443     albertel 13887:                 $result = $expire_role_result;
                   13888:             }
                   13889:         }
                   13890:         if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.1075.2.31  raeburn  13891:             $modify_section_result = 
                   13892:                 &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
                   13893:                                                            undef,undef,undef,$sec,
                   13894:                                                            $end,$start,'','',$cid,
                   13895:                                                            '',$context,$credits);
1.443     albertel 13896:             if ($modify_section_result =~ /^ok/) {
                   13897:                 if ($secchange == 1) {
1.628     raeburn  13898:                     if ($sec eq '') {
                   13899:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
                   13900:                     } else {
                   13901:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
                   13902:                     }
1.443     albertel 13903:                 } elsif ($oldsec eq '-1') {
1.628     raeburn  13904:                     if ($sec eq '') {
                   13905:                         $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
                   13906:                     } else {
                   13907:                         $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   13908:                     }
1.443     albertel 13909:                 } else {
1.628     raeburn  13910:                     if ($sec eq '') {
                   13911:                         $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
                   13912:                     } else {
                   13913:                         $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   13914:                     }
1.443     albertel 13915:                 }
                   13916:             } else {
1.628     raeburn  13917:                 if ($secchange) {       
                   13918:                     $$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;
                   13919:                 } else {
                   13920:                     $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
                   13921:                 }
1.443     albertel 13922:             }
                   13923:             $result = $modify_section_result;
                   13924:         } elsif ($secchange == 1) {
1.628     raeburn  13925:             if ($oldsec eq '') {
1.1075.2.20  raeburn  13926:                 $$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  13927:             } else {
                   13928:                 $$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;
                   13929:             }
1.626     raeburn  13930:             if ($expire_role_result eq 'refused') {
                   13931:                 my $newsecurl = '/'.$cid;
                   13932:                 $newsecurl =~ s/\_/\//g;
                   13933:                 if ($sec ne '') {
                   13934:                     $newsecurl.='/'.$sec;
                   13935:                 }
                   13936:                 if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
                   13937:                     if ($sec eq '') {
                   13938:                         $$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;
                   13939:                     } else {
                   13940:                         $$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;
                   13941:                     }
                   13942:                 }
                   13943:             }
1.443     albertel 13944:         }
                   13945:     } else {
1.626     raeburn  13946:         $$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 13947:         $result = "error: incomplete course id\n";
                   13948:     }
                   13949:     return $result;
                   13950: }
                   13951: 
1.1075.2.25  raeburn  13952: sub show_role_extent {
                   13953:     my ($scope,$context,$role) = @_;
                   13954:     $scope =~ s{^/}{};
                   13955:     my @courseroles = &Apache::lonuserutils::roles_by_context('course',1);
                   13956:     push(@courseroles,'co');
                   13957:     my @authorroles = &Apache::lonuserutils::roles_by_context('author');
                   13958:     if (($context eq 'course') || (grep(/^\Q$role\E/,@courseroles))) {
                   13959:         $scope =~ s{/}{_};
                   13960:         return '<span class="LC_cusr_emph">'.$env{'course.'.$scope.'.description'}.'</span>';
                   13961:     } elsif (($context eq 'author') || (grep(/^\Q$role\E/,@authorroles))) {
                   13962:         my ($audom,$auname) = split(/\//,$scope);
                   13963:         return &mt('[_1] Author Space','<span class="LC_cusr_emph">'.
                   13964:                    &Apache::loncommon::plainname($auname,$audom).'</span>');
                   13965:     } else {
                   13966:         $scope =~ s{/$}{};
                   13967:         return &mt('Domain: [_1]','<span class="LC_cusr_emph">'.
                   13968:                    &Apache::lonnet::domain($scope,'description').'</span>');
                   13969:     }
                   13970: }
                   13971: 
1.443     albertel 13972: ############################################################
                   13973: ############################################################
                   13974: 
1.566     albertel 13975: sub check_clone {
1.578     raeburn  13976:     my ($args,$linefeed) = @_;
1.566     albertel 13977:     my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
                   13978:     my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
                   13979:     my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
                   13980:     my $clonemsg;
                   13981:     my $can_clone = 0;
1.944     raeburn  13982:     my $lctype = lc($args->{'crstype'});
1.908     raeburn  13983:     if ($lctype ne 'community') {
                   13984:         $lctype = 'course';
                   13985:     }
1.566     albertel 13986:     if ($clonehome eq 'no_host') {
1.944     raeburn  13987:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  13988:             $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'});
                   13989:         } else {
                   13990:             $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'});
                   13991:         }     
1.566     albertel 13992:     } else {
                   13993: 	my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.944     raeburn  13994:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  13995:             if ($clonedesc{'type'} ne 'Community') {
                   13996:                  $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'});
                   13997:                 return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   13998:             }
                   13999:         }
1.882     raeburn  14000: 	if (($env{'request.role.domain'} eq $args->{'clonedomain'}) && 
                   14001:             (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566     albertel 14002: 	    $can_clone = 1;
                   14003: 	} else {
                   14004: 	    my %clonehash = &Apache::lonnet::get('environment',['cloners'],
                   14005: 						 $args->{'clonedomain'},$args->{'clonecourse'});
                   14006: 	    my @cloners = split(/,/,$clonehash{'cloners'});
1.578     raeburn  14007:             if (grep(/^\*$/,@cloners)) {
                   14008:                 $can_clone = 1;
                   14009:             } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
                   14010:                 $can_clone = 1;
                   14011:             } else {
1.908     raeburn  14012:                 my $ccrole = 'cc';
1.944     raeburn  14013:                 if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  14014:                     $ccrole = 'co';
                   14015:                 }
1.578     raeburn  14016: 	        my %roleshash =
                   14017: 		    &Apache::lonnet::get_my_roles($args->{'ccuname'},
                   14018: 					 $args->{'ccdomain'},
1.908     raeburn  14019:                                          'userroles',['active'],[$ccrole],
1.578     raeburn  14020: 					 [$args->{'clonedomain'}]);
1.908     raeburn  14021: 	        if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {
1.942     raeburn  14022:                     $can_clone = 1;
                   14023:                 } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},$args->{'ccuname'},$args->{'ccdomain'})) {
                   14024:                     $can_clone = 1;
                   14025:                 } else {
1.944     raeburn  14026:                     if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  14027:                         $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'});
                   14028:                     } else {
                   14029:                         $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'});
                   14030:                     }
1.578     raeburn  14031: 	        }
1.566     albertel 14032: 	    }
1.578     raeburn  14033:         }
1.566     albertel 14034:     }
                   14035:     return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   14036: }
                   14037: 
1.444     albertel 14038: sub construct_course {
1.1075.2.59  raeburn  14039:     my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category,$coderef) = @_;
1.444     albertel 14040:     my $outcome;
1.541     raeburn  14041:     my $linefeed =  '<br />'."\n";
                   14042:     if ($context eq 'auto') {
                   14043:         $linefeed = "\n";
                   14044:     }
1.566     albertel 14045: 
                   14046: #
                   14047: # Are we cloning?
                   14048: #
                   14049:     my ($can_clone, $clonemsg, $cloneid, $clonehome);
                   14050:     if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578     raeburn  14051: 	($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566     albertel 14052: 	if ($context ne 'auto') {
1.578     raeburn  14053:             if ($clonemsg ne '') {
                   14054: 	        $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
                   14055:             }
1.566     albertel 14056: 	}
                   14057: 	$outcome .= $clonemsg.$linefeed;
                   14058: 
                   14059:         if (!$can_clone) {
                   14060: 	    return (0,$outcome);
                   14061: 	}
                   14062:     }
                   14063: 
1.444     albertel 14064: #
                   14065: # Open course
                   14066: #
                   14067:     my $crstype = lc($args->{'crstype'});
                   14068:     my %cenv=();
                   14069:     $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
                   14070:                                              $args->{'cdescr'},
                   14071:                                              $args->{'curl'},
                   14072:                                              $args->{'course_home'},
                   14073:                                              $args->{'nonstandard'},
                   14074:                                              $args->{'crscode'},
                   14075:                                              $args->{'ccuname'}.':'.
                   14076:                                              $args->{'ccdomain'},
1.882     raeburn  14077:                                              $args->{'crstype'},
1.885     raeburn  14078:                                              $cnum,$context,$category);
1.444     albertel 14079: 
                   14080:     # Note: The testing routines depend on this being output; see 
                   14081:     # Utils::Course. This needs to at least be output as a comment
                   14082:     # if anyone ever decides to not show this, and Utils::Course::new
                   14083:     # will need to be suitably modified.
1.541     raeburn  14084:     $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
1.943     raeburn  14085:     if ($$courseid =~ /^error:/) {
                   14086:         return (0,$outcome);
                   14087:     }
                   14088: 
1.444     albertel 14089: #
                   14090: # Check if created correctly
                   14091: #
1.479     albertel 14092:     ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444     albertel 14093:     my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943     raeburn  14094:     if ($crsuhome eq 'no_host') {
                   14095:         $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
                   14096:         return (0,$outcome);
                   14097:     }
1.541     raeburn  14098:     $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566     albertel 14099: 
1.444     albertel 14100: #
1.566     albertel 14101: # Do the cloning
                   14102: #   
                   14103:     if ($can_clone && $cloneid) {
                   14104: 	$clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
                   14105: 	if ($context ne 'auto') {
                   14106: 	    $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
                   14107: 	}
                   14108: 	$outcome .= $clonemsg.$linefeed;
                   14109: 	my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444     albertel 14110: # Copy all files
1.637     www      14111: 	&Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444     albertel 14112: # Restore URL
1.566     albertel 14113: 	$cenv{'url'}=$oldcenv{'url'};
1.444     albertel 14114: # Restore title
1.566     albertel 14115: 	$cenv{'description'}=$oldcenv{'description'};
1.955     raeburn  14116: # Restore creation date, creator and creation context.
                   14117:         $cenv{'internal.created'}=$oldcenv{'internal.created'};
                   14118:         $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
                   14119:         $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444     albertel 14120: # Mark as cloned
1.566     albertel 14121: 	$cenv{'clonedfrom'}=$cloneid;
1.638     www      14122: # Need to clone grading mode
                   14123:         my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
                   14124:         $cenv{'grading'}=$newenv{'grading'};
                   14125: # Do not clone these environment entries
                   14126:         &Apache::lonnet::del('environment',
                   14127:                   ['default_enrollment_start_date',
                   14128:                    'default_enrollment_end_date',
                   14129:                    'question.email',
                   14130:                    'policy.email',
                   14131:                    'comment.email',
                   14132:                    'pch.users.denied',
1.725     raeburn  14133:                    'plc.users.denied',
                   14134:                    'hidefromcat',
1.1075.2.36  raeburn  14135:                    'checkforpriv',
1.1075.2.59  raeburn  14136:                    'categories',
                   14137:                    'internal.uniquecode'],
1.638     www      14138:                    $$crsudom,$$crsunum);
1.1075.2.63  raeburn  14139:         if ($args->{'textbook'}) {
                   14140:             $cenv{'internal.textbook'} = $args->{'textbook'};
                   14141:         }
1.444     albertel 14142:     }
1.566     albertel 14143: 
1.444     albertel 14144: #
                   14145: # Set environment (will override cloned, if existing)
                   14146: #
                   14147:     my @sections = ();
                   14148:     my @xlists = ();
                   14149:     if ($args->{'crstype'}) {
                   14150:         $cenv{'type'}=$args->{'crstype'};
                   14151:     }
                   14152:     if ($args->{'crsid'}) {
                   14153:         $cenv{'courseid'}=$args->{'crsid'};
                   14154:     }
                   14155:     if ($args->{'crscode'}) {
                   14156:         $cenv{'internal.coursecode'}=$args->{'crscode'};
                   14157:     }
                   14158:     if ($args->{'crsquota'} ne '') {
                   14159:         $cenv{'internal.coursequota'}=$args->{'crsquota'};
                   14160:     } else {
                   14161:         $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
                   14162:     }
                   14163:     if ($args->{'ccuname'}) {
                   14164:         $cenv{'internal.courseowner'} = $args->{'ccuname'}.
                   14165:                                         ':'.$args->{'ccdomain'};
                   14166:     } else {
                   14167:         $cenv{'internal.courseowner'} = $args->{'curruser'};
                   14168:     }
1.1075.2.31  raeburn  14169:     if ($args->{'defaultcredits'}) {
                   14170:         $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};
                   14171:     }
1.444     albertel 14172:     my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
                   14173:     if ($args->{'crssections'}) {
                   14174:         $cenv{'internal.sectionnums'} = '';
                   14175:         if ($args->{'crssections'} =~ m/,/) {
                   14176:             @sections = split/,/,$args->{'crssections'};
                   14177:         } else {
                   14178:             $sections[0] = $args->{'crssections'};
                   14179:         }
                   14180:         if (@sections > 0) {
                   14181:             foreach my $item (@sections) {
                   14182:                 my ($sec,$gp) = split/:/,$item;
                   14183:                 my $class = $args->{'crscode'}.$sec;
                   14184:                 my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
                   14185:                 $cenv{'internal.sectionnums'} .= $item.',';
                   14186:                 unless ($addcheck eq 'ok') {
                   14187:                     push @badclasses, $class;
                   14188:                 }
                   14189:             }
                   14190:             $cenv{'internal.sectionnums'} =~ s/,$//;
                   14191:         }
                   14192:     }
                   14193: # do not hide course coordinator from staff listing, 
                   14194: # even if privileged
                   14195:     $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
1.1075.2.36  raeburn  14196: # add course coordinator's domain to domains to check for privileged users
                   14197: # if different to course domain
                   14198:     if ($$crsudom ne $args->{'ccdomain'}) {
                   14199:         $cenv{'checkforpriv'} = $args->{'ccdomain'};
                   14200:     }
1.444     albertel 14201: # add crosslistings
                   14202:     if ($args->{'crsxlist'}) {
                   14203:         $cenv{'internal.crosslistings'}='';
                   14204:         if ($args->{'crsxlist'} =~ m/,/) {
                   14205:             @xlists = split/,/,$args->{'crsxlist'};
                   14206:         } else {
                   14207:             $xlists[0] = $args->{'crsxlist'};
                   14208:         }
                   14209:         if (@xlists > 0) {
                   14210:             foreach my $item (@xlists) {
                   14211:                 my ($xl,$gp) = split/:/,$item;
                   14212:                 my $addcheck =  &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
                   14213:                 $cenv{'internal.crosslistings'} .= $item.',';
                   14214:                 unless ($addcheck eq 'ok') {
                   14215:                     push @badclasses, $xl;
                   14216:                 }
                   14217:             }
                   14218:             $cenv{'internal.crosslistings'} =~ s/,$//;
                   14219:         }
                   14220:     }
                   14221:     if ($args->{'autoadds'}) {
                   14222:         $cenv{'internal.autoadds'}=$args->{'autoadds'};
                   14223:     }
                   14224:     if ($args->{'autodrops'}) {
                   14225:         $cenv{'internal.autodrops'}=$args->{'autodrops'};
                   14226:     }
                   14227: # check for notification of enrollment changes
                   14228:     my @notified = ();
                   14229:     if ($args->{'notify_owner'}) {
                   14230:         if ($args->{'ccuname'} ne '') {
                   14231:             push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
                   14232:         }
                   14233:     }
                   14234:     if ($args->{'notify_dc'}) {
                   14235:         if ($uname ne '') { 
1.630     raeburn  14236:             push(@notified,$uname.':'.$udom);
1.444     albertel 14237:         }
                   14238:     }
                   14239:     if (@notified > 0) {
                   14240:         my $notifylist;
                   14241:         if (@notified > 1) {
                   14242:             $notifylist = join(',',@notified);
                   14243:         } else {
                   14244:             $notifylist = $notified[0];
                   14245:         }
                   14246:         $cenv{'internal.notifylist'} = $notifylist;
                   14247:     }
                   14248:     if (@badclasses > 0) {
                   14249:         my %lt=&Apache::lonlocal::texthash(
                   14250:                 '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',
                   14251:                 'dnhr' => 'does not have rights to access enrollment in these classes',
                   14252:                 'adby' => 'as determined by the policies of your institution on access to official classlists'
                   14253:         );
1.541     raeburn  14254:         my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
                   14255:                            ' ('.$lt{'adby'}.')';
                   14256:         if ($context eq 'auto') {
                   14257:             $outcome .= $badclass_msg.$linefeed;
1.566     albertel 14258:             $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.541     raeburn  14259:             foreach my $item (@badclasses) {
                   14260:                 if ($context eq 'auto') {
                   14261:                     $outcome .= " - $item\n";
                   14262:                 } else {
                   14263:                     $outcome .= "<li>$item</li>\n";
                   14264:                 }
                   14265:             }
                   14266:             if ($context eq 'auto') {
                   14267:                 $outcome .= $linefeed;
                   14268:             } else {
1.566     albertel 14269:                 $outcome .= "</ul><br /><br /></div>\n";
1.541     raeburn  14270:             }
                   14271:         } 
1.444     albertel 14272:     }
                   14273:     if ($args->{'no_end_date'}) {
                   14274:         $args->{'endaccess'} = 0;
                   14275:     }
                   14276:     $cenv{'internal.autostart'}=$args->{'enrollstart'};
                   14277:     $cenv{'internal.autoend'}=$args->{'enrollend'};
                   14278:     $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
                   14279:     $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
                   14280:     if ($args->{'showphotos'}) {
                   14281:       $cenv{'internal.showphotos'}=$args->{'showphotos'};
                   14282:     }
                   14283:     $cenv{'internal.authtype'} = $args->{'authtype'};
                   14284:     $cenv{'internal.autharg'} = $args->{'autharg'}; 
                   14285:     if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
                   14286:         if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'}  eq '') {
1.541     raeburn  14287:             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'); 
                   14288:             if ($context eq 'auto') {
                   14289:                 $outcome .= $krb_msg;
                   14290:             } else {
1.566     albertel 14291:                 $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541     raeburn  14292:             }
                   14293:             $outcome .= $linefeed;
1.444     albertel 14294:         }
                   14295:     }
                   14296:     if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
                   14297:        if ($args->{'setpolicy'}) {
                   14298:            $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   14299:        }
                   14300:        if ($args->{'setcontent'}) {
                   14301:            $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   14302:        }
                   14303:     }
                   14304:     if ($args->{'reshome'}) {
                   14305: 	$cenv{'reshome'}=$args->{'reshome'}.'/';
                   14306: 	$cenv{'reshome'}=~s/\/+$/\//;
                   14307:     }
                   14308: #
                   14309: # course has keyed access
                   14310: #
                   14311:     if ($args->{'setkeys'}) {
                   14312:        $cenv{'keyaccess'}='yes';
                   14313:     }
                   14314: # if specified, key authority is not course, but user
                   14315: # only active if keyaccess is yes
                   14316:     if ($args->{'keyauth'}) {
1.487     albertel 14317: 	my ($user,$domain) = split(':',$args->{'keyauth'});
                   14318: 	$user = &LONCAPA::clean_username($user);
                   14319: 	$domain = &LONCAPA::clean_username($domain);
1.488     foxr     14320: 	if ($user ne '' && $domain ne '') {
1.487     albertel 14321: 	    $cenv{'keyauth'}=$user.':'.$domain;
1.444     albertel 14322: 	}
                   14323:     }
                   14324: 
1.1075.2.59  raeburn  14325: #
                   14326: #  generate and store uniquecode (available to course requester), if course should have one.
                   14327: #
                   14328:     if ($args->{'uniquecode'}) {
                   14329:         my ($code,$error) = &make_unique_code($$crsudom,$$crsunum);
                   14330:         if ($code) {
                   14331:             $cenv{'internal.uniquecode'} = $code;
                   14332:             my %crsinfo =
                   14333:                 &Apache::lonnet::courseiddump($$crsudom,'.',1,'.','.',$$crsunum,undef,undef,'.');
                   14334:             if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') {
                   14335:                 $crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code;
                   14336:                 my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime');
                   14337:             }
                   14338:             if (ref($coderef)) {
                   14339:                 $$coderef = $code;
                   14340:             }
                   14341:         }
                   14342:     }
                   14343: 
1.444     albertel 14344:     if ($args->{'disresdis'}) {
                   14345:         $cenv{'pch.roles.denied'}='st';
                   14346:     }
                   14347:     if ($args->{'disablechat'}) {
                   14348:         $cenv{'plc.roles.denied'}='st';
                   14349:     }
                   14350: 
                   14351:     # Record we've not yet viewed the Course Initialization Helper for this 
                   14352:     # course
                   14353:     $cenv{'course.helper.not.run'} = 1;
                   14354:     #
                   14355:     # Use new Randomseed
                   14356:     #
                   14357:     $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
                   14358:     $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
                   14359:     #
                   14360:     # The encryption code and receipt prefix for this course
                   14361:     #
                   14362:     $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
                   14363:     $cenv{'internal.encpref'}=100+int(9*rand(99));
                   14364:     #
                   14365:     # By default, use standard grading
                   14366:     if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
                   14367: 
1.541     raeburn  14368:     $outcome .= $linefeed.&mt('Setting environment').': '.                 
                   14369:           &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 14370: #
                   14371: # Open all assignments
                   14372: #
                   14373:     if ($args->{'openall'}) {
                   14374:        my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
                   14375:        my %storecontent = ($storeunder         => time,
                   14376:                            $storeunder.'.type' => 'date_start');
                   14377:        
                   14378:        $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541     raeburn  14379:                  ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 14380:    }
                   14381: #
                   14382: # Set first page
                   14383: #
                   14384:     unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
                   14385: 	    || ($cloneid)) {
1.445     albertel 14386: 	use LONCAPA::map;
1.444     albertel 14387: 	$outcome .= &mt('Setting first resource').': ';
1.445     albertel 14388: 
                   14389: 	my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
                   14390:         my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
                   14391: 
1.444     albertel 14392:         $outcome .= ($fatal?$errtext:'read ok').' - ';
                   14393:         my $title; my $url;
                   14394:         if ($args->{'firstres'} eq 'syl') {
1.690     bisitz   14395: 	    $title=&mt('Syllabus');
1.444     albertel 14396:             $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
                   14397:         } else {
1.963     raeburn  14398:             $title=&mt('Table of Contents');
1.444     albertel 14399:             $url='/adm/navmaps';
                   14400:         }
1.445     albertel 14401: 
                   14402:         $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
                   14403: 	(my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
                   14404: 
                   14405: 	if ($errtext) { $fatal=2; }
1.541     raeburn  14406:         $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444     albertel 14407:     }
1.566     albertel 14408: 
                   14409:     return (1,$outcome);
1.444     albertel 14410: }
                   14411: 
1.1075.2.59  raeburn  14412: sub make_unique_code {
                   14413:     my ($cdom,$cnum) = @_;
                   14414:     # get lock on uniquecodes db
                   14415:     my $lockhash = {
                   14416:                       $cnum."\0".'uniquecodes' => $env{'user.name'}.
                   14417:                                                   ':'.$env{'user.domain'},
                   14418:                    };
                   14419:     my $tries = 0;
                   14420:     my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
                   14421:     my ($code,$error);
                   14422: 
                   14423:     while (($gotlock ne 'ok') && ($tries<3)) {
                   14424:         $tries ++;
                   14425:         sleep 1;
                   14426:         $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
                   14427:     }
                   14428:     if ($gotlock eq 'ok') {
                   14429:         my %currcodes = &Apache::lonnet::dump_dom('uniquecodes',$cdom);
                   14430:         my $gotcode;
                   14431:         my $attempts = 0;
                   14432:         while ((!$gotcode) && ($attempts < 100)) {
                   14433:             $code = &generate_code();
                   14434:             if (!exists($currcodes{$code})) {
                   14435:                 $gotcode = 1;
                   14436:                 unless (&Apache::lonnet::newput_dom('uniquecodes',{ $code => $cnum },$cdom) eq 'ok') {
                   14437:                     $error = 'nostore';
                   14438:                 }
                   14439:             }
                   14440:             $attempts ++;
                   14441:         }
                   14442:         my @del_lock = ($cnum."\0".'uniquecodes');
                   14443:         my $dellockoutcome = &Apache::lonnet::del_dom('uniquecodes',\@del_lock,$cdom);
                   14444:     } else {
                   14445:         $error = 'nolock';
                   14446:     }
                   14447:     return ($code,$error);
                   14448: }
                   14449: 
                   14450: sub generate_code {
                   14451:     my $code;
                   14452:     my @letts = qw(B C D G H J K M N P Q R S T V W X Z);
                   14453:     for (my $i=0; $i<6; $i++) {
                   14454:         my $lettnum = int (rand 2);
                   14455:         my $item = '';
                   14456:         if ($lettnum) {
                   14457:             $item = $letts[int( rand(18) )];
                   14458:         } else {
                   14459:             $item = 1+int( rand(8) );
                   14460:         }
                   14461:         $code .= $item;
                   14462:     }
                   14463:     return $code;
                   14464: }
                   14465: 
1.444     albertel 14466: ############################################################
                   14467: ############################################################
                   14468: 
1.953     droeschl 14469: #SD
                   14470: # only Community and Course, or anything else?
1.378     raeburn  14471: sub course_type {
                   14472:     my ($cid) = @_;
                   14473:     if (!defined($cid)) {
                   14474:         $cid = $env{'request.course.id'};
                   14475:     }
1.404     albertel 14476:     if (defined($env{'course.'.$cid.'.type'})) {
                   14477:         return $env{'course.'.$cid.'.type'};
1.378     raeburn  14478:     } else {
                   14479:         return 'Course';
1.377     raeburn  14480:     }
                   14481: }
1.156     albertel 14482: 
1.406     raeburn  14483: sub group_term {
                   14484:     my $crstype = &course_type();
                   14485:     my %names = (
                   14486:                   'Course' => 'group',
1.865     raeburn  14487:                   'Community' => 'group',
1.406     raeburn  14488:                 );
                   14489:     return $names{$crstype};
                   14490: }
                   14491: 
1.902     raeburn  14492: sub course_types {
1.1075.2.59  raeburn  14493:     my @types = ('official','unofficial','community','textbook');
1.902     raeburn  14494:     my %typename = (
                   14495:                          official   => 'Official course',
                   14496:                          unofficial => 'Unofficial course',
                   14497:                          community  => 'Community',
1.1075.2.59  raeburn  14498:                          textbook   => 'Textbook course',
1.902     raeburn  14499:                    );
                   14500:     return (\@types,\%typename);
                   14501: }
                   14502: 
1.156     albertel 14503: sub icon {
                   14504:     my ($file)=@_;
1.505     albertel 14505:     my $curfext = lc((split(/\./,$file))[-1]);
1.168     albertel 14506:     my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156     albertel 14507:     my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168     albertel 14508:     if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
                   14509: 	if (-e  $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
                   14510: 	          $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   14511: 	            $curfext.".gif") {
                   14512: 	    $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   14513: 		$curfext.".gif";
                   14514: 	}
                   14515:     }
1.249     albertel 14516:     return &lonhttpdurl($iconname);
1.154     albertel 14517: } 
1.84      albertel 14518: 
1.575     albertel 14519: sub lonhttpdurl {
1.692     www      14520: #
                   14521: # Had been used for "small fry" static images on separate port 8080.
                   14522: # Modify here if lightweight http functionality desired again.
                   14523: # Currently eliminated due to increasing firewall issues.
                   14524: #
1.575     albertel 14525:     my ($url)=@_;
1.692     www      14526:     return $url;
1.215     albertel 14527: }
                   14528: 
1.213     albertel 14529: sub connection_aborted {
                   14530:     my ($r)=@_;
                   14531:     $r->print(" ");$r->rflush();
                   14532:     my $c = $r->connection;
                   14533:     return $c->aborted();
                   14534: }
                   14535: 
1.221     foxr     14536: #    Escapes strings that may have embedded 's that will be put into
1.222     foxr     14537: #    strings as 'strings'.
                   14538: sub escape_single {
1.221     foxr     14539:     my ($input) = @_;
1.223     albertel 14540:     $input =~ s/\\/\\\\/g;	# Escape the \'s..(must be first)>
1.221     foxr     14541:     $input =~ s/\'/\\\'/g;	# Esacpe the 's....
                   14542:     return $input;
                   14543: }
1.223     albertel 14544: 
1.222     foxr     14545: #  Same as escape_single, but escape's "'s  This 
                   14546: #  can be used for  "strings"
                   14547: sub escape_double {
                   14548:     my ($input) = @_;
                   14549:     $input =~ s/\\/\\\\/g;	# Escape the /'s..(must be first)>
                   14550:     $input =~ s/\"/\\\"/g;	# Esacpe the "s....
                   14551:     return $input;
                   14552: }
1.223     albertel 14553:  
1.222     foxr     14554: #   Escapes the last element of a full URL.
                   14555: sub escape_url {
                   14556:     my ($url)   = @_;
1.238     raeburn  14557:     my @urlslices = split(/\//, $url,-1);
1.369     www      14558:     my $lastitem = &escape(pop(@urlslices));
1.1075.2.83  raeburn  14559:     return &HTML::Entities::encode(join('/',@urlslices),"'").'/'.$lastitem;
1.222     foxr     14560: }
1.462     albertel 14561: 
1.820     raeburn  14562: sub compare_arrays {
                   14563:     my ($arrayref1,$arrayref2) = @_;
                   14564:     my (@difference,%count);
                   14565:     @difference = ();
                   14566:     %count = ();
                   14567:     if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
                   14568:         foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
                   14569:         foreach my $element (keys(%count)) {
                   14570:             if ($count{$element} == 1) {
                   14571:                 push(@difference,$element);
                   14572:             }
                   14573:         }
                   14574:     }
                   14575:     return @difference;
                   14576: }
                   14577: 
1.817     bisitz   14578: # -------------------------------------------------------- Initialize user login
1.462     albertel 14579: sub init_user_environment {
1.463     albertel 14580:     my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462     albertel 14581:     my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
                   14582: 
                   14583:     my $public=($username eq 'public' && $domain eq 'public');
                   14584: 
                   14585: # See if old ID present, if so, remove
                   14586: 
1.1062    raeburn  14587:     my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
1.462     albertel 14588:     my $now=time;
                   14589: 
                   14590:     if ($public) {
                   14591: 	my $max_public=100;
                   14592: 	my $oldest;
                   14593: 	my $oldest_time=0;
                   14594: 	for(my $next=1;$next<=$max_public;$next++) {
                   14595: 	    if (-e $lonids."/publicuser_$next.id") {
                   14596: 		my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
                   14597: 		if ($mtime<$oldest_time || !$oldest_time) {
                   14598: 		    $oldest_time=$mtime;
                   14599: 		    $oldest=$next;
                   14600: 		}
                   14601: 	    } else {
                   14602: 		$cookie="publicuser_$next";
                   14603: 		last;
                   14604: 	    }
                   14605: 	}
                   14606: 	if (!$cookie) { $cookie="publicuser_$oldest"; }
                   14607:     } else {
1.463     albertel 14608: 	# if this isn't a robot, kill any existing non-robot sessions
                   14609: 	if (!$args->{'robot'}) {
                   14610: 	    opendir(DIR,$lonids);
                   14611: 	    while ($filename=readdir(DIR)) {
                   14612: 		if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
                   14613: 		    unlink($lonids.'/'.$filename);
                   14614: 		}
1.462     albertel 14615: 	    }
1.463     albertel 14616: 	    closedir(DIR);
1.1075.2.84  raeburn  14617: # If there is a undeleted lockfile for the user's paste buffer remove it.
                   14618:             my $namespace = 'nohist_courseeditor';
                   14619:             my $lockingkey = 'paste'."\0".'locked_num';
                   14620:             my %lockhash = &Apache::lonnet::get($namespace,[$lockingkey],
                   14621:                                                 $domain,$username);
                   14622:             if (exists($lockhash{$lockingkey})) {
                   14623:                 my $delresult = &Apache::lonnet::del($namespace,[$lockingkey],$domain,$username);
                   14624:                 unless ($delresult eq 'ok') {
                   14625:                     &Apache::lonnet::logthis("Failed to delete paste buffer locking key in $namespace for ".$username.":".$domain." Result was: $delresult");
                   14626:                 }
                   14627:             }
1.462     albertel 14628: 	}
                   14629: # Give them a new cookie
1.463     albertel 14630: 	my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684     www      14631: 		                   : $now.$$.int(rand(10000)));
1.463     albertel 14632: 	$cookie="$username\_$id\_$domain\_$authhost";
1.462     albertel 14633:     
                   14634: # Initialize roles
                   14635: 
1.1062    raeburn  14636: 	($userroles,$firstaccenv,$timerintenv) = 
                   14637:             &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462     albertel 14638:     }
                   14639: # ------------------------------------ Check browser type and MathML capability
                   14640: 
1.1075.2.77  raeburn  14641:     my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,$clientunicode,
                   14642:         $clientos,$clientmobile,$clientinfo,$clientosversion) = &decode_user_agent($r);
1.462     albertel 14643: 
                   14644: # ------------------------------------------------------------- Get environment
                   14645: 
                   14646:     my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
                   14647:     my ($tmp) = keys(%userenv);
                   14648:     if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   14649:     } else {
                   14650: 	undef(%userenv);
                   14651:     }
                   14652:     if (($userenv{'interface'}) && (!$form->{'interface'})) {
                   14653: 	$form->{'interface'}=$userenv{'interface'};
                   14654:     }
                   14655:     if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
                   14656: 
                   14657: # --------------- Do not trust query string to be put directly into environment
1.817     bisitz   14658:     foreach my $option ('interface','localpath','localres') {
                   14659:         $form->{$option}=~s/[\n\r\=]//gs;
1.462     albertel 14660:     }
                   14661: # --------------------------------------------------------- Write first profile
                   14662: 
                   14663:     {
                   14664: 	my %initial_env = 
                   14665: 	    ("user.name"          => $username,
                   14666: 	     "user.domain"        => $domain,
                   14667: 	     "user.home"          => $authhost,
                   14668: 	     "browser.type"       => $clientbrowser,
                   14669: 	     "browser.version"    => $clientversion,
                   14670: 	     "browser.mathml"     => $clientmathml,
                   14671: 	     "browser.unicode"    => $clientunicode,
                   14672: 	     "browser.os"         => $clientos,
1.1075.2.42  raeburn  14673:              "browser.mobile"     => $clientmobile,
                   14674:              "browser.info"       => $clientinfo,
1.1075.2.77  raeburn  14675:              "browser.osversion"  => $clientosversion,
1.462     albertel 14676: 	     "server.domain"      => $Apache::lonnet::perlvar{'lonDefDomain'},
                   14677: 	     "request.course.fn"  => '',
                   14678: 	     "request.course.uri" => '',
                   14679: 	     "request.course.sec" => '',
                   14680: 	     "request.role"       => 'cm',
                   14681: 	     "request.role.adv"   => $env{'user.adv'},
                   14682: 	     "request.host"       => $ENV{'REMOTE_ADDR'},);
                   14683: 
                   14684:         if ($form->{'localpath'}) {
                   14685: 	    $initial_env{"browser.localpath"}  = $form->{'localpath'};
                   14686: 	    $initial_env{"browser.localres"}   = $form->{'localres'};
                   14687:         }
                   14688: 	
                   14689: 	if ($form->{'interface'}) {
                   14690: 	    $form->{'interface'}=~s/\W//gs;
                   14691: 	    $initial_env{"browser.interface"} = $form->{'interface'};
                   14692: 	    $env{'browser.interface'}=$form->{'interface'};
                   14693: 	}
                   14694: 
1.1075.2.54  raeburn  14695:         if ($form->{'iptoken'}) {
                   14696:             my $lonhost = $r->dir_config('lonHostID');
                   14697:             $initial_env{"user.noloadbalance"} = $lonhost;
                   14698:             $env{'user.noloadbalance'} = $lonhost;
                   14699:         }
                   14700: 
1.981     raeburn  14701:         my %is_adv = ( is_adv => $env{'user.adv'} );
1.1016    raeburn  14702:         my %domdef;
                   14703:         unless ($domain eq 'public') {
                   14704:             %domdef = &Apache::lonnet::get_domain_defaults($domain);
                   14705:         }
1.980     raeburn  14706: 
1.1075.2.7  raeburn  14707:         foreach my $tool ('aboutme','blog','webdav','portfolio') {
1.724     raeburn  14708:             $userenv{'availabletools.'.$tool} = 
1.980     raeburn  14709:                 &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
                   14710:                                                   undef,\%userenv,\%domdef,\%is_adv);
1.724     raeburn  14711:         }
                   14712: 
1.1075.2.59  raeburn  14713:         foreach my $crstype ('official','unofficial','community','textbook') {
1.765     raeburn  14714:             $userenv{'canrequest.'.$crstype} =
                   14715:                 &Apache::lonnet::usertools_access($username,$domain,$crstype,
1.980     raeburn  14716:                                                   'reload','requestcourses',
                   14717:                                                   \%userenv,\%domdef,\%is_adv);
1.765     raeburn  14718:         }
                   14719: 
1.1075.2.14  raeburn  14720:         $userenv{'canrequest.author'} =
                   14721:             &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
                   14722:                                         'reload','requestauthor',
                   14723:                                         \%userenv,\%domdef,\%is_adv);
                   14724:         my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
                   14725:                                              $domain,$username);
                   14726:         my $reqstatus = $reqauthor{'author_status'};
                   14727:         if ($reqstatus eq 'approval' || $reqstatus eq 'approved') {
                   14728:             if (ref($reqauthor{'author'}) eq 'HASH') {
                   14729:                 $userenv{'requestauthorqueued'} = $reqstatus.':'.
                   14730:                                                   $reqauthor{'author'}{'timestamp'};
                   14731:             }
                   14732:         }
                   14733: 
1.462     albertel 14734: 	$env{'user.environment'} = "$lonids/$cookie.id";
1.1062    raeburn  14735: 
1.462     albertel 14736: 	if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
                   14737: 		 &GDBM_WRCREAT(),0640)) {
                   14738: 	    &_add_to_env(\%disk_env,\%initial_env);
                   14739: 	    &_add_to_env(\%disk_env,\%userenv,'environment.');
                   14740: 	    &_add_to_env(\%disk_env,$userroles);
1.1062    raeburn  14741:             if (ref($firstaccenv) eq 'HASH') {
                   14742:                 &_add_to_env(\%disk_env,$firstaccenv);
                   14743:             }
                   14744:             if (ref($timerintenv) eq 'HASH') {
                   14745:                 &_add_to_env(\%disk_env,$timerintenv);
                   14746:             }
1.463     albertel 14747: 	    if (ref($args->{'extra_env'})) {
                   14748: 		&_add_to_env(\%disk_env,$args->{'extra_env'});
                   14749: 	    }
1.462     albertel 14750: 	    untie(%disk_env);
                   14751: 	} else {
1.705     tempelho 14752: 	    &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
                   14753: 			   'Could not create environment storage in lonauth: '.$!.'</span>');
1.462     albertel 14754: 	    return 'error: '.$!;
                   14755: 	}
                   14756:     }
                   14757:     $env{'request.role'}='cm';
                   14758:     $env{'request.role.adv'}=$env{'user.adv'};
                   14759:     $env{'browser.type'}=$clientbrowser;
                   14760: 
                   14761:     return $cookie;
                   14762: 
                   14763: }
                   14764: 
                   14765: sub _add_to_env {
                   14766:     my ($idf,$env_data,$prefix) = @_;
1.676     raeburn  14767:     if (ref($env_data) eq 'HASH') {
                   14768:         while (my ($key,$value) = each(%$env_data)) {
                   14769: 	    $idf->{$prefix.$key} = $value;
                   14770: 	    $env{$prefix.$key}   = $value;
                   14771:         }
1.462     albertel 14772:     }
                   14773: }
                   14774: 
1.685     tempelho 14775: # --- Get the symbolic name of a problem and the url
                   14776: sub get_symb {
                   14777:     my ($request,$silent) = @_;
1.726     raeburn  14778:     (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685     tempelho 14779:     my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
                   14780:     if ($symb eq '') {
                   14781:         if (!$silent) {
1.1071    raeburn  14782:             if (ref($request)) { 
                   14783:                 $request->print("Unable to handle ambiguous references:$url:.");
                   14784:             }
1.685     tempelho 14785:             return ();
                   14786:         }
                   14787:     }
                   14788:     &Apache::lonenc::check_decrypt(\$symb);
                   14789:     return ($symb);
                   14790: }
                   14791: 
                   14792: # --------------------------------------------------------------Get annotation
                   14793: 
                   14794: sub get_annotation {
                   14795:     my ($symb,$enc) = @_;
                   14796: 
                   14797:     my $key = $symb;
                   14798:     if (!$enc) {
                   14799:         $key =
                   14800:             &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
                   14801:     }
                   14802:     my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
                   14803:     return $annotation{$key};
                   14804: }
                   14805: 
                   14806: sub clean_symb {
1.731     raeburn  14807:     my ($symb,$delete_enc) = @_;
1.685     tempelho 14808: 
                   14809:     &Apache::lonenc::check_decrypt(\$symb);
                   14810:     my $enc = $env{'request.enc'};
1.731     raeburn  14811:     if ($delete_enc) {
1.730     raeburn  14812:         delete($env{'request.enc'});
                   14813:     }
1.685     tempelho 14814: 
                   14815:     return ($symb,$enc);
                   14816: }
1.462     albertel 14817: 
1.1075.2.69  raeburn  14818: ############################################################
                   14819: ############################################################
                   14820: 
                   14821: =pod
                   14822: 
                   14823: =head1 Routines for building display used to search for courses
                   14824: 
                   14825: 
                   14826: =over 4
                   14827: 
                   14828: =item * &build_filters()
                   14829: 
                   14830: Create markup for a table used to set filters to use when selecting
                   14831: courses in a domain.  Used by lonpickcourse.pm, lonmodifycourse.pm
                   14832: and quotacheck.pl
                   14833: 
                   14834: 
                   14835: Inputs:
                   14836: 
                   14837: filterlist - anonymous array of fields to include as potential filters
                   14838: 
                   14839: crstype - course type
                   14840: 
                   14841: roleelement - fifth arg in selectcourse_link() populates fifth arg in javascript: opencrsbrowser() function, used
                   14842:               to pop-open a course selector (will contain "extra element").
                   14843: 
                   14844: multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1
                   14845: 
                   14846: filter - anonymous hash of criteria and their values
                   14847: 
                   14848: action - form action
                   14849: 
                   14850: numfiltersref - ref to scalar (count of number of elements in institutional codes -- e.g., 4 for year, semester, department, and number)
                   14851: 
                   14852: caller - caller context (e.g., set to 'modifycourse' when routine is called from lonmodifycourse.pm)
                   14853: 
                   14854: cloneruname - username of owner of new course who wants to clone
                   14855: 
                   14856: clonerudom - domain of owner of new course who wants to clone
                   14857: 
                   14858: typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community)
                   14859: 
                   14860: codetitlesref - reference to array of titles of components in institutional codes (official courses)
                   14861: 
                   14862: codedom - domain
                   14863: 
                   14864: formname - value of form element named "form".
                   14865: 
                   14866: fixeddom - domain, if fixed.
                   14867: 
                   14868: prevphase - value to assign to form element named "phase" when going back to the previous screen
                   14869: 
                   14870: cnameelement - name of form element in form on opener page which will receive title of selected course
                   14871: 
                   14872: cnumelement - name of form element in form on opener page which will receive courseID  of selected course
                   14873: 
                   14874: cdomelement - name of form element in form on opener page which will receive domain of selected course
                   14875: 
                   14876: setroles - includes access constraint identifier when setting a roles-based condition for acces to a portfolio file
                   14877: 
                   14878: clonetext - hidden form elements containing list of courses cloneable by intended course owner when DC creates a course
                   14879: 
                   14880: clonewarning - warning message about missing information for intended course owner when DC creates a course
                   14881: 
                   14882: 
                   14883: Returns: $output - HTML for display of search criteria, and hidden form elements.
                   14884: 
                   14885: 
                   14886: Side Effects: None
                   14887: 
                   14888: =cut
                   14889: 
                   14890: # ---------------------------------------------- search for courses based on last activity etc.
                   14891: 
                   14892: sub build_filters {
                   14893:     my ($filterlist,$crstype,$roleelement,$multelement,$filter,$action,
                   14894:         $numtitlesref,$caller,$cloneruname,$clonerudom,$typeelement,
                   14895:         $codetitlesref,$codedom,$formname,$fixeddom,$prevphase,
                   14896:         $cnameelement,$cnumelement,$cdomelement,$setroles,
                   14897:         $clonetext,$clonewarning) = @_;
                   14898:     my ($list,$jscript);
                   14899:     my $onchange = 'javascript:updateFilters(this)';
                   14900:     my ($domainselectform,$sincefilterform,$createdfilterform,
                   14901:         $ownerdomselectform,$persondomselectform,$instcodeform,
                   14902:         $typeselectform,$instcodetitle);
                   14903:     if ($formname eq '') {
                   14904:         $formname = $caller;
                   14905:     }
                   14906:     foreach my $item (@{$filterlist}) {
                   14907:         unless (($item eq 'descriptfilter') || ($item eq 'instcodefilter') ||
                   14908:                 ($item eq 'sincefilter') || ($item eq 'createdfilter')) {
                   14909:             if ($item eq 'domainfilter') {
                   14910:                 $filter->{$item} = &LONCAPA::clean_domain($filter->{$item});
                   14911:             } elsif ($item eq 'coursefilter') {
                   14912:                 $filter->{$item} = &LONCAPA::clean_courseid($filter->{$item});
                   14913:             } elsif ($item eq 'ownerfilter') {
                   14914:                 $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
                   14915:             } elsif ($item eq 'ownerdomfilter') {
                   14916:                 $filter->{'ownerdomfilter'} =
                   14917:                     &LONCAPA::clean_domain($filter->{$item});
                   14918:                 $ownerdomselectform = &select_dom_form($filter->{'ownerdomfilter'},
                   14919:                                                        'ownerdomfilter',1);
                   14920:             } elsif ($item eq 'personfilter') {
                   14921:                 $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
                   14922:             } elsif ($item eq 'persondomfilter') {
                   14923:                 $persondomselectform = &select_dom_form($filter->{'persondomfilter'},
                   14924:                                                         'persondomfilter',1);
                   14925:             } else {
                   14926:                 $filter->{$item} =~ s/\W//g;
                   14927:             }
                   14928:             if (!$filter->{$item}) {
                   14929:                 $filter->{$item} = '';
                   14930:             }
                   14931:         }
                   14932:         if ($item eq 'domainfilter') {
                   14933:             my $allow_blank = 1;
                   14934:             if ($formname eq 'portform') {
                   14935:                 $allow_blank=0;
                   14936:             } elsif ($formname eq 'studentform') {
                   14937:                 $allow_blank=0;
                   14938:             }
                   14939:             if ($fixeddom) {
                   14940:                 $domainselectform = '<input type="hidden" name="domainfilter"'.
                   14941:                                     ' value="'.$codedom.'" />'.
                   14942:                                     &Apache::lonnet::domain($codedom,'description');
                   14943:             } else {
                   14944:                 $domainselectform = &select_dom_form($filter->{$item},
                   14945:                                                      'domainfilter',
                   14946:                                                       $allow_blank,'',$onchange);
                   14947:             }
                   14948:         } else {
                   14949:             $list->{$item} = &HTML::Entities::encode($filter->{$item},'<>&"');
                   14950:         }
                   14951:     }
                   14952: 
                   14953:     # last course activity filter and selection
                   14954:     $sincefilterform = &timebased_select_form('sincefilter',$filter);
                   14955: 
                   14956:     # course created filter and selection
                   14957:     if (exists($filter->{'createdfilter'})) {
                   14958:         $createdfilterform = &timebased_select_form('createdfilter',$filter);
                   14959:     }
                   14960: 
                   14961:     my %lt = &Apache::lonlocal::texthash(
                   14962:                 'cac' => "$crstype Activity",
                   14963:                 'ccr' => "$crstype Created",
                   14964:                 'cde' => "$crstype Title",
                   14965:                 'cdo' => "$crstype Domain",
                   14966:                 'ins' => 'Institutional Code',
                   14967:                 'inc' => 'Institutional Categorization',
                   14968:                 'cow' => "$crstype Owner/Co-owner",
                   14969:                 'cop' => "$crstype Personnel Includes",
                   14970:                 'cog' => 'Type',
                   14971:              );
                   14972: 
                   14973:     if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
                   14974:         my $typeval = 'Course';
                   14975:         if ($crstype eq 'Community') {
                   14976:             $typeval = 'Community';
                   14977:         }
                   14978:         $typeselectform = '<input type="hidden" name="type" value="'.$typeval.'" />';
                   14979:     } else {
                   14980:         $typeselectform =  '<select name="type" size="1"';
                   14981:         if ($onchange) {
                   14982:             $typeselectform .= ' onchange="'.$onchange.'"';
                   14983:         }
                   14984:         $typeselectform .= '>'."\n";
                   14985:         foreach my $posstype ('Course','Community') {
                   14986:             $typeselectform.='<option value="'.$posstype.'"'.
                   14987:                 ($posstype eq $crstype ? ' selected="selected" ' : ''). ">".&mt($posstype)."</option>\n";
                   14988:         }
                   14989:         $typeselectform.="</select>";
                   14990:     }
                   14991: 
                   14992:     my ($cloneableonlyform,$cloneabletitle);
                   14993:     if (exists($filter->{'cloneableonly'})) {
                   14994:         my $cloneableon = '';
                   14995:         my $cloneableoff = ' checked="checked"';
                   14996:         if ($filter->{'cloneableonly'}) {
                   14997:             $cloneableon = $cloneableoff;
                   14998:             $cloneableoff = '';
                   14999:         }
                   15000:         $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>';
                   15001:         if ($formname eq 'ccrs') {
1.1075.2.71  raeburn  15002:             $cloneabletitle = &mt('Cloneable for [_1]',$cloneruname.':'.$clonerudom);
1.1075.2.69  raeburn  15003:         } else {
                   15004:             $cloneabletitle = &mt('Cloneable by you');
                   15005:         }
                   15006:     }
                   15007:     my $officialjs;
                   15008:     if ($crstype eq 'Course') {
                   15009:         if (exists($filter->{'instcodefilter'})) {
                   15010: #            if (($fixeddom) || ($formname eq 'requestcrs') ||
                   15011: #                ($formname eq 'modifycourse') || ($formname eq 'filterpicker')) {
                   15012:             if ($codedom) {
                   15013:                 $officialjs = 1;
                   15014:                 ($instcodeform,$jscript,$$numtitlesref) =
                   15015:                     &Apache::courseclassifier::instcode_selectors($codedom,'filterpicker',
                   15016:                                                                   $officialjs,$codetitlesref);
                   15017:                 if ($jscript) {
                   15018:                     $jscript = '<script type="text/javascript">'."\n".
                   15019:                                '// <![CDATA['."\n".
                   15020:                                $jscript."\n".
                   15021:                                '// ]]>'."\n".
                   15022:                                '</script>'."\n";
                   15023:                 }
                   15024:             }
                   15025:             if ($instcodeform eq '') {
                   15026:                 $instcodeform =
                   15027:                     '<input type="text" name="instcodefilter" size="10" value="'.
                   15028:                     $list->{'instcodefilter'}.'" />';
                   15029:                 $instcodetitle = $lt{'ins'};
                   15030:             } else {
                   15031:                 $instcodetitle = $lt{'inc'};
                   15032:             }
                   15033:             if ($fixeddom) {
                   15034:                 $instcodetitle .= '<br />('.$codedom.')';
                   15035:             }
                   15036:         }
                   15037:     }
                   15038:     my $output = qq|
                   15039: <form method="post" name="filterpicker" action="$action">
                   15040: <input type="hidden" name="form" value="$formname" />
                   15041: |;
                   15042:     if ($formname eq 'modifycourse') {
                   15043:         $output .= '<input type="hidden" name="phase" value="courselist" />'."\n".
                   15044:                    '<input type="hidden" name="prevphase" value="'.
                   15045:                    $prevphase.'" />'."\n";
1.1075.2.82  raeburn  15046:     } elsif ($formname eq 'quotacheck') {
                   15047:         $output .= qq|
                   15048: <input type="hidden" name="sortby" value="" />
                   15049: <input type="hidden" name="sortorder" value="" />
                   15050: |;
                   15051:     } else {
1.1075.2.69  raeburn  15052:         my $name_input;
                   15053:         if ($cnameelement ne '') {
                   15054:             $name_input = '<input type="hidden" name="cnameelement" value="'.
                   15055:                           $cnameelement.'" />';
                   15056:         }
                   15057:         $output .= qq|
                   15058: <input type="hidden" name="cnumelement" value="$cnumelement" />
                   15059: <input type="hidden" name="cdomelement" value="$cdomelement" />
                   15060: $name_input
                   15061: $roleelement
                   15062: $multelement
                   15063: $typeelement
                   15064: |;
                   15065:         if ($formname eq 'portform') {
                   15066:             $output .= '<input type="hidden" name="setroles" value="'.$setroles.'" />'."\n";
                   15067:         }
                   15068:     }
                   15069:     if ($fixeddom) {
                   15070:         $output .= '<input type="hidden" name="fixeddom" value="'.$fixeddom.'" />'."\n";
                   15071:     }
                   15072:     $output .= "<br />\n".&Apache::lonhtmlcommon::start_pick_box();
                   15073:     if ($sincefilterform) {
                   15074:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cac'})
                   15075:                   .$sincefilterform
                   15076:                   .&Apache::lonhtmlcommon::row_closure();
                   15077:     }
                   15078:     if ($createdfilterform) {
                   15079:         $output .= &Apache::lonhtmlcommon::row_title($lt{'ccr'})
                   15080:                   .$createdfilterform
                   15081:                   .&Apache::lonhtmlcommon::row_closure();
                   15082:     }
                   15083:     if ($domainselectform) {
                   15084:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cdo'})
                   15085:                   .$domainselectform
                   15086:                   .&Apache::lonhtmlcommon::row_closure();
                   15087:     }
                   15088:     if ($typeselectform) {
                   15089:         if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
                   15090:             $output .= $typeselectform;
                   15091:         } else {
                   15092:             $output .= &Apache::lonhtmlcommon::row_title($lt{'cog'})
                   15093:                       .$typeselectform
                   15094:                       .&Apache::lonhtmlcommon::row_closure();
                   15095:         }
                   15096:     }
                   15097:     if ($instcodeform) {
                   15098:         $output .= &Apache::lonhtmlcommon::row_title($instcodetitle)
                   15099:                   .$instcodeform
                   15100:                   .&Apache::lonhtmlcommon::row_closure();
                   15101:     }
                   15102:     if (exists($filter->{'ownerfilter'})) {
                   15103:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cow'}).
                   15104:                    '<table><tr><td>'.&mt('Username').'<br />'.
                   15105:                    '<input type="text" name="ownerfilter" size="20" value="'.
                   15106:                    $list->{'ownerfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
                   15107:                    $ownerdomselectform.'</td></tr></table>'.
                   15108:                    &Apache::lonhtmlcommon::row_closure();
                   15109:     }
                   15110:     if (exists($filter->{'personfilter'})) {
                   15111:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cop'}).
                   15112:                    '<table><tr><td>'.&mt('Username').'<br />'.
                   15113:                    '<input type="text" name="personfilter" size="20" value="'.
                   15114:                    $list->{'personfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
                   15115:                    $persondomselectform.'</td></tr></table>'.
                   15116:                    &Apache::lonhtmlcommon::row_closure();
                   15117:     }
                   15118:     if (exists($filter->{'coursefilter'})) {
                   15119:         $output .= &Apache::lonhtmlcommon::row_title(&mt('LON-CAPA course ID'))
                   15120:                   .'<input type="text" name="coursefilter" size="25" value="'
                   15121:                   .$list->{'coursefilter'}.'" />'
                   15122:                   .&Apache::lonhtmlcommon::row_closure();
                   15123:     }
                   15124:     if ($cloneableonlyform) {
                   15125:         $output .= &Apache::lonhtmlcommon::row_title($cloneabletitle).
                   15126:                    $cloneableonlyform.&Apache::lonhtmlcommon::row_closure();
                   15127:     }
                   15128:     if (exists($filter->{'descriptfilter'})) {
                   15129:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cde'})
                   15130:                   .'<input type="text" name="descriptfilter" size="40" value="'
                   15131:                   .$list->{'descriptfilter'}.'" />'
                   15132:                   .&Apache::lonhtmlcommon::row_closure(1);
                   15133:     }
                   15134:     $output .= &Apache::lonhtmlcommon::end_pick_box().'<p>'.$clonetext."\n".
                   15135:                '<input type="hidden" name="updater" value="" />'."\n".
                   15136:                '<input type="submit" name="gosearch" value="'.
                   15137:                &mt('Search').'" /></p>'."\n".'</form>'."\n".'<hr />'."\n";
                   15138:     return $jscript.$clonewarning.$output;
                   15139: }
                   15140: 
                   15141: =pod
                   15142: 
                   15143: =item * &timebased_select_form()
                   15144: 
                   15145: Create markup for a dropdown list used to select a time-based
                   15146: filter e.g., Course Activity, Course Created, when searching for courses
                   15147: or communities
                   15148: 
                   15149: Inputs:
                   15150: 
                   15151: item - name of form element (sincefilter or createdfilter)
                   15152: 
                   15153: filter - anonymous hash of criteria and their values
                   15154: 
                   15155: Returns: HTML for a select box contained a blank, then six time selections,
                   15156:          with value set in incoming form variables currently selected.
                   15157: 
                   15158: Side Effects: None
                   15159: 
                   15160: =cut
                   15161: 
                   15162: sub timebased_select_form {
                   15163:     my ($item,$filter) = @_;
                   15164:     if (ref($filter) eq 'HASH') {
                   15165:         $filter->{$item} =~ s/[^\d-]//g;
                   15166:         if (!$filter->{$item}) { $filter->{$item}=-1; }
                   15167:         return &select_form(
                   15168:                             $filter->{$item},
                   15169:                             $item,
                   15170:                             {      '-1' => '',
                   15171:                                 '86400' => &mt('today'),
                   15172:                                '604800' => &mt('last week'),
                   15173:                               '2592000' => &mt('last month'),
                   15174:                               '7776000' => &mt('last three months'),
                   15175:                              '15552000' => &mt('last six months'),
                   15176:                              '31104000' => &mt('last year'),
                   15177:                     'select_form_order' =>
                   15178:                            ['-1','86400','604800','2592000','7776000',
                   15179:                             '15552000','31104000']});
                   15180:     }
                   15181: }
                   15182: 
                   15183: =pod
                   15184: 
                   15185: =item * &js_changer()
                   15186: 
                   15187: Create script tag containing Javascript used to submit course search form
                   15188: when course type or domain is changed, and also to hide 'Searching ...' on
                   15189: page load completion for page showing search result.
                   15190: 
                   15191: Inputs: None
                   15192: 
                   15193: Returns: markup containing updateFilters() and hideSearching() javascript functions.
                   15194: 
                   15195: Side Effects: None
                   15196: 
                   15197: =cut
                   15198: 
                   15199: sub js_changer {
                   15200:     return <<ENDJS;
                   15201: <script type="text/javascript">
                   15202: // <![CDATA[
                   15203: function updateFilters(caller) {
                   15204:     if (typeof(caller) != "undefined") {
                   15205:         document.filterpicker.updater.value = caller.name;
                   15206:     }
                   15207:     document.filterpicker.submit();
                   15208: }
                   15209: 
                   15210: function hideSearching() {
                   15211:     if (document.getElementById('searching')) {
                   15212:         document.getElementById('searching').style.display = 'none';
                   15213:     }
                   15214:     return;
                   15215: }
                   15216: 
                   15217: // ]]>
                   15218: </script>
                   15219: 
                   15220: ENDJS
                   15221: }
                   15222: 
                   15223: =pod
                   15224: 
                   15225: =item * &search_courses()
                   15226: 
                   15227: Process selected filters form course search form and pass to lonnet::courseiddump
                   15228: to retrieve a hash for which keys are courseIDs which match the selected filters.
                   15229: 
                   15230: Inputs:
                   15231: 
                   15232: dom - domain being searched
                   15233: 
                   15234: type - course type ('Course' or 'Community' or '.' if any).
                   15235: 
                   15236: filter - anonymous hash of criteria and their values
                   15237: 
                   15238: numtitles - for institutional codes - number of categories
                   15239: 
                   15240: cloneruname - optional username of new course owner
                   15241: 
                   15242: clonerudom - optional domain of new course owner
                   15243: 
                   15244: domcloner - Optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by,
                   15245:             (used when DC is using course creation form)
                   15246: 
                   15247: codetitles - reference to array of titles of components in institutional codes (official courses).
                   15248: 
                   15249: 
                   15250: Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type.
                   15251: 
                   15252: 
                   15253: Side Effects: None
                   15254: 
                   15255: =cut
                   15256: 
                   15257: 
                   15258: sub search_courses {
                   15259:     my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles) = @_;
                   15260:     my (%courses,%showcourses,$cloner);
                   15261:     if (($filter->{'ownerfilter'} ne '') ||
                   15262:         ($filter->{'ownerdomfilter'} ne '')) {
                   15263:         $filter->{'combownerfilter'} = $filter->{'ownerfilter'}.':'.
                   15264:                                        $filter->{'ownerdomfilter'};
                   15265:     }
                   15266:     foreach my $item ('descriptfilter','coursefilter','combownerfilter') {
                   15267:         if (!$filter->{$item}) {
                   15268:             $filter->{$item}='.';
                   15269:         }
                   15270:     }
                   15271:     my $now = time;
                   15272:     my $timefilter =
                   15273:        ($filter->{'sincefilter'}==-1?1:$now-$filter->{'sincefilter'});
                   15274:     my ($createdbefore,$createdafter);
                   15275:     if (($filter->{'createdfilter'} ne '') && ($filter->{'createdfilter'} !=-1)) {
                   15276:         $createdbefore = $now;
                   15277:         $createdafter = $now-$filter->{'createdfilter'};
                   15278:     }
                   15279:     my ($instcodefilter,$regexpok);
                   15280:     if ($numtitles) {
                   15281:         if ($env{'form.official'} eq 'on') {
                   15282:             $instcodefilter =
                   15283:                 &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
                   15284:             $regexpok = 1;
                   15285:         } elsif ($env{'form.official'} eq 'off') {
                   15286:             $instcodefilter = &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
                   15287:             unless ($instcodefilter eq '') {
                   15288:                 $regexpok = -1;
                   15289:             }
                   15290:         }
                   15291:     } else {
                   15292:         $instcodefilter = $filter->{'instcodefilter'};
                   15293:     }
                   15294:     if ($instcodefilter eq '') { $instcodefilter = '.'; }
                   15295:     if ($type eq '') { $type = '.'; }
                   15296: 
                   15297:     if (($clonerudom ne '') && ($cloneruname ne '')) {
                   15298:         $cloner = $cloneruname.':'.$clonerudom;
                   15299:     }
                   15300:     %courses = &Apache::lonnet::courseiddump($dom,
                   15301:                                              $filter->{'descriptfilter'},
                   15302:                                              $timefilter,
                   15303:                                              $instcodefilter,
                   15304:                                              $filter->{'combownerfilter'},
                   15305:                                              $filter->{'coursefilter'},
                   15306:                                              undef,undef,$type,$regexpok,undef,undef,
                   15307:                                              undef,undef,$cloner,$env{'form.cc_clone'},
                   15308:                                              $filter->{'cloneableonly'},
                   15309:                                              $createdbefore,$createdafter,undef,
                   15310:                                              $domcloner);
                   15311:     if (($filter->{'personfilter'} ne '') && ($filter->{'persondomfilter'} ne '')) {
                   15312:         my $ccrole;
                   15313:         if ($type eq 'Community') {
                   15314:             $ccrole = 'co';
                   15315:         } else {
                   15316:             $ccrole = 'cc';
                   15317:         }
                   15318:         my %rolehash = &Apache::lonnet::get_my_roles($filter->{'personfilter'},
                   15319:                                                      $filter->{'persondomfilter'},
                   15320:                                                      'userroles',undef,
                   15321:                                                      [$ccrole,'in','ad','ep','ta','cr'],
                   15322:                                                      $dom);
                   15323:         foreach my $role (keys(%rolehash)) {
                   15324:             my ($cnum,$cdom,$courserole) = split(':',$role);
                   15325:             my $cid = $cdom.'_'.$cnum;
                   15326:             if (exists($courses{$cid})) {
                   15327:                 if (ref($courses{$cid}) eq 'HASH') {
                   15328:                     if (ref($courses{$cid}{roles}) eq 'ARRAY') {
                   15329:                         if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) {
                   15330:                             push (@{$courses{$cid}{roles}},$courserole);
                   15331:                         }
                   15332:                     } else {
                   15333:                         $courses{$cid}{roles} = [$courserole];
                   15334:                     }
                   15335:                     $showcourses{$cid} = $courses{$cid};
                   15336:                 }
                   15337:             }
                   15338:         }
                   15339:         %courses = %showcourses;
                   15340:     }
                   15341:     return %courses;
                   15342: }
                   15343: 
                   15344: =pod
                   15345: 
                   15346: =back
                   15347: 
                   15348: =cut
                   15349: 
                   15350: 
1.1075.2.11  raeburn  15351: sub update_content_constraints {
                   15352:     my ($cdom,$cnum,$chome,$cid) = @_;
                   15353:     my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
                   15354:     my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
                   15355:     my %checkresponsetypes;
                   15356:     foreach my $key (keys(%Apache::lonnet::needsrelease)) {
                   15357:         my ($item,$name,$value) = split(/:/,$key);
                   15358:         if ($item eq 'resourcetag') {
                   15359:             if ($name eq 'responsetype') {
                   15360:                 $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
                   15361:             }
                   15362:         }
                   15363:     }
                   15364:     my $navmap = Apache::lonnavmaps::navmap->new();
                   15365:     if (defined($navmap)) {
                   15366:         my %allresponses;
                   15367:         foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
                   15368:             my %responses = $res->responseTypes();
                   15369:             foreach my $key (keys(%responses)) {
                   15370:                 next unless(exists($checkresponsetypes{$key}));
                   15371:                 $allresponses{$key} += $responses{$key};
                   15372:             }
                   15373:         }
                   15374:         foreach my $key (keys(%allresponses)) {
                   15375:             my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
                   15376:             if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
                   15377:                 ($reqdmajor,$reqdminor) = ($major,$minor);
                   15378:             }
                   15379:         }
                   15380:         undef($navmap);
                   15381:     }
                   15382:     unless (($reqdmajor eq '') && ($reqdminor eq '')) {
                   15383:         &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
                   15384:     }
                   15385:     return;
                   15386: }
                   15387: 
1.1075.2.27  raeburn  15388: sub allmaps_incourse {
                   15389:     my ($cdom,$cnum,$chome,$cid) = @_;
                   15390:     if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') {
                   15391:         $cid = $env{'request.course.id'};
                   15392:         $cdom = $env{'course.'.$cid.'.domain'};
                   15393:         $cnum = $env{'course.'.$cid.'.num'};
                   15394:         $chome = $env{'course.'.$cid.'.home'};
                   15395:     }
                   15396:     my %allmaps = ();
                   15397:     my $lastchange =
                   15398:         &Apache::lonnet::get_coursechange($cdom,$cnum);
                   15399:     if ($lastchange > $env{'request.course.tied'}) {
                   15400:         my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
                   15401:         unless ($ferr) {
                   15402:             &update_content_constraints($cdom,$cnum,$chome,$cid);
                   15403:         }
                   15404:     }
                   15405:     my $navmap = Apache::lonnavmaps::navmap->new();
                   15406:     if (defined($navmap)) {
                   15407:         foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) {
                   15408:             $allmaps{$res->src()} = 1;
                   15409:         }
                   15410:     }
                   15411:     return \%allmaps;
                   15412: }
                   15413: 
1.1075.2.11  raeburn  15414: sub parse_supplemental_title {
                   15415:     my ($title) = @_;
                   15416: 
                   15417:     my ($foldertitle,$renametitle);
                   15418:     if ($title =~ /&amp;&amp;&amp;/) {
                   15419:         $title = &HTML::Entites::decode($title);
                   15420:     }
                   15421:     if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
                   15422:         $renametitle=$4;
                   15423:         my ($time,$uname,$udom) = ($1,$2,$3);
                   15424:         $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
                   15425:         my $name =  &plainname($uname,$udom);
                   15426:         $name = &HTML::Entities::encode($name,'"<>&\'');
                   15427:         $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
                   15428:         $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.
                   15429:             $name.': <br />'.$foldertitle;
                   15430:     }
                   15431:     if (wantarray) {
                   15432:         return ($title,$foldertitle,$renametitle);
                   15433:     }
                   15434:     return $title;
                   15435: }
                   15436: 
1.1075.2.43  raeburn  15437: sub recurse_supplemental {
                   15438:     my ($cnum,$cdom,$suppmap,$numfiles,$errors) = @_;
                   15439:     if ($suppmap) {
                   15440:         my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
                   15441:         if ($fatal) {
                   15442:             $errors ++;
                   15443:         } else {
                   15444:             if ($#LONCAPA::map::resources > 0) {
                   15445:                 foreach my $res (@LONCAPA::map::resources) {
                   15446:                     my ($title,$src,$ext,$type,$status)=split(/\:/,$res);
                   15447:                     if (($src ne '') && ($status eq 'res')) {
1.1075.2.46  raeburn  15448:                         if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
                   15449:                             ($numfiles,$errors) = &recurse_supplemental($cnum,$cdom,$1,$numfiles,$errors);
1.1075.2.43  raeburn  15450:                         } else {
                   15451:                             $numfiles ++;
                   15452:                         }
                   15453:                     }
                   15454:                 }
                   15455:             }
                   15456:         }
                   15457:     }
                   15458:     return ($numfiles,$errors);
                   15459: }
                   15460: 
1.1075.2.18  raeburn  15461: sub symb_to_docspath {
                   15462:     my ($symb) = @_;
                   15463:     return unless ($symb);
                   15464:     my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
                   15465:     if ($resurl=~/\.(sequence|page)$/) {
                   15466:         $mapurl=$resurl;
                   15467:     } elsif ($resurl eq 'adm/navmaps') {
                   15468:         $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
                   15469:     }
                   15470:     my $mapresobj;
                   15471:     my $navmap = Apache::lonnavmaps::navmap->new();
                   15472:     if (ref($navmap)) {
                   15473:         $mapresobj = $navmap->getResourceByUrl($mapurl);
                   15474:     }
                   15475:     $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
                   15476:     my $type=$2;
                   15477:     my $path;
                   15478:     if (ref($mapresobj)) {
                   15479:         my $pcslist = $mapresobj->map_hierarchy();
                   15480:         if ($pcslist ne '') {
                   15481:             foreach my $pc (split(/,/,$pcslist)) {
                   15482:                 next if ($pc <= 1);
                   15483:                 my $res = $navmap->getByMapPc($pc);
                   15484:                 if (ref($res)) {
                   15485:                     my $thisurl = $res->src();
                   15486:                     $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
                   15487:                     my $thistitle = $res->title();
                   15488:                     $path .= '&'.
                   15489:                              &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
1.1075.2.46  raeburn  15490:                              &escape($thistitle).
1.1075.2.18  raeburn  15491:                              ':'.$res->randompick().
                   15492:                              ':'.$res->randomout().
                   15493:                              ':'.$res->encrypted().
                   15494:                              ':'.$res->randomorder().
                   15495:                              ':'.$res->is_page();
                   15496:                 }
                   15497:             }
                   15498:         }
                   15499:         $path =~ s/^\&//;
                   15500:         my $maptitle = $mapresobj->title();
                   15501:         if ($mapurl eq 'default') {
1.1075.2.38  raeburn  15502:             $maptitle = 'Main Content';
1.1075.2.18  raeburn  15503:         }
                   15504:         $path .= (($path ne '')? '&' : '').
                   15505:                  &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1075.2.46  raeburn  15506:                  &escape($maptitle).
1.1075.2.18  raeburn  15507:                  ':'.$mapresobj->randompick().
                   15508:                  ':'.$mapresobj->randomout().
                   15509:                  ':'.$mapresobj->encrypted().
                   15510:                  ':'.$mapresobj->randomorder().
                   15511:                  ':'.$mapresobj->is_page();
                   15512:     } else {
                   15513:         my $maptitle = &Apache::lonnet::gettitle($mapurl);
                   15514:         my $ispage = (($type eq 'page')? 1 : '');
                   15515:         if ($mapurl eq 'default') {
1.1075.2.38  raeburn  15516:             $maptitle = 'Main Content';
1.1075.2.18  raeburn  15517:         }
                   15518:         $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1075.2.46  raeburn  15519:                 &escape($maptitle).':::::'.$ispage;
1.1075.2.18  raeburn  15520:     }
                   15521:     unless ($mapurl eq 'default') {
                   15522:         $path = 'default&'.
1.1075.2.46  raeburn  15523:                 &escape('Main Content').
1.1075.2.18  raeburn  15524:                 ':::::&'.$path;
                   15525:     }
                   15526:     return $path;
                   15527: }
                   15528: 
1.1075.2.14  raeburn  15529: sub captcha_display {
                   15530:     my ($context,$lonhost) = @_;
                   15531:     my ($output,$error);
                   15532:     my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
                   15533:     if ($captcha eq 'original') {
                   15534:         $output = &create_captcha();
                   15535:         unless ($output) {
                   15536:             $error = 'captcha';
                   15537:         }
                   15538:     } elsif ($captcha eq 'recaptcha') {
                   15539:         $output = &create_recaptcha($pubkey);
                   15540:         unless ($output) {
                   15541:             $error = 'recaptcha';
                   15542:         }
                   15543:     }
1.1075.2.66  raeburn  15544:     return ($output,$error,$captcha);
1.1075.2.14  raeburn  15545: }
                   15546: 
                   15547: sub captcha_response {
                   15548:     my ($context,$lonhost) = @_;
                   15549:     my ($captcha_chk,$captcha_error);
                   15550:     my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
                   15551:     if ($captcha eq 'original') {
                   15552:         ($captcha_chk,$captcha_error) = &check_captcha();
                   15553:     } elsif ($captcha eq 'recaptcha') {
                   15554:         $captcha_chk = &check_recaptcha($privkey);
                   15555:     } else {
                   15556:         $captcha_chk = 1;
                   15557:     }
                   15558:     return ($captcha_chk,$captcha_error);
                   15559: }
                   15560: 
                   15561: sub get_captcha_config {
                   15562:     my ($context,$lonhost) = @_;
                   15563:     my ($captcha,$pubkey,$privkey,$hashtocheck);
                   15564:     my $hostname = &Apache::lonnet::hostname($lonhost);
                   15565:     my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
                   15566:     my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
                   15567:     if ($context eq 'usercreation') {
                   15568:         my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
                   15569:         if (ref($domconfig{$context}) eq 'HASH') {
                   15570:             $hashtocheck = $domconfig{$context}{'cancreate'};
                   15571:             if (ref($hashtocheck) eq 'HASH') {
                   15572:                 if ($hashtocheck->{'captcha'} eq 'recaptcha') {
                   15573:                     if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
                   15574:                         $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
                   15575:                         $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
                   15576:                     }
                   15577:                     if ($privkey && $pubkey) {
                   15578:                         $captcha = 'recaptcha';
                   15579:                     } else {
                   15580:                         $captcha = 'original';
                   15581:                     }
                   15582:                 } elsif ($hashtocheck->{'captcha'} ne 'notused') {
                   15583:                     $captcha = 'original';
                   15584:                 }
                   15585:             }
                   15586:         } else {
                   15587:             $captcha = 'captcha';
                   15588:         }
                   15589:     } elsif ($context eq 'login') {
                   15590:         my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
                   15591:         if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
                   15592:             $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
                   15593:             $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
                   15594:             if ($privkey && $pubkey) {
                   15595:                 $captcha = 'recaptcha';
                   15596:             } else {
                   15597:                 $captcha = 'original';
                   15598:             }
                   15599:         } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
                   15600:             $captcha = 'original';
                   15601:         }
                   15602:     }
                   15603:     return ($captcha,$pubkey,$privkey);
                   15604: }
                   15605: 
                   15606: sub create_captcha {
                   15607:     my %captcha_params = &captcha_settings();
                   15608:     my ($output,$maxtries,$tries) = ('',10,0);
                   15609:     while ($tries < $maxtries) {
                   15610:         $tries ++;
                   15611:         my $captcha = Authen::Captcha->new (
                   15612:                                            output_folder => $captcha_params{'output_dir'},
                   15613:                                            data_folder   => $captcha_params{'db_dir'},
                   15614:                                           );
                   15615:         my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
                   15616: 
                   15617:         if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
                   15618:             $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
                   15619:                       &mt('Type in the letters/numbers shown below').'&nbsp;'.
1.1075.2.66  raeburn  15620:                       '<input type="text" size="5" name="code" value="" autocomplete="off" />'.
                   15621:                       '<br />'.
                   15622:                       '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />';
1.1075.2.14  raeburn  15623:             last;
                   15624:         }
                   15625:     }
                   15626:     return $output;
                   15627: }
                   15628: 
                   15629: sub captcha_settings {
                   15630:     my %captcha_params = (
                   15631:                            output_dir     => $Apache::lonnet::perlvar{'lonCaptchaDir'},
                   15632:                            www_output_dir => "/captchaspool",
                   15633:                            db_dir         => $Apache::lonnet::perlvar{'lonCaptchaDb'},
                   15634:                            numchars       => '5',
                   15635:                          );
                   15636:     return %captcha_params;
                   15637: }
                   15638: 
                   15639: sub check_captcha {
                   15640:     my ($captcha_chk,$captcha_error);
                   15641:     my $code = $env{'form.code'};
                   15642:     my $md5sum = $env{'form.crypt'};
                   15643:     my %captcha_params = &captcha_settings();
                   15644:     my $captcha = Authen::Captcha->new(
                   15645:                       output_folder => $captcha_params{'output_dir'},
                   15646:                       data_folder   => $captcha_params{'db_dir'},
                   15647:                   );
1.1075.2.26  raeburn  15648:     $captcha_chk = $captcha->check_code($code,$md5sum);
1.1075.2.14  raeburn  15649:     my %captcha_hash = (
                   15650:                         0       => 'Code not checked (file error)',
                   15651:                        -1      => 'Failed: code expired',
                   15652:                        -2      => 'Failed: invalid code (not in database)',
                   15653:                        -3      => 'Failed: invalid code (code does not match crypt)',
                   15654:     );
                   15655:     if ($captcha_chk != 1) {
                   15656:         $captcha_error = $captcha_hash{$captcha_chk}
                   15657:     }
                   15658:     return ($captcha_chk,$captcha_error);
                   15659: }
                   15660: 
                   15661: sub create_recaptcha {
                   15662:     my ($pubkey) = @_;
1.1075.2.51  raeburn  15663:     my $use_ssl;
                   15664:     if ($ENV{'SERVER_PORT'} == 443) {
                   15665:         $use_ssl = 1;
                   15666:     }
1.1075.2.14  raeburn  15667:     my $captcha = Captcha::reCAPTCHA->new;
                   15668:     return $captcha->get_options_setter({theme => 'white'})."\n".
1.1075.2.51  raeburn  15669:            $captcha->get_html($pubkey,undef,$use_ssl).
1.1075.2.14  raeburn  15670:            &mt('If either word is hard to read, [_1] will replace them.',
1.1075.2.39  raeburn  15671:                '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
1.1075.2.14  raeburn  15672:            '<br /><br />';
                   15673: }
                   15674: 
                   15675: sub check_recaptcha {
                   15676:     my ($privkey) = @_;
                   15677:     my $captcha_chk;
                   15678:     my $captcha = Captcha::reCAPTCHA->new;
                   15679:     my $captcha_result =
                   15680:         $captcha->check_answer(
                   15681:                                 $privkey,
                   15682:                                 $ENV{'REMOTE_ADDR'},
                   15683:                                 $env{'form.recaptcha_challenge_field'},
                   15684:                                 $env{'form.recaptcha_response_field'},
                   15685:                               );
                   15686:     if ($captcha_result->{is_valid}) {
                   15687:         $captcha_chk = 1;
                   15688:     }
                   15689:     return $captcha_chk;
                   15690: }
                   15691: 
1.1075.2.64  raeburn  15692: sub emailusername_info {
1.1075.2.67  raeburn  15693:     my @fields = ('firstname','lastname','institution','web','location','officialemail');
1.1075.2.64  raeburn  15694:     my %titles = &Apache::lonlocal::texthash (
                   15695:                      lastname      => 'Last Name',
                   15696:                      firstname     => 'First Name',
                   15697:                      institution   => 'School/college/university',
                   15698:                      location      => "School's city, state/province, country",
                   15699:                      web           => "School's web address",
                   15700:                      officialemail => 'E-mail address at institution (if different)',
                   15701:                  );
                   15702:     return (\@fields,\%titles);
                   15703: }
                   15704: 
1.1075.2.56  raeburn  15705: sub cleanup_html {
                   15706:     my ($incoming) = @_;
                   15707:     my $outgoing;
                   15708:     if ($incoming ne '') {
                   15709:         $outgoing = $incoming;
                   15710:         $outgoing =~ s/;/&#059;/g;
                   15711:         $outgoing =~ s/\#/&#035;/g;
                   15712:         $outgoing =~ s/\&/&#038;/g;
                   15713:         $outgoing =~ s/</&#060;/g;
                   15714:         $outgoing =~ s/>/&#062;/g;
                   15715:         $outgoing =~ s/\(/&#040/g;
                   15716:         $outgoing =~ s/\)/&#041;/g;
                   15717:         $outgoing =~ s/"/&#034;/g;
                   15718:         $outgoing =~ s/'/&#039;/g;
                   15719:         $outgoing =~ s/\$/&#036;/g;
                   15720:         $outgoing =~ s{/}{&#047;}g;
                   15721:         $outgoing =~ s/=/&#061;/g;
                   15722:         $outgoing =~ s/\\/&#092;/g
                   15723:     }
                   15724:     return $outgoing;
                   15725: }
                   15726: 
1.1075.2.74  raeburn  15727: # Checks for critical messages and returns a redirect url if one exists.
                   15728: # $interval indicates how often to check for messages.
                   15729: sub critical_redirect {
                   15730:     my ($interval) = @_;
                   15731:     if ((time-$env{'user.criticalcheck.time'})>$interval) {
                   15732:         my @what=&Apache::lonnet::dump('critical', $env{'user.domain'},
                   15733:                                         $env{'user.name'});
                   15734:         &Apache::lonnet::appenv({'user.criticalcheck.time'=>time});
                   15735:         my $redirecturl;
                   15736:         if ($what[0]) {
                   15737:             if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) {
                   15738:                 $redirecturl='/adm/email?critical=display';
                   15739:                 my $url=&Apache::lonnet::absolute_url().$redirecturl;
                   15740:                 return (1, $url);
                   15741:             }
                   15742:         }
                   15743:     }
                   15744:     return ();
                   15745: }
                   15746: 
1.1075.2.64  raeburn  15747: # Use:
                   15748: #   my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
                   15749: #
                   15750: ##################################################
                   15751: #          password associated functions         #
                   15752: ##################################################
                   15753: sub des_keys {
                   15754:     # Make a new key for DES encryption.
                   15755:     # Each key has two parts which are returned separately.
                   15756:     # Please note:  Each key must be passed through the &hex function
                   15757:     # before it is output to the web browser.  The hex versions cannot
                   15758:     # be used to decrypt.
                   15759:     my @hexstr=('0','1','2','3','4','5','6','7',
                   15760:                 '8','9','a','b','c','d','e','f');
                   15761:     my $lkey='';
                   15762:     for (0..7) {
                   15763:         $lkey.=$hexstr[rand(15)];
                   15764:     }
                   15765:     my $ukey='';
                   15766:     for (0..7) {
                   15767:         $ukey.=$hexstr[rand(15)];
                   15768:     }
                   15769:     return ($lkey,$ukey);
                   15770: }
                   15771: 
                   15772: sub des_decrypt {
                   15773:     my ($key,$cyphertext) = @_;
                   15774:     my $keybin=pack("H16",$key);
                   15775:     my $cypher;
                   15776:     if ($Crypt::DES::VERSION>=2.03) {
                   15777:         $cypher=new Crypt::DES $keybin;
                   15778:     } else {
                   15779:         $cypher=new DES $keybin;
                   15780:     }
                   15781:     my $plaintext=
                   15782:         $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,0,16))));
                   15783:     $plaintext.=
                   15784:         $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,16,16))));
                   15785:     $plaintext=substr($plaintext,1,ord(substr($plaintext,0,1)) );
                   15786:     return $plaintext;
                   15787: }
                   15788: 
1.112     bowersj2 15789: 1;
                   15790: __END__;
1.41      ng       15791: 

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