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

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.102! raeburn     4: # $Id: loncommon.pm,v 1.1075.2.101 2016/08/05 22:24:31 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.1075.2.102! raeburn    75: use DateTime::Locale;
1.1075.2.94  raeburn    76: use Encode();
1.1075.2.14  raeburn    77: use Authen::Captcha;
                     78: use Captcha::reCAPTCHA;
1.1075.2.64  raeburn    79: use Crypt::DES;
                     80: use DynaLoader; # for Crypt::DES version
1.117     www        81: 
1.517     raeburn    82: # ---------------------------------------------- Designs
                     83: use vars qw(%defaultdesign);
                     84: 
1.22      www        85: my $readit;
                     86: 
1.517     raeburn    87: 
1.157     matthew    88: ##
                     89: ## Global Variables
                     90: ##
1.46      matthew    91: 
1.643     foxr       92: 
                     93: # ----------------------------------------------- SSI with retries:
                     94: #
                     95: 
                     96: =pod
                     97: 
1.648     raeburn    98: =head1 Server Side include with retries:
1.643     foxr       99: 
                    100: =over 4
                    101: 
1.648     raeburn   102: =item * &ssi_with_retries(resource,retries form)
1.643     foxr      103: 
                    104: Performs an ssi with some number of retries.  Retries continue either
                    105: until the result is ok or until the retry count supplied by the
                    106: caller is exhausted.  
                    107: 
                    108: Inputs:
1.648     raeburn   109: 
                    110: =over 4
                    111: 
1.643     foxr      112: resource   - Identifies the resource to insert.
1.648     raeburn   113: 
1.643     foxr      114: retries    - Count of the number of retries allowed.
1.648     raeburn   115: 
1.643     foxr      116: form       - Hash that identifies the rendering options.
                    117: 
1.648     raeburn   118: =back
                    119: 
                    120: Returns:
                    121: 
                    122: =over 4
                    123: 
1.643     foxr      124: content    - The content of the response.  If retries were exhausted this is empty.
1.648     raeburn   125: 
1.643     foxr      126: response   - The response from the last attempt (which may or may not have been successful.
                    127: 
1.648     raeburn   128: =back
                    129: 
                    130: =back
                    131: 
1.643     foxr      132: =cut
                    133: 
                    134: sub ssi_with_retries {
                    135:     my ($resource, $retries, %form) = @_;
                    136: 
                    137: 
                    138:     my $ok = 0;			# True if we got a good response.
                    139:     my $content;
                    140:     my $response;
                    141: 
                    142:     # Try to get the ssi done. within the retries count:
                    143: 
                    144:     do {
                    145: 	($content, $response) = &Apache::lonnet::ssi($resource, %form);
                    146: 	$ok      = $response->is_success;
1.650     www       147:         if (!$ok) {
                    148:             &Apache::lonnet::logthis("Failed ssi_with_retries on $resource: ".$response->is_success.', '.$response->code.', '.$response->message);
                    149:         }
1.643     foxr      150: 	$retries--;
                    151:     } while (!$ok && ($retries > 0));
                    152: 
                    153:     if (!$ok) {
                    154: 	$content = '';		# On error return an empty content.
                    155:     }
                    156:     return ($content, $response);
                    157: 
                    158: }
                    159: 
                    160: 
                    161: 
1.20      www       162: # ----------------------------------------------- Filetypes/Languages/Copyright
1.12      harris41  163: my %language;
1.124     www       164: my %supported_language;
1.1048    foxr      165: my %latex_language;		# For choosing hyphenation in <transl..>
                    166: my %latex_language_bykey;	# for choosing hyphenation from metadata
1.12      harris41  167: my %cprtag;
1.192     taceyjo1  168: my %scprtag;
1.351     www       169: my %fe; my %fd; my %fm;
1.41      ng        170: my %category_extensions;
1.12      harris41  171: 
1.46      matthew   172: # ---------------------------------------------- Thesaurus variables
1.144     matthew   173: #
                    174: # %Keywords:
                    175: #      A hash used by &keyword to determine if a word is considered a keyword.
                    176: # $thesaurus_db_file 
                    177: #      Scalar containing the full path to the thesaurus database.
1.46      matthew   178: 
                    179: my %Keywords;
                    180: my $thesaurus_db_file;
                    181: 
1.144     matthew   182: #
                    183: # Initialize values from language.tab, copyright.tab, filetypes.tab,
                    184: # thesaurus.tab, and filecategories.tab.
                    185: #
1.18      www       186: BEGIN {
1.46      matthew   187:     # Variable initialization
                    188:     $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
                    189:     #
1.22      www       190:     unless ($readit) {
1.12      harris41  191: # ------------------------------------------------------------------- languages
                    192:     {
1.158     raeburn   193:         my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    194:                                    '/language.tab';
                    195:         if ( open(my $fh,"<$langtabfile") ) {
1.356     albertel  196:             while (my $line = <$fh>) {
                    197:                 next if ($line=~/^\#/);
                    198:                 chomp($line);
1.1048    foxr      199:                 my ($key,$two,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line));
1.158     raeburn   200:                 $language{$key}=$val.' - '.$enc;
                    201:                 if ($sup) {
                    202:                     $supported_language{$key}=$sup;
                    203:                 }
1.1048    foxr      204: 		if ($latex) {
                    205: 		    $latex_language_bykey{$key} = $latex;
                    206: 		    $latex_language{$two} = $latex;
                    207: 		}
1.158     raeburn   208:             }
                    209:             close($fh);
                    210:         }
1.12      harris41  211:     }
                    212: # ------------------------------------------------------------------ copyrights
                    213:     {
1.158     raeburn   214:         my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
                    215:                                   '/copyright.tab';
                    216:         if ( open (my $fh,"<$copyrightfile") ) {
1.356     albertel  217:             while (my $line = <$fh>) {
                    218:                 next if ($line=~/^\#/);
                    219:                 chomp($line);
                    220:                 my ($key,$val)=(split(/\s+/,$line,2));
1.158     raeburn   221:                 $cprtag{$key}=$val;
                    222:             }
                    223:             close($fh);
                    224:         }
1.12      harris41  225:     }
1.351     www       226: # ----------------------------------------------------------- source copyrights
1.192     taceyjo1  227:     {
                    228:         my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
                    229:                                   '/source_copyright.tab';
                    230:         if ( open (my $fh,"<$sourcecopyrightfile") ) {
1.356     albertel  231:             while (my $line = <$fh>) {
                    232:                 next if ($line =~ /^\#/);
                    233:                 chomp($line);
                    234:                 my ($key,$val)=(split(/\s+/,$line,2));
1.192     taceyjo1  235:                 $scprtag{$key}=$val;
                    236:             }
                    237:             close($fh);
                    238:         }
                    239:     }
1.63      www       240: 
1.517     raeburn   241: # -------------------------------------------------------------- default domain designs
1.63      www       242:     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
1.517     raeburn   243:     my $designfile = $designdir.'/default.tab';
                    244:     if ( open (my $fh,"<$designfile") ) {
                    245:         while (my $line = <$fh>) {
                    246:             next if ($line =~ /^\#/);
                    247:             chomp($line);
                    248:             my ($key,$val)=(split(/\=/,$line));
                    249:             if ($val) { $defaultdesign{$key}=$val; }
                    250:         }
                    251:         close($fh);
1.63      www       252:     }
                    253: 
1.15      harris41  254: # ------------------------------------------------------------- file categories
                    255:     {
1.158     raeburn   256:         my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    257:                                   '/filecategories.tab';
                    258:         if ( open (my $fh,"<$categoryfile") ) {
1.356     albertel  259: 	    while (my $line = <$fh>) {
                    260: 		next if ($line =~ /^\#/);
                    261: 		chomp($line);
                    262:                 my ($extension,$category)=(split(/\s+/,$line,2));
1.158     raeburn   263:                 push @{$category_extensions{lc($category)}},$extension;
                    264:             }
                    265:             close($fh);
                    266:         }
                    267: 
1.15      harris41  268:     }
1.12      harris41  269: # ------------------------------------------------------------------ file types
                    270:     {
1.158     raeburn   271:         my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    272:                '/filetypes.tab';
                    273:         if ( open (my $fh,"<$typesfile") ) {
1.356     albertel  274:             while (my $line = <$fh>) {
                    275: 		next if ($line =~ /^\#/);
                    276: 		chomp($line);
                    277:                 my ($ending,$emb,$mime,$descr)=split(/\s+/,$line,4);
1.158     raeburn   278:                 if ($descr ne '') {
                    279:                     $fe{$ending}=lc($emb);
                    280:                     $fd{$ending}=$descr;
1.351     www       281:                     if ($mime ne 'unk') { $fm{$ending}=$mime; }
1.158     raeburn   282:                 }
                    283:             }
                    284:             close($fh);
                    285:         }
1.12      harris41  286:     }
1.22      www       287:     &Apache::lonnet::logthis(
1.705     tempelho  288:              "<span style='color:yellow;'>INFO: Read file types</span>");
1.22      www       289:     $readit=1;
1.46      matthew   290:     }  # end of unless($readit) 
1.32      matthew   291:     
                    292: }
1.112     bowersj2  293: 
1.42      matthew   294: ###############################################################
                    295: ##           HTML and Javascript Helper Functions            ##
                    296: ###############################################################
                    297: 
                    298: =pod 
                    299: 
1.112     bowersj2  300: =head1 HTML and Javascript Functions
1.42      matthew   301: 
1.112     bowersj2  302: =over 4
                    303: 
1.648     raeburn   304: =item * &browser_and_searcher_javascript()
1.112     bowersj2  305: 
                    306: X<browsing, javascript>X<searching, javascript>Returns a string
                    307: containing javascript with two functions, C<openbrowser> and
                    308: C<opensearcher>. Returned string does not contain E<lt>scriptE<gt>
                    309: tags.
1.42      matthew   310: 
1.648     raeburn   311: =item * &openbrowser(formname,elementname,only,omit) [javascript]
1.42      matthew   312: 
                    313: inputs: formname, elementname, only, omit
                    314: 
                    315: formname and elementname indicate the name of the html form and name of
                    316: the element that the results of the browsing selection are to be placed in. 
                    317: 
                    318: Specifying 'only' will restrict the browser to displaying only files
1.185     www       319: with the given extension.  Can be a comma separated list.
1.42      matthew   320: 
                    321: Specifying 'omit' will restrict the browser to NOT displaying files
1.185     www       322: with the given extension.  Can be a comma separated list.
1.42      matthew   323: 
1.648     raeburn   324: =item * &opensearcher(formname,elementname) [javascript]
1.42      matthew   325: 
                    326: Inputs: formname, elementname
                    327: 
                    328: formname and elementname specify the name of the html form and the name
                    329: of the element the selection from the search results will be placed in.
1.542     raeburn   330: 
1.42      matthew   331: =cut
                    332: 
                    333: sub browser_and_searcher_javascript {
1.199     albertel  334:     my ($mode)=@_;
                    335:     if (!defined($mode)) { $mode='edit'; }
1.453     albertel  336:     my $resurl=&escape_single(&lastresurl());
1.42      matthew   337:     return <<END;
1.219     albertel  338: // <!-- BEGIN LON-CAPA Internal
1.50      matthew   339:     var editbrowser = null;
1.135     albertel  340:     function openbrowser(formname,elementname,only,omit,titleelement) {
1.170     www       341:         var url = '$resurl/?';
1.42      matthew   342:         if (editbrowser == null) {
                    343:             url += 'launch=1&';
                    344:         }
                    345:         url += 'catalogmode=interactive&';
1.199     albertel  346:         url += 'mode=$mode&';
1.611     albertel  347:         url += 'inhibitmenu=yes&';
1.42      matthew   348:         url += 'form=' + formname + '&';
                    349:         if (only != null) {
                    350:             url += 'only=' + only + '&';
1.217     albertel  351:         } else {
                    352:             url += 'only=&';
                    353: 	}
1.42      matthew   354:         if (omit != null) {
                    355:             url += 'omit=' + omit + '&';
1.217     albertel  356:         } else {
                    357:             url += 'omit=&';
                    358: 	}
1.135     albertel  359:         if (titleelement != null) {
                    360:             url += 'titleelement=' + titleelement + '&';
1.217     albertel  361:         } else {
                    362: 	    url += 'titleelement=&';
                    363: 	}
1.42      matthew   364:         url += 'element=' + elementname + '';
                    365:         var title = 'Browser';
1.435     albertel  366:         var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42      matthew   367:         options += ',width=700,height=600';
                    368:         editbrowser = open(url,title,options,'1');
                    369:         editbrowser.focus();
                    370:     }
                    371:     var editsearcher;
1.135     albertel  372:     function opensearcher(formname,elementname,titleelement) {
1.42      matthew   373:         var url = '/adm/searchcat?';
                    374:         if (editsearcher == null) {
                    375:             url += 'launch=1&';
                    376:         }
                    377:         url += 'catalogmode=interactive&';
1.199     albertel  378:         url += 'mode=$mode&';
1.42      matthew   379:         url += 'form=' + formname + '&';
1.135     albertel  380:         if (titleelement != null) {
                    381:             url += 'titleelement=' + titleelement + '&';
1.217     albertel  382:         } else {
                    383: 	    url += 'titleelement=&';
                    384: 	}
1.42      matthew   385:         url += 'element=' + elementname + '';
                    386:         var title = 'Search';
1.435     albertel  387:         var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42      matthew   388:         options += ',width=700,height=600';
                    389:         editsearcher = open(url,title,options,'1');
                    390:         editsearcher.focus();
                    391:     }
1.219     albertel  392: // END LON-CAPA Internal -->
1.42      matthew   393: END
1.170     www       394: }
                    395: 
                    396: sub lastresurl {
1.258     albertel  397:     if ($env{'environment.lastresurl'}) {
                    398: 	return $env{'environment.lastresurl'}
1.170     www       399:     } else {
                    400: 	return '/res';
                    401:     }
                    402: }
                    403: 
                    404: sub storeresurl {
                    405:     my $resurl=&Apache::lonnet::clutter(shift);
                    406:     unless ($resurl=~/^\/res/) { return 0; }
                    407:     $resurl=~s/\/$//;
                    408:     &Apache::lonnet::put('environment',{'lastresurl' => $resurl});
1.646     raeburn   409:     &Apache::lonnet::appenv({'environment.lastresurl' => $resurl});
1.170     www       410:     return 1;
1.42      matthew   411: }
                    412: 
1.74      www       413: sub studentbrowser_javascript {
1.111     www       414:    unless (
1.258     albertel  415:             (($env{'request.course.id'}) && 
1.302     albertel  416:              (&Apache::lonnet::allowed('srm',$env{'request.course.id'})
                    417: 	      || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
                    418: 					  '/'.$env{'request.course.sec'})
                    419: 	      ))
1.258     albertel  420:          || ($env{'request.role'}=~/^(au|dc|su)/)
1.111     www       421:           ) { return ''; }  
1.74      www       422:    return (<<'ENDSTDBRW');
1.776     bisitz    423: <script type="text/javascript" language="Javascript">
1.824     bisitz    424: // <![CDATA[
1.74      www       425:     var stdeditbrowser;
1.999     www       426:     function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadvonly) {
1.74      www       427:         var url = '/adm/pickstudent?';
                    428:         var filter;
1.558     albertel  429: 	if (!ignorefilter) {
                    430: 	    eval('filter=document.'+formname+'.'+uname+'.value;');
                    431: 	}
1.74      www       432:         if (filter != null) {
                    433:            if (filter != '') {
                    434:                url += 'filter='+filter+'&';
                    435: 	   }
                    436:         }
                    437:         url += 'form=' + formname + '&unameelement='+uname+
1.999     www       438:                                     '&udomelement='+udom+
                    439:                                     '&clicker='+clicker;
1.111     www       440: 	if (roleflag) { url+="&roles=1"; }
1.793     raeburn   441:         if (courseadvonly) { url+="&courseadvonly=1"; }
1.102     www       442:         var title = 'Student_Browser';
1.74      www       443:         var options = 'scrollbars=1,resizable=1,menubar=0';
                    444:         options += ',width=700,height=600';
                    445:         stdeditbrowser = open(url,title,options,'1');
                    446:         stdeditbrowser.focus();
                    447:     }
1.824     bisitz    448: // ]]>
1.74      www       449: </script>
                    450: ENDSTDBRW
                    451: }
1.42      matthew   452: 
1.1003    www       453: sub resourcebrowser_javascript {
                    454:    unless ($env{'request.course.id'}) { return ''; }
1.1004    www       455:    return (<<'ENDRESBRW');
1.1003    www       456: <script type="text/javascript" language="Javascript">
                    457: // <![CDATA[
                    458:     var reseditbrowser;
1.1004    www       459:     function openresbrowser(formname,reslink) {
1.1005    www       460:         var url = '/adm/pickresource?form='+formname+'&reslink='+reslink;
1.1003    www       461:         var title = 'Resource_Browser';
                    462:         var options = 'scrollbars=1,resizable=1,menubar=0';
1.1005    www       463:         options += ',width=700,height=500';
1.1004    www       464:         reseditbrowser = open(url,title,options,'1');
                    465:         reseditbrowser.focus();
1.1003    www       466:     }
                    467: // ]]>
                    468: </script>
1.1004    www       469: ENDRESBRW
1.1003    www       470: }
                    471: 
1.74      www       472: sub selectstudent_link {
1.999     www       473:    my ($form,$unameele,$udomele,$courseadvonly,$clickerid)=@_;
                    474:    my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
                    475:                       &Apache::lonhtmlcommon::entity_encode($unameele)."','".
                    476:                       &Apache::lonhtmlcommon::entity_encode($udomele)."'";
1.258     albertel  477:    if ($env{'request.course.id'}) {  
1.302     albertel  478:        if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
                    479: 	   && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.
                    480: 					'/'.$env{'request.course.sec'})) {
1.111     www       481: 	   return '';
                    482:        }
1.999     www       483:        $callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";
1.793     raeburn   484:        if ($courseadvonly)  {
                    485:            $callargs .= ",'',1,1";
                    486:        }
                    487:        return '<span class="LC_nobreak">'.
                    488:               '<a href="javascript:openstdbrowser('.$callargs.');">'.
                    489:               &mt('Select User').'</a></span>';
1.74      www       490:    }
1.258     albertel  491:    if ($env{'request.role'}=~/^(au|dc|su)/) {
1.1012    www       492:        $callargs .= ",'',1"; 
1.793     raeburn   493:        return '<span class="LC_nobreak">'.
                    494:               '<a href="javascript:openstdbrowser('.$callargs.');">'.
                    495:               &mt('Select User').'</a></span>';
1.111     www       496:    }
                    497:    return '';
1.91      www       498: }
                    499: 
1.1004    www       500: sub selectresource_link {
                    501:    my ($form,$reslink,$arg)=@_;
                    502:    
                    503:    my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
                    504:                       &Apache::lonhtmlcommon::entity_encode($reslink)."'";
                    505:    unless ($env{'request.course.id'}) { return $arg; }
                    506:    return '<span class="LC_nobreak">'.
                    507:               '<a href="javascript:openresbrowser('.$callargs.');">'.
                    508:               $arg.'</a></span>';
                    509: }
                    510: 
                    511: 
                    512: 
1.653     raeburn   513: sub authorbrowser_javascript {
                    514:     return <<"ENDAUTHORBRW";
1.776     bisitz    515: <script type="text/javascript" language="JavaScript">
1.824     bisitz    516: // <![CDATA[
1.653     raeburn   517: var stdeditbrowser;
                    518: 
                    519: function openauthorbrowser(formname,udom) {
                    520:     var url = '/adm/pickauthor?';
                    521:     url += 'form='+formname+'&roledom='+udom;
                    522:     var title = 'Author_Browser';
                    523:     var options = 'scrollbars=1,resizable=1,menubar=0';
                    524:     options += ',width=700,height=600';
                    525:     stdeditbrowser = open(url,title,options,'1');
                    526:     stdeditbrowser.focus();
                    527: }
                    528: 
1.824     bisitz    529: // ]]>
1.653     raeburn   530: </script>
                    531: ENDAUTHORBRW
                    532: }
                    533: 
1.91      www       534: sub coursebrowser_javascript {
1.1075.2.31  raeburn   535:     my ($domainfilter,$sec_element,$formname,$role_element,$crstype,
1.1075.2.95  raeburn   536:         $credits_element,$instcode) = @_;
1.932     raeburn   537:     my $wintitle = 'Course_Browser';
1.931     raeburn   538:     if ($crstype eq 'Community') {
1.932     raeburn   539:         $wintitle = 'Community_Browser';
1.909     raeburn   540:     }
1.876     raeburn   541:     my $id_functions = &javascript_index_functions();
                    542:     my $output = '
1.776     bisitz    543: <script type="text/javascript" language="JavaScript">
1.824     bisitz    544: // <![CDATA[
1.468     raeburn   545:     var stdeditbrowser;'."\n";
1.876     raeburn   546: 
                    547:     $output .= <<"ENDSTDBRW";
1.909     raeburn   548:     function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,type,type_elem) {
1.91      www       549:         var url = '/adm/pickcourse?';
1.895     raeburn   550:         var formid = getFormIdByName(formname);
1.876     raeburn   551:         var domainfilter = getDomainFromSelectbox(formname,udom);
1.128     albertel  552:         if (domainfilter != null) {
                    553:            if (domainfilter != '') {
                    554:                url += 'domainfilter='+domainfilter+'&';
                    555: 	   }
                    556:         }
1.91      www       557:         url += 'form=' + formname + '&cnumelement='+uname+
1.187     albertel  558: 	                            '&cdomelement='+udom+
                    559:                                     '&cnameelement='+desc;
1.468     raeburn   560:         if (extra_element !=null && extra_element != '') {
1.594     raeburn   561:             if (formname == 'rolechoice' || formname == 'studentform') {
1.468     raeburn   562:                 url += '&roleelement='+extra_element;
                    563:                 if (domainfilter == null || domainfilter == '') {
                    564:                     url += '&domainfilter='+extra_element;
                    565:                 }
1.234     raeburn   566:             }
1.468     raeburn   567:             else {
                    568:                 if (formname == 'portform') {
                    569:                     url += '&setroles='+extra_element;
1.800     raeburn   570:                 } else {
                    571:                     if (formname == 'rules') {
                    572:                         url += '&fixeddom='+extra_element; 
                    573:                     }
1.468     raeburn   574:                 }
                    575:             }     
1.230     raeburn   576:         }
1.909     raeburn   577:         if (type != null && type != '') {
                    578:             url += '&type='+type;
                    579:         }
                    580:         if (type_elem != null && type_elem != '') {
                    581:             url += '&typeelement='+type_elem;
                    582:         }
1.872     raeburn   583:         if (formname == 'ccrs') {
                    584:             var ownername = document.forms[formid].ccuname.value;
                    585:             var ownerdom =  document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value;
1.1075.2.101  raeburn   586:             url += '&cloner='+ownername+':'+ownerdom;
                    587:             if (type == 'Course') {
                    588:                 url += '&crscode='+document.forms[formid].crscode.value;
                    589:             }
1.1075.2.95  raeburn   590:         }
                    591:         if (formname == 'requestcrs') {
                    592:             url += '&crsdom=$domainfilter&crscode=$instcode';
1.872     raeburn   593:         }
1.293     raeburn   594:         if (multflag !=null && multflag != '') {
                    595:             url += '&multiple='+multflag;
                    596:         }
1.909     raeburn   597:         var title = '$wintitle';
1.91      www       598:         var options = 'scrollbars=1,resizable=1,menubar=0';
                    599:         options += ',width=700,height=600';
                    600:         stdeditbrowser = open(url,title,options,'1');
                    601:         stdeditbrowser.focus();
                    602:     }
1.876     raeburn   603: $id_functions
                    604: ENDSTDBRW
1.1075.2.31  raeburn   605:     if (($sec_element ne '') || ($role_element ne '') || ($credits_element ne '')) {
                    606:         $output .= &setsec_javascript($sec_element,$formname,$role_element,
                    607:                                       $credits_element);
1.876     raeburn   608:     }
                    609:     $output .= '
                    610: // ]]>
                    611: </script>';
                    612:     return $output;
                    613: }
                    614: 
                    615: sub javascript_index_functions {
                    616:     return <<"ENDJS";
                    617: 
                    618: function getFormIdByName(formname) {
                    619:     for (var i=0;i<document.forms.length;i++) {
                    620:         if (document.forms[i].name == formname) {
                    621:             return i;
                    622:         }
                    623:     }
                    624:     return -1;
                    625: }
                    626: 
                    627: function getIndexByName(formid,item) {
                    628:     for (var i=0;i<document.forms[formid].elements.length;i++) {
                    629:         if (document.forms[formid].elements[i].name == item) {
                    630:             return i;
                    631:         }
                    632:     }
                    633:     return -1;
                    634: }
1.468     raeburn   635: 
1.876     raeburn   636: function getDomainFromSelectbox(formname,udom) {
                    637:     var userdom;
                    638:     var formid = getFormIdByName(formname);
                    639:     if (formid > -1) {
                    640:         var domid = getIndexByName(formid,udom);
                    641:         if (domid > -1) {
                    642:             if (document.forms[formid].elements[domid].type == 'select-one') {
                    643:                 userdom=document.forms[formid].elements[domid].options[document.forms[formid].elements[domid].selectedIndex].value;
                    644:             }
                    645:             if (document.forms[formid].elements[domid].type == 'hidden') {
                    646:                 userdom=document.forms[formid].elements[domid].value;
1.468     raeburn   647:             }
                    648:         }
                    649:     }
1.876     raeburn   650:     return userdom;
                    651: }
                    652: 
                    653: ENDJS
1.468     raeburn   654: 
1.876     raeburn   655: }
                    656: 
1.1017    raeburn   657: sub javascript_array_indexof {
1.1018    raeburn   658:     return <<ENDJS;
1.1017    raeburn   659: <script type="text/javascript" language="JavaScript">
                    660: // <![CDATA[
                    661: 
                    662: if (!Array.prototype.indexOf) {
                    663:     Array.prototype.indexOf = function (searchElement /*, fromIndex */ ) {
                    664:         "use strict";
                    665:         if (this === void 0 || this === null) {
                    666:             throw new TypeError();
                    667:         }
                    668:         var t = Object(this);
                    669:         var len = t.length >>> 0;
                    670:         if (len === 0) {
                    671:             return -1;
                    672:         }
                    673:         var n = 0;
                    674:         if (arguments.length > 0) {
                    675:             n = Number(arguments[1]);
                    676:             if (n !== n) { // shortcut for verifying if it's NaN
                    677:                 n = 0;
                    678:             } else if (n !== 0 && n !== (1 / 0) && n !== -(1 / 0)) {
                    679:                 n = (n > 0 || -1) * Math.floor(Math.abs(n));
                    680:             }
                    681:         }
                    682:         if (n >= len) {
                    683:             return -1;
                    684:         }
                    685:         var k = n >= 0 ? n : Math.max(len - Math.abs(n), 0);
                    686:         for (; k < len; k++) {
                    687:             if (k in t && t[k] === searchElement) {
                    688:                 return k;
                    689:             }
                    690:         }
                    691:         return -1;
                    692:     }
                    693: }
                    694: 
                    695: // ]]>
                    696: </script>
                    697: 
                    698: ENDJS
                    699: 
                    700: }
                    701: 
1.876     raeburn   702: sub userbrowser_javascript {
                    703:     my $id_functions = &javascript_index_functions();
                    704:     return <<"ENDUSERBRW";
                    705: 
1.888     raeburn   706: function openuserbrowser(formname,uname,udom,ulast,ufirst,uemail,hideudom,crsdom,caller) {
1.876     raeburn   707:     var url = '/adm/pickuser?';
                    708:     var userdom = getDomainFromSelectbox(formname,udom);
                    709:     if (userdom != null) {
                    710:        if (userdom != '') {
                    711:            url += 'srchdom='+userdom+'&';
                    712:        }
                    713:     }
                    714:     url += 'form=' + formname + '&unameelement='+uname+
                    715:                                 '&udomelement='+udom+
                    716:                                 '&ulastelement='+ulast+
                    717:                                 '&ufirstelement='+ufirst+
                    718:                                 '&uemailelement='+uemail+
1.881     raeburn   719:                                 '&hideudomelement='+hideudom+
                    720:                                 '&coursedom='+crsdom;
1.888     raeburn   721:     if ((caller != null) && (caller != undefined)) {
                    722:         url += '&caller='+caller;
                    723:     }
1.876     raeburn   724:     var title = 'User_Browser';
                    725:     var options = 'scrollbars=1,resizable=1,menubar=0';
                    726:     options += ',width=700,height=600';
                    727:     var stdeditbrowser = open(url,title,options,'1');
                    728:     stdeditbrowser.focus();
                    729: }
                    730: 
1.888     raeburn   731: function fix_domain (formname,udom,origdom,uname) {
1.876     raeburn   732:     var formid = getFormIdByName(formname);
                    733:     if (formid > -1) {
1.888     raeburn   734:         var unameid = getIndexByName(formid,uname);
1.876     raeburn   735:         var domid = getIndexByName(formid,udom);
                    736:         var hidedomid = getIndexByName(formid,origdom);
                    737:         if (hidedomid > -1) {
                    738:             var fixeddom = document.forms[formid].elements[hidedomid].value;
1.888     raeburn   739:             var unameval = document.forms[formid].elements[unameid].value;
                    740:             if ((fixeddom != '') && (fixeddom != undefined) && (fixeddom != null) && (unameval != '') && (unameval != undefined) && (unameval != null)) {
                    741:                 if (domid > -1) {
                    742:                     var slct = document.forms[formid].elements[domid];
                    743:                     if (slct.type == 'select-one') {
                    744:                         var i;
                    745:                         for (i=0;i<slct.length;i++) {
                    746:                             if (slct.options[i].value==fixeddom) { slct.selectedIndex=i; }
                    747:                         }
                    748:                     }
                    749:                     if (slct.type == 'hidden') {
                    750:                         slct.value = fixeddom;
1.876     raeburn   751:                     }
                    752:                 }
1.468     raeburn   753:             }
                    754:         }
                    755:     }
1.876     raeburn   756:     return;
                    757: }
                    758: 
                    759: $id_functions
                    760: ENDUSERBRW
1.468     raeburn   761: }
                    762: 
                    763: sub setsec_javascript {
1.1075.2.31  raeburn   764:     my ($sec_element,$formname,$role_element,$credits_element) = @_;
1.905     raeburn   765:     my (@courserolenames,@communityrolenames,$rolestr,$courserolestr,
                    766:         $communityrolestr);
                    767:     if ($role_element ne '') {
                    768:         my @allroles = ('st','ta','ep','in','ad');
                    769:         foreach my $crstype ('Course','Community') {
                    770:             if ($crstype eq 'Community') {
                    771:                 foreach my $role (@allroles) {
                    772:                     push(@communityrolenames,&Apache::lonnet::plaintext($role,$crstype));
                    773:                 }
                    774:                 push(@communityrolenames,&Apache::lonnet::plaintext('co'));
                    775:             } else {
                    776:                 foreach my $role (@allroles) {
                    777:                     push(@courserolenames,&Apache::lonnet::plaintext($role,$crstype));
                    778:                 }
                    779:                 push(@courserolenames,&Apache::lonnet::plaintext('cc'));
                    780:             }
                    781:         }
                    782:         $rolestr = '"'.join('","',@allroles).'"';
                    783:         $courserolestr = '"'.join('","',@courserolenames).'"';
                    784:         $communityrolestr = '"'.join('","',@communityrolenames).'"';
                    785:     }
1.468     raeburn   786:     my $setsections = qq|
                    787: function setSect(sectionlist) {
1.629     raeburn   788:     var sectionsArray = new Array();
                    789:     if ((sectionlist != '') && (typeof sectionlist != "undefined")) {
                    790:         sectionsArray = sectionlist.split(",");
                    791:     }
1.468     raeburn   792:     var numSections = sectionsArray.length;
                    793:     document.$formname.$sec_element.length = 0;
                    794:     if (numSections == 0) {
                    795:         document.$formname.$sec_element.multiple=false;
                    796:         document.$formname.$sec_element.size=1;
                    797:         document.$formname.$sec_element.options[0] = new Option('No existing sections','',false,false)
                    798:     } else {
                    799:         if (numSections == 1) {
                    800:             document.$formname.$sec_element.multiple=false;
                    801:             document.$formname.$sec_element.size=1;
                    802:             document.$formname.$sec_element.options[0] = new Option('Select','',true,true);
                    803:             document.$formname.$sec_element.options[1] = new Option('No section','',false,false)
                    804:             document.$formname.$sec_element.options[2] = new Option(sectionsArray[0],sectionsArray[0],false,false);
                    805:         } else {
                    806:             for (var i=0; i<numSections; i++) {
                    807:                 document.$formname.$sec_element.options[i] = new Option(sectionsArray[i],sectionsArray[i],false,false)
                    808:             }
                    809:             document.$formname.$sec_element.multiple=true
                    810:             if (numSections < 3) {
                    811:                 document.$formname.$sec_element.size=numSections;
                    812:             } else {
                    813:                 document.$formname.$sec_element.size=3;
                    814:             }
                    815:             document.$formname.$sec_element.options[0].selected = false
                    816:         }
                    817:     }
1.91      www       818: }
1.905     raeburn   819: 
                    820: function setRole(crstype) {
1.468     raeburn   821: |;
1.905     raeburn   822:     if ($role_element eq '') {
                    823:         $setsections .= '    return;
                    824: }
                    825: ';
                    826:     } else {
                    827:         $setsections .= qq|
                    828:     var elementLength = document.$formname.$role_element.length;
                    829:     var allroles = Array($rolestr);
                    830:     var courserolenames = Array($courserolestr);
                    831:     var communityrolenames = Array($communityrolestr);
                    832:     if (elementLength != undefined) {
                    833:         if (document.$formname.$role_element.options[5].value == 'cc') {
                    834:             if (crstype == 'Course') {
                    835:                 return;
                    836:             } else {
                    837:                 allroles[5] = 'co';
                    838:                 for (var i=0; i<6; i++) {
                    839:                     document.$formname.$role_element.options[i].value = allroles[i];
                    840:                     document.$formname.$role_element.options[i].text = communityrolenames[i];
                    841:                 }
                    842:             }
                    843:         } else {
                    844:             if (crstype == 'Community') {
                    845:                 return;
                    846:             } else {
                    847:                 allroles[5] = 'cc';
                    848:                 for (var i=0; i<6; i++) {
                    849:                     document.$formname.$role_element.options[i].value = allroles[i];
                    850:                     document.$formname.$role_element.options[i].text = courserolenames[i];
                    851:                 }
                    852:             }
                    853:         }
                    854:     }
                    855:     return;
                    856: }
                    857: |;
                    858:     }
1.1075.2.31  raeburn   859:     if ($credits_element) {
                    860:         $setsections .= qq|
                    861: function setCredits(defaultcredits) {
                    862:     document.$formname.$credits_element.value = defaultcredits;
                    863:     return;
                    864: }
                    865: |;
                    866:     }
1.468     raeburn   867:     return $setsections;
                    868: }
                    869: 
1.91      www       870: sub selectcourse_link {
1.909     raeburn   871:    my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype,
                    872:        $typeelement) = @_;
                    873:    my $type = $selecttype;
1.871     raeburn   874:    my $linktext = &mt('Select Course');
                    875:    if ($selecttype eq 'Community') {
1.909     raeburn   876:        $linktext = &mt('Select Community');
1.906     raeburn   877:    } elsif ($selecttype eq 'Course/Community') {
                    878:        $linktext = &mt('Select Course/Community');
1.909     raeburn   879:        $type = '';
1.1019    raeburn   880:    } elsif ($selecttype eq 'Select') {
                    881:        $linktext = &mt('Select');
                    882:        $type = '';
1.871     raeburn   883:    }
1.787     bisitz    884:    return '<span class="LC_nobreak">'
                    885:          ."<a href='"
                    886:          .'javascript:opencrsbrowser("'.$form.'","'.$unameele
                    887:          .'","'.$udomele.'","'.$desc.'","'.$extra_element
1.909     raeburn   888:          .'","'.$multflag.'","'.$type.'","'.$typeelement.'");'
1.871     raeburn   889:          ."'>".$linktext.'</a>'
1.787     bisitz    890:          .'</span>';
1.74      www       891: }
1.42      matthew   892: 
1.653     raeburn   893: sub selectauthor_link {
                    894:    my ($form,$udom)=@_;
                    895:    return '<a href="javascript:openauthorbrowser('."'$form','$udom'".');">'.
                    896:           &mt('Select Author').'</a>';
                    897: }
                    898: 
1.876     raeburn   899: sub selectuser_link {
1.881     raeburn   900:     my ($form,$unameelem,$domelem,$lastelem,$firstelem,$emailelem,$hdomelem,
1.888     raeburn   901:         $coursedom,$linktext,$caller) = @_;
1.876     raeburn   902:     return '<a href="javascript:openuserbrowser('."'$form','$unameelem','$domelem',".
1.888     raeburn   903:            "'$lastelem','$firstelem','$emailelem','$hdomelem','$coursedom','$caller'".
1.881     raeburn   904:            ');">'.$linktext.'</a>';
1.876     raeburn   905: }
                    906: 
1.273     raeburn   907: sub check_uncheck_jscript {
                    908:     my $jscript = <<"ENDSCRT";
                    909: function checkAll(field) {
                    910:     if (field.length > 0) {
                    911:         for (i = 0; i < field.length; i++) {
1.1075.2.14  raeburn   912:             if (!field[i].disabled) {
                    913:                 field[i].checked = true;
                    914:             }
1.273     raeburn   915:         }
                    916:     } else {
1.1075.2.14  raeburn   917:         if (!field.disabled) {
                    918:             field.checked = true;
                    919:         }
1.273     raeburn   920:     }
                    921: }
                    922:  
                    923: function uncheckAll(field) {
                    924:     if (field.length > 0) {
                    925:         for (i = 0; i < field.length; i++) {
                    926:             field[i].checked = false ;
1.543     albertel  927:         }
                    928:     } else {
1.273     raeburn   929:         field.checked = false ;
                    930:     }
                    931: }
                    932: ENDSCRT
                    933:     return $jscript;
                    934: }
                    935: 
1.656     www       936: sub select_timezone {
1.659     raeburn   937:    my ($name,$selected,$onchange,$includeempty)=@_;
                    938:    my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
                    939:    if ($includeempty) {
                    940:        $output .= '<option value=""';
                    941:        if (($selected eq '') || ($selected eq 'local')) {
                    942:            $output .= ' selected="selected" ';
                    943:        }
                    944:        $output .= '> </option>';
                    945:    }
1.657     raeburn   946:    my @timezones = DateTime::TimeZone->all_names;
                    947:    foreach my $tzone (@timezones) {
                    948:        $output.= '<option value="'.$tzone.'"';
                    949:        if ($tzone eq $selected) {
                    950:            $output.=' selected="selected"';
                    951:        }
                    952:        $output.=">$tzone</option>\n";
1.656     www       953:    }
                    954:    $output.="</select>";
                    955:    return $output;
                    956: }
1.273     raeburn   957: 
1.687     raeburn   958: sub select_datelocale {
                    959:     my ($name,$selected,$onchange,$includeempty)=@_;
                    960:     my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
                    961:     if ($includeempty) {
                    962:         $output .= '<option value=""';
                    963:         if ($selected eq '') {
                    964:             $output .= ' selected="selected" ';
                    965:         }
                    966:         $output .= '> </option>';
                    967:     }
1.1075.2.102! raeburn   968:     my @languages = &Apache::lonlocal::preferred_languages();
1.687     raeburn   969:     my (@possibles,%locale_names);
1.1075.2.102! raeburn   970:     my @locales = DateTime::Locale->ids();
        !           971:     foreach my $id (@locales) {
        !           972:         if ($id ne '') {
        !           973:             my ($en_terr,$native_terr);
        !           974:             my $loc = DateTime::Locale->load($id);
        !           975:             if (ref($loc)) {
        !           976:                 $en_terr = $loc->name();
        !           977:                 $native_terr = $loc->native_name();
1.687     raeburn   978:                 if (grep(/^en$/,@languages) || !@languages) {
                    979:                     if ($en_terr ne '') {
                    980:                         $locale_names{$id} = '('.$en_terr.')';
                    981:                     } elsif ($native_terr ne '') {
                    982:                         $locale_names{$id} = $native_terr;
                    983:                     }
                    984:                 } else {
                    985:                     if ($native_terr ne '') {
                    986:                         $locale_names{$id} = $native_terr.' ';
                    987:                     } elsif ($en_terr ne '') {
                    988:                         $locale_names{$id} = '('.$en_terr.')';
                    989:                     }
                    990:                 }
1.1075.2.94  raeburn   991:                 $locale_names{$id} = Encode::encode('UTF-8',$locale_names{$id});
1.1075.2.102! raeburn   992:                 push(@possibles,$id);
1.687     raeburn   993:             }
                    994:         }
                    995:     }
                    996:     foreach my $item (sort(@possibles)) {
                    997:         $output.= '<option value="'.$item.'"';
                    998:         if ($item eq $selected) {
                    999:             $output.=' selected="selected"';
                   1000:         }
                   1001:         $output.=">$item";
                   1002:         if ($locale_names{$item} ne '') {
1.1075.2.94  raeburn  1003:             $output.='  '.$locale_names{$item};
1.687     raeburn  1004:         }
                   1005:         $output.="</option>\n";
                   1006:     }
                   1007:     $output.="</select>";
                   1008:     return $output;
                   1009: }
                   1010: 
1.792     raeburn  1011: sub select_language {
                   1012:     my ($name,$selected,$includeempty) = @_;
                   1013:     my %langchoices;
                   1014:     if ($includeempty) {
1.1075.2.32  raeburn  1015:         %langchoices = ('' => 'No language preference');
1.792     raeburn  1016:     }
                   1017:     foreach my $id (&languageids()) {
                   1018:         my $code = &supportedlanguagecode($id);
                   1019:         if ($code) {
                   1020:             $langchoices{$code} = &plainlanguagedescription($id);
                   1021:         }
                   1022:     }
1.1075.2.32  raeburn  1023:     %langchoices = &Apache::lonlocal::texthash(%langchoices);
1.970     raeburn  1024:     return &select_form($selected,$name,\%langchoices);
1.792     raeburn  1025: }
                   1026: 
1.42      matthew  1027: =pod
1.36      matthew  1028: 
1.648     raeburn  1029: =item * &linked_select_forms(...)
1.36      matthew  1030: 
                   1031: linked_select_forms returns a string containing a <script></script> block
                   1032: and html for two <select> menus.  The select menus will be linked in that
                   1033: changing the value of the first menu will result in new values being placed
                   1034: in the second menu.  The values in the select menu will appear in alphabetical
1.609     raeburn  1035: order unless a defined order is provided.
1.36      matthew  1036: 
                   1037: linked_select_forms takes the following ordered inputs:
                   1038: 
                   1039: =over 4
                   1040: 
1.112     bowersj2 1041: =item * $formname, the name of the <form> tag
1.36      matthew  1042: 
1.112     bowersj2 1043: =item * $middletext, the text which appears between the <select> tags
1.36      matthew  1044: 
1.112     bowersj2 1045: =item * $firstdefault, the default value for the first menu
1.36      matthew  1046: 
1.112     bowersj2 1047: =item * $firstselectname, the name of the first <select> tag
1.36      matthew  1048: 
1.112     bowersj2 1049: =item * $secondselectname, the name of the second <select> tag
1.36      matthew  1050: 
1.112     bowersj2 1051: =item * $hashref, a reference to a hash containing the data for the menus.
1.36      matthew  1052: 
1.609     raeburn  1053: =item * $menuorder, the order of values in the first menu
                   1054: 
1.1075.2.31  raeburn  1055: =item * $onchangefirst, additional javascript call to execute for an onchange
                   1056:         event for the first <select> tag
                   1057: 
                   1058: =item * $onchangesecond, additional javascript call to execute for an onchange
                   1059:         event for the second <select> tag
                   1060: 
1.41      ng       1061: =back 
                   1062: 
1.36      matthew  1063: Below is an example of such a hash.  Only the 'text', 'default', and 
                   1064: 'select2' keys must appear as stated.  keys(%menu) are the possible 
                   1065: values for the first select menu.  The text that coincides with the 
1.41      ng       1066: first menu value is given in $menu{$choice1}->{'text'}.  The values 
1.36      matthew  1067: and text for the second menu are given in the hash pointed to by 
                   1068: $menu{$choice1}->{'select2'}.  
                   1069: 
1.112     bowersj2 1070:  my %menu = ( A1 => { text =>"Choice A1" ,
                   1071:                        default => "B3",
                   1072:                        select2 => { 
                   1073:                            B1 => "Choice B1",
                   1074:                            B2 => "Choice B2",
                   1075:                            B3 => "Choice B3",
                   1076:                            B4 => "Choice B4"
1.609     raeburn  1077:                            },
                   1078:                        order => ['B4','B3','B1','B2'],
1.112     bowersj2 1079:                    },
                   1080:                A2 => { text =>"Choice A2" ,
                   1081:                        default => "C2",
                   1082:                        select2 => { 
                   1083:                            C1 => "Choice C1",
                   1084:                            C2 => "Choice C2",
                   1085:                            C3 => "Choice C3"
1.609     raeburn  1086:                            },
                   1087:                        order => ['C2','C1','C3'],
1.112     bowersj2 1088:                    },
                   1089:                A3 => { text =>"Choice A3" ,
                   1090:                        default => "D6",
                   1091:                        select2 => { 
                   1092:                            D1 => "Choice D1",
                   1093:                            D2 => "Choice D2",
                   1094:                            D3 => "Choice D3",
                   1095:                            D4 => "Choice D4",
                   1096:                            D5 => "Choice D5",
                   1097:                            D6 => "Choice D6",
                   1098:                            D7 => "Choice D7"
1.609     raeburn  1099:                            },
                   1100:                        order => ['D4','D3','D2','D1','D7','D6','D5'],
1.112     bowersj2 1101:                    }
                   1102:                );
1.36      matthew  1103: 
                   1104: =cut
                   1105: 
                   1106: sub linked_select_forms {
                   1107:     my ($formname,
                   1108:         $middletext,
                   1109:         $firstdefault,
                   1110:         $firstselectname,
                   1111:         $secondselectname, 
1.609     raeburn  1112:         $hashref,
                   1113:         $menuorder,
1.1075.2.31  raeburn  1114:         $onchangefirst,
                   1115:         $onchangesecond
1.36      matthew  1116:         ) = @_;
                   1117:     my $second = "document.$formname.$secondselectname";
                   1118:     my $first = "document.$formname.$firstselectname";
                   1119:     # output the javascript to do the changing
                   1120:     my $result = '';
1.776     bisitz   1121:     $result.='<script type="text/javascript" language="JavaScript">'."\n";
1.824     bisitz   1122:     $result.="// <![CDATA[\n";
1.36      matthew  1123:     $result.="var select2data = new Object();\n";
                   1124:     $" = '","';
                   1125:     my $debug = '';
                   1126:     foreach my $s1 (sort(keys(%$hashref))) {
                   1127:         $result.="select2data.d_$s1 = new Object();\n";        
                   1128:         $result.="select2data.d_$s1.def = new String('".
                   1129:             $hashref->{$s1}->{'default'}."');\n";
1.609     raeburn  1130:         $result.="select2data.d_$s1.values = new Array(";
1.36      matthew  1131:         my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
1.609     raeburn  1132:         if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
                   1133:             @s2values = @{$hashref->{$s1}->{'order'}};
                   1134:         }
1.36      matthew  1135:         $result.="\"@s2values\");\n";
                   1136:         $result.="select2data.d_$s1.texts = new Array(";        
                   1137:         my @s2texts;
                   1138:         foreach my $value (@s2values) {
                   1139:             push @s2texts, $hashref->{$s1}->{'select2'}->{$value};
                   1140:         }
                   1141:         $result.="\"@s2texts\");\n";
                   1142:     }
                   1143:     $"=' ';
                   1144:     $result.= <<"END";
                   1145: 
                   1146: function select1_changed() {
                   1147:     // Determine new choice
                   1148:     var newvalue = "d_" + $first.value;
                   1149:     // update select2
                   1150:     var values     = select2data[newvalue].values;
                   1151:     var texts      = select2data[newvalue].texts;
                   1152:     var select2def = select2data[newvalue].def;
                   1153:     var i;
                   1154:     // out with the old
                   1155:     for (i = 0; i < $second.options.length; i++) {
                   1156:         $second.options[i] = null;
                   1157:     }
                   1158:     // in with the nuclear
                   1159:     for (i=0;i<values.length; i++) {
                   1160:         $second.options[i] = new Option(values[i]);
1.143     matthew  1161:         $second.options[i].value = values[i];
1.36      matthew  1162:         $second.options[i].text = texts[i];
                   1163:         if (values[i] == select2def) {
                   1164:             $second.options[i].selected = true;
                   1165:         }
                   1166:     }
                   1167: }
1.824     bisitz   1168: // ]]>
1.36      matthew  1169: </script>
                   1170: END
                   1171:     # output the initial values for the selection lists
1.1075.2.31  raeburn  1172:     $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed();$onchangefirst\">\n";
1.609     raeburn  1173:     my @order = sort(keys(%{$hashref}));
                   1174:     if (ref($menuorder) eq 'ARRAY') {
                   1175:         @order = @{$menuorder};
                   1176:     }
                   1177:     foreach my $value (@order) {
1.36      matthew  1178:         $result.="    <option value=\"$value\" ";
1.253     albertel 1179:         $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119     www      1180:         $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36      matthew  1181:     }
                   1182:     $result .= "</select>\n";
                   1183:     my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
                   1184:     $result .= $middletext;
1.1075.2.31  raeburn  1185:     $result .= "<select size=\"1\" name=\"$secondselectname\"";
                   1186:     if ($onchangesecond) {
                   1187:         $result .= ' onchange="'.$onchangesecond.'"';
                   1188:     }
                   1189:     $result .= ">\n";
1.36      matthew  1190:     my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609     raeburn  1191:     
                   1192:     my @secondorder = sort(keys(%select2));
                   1193:     if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
                   1194:         @secondorder = @{$hashref->{$firstdefault}->{'order'}};
                   1195:     }
                   1196:     foreach my $value (@secondorder) {
1.36      matthew  1197:         $result.="    <option value=\"$value\" ";        
1.253     albertel 1198:         $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119     www      1199:         $result.=">".&mt($select2{$value})."</option>\n";
1.36      matthew  1200:     }
                   1201:     $result .= "</select>\n";
                   1202:     #    return $debug;
                   1203:     return $result;
                   1204: }   #  end of sub linked_select_forms {
                   1205: 
1.45      matthew  1206: =pod
1.44      bowersj2 1207: 
1.973     raeburn  1208: =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height,$imgid)
1.44      bowersj2 1209: 
1.112     bowersj2 1210: Returns a string corresponding to an HTML link to the given help
                   1211: $topic, where $topic corresponds to the name of a .tex file in
                   1212: /home/httpd/html/adm/help/tex, with underscores replaced by
                   1213: spaces. 
                   1214: 
                   1215: $text will optionally be linked to the same topic, allowing you to
                   1216: link text in addition to the graphic. If you do not want to link
                   1217: text, but wish to specify one of the later parameters, pass an
                   1218: empty string. 
                   1219: 
                   1220: $stayOnPage is a value that will be interpreted as a boolean. If true,
                   1221: the link will not open a new window. If false, the link will open
                   1222: a new window using Javascript. (Default is false.) 
                   1223: 
                   1224: $width and $height are optional numerical parameters that will
                   1225: override the width and height of the popped up window, which may
1.973     raeburn  1226: be useful for certain help topics with big pictures included.
                   1227: 
                   1228: $imgid is the id of the img tag used for the help icon. This may be
                   1229: used in a javascript call to switch the image src.  See 
                   1230: lonhtmlcommon::htmlareaselectactive() for an example.
1.44      bowersj2 1231: 
                   1232: =cut
                   1233: 
                   1234: sub help_open_topic {
1.973     raeburn  1235:     my ($topic, $text, $stayOnPage, $width, $height, $imgid) = @_;
1.48      bowersj2 1236:     $text = "" if (not defined $text);
1.44      bowersj2 1237:     $stayOnPage = 0 if (not defined $stayOnPage);
1.1033    www      1238:     $width = 500 if (not defined $width);
1.44      bowersj2 1239:     $height = 400 if (not defined $height);
                   1240:     my $filename = $topic;
                   1241:     $filename =~ s/ /_/g;
                   1242: 
1.48      bowersj2 1243:     my $template = "";
                   1244:     my $link;
1.572     banghart 1245:     
1.159     www      1246:     $topic=~s/\W/\_/g;
1.44      bowersj2 1247: 
1.572     banghart 1248:     if (!$stayOnPage) {
1.1075.2.50  raeburn  1249:         if ($env{'browser.mobile'}) {
                   1250: 	    $link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');";
                   1251:         } else {
                   1252:             $link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1253:         }
1.1037    www      1254:     } elsif ($stayOnPage eq 'popup') {
                   1255:         $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 1256:     } else {
1.48      bowersj2 1257: 	$link = "/adm/help/${filename}.hlp";
                   1258:     }
                   1259: 
                   1260:     # Add the text
1.755     neumanie 1261:     if ($text ne "") {	
1.763     bisitz   1262: 	$template.='<span class="LC_help_open_topic">'
                   1263:                   .'<a target="_top" href="'.$link.'">'
                   1264:                   .$text.'</a>';
1.48      bowersj2 1265:     }
                   1266: 
1.763     bisitz   1267:     # (Always) Add the graphic
1.179     matthew  1268:     my $title = &mt('Online Help');
1.667     raeburn  1269:     my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.973     raeburn  1270:     if ($imgid ne '') {
                   1271:         $imgid = ' id="'.$imgid.'"';
                   1272:     }
1.763     bisitz   1273:     $template.=' <a target="_top" href="'.$link.'" title="'.$title.'">'
                   1274:               .'<img src="'.$helpicon.'" border="0"'
                   1275:               .' alt="'.&mt('Help: [_1]',$topic).'"'
1.973     raeburn  1276:               .' title="'.$title.'" style="vertical-align:middle;"'.$imgid 
1.763     bisitz   1277:               .' /></a>';
                   1278:     if ($text ne "") {	
                   1279:         $template.='</span>';
                   1280:     }
1.44      bowersj2 1281:     return $template;
                   1282: 
1.106     bowersj2 1283: }
                   1284: 
                   1285: # This is a quicky function for Latex cheatsheet editing, since it 
                   1286: # appears in at least four places
                   1287: sub helpLatexCheatsheet {
1.1037    www      1288:     my ($topic,$text,$not_author,$stayOnPage) = @_;
1.732     raeburn  1289:     my $out;
1.106     bowersj2 1290:     my $addOther = '';
1.732     raeburn  1291:     if ($topic) {
1.1037    www      1292: 	$addOther = '<span>'.&help_open_topic($topic,&mt($text),$stayOnPage, undef, 600).'</span> ';
1.763     bisitz   1293:     }
                   1294:     $out = '<span>' # Start cheatsheet
                   1295: 	  .$addOther
                   1296:           .'<span>'
1.1037    www      1297: 	  .&help_open_topic('Greek_Symbols',&mt('Greek Symbols'),$stayOnPage,undef,600)
1.763     bisitz   1298: 	  .'</span> <span>'
1.1037    www      1299: 	  .&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600)
1.763     bisitz   1300: 	  .'</span>';
1.732     raeburn  1301:     unless ($not_author) {
1.763     bisitz   1302:         $out .= ' <span>'
1.1037    www      1303: 	       .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)
1.1075.2.71  raeburn  1304: 	       .'</span> <span>'
1.1075.2.78  raeburn  1305:                .&help_open_topic('Authoring_Multilingual_Problems',&mt('Languages'),$stayOnPage,undef,600)
1.1075.2.71  raeburn  1306:                .'</span>';
1.732     raeburn  1307:     }
1.763     bisitz   1308:     $out .= '</span>'; # End cheatsheet
1.732     raeburn  1309:     return $out;
1.172     www      1310: }
                   1311: 
1.430     albertel 1312: sub general_help {
                   1313:     my $helptopic='Student_Intro';
                   1314:     if ($env{'request.role'}=~/^(ca|au)/) {
                   1315: 	$helptopic='Authoring_Intro';
1.907     raeburn  1316:     } elsif ($env{'request.role'}=~/^(cc|co)/) {
1.430     albertel 1317: 	$helptopic='Course_Coordination_Intro';
1.672     raeburn  1318:     } elsif ($env{'request.role'}=~/^dc/) {
                   1319:         $helptopic='Domain_Coordination_Intro';
1.430     albertel 1320:     }
                   1321:     return $helptopic;
                   1322: }
                   1323: 
                   1324: sub update_help_link {
                   1325:     my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
                   1326:     my $origurl = $ENV{'REQUEST_URI'};
                   1327:     $origurl=~s|^/~|/priv/|;
                   1328:     my $timestamp = time;
                   1329:     foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
                   1330:         $$datum = &escape($$datum);
                   1331:     }
                   1332: 
                   1333:     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";
                   1334:     my $output .= <<"ENDOUTPUT";
                   1335: <script type="text/javascript">
1.824     bisitz   1336: // <![CDATA[
1.430     albertel 1337: banner_link = '$banner_link';
1.824     bisitz   1338: // ]]>
1.430     albertel 1339: </script>
                   1340: ENDOUTPUT
                   1341:     return $output;
                   1342: }
                   1343: 
                   1344: # now just updates the help link and generates a blue icon
1.193     raeburn  1345: sub help_open_menu {
1.430     albertel 1346:     my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text) 
1.552     banghart 1347: 	= @_;    
1.949     droeschl 1348:     $stayOnPage = 1;
1.430     albertel 1349:     my $output;
                   1350:     if ($component_help) {
                   1351: 	if (!$text) {
                   1352: 	    $output=&help_open_topic($component_help,undef,$stayOnPage,
                   1353: 				       $width,$height);
                   1354: 	} else {
                   1355: 	    my $help_text;
                   1356: 	    $help_text=&unescape($topic);
                   1357: 	    $output='<table><tr><td>'.
                   1358: 		&help_open_topic($component_help,$help_text,$stayOnPage,
                   1359: 				 $width,$height).'</td></tr></table>';
                   1360: 	}
                   1361:     }
                   1362:     my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
                   1363:     return $output.$banner_link;
                   1364: }
                   1365: 
                   1366: sub top_nav_help {
                   1367:     my ($text) = @_;
1.436     albertel 1368:     $text = &mt($text);
1.1075.2.60  raeburn  1369:     my $stay_on_page;
                   1370:     unless ($env{'environment.remote'} eq 'on') {
                   1371:         $stay_on_page = 1;
                   1372:     }
1.1075.2.61  raeburn  1373:     my ($link,$banner_link);
                   1374:     unless ($env{'request.noversionuri'} =~ m{^/adm/helpmenu}) {
                   1375:         $link = ($stay_on_page) ? "javascript:helpMenu('display')"
                   1376: 	                         : "javascript:helpMenu('open')";
                   1377:         $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
                   1378:     }
1.201     raeburn  1379:     my $title = &mt('Get help');
1.1075.2.61  raeburn  1380:     if ($link) {
                   1381:         return <<"END";
1.436     albertel 1382: $banner_link
1.1075.2.56  raeburn  1383: <a href="$link" title="$title">$text</a>
1.436     albertel 1384: END
1.1075.2.61  raeburn  1385:     } else {
                   1386:         return '&nbsp;'.$text.'&nbsp;';
                   1387:     }
1.436     albertel 1388: }
                   1389: 
                   1390: sub help_menu_js {
1.1075.2.52  raeburn  1391:     my ($httphost) = @_;
1.949     droeschl 1392:     my $stayOnPage = 1;
1.436     albertel 1393:     my $width = 620;
                   1394:     my $height = 600;
1.430     albertel 1395:     my $helptopic=&general_help();
1.1075.2.52  raeburn  1396:     my $details_link = $httphost.'/adm/help/'.$helptopic.'.hlp';
1.261     albertel 1397:     my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331     albertel 1398:     my $start_page =
                   1399:         &Apache::loncommon::start_page('Help Menu', undef,
                   1400: 				       {'frameset'    => 1,
                   1401: 					'js_ready'    => 1,
1.1075.2.52  raeburn  1402:                                         'use_absolute' => $httphost, 
1.331     albertel 1403: 					'add_entries' => {
                   1404: 					    'border' => '0',
1.579     raeburn  1405: 					    'rows'   => "110,*",},});
1.331     albertel 1406:     my $end_page =
                   1407:         &Apache::loncommon::end_page({'frameset' => 1,
                   1408: 				      'js_ready' => 1,});
                   1409: 
1.436     albertel 1410:     my $template .= <<"ENDTEMPLATE";
                   1411: <script type="text/javascript">
1.877     bisitz   1412: // <![CDATA[
1.253     albertel 1413: // <!-- BEGIN LON-CAPA Internal
1.430     albertel 1414: var banner_link = '';
1.243     raeburn  1415: function helpMenu(target) {
                   1416:     var caller = this;
                   1417:     if (target == 'open') {
                   1418:         var newWindow = null;
                   1419:         try {
1.262     albertel 1420:             newWindow =  window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243     raeburn  1421:         }
                   1422:         catch(error) {
                   1423:             writeHelp(caller);
                   1424:             return;
                   1425:         }
                   1426:         if (newWindow) {
                   1427:             caller = newWindow;
                   1428:         }
1.193     raeburn  1429:     }
1.243     raeburn  1430:     writeHelp(caller);
                   1431:     return;
                   1432: }
                   1433: function writeHelp(caller) {
1.1075.2.61  raeburn  1434:     caller.document.writeln('$start_page\\n<frame name="bannerframe" src="'+banner_link+'" marginwidth="0" marginheight="0" frameborder="0">\\n');
                   1435:     caller.document.writeln('<frame name="bodyframe" src="$details_link" marginwidth="0" marginheight="0" frameborder="0">\\n$end_page');
                   1436:     caller.document.close();
                   1437:     caller.focus();
1.193     raeburn  1438: }
1.877     bisitz   1439: // END LON-CAPA Internal -->
1.253     albertel 1440: // ]]>
1.436     albertel 1441: </script>
1.193     raeburn  1442: ENDTEMPLATE
                   1443:     return $template;
                   1444: }
                   1445: 
1.172     www      1446: sub help_open_bug {
                   1447:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1448:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1449:     unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
                   1450:     $text = "" if (not defined $text);
                   1451: 	$stayOnPage=1;
1.184     albertel 1452:     $width = 600 if (not defined $width);
                   1453:     $height = 600 if (not defined $height);
1.172     www      1454: 
                   1455:     $topic=~s/\W+/\+/g;
                   1456:     my $link='';
                   1457:     my $template='';
1.379     albertel 1458:     my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&amp;bug_file_loc='.
                   1459: 	&escape($ENV{'REQUEST_URI'}).'&amp;component='.$topic;
1.172     www      1460:     if (!$stayOnPage)
                   1461:     {
                   1462: 	$link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1463:     }
                   1464:     else
                   1465:     {
                   1466: 	$link = $url;
                   1467:     }
                   1468:     # Add the text
                   1469:     if ($text ne "")
                   1470:     {
                   1471: 	$template .= 
                   1472:   "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705     tempelho 1473:   "<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
1.172     www      1474:     }
                   1475: 
                   1476:     # Add the graphic
1.179     matthew  1477:     my $title = &mt('Report a Bug');
1.215     albertel 1478:     my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172     www      1479:     $template .= <<"ENDTEMPLATE";
1.436     albertel 1480:  <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172     www      1481: ENDTEMPLATE
                   1482:     if ($text ne '') { $template.='</td></tr></table>' };
                   1483:     return $template;
                   1484: 
                   1485: }
                   1486: 
                   1487: sub help_open_faq {
                   1488:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1489:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1490:     unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
                   1491:     $text = "" if (not defined $text);
                   1492: 	$stayOnPage=1;
                   1493:     $width = 350 if (not defined $width);
                   1494:     $height = 400 if (not defined $height);
                   1495: 
                   1496:     $topic=~s/\W+/\+/g;
                   1497:     my $link='';
                   1498:     my $template='';
                   1499:     my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
                   1500:     if (!$stayOnPage)
                   1501:     {
                   1502: 	$link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1503:     }
                   1504:     else
                   1505:     {
                   1506: 	$link = $url;
                   1507:     }
                   1508: 
                   1509:     # Add the text
                   1510:     if ($text ne "")
                   1511:     {
                   1512: 	$template .= 
1.173     www      1513:   "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705     tempelho 1514:   "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF; font-size:10pt;\">$text</span></a>";
1.172     www      1515:     }
                   1516: 
                   1517:     # Add the graphic
1.179     matthew  1518:     my $title = &mt('View the FAQ');
1.215     albertel 1519:     my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172     www      1520:     $template .= <<"ENDTEMPLATE";
1.436     albertel 1521:  <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172     www      1522: ENDTEMPLATE
                   1523:     if ($text ne '') { $template.='</td></tr></table>' };
                   1524:     return $template;
                   1525: 
1.44      bowersj2 1526: }
1.37      matthew  1527: 
1.180     matthew  1528: ###############################################################
                   1529: ###############################################################
                   1530: 
1.45      matthew  1531: =pod
                   1532: 
1.648     raeburn  1533: =item * &change_content_javascript():
1.256     matthew  1534: 
                   1535: This and the next function allow you to create small sections of an
                   1536: otherwise static HTML page that you can update on the fly with
                   1537: Javascript, even in Netscape 4.
                   1538: 
                   1539: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
                   1540: must be written to the HTML page once. It will prove the Javascript
                   1541: function "change(name, content)". Calling the change function with the
                   1542: name of the section 
                   1543: you want to update, matching the name passed to C<changable_area>, and
                   1544: the new content you want to put in there, will put the content into
                   1545: that area.
                   1546: 
                   1547: B<Note>: Netscape 4 only reserves enough space for the changable area
                   1548: to contain room for the original contents. You need to "make space"
                   1549: for whatever changes you wish to make, and be B<sure> to check your
                   1550: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
                   1551: it's adequate for updating a one-line status display, but little more.
                   1552: This script will set the space to 100% width, so you only need to
                   1553: worry about height in Netscape 4.
                   1554: 
                   1555: Modern browsers are much less limiting, and if you can commit to the
                   1556: user not using Netscape 4, this feature may be used freely with
                   1557: pretty much any HTML.
                   1558: 
                   1559: =cut
                   1560: 
                   1561: sub change_content_javascript {
                   1562:     # If we're on Netscape 4, we need to use Layer-based code
1.258     albertel 1563:     if ($env{'browser.type'} eq 'netscape' &&
                   1564: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1565: 	return (<<NETSCAPE4);
                   1566: 	function change(name, content) {
                   1567: 	    doc = document.layers[name+"___escape"].layers[0].document;
                   1568: 	    doc.open();
                   1569: 	    doc.write(content);
                   1570: 	    doc.close();
                   1571: 	}
                   1572: NETSCAPE4
                   1573:     } else {
                   1574: 	# Otherwise, we need to use semi-standards-compliant code
                   1575: 	# (technically, "innerHTML" isn't standard but the equivalent
                   1576: 	# is really scary, and every useful browser supports it
                   1577: 	return (<<DOMBASED);
                   1578: 	function change(name, content) {
                   1579: 	    element = document.getElementById(name);
                   1580: 	    element.innerHTML = content;
                   1581: 	}
                   1582: DOMBASED
                   1583:     }
                   1584: }
                   1585: 
                   1586: =pod
                   1587: 
1.648     raeburn  1588: =item * &changable_area($name,$origContent):
1.256     matthew  1589: 
                   1590: This provides a "changable area" that can be modified on the fly via
                   1591: the Javascript code provided in C<change_content_javascript>. $name is
                   1592: the name you will use to reference the area later; do not repeat the
                   1593: same name on a given HTML page more then once. $origContent is what
                   1594: the area will originally contain, which can be left blank.
                   1595: 
                   1596: =cut
                   1597: 
                   1598: sub changable_area {
                   1599:     my ($name, $origContent) = @_;
                   1600: 
1.258     albertel 1601:     if ($env{'browser.type'} eq 'netscape' &&
                   1602: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1603: 	# If this is netscape 4, we need to use the Layer tag
                   1604: 	return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
                   1605:     } else {
                   1606: 	return "<span id='$name'>$origContent</span>";
                   1607:     }
                   1608: }
                   1609: 
                   1610: =pod
                   1611: 
1.648     raeburn  1612: =item * &viewport_geometry_js 
1.590     raeburn  1613: 
                   1614: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
                   1615: 
                   1616: =cut
                   1617: 
                   1618: 
                   1619: sub viewport_geometry_js { 
                   1620:     return <<"GEOMETRY";
                   1621: var Geometry = {};
                   1622: function init_geometry() {
                   1623:     if (Geometry.init) { return };
                   1624:     Geometry.init=1;
                   1625:     if (window.innerHeight) {
                   1626:         Geometry.getViewportHeight   = function() { return window.innerHeight; };
                   1627:         Geometry.getViewportWidth   = function() { return window.innerWidth; };
                   1628:         Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
                   1629:         Geometry.getVerticalScroll   = function() { return window.pageYOffset; };
                   1630:     }
                   1631:     else if (document.documentElement && document.documentElement.clientHeight) {
                   1632:         Geometry.getViewportHeight =
                   1633:             function() { return document.documentElement.clientHeight; };
                   1634:         Geometry.getViewportWidth =
                   1635:             function() { return document.documentElement.clientWidth; };
                   1636: 
                   1637:         Geometry.getHorizontalScroll =
                   1638:             function() { return document.documentElement.scrollLeft; };
                   1639:         Geometry.getVerticalScroll =
                   1640:             function() { return document.documentElement.scrollTop; };
                   1641:     }
                   1642:     else if (document.body.clientHeight) {
                   1643:         Geometry.getViewportHeight =
                   1644:             function() { return document.body.clientHeight; };
                   1645:         Geometry.getViewportWidth =
                   1646:             function() { return document.body.clientWidth; };
                   1647:         Geometry.getHorizontalScroll =
                   1648:             function() { return document.body.scrollLeft; };
                   1649:         Geometry.getVerticalScroll =
                   1650:             function() { return document.body.scrollTop; };
                   1651:     }
                   1652: }
                   1653: 
                   1654: GEOMETRY
                   1655: }
                   1656: 
                   1657: =pod
                   1658: 
1.648     raeburn  1659: =item * &viewport_size_js()
1.590     raeburn  1660: 
                   1661: 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. 
                   1662: 
                   1663: =cut
                   1664: 
                   1665: sub viewport_size_js {
                   1666:     my $geometry = &viewport_geometry_js();
                   1667:     return <<"DIMS";
                   1668: 
                   1669: $geometry
                   1670: 
                   1671: function getViewportDims(width,height) {
                   1672:     init_geometry();
                   1673:     width.value = Geometry.getViewportWidth();
                   1674:     height.value = Geometry.getViewportHeight();
                   1675:     return;
                   1676: }
                   1677: 
                   1678: DIMS
                   1679: }
                   1680: 
                   1681: =pod
                   1682: 
1.648     raeburn  1683: =item * &resize_textarea_js()
1.565     albertel 1684: 
                   1685: emits the needed javascript to resize a textarea to be as big as possible
                   1686: 
                   1687: creates a function resize_textrea that takes two IDs first should be
                   1688: the id of the element to resize, second should be the id of a div that
                   1689: surrounds everything that comes after the textarea, this routine needs
                   1690: to be attached to the <body> for the onload and onresize events.
                   1691: 
1.648     raeburn  1692: =back
1.565     albertel 1693: 
                   1694: =cut
                   1695: 
                   1696: sub resize_textarea_js {
1.590     raeburn  1697:     my $geometry = &viewport_geometry_js();
1.565     albertel 1698:     return <<"RESIZE";
                   1699:     <script type="text/javascript">
1.824     bisitz   1700: // <![CDATA[
1.590     raeburn  1701: $geometry
1.565     albertel 1702: 
1.588     albertel 1703: function getX(element) {
                   1704:     var x = 0;
                   1705:     while (element) {
                   1706: 	x += element.offsetLeft;
                   1707: 	element = element.offsetParent;
                   1708:     }
                   1709:     return x;
                   1710: }
                   1711: function getY(element) {
                   1712:     var y = 0;
                   1713:     while (element) {
                   1714: 	y += element.offsetTop;
                   1715: 	element = element.offsetParent;
                   1716:     }
                   1717:     return y;
                   1718: }
                   1719: 
                   1720: 
1.565     albertel 1721: function resize_textarea(textarea_id,bottom_id) {
                   1722:     init_geometry();
                   1723:     var textarea        = document.getElementById(textarea_id);
                   1724:     //alert(textarea);
                   1725: 
1.588     albertel 1726:     var textarea_top    = getY(textarea);
1.565     albertel 1727:     var textarea_height = textarea.offsetHeight;
                   1728:     var bottom          = document.getElementById(bottom_id);
1.588     albertel 1729:     var bottom_top      = getY(bottom);
1.565     albertel 1730:     var bottom_height   = bottom.offsetHeight;
                   1731:     var window_height   = Geometry.getViewportHeight();
1.588     albertel 1732:     var fudge           = 23;
1.565     albertel 1733:     var new_height      = window_height-fudge-textarea_top-bottom_height;
                   1734:     if (new_height < 300) {
                   1735: 	new_height = 300;
                   1736:     }
                   1737:     textarea.style.height=new_height+'px';
                   1738: }
1.824     bisitz   1739: // ]]>
1.565     albertel 1740: </script>
                   1741: RESIZE
                   1742: 
                   1743: }
                   1744: 
                   1745: =pod
                   1746: 
1.256     matthew  1747: =head1 Excel and CSV file utility routines
                   1748: 
                   1749: =cut
                   1750: 
                   1751: ###############################################################
                   1752: ###############################################################
                   1753: 
                   1754: =pod
                   1755: 
1.1075.2.56  raeburn  1756: =over 4
                   1757: 
1.648     raeburn  1758: =item * &csv_translate($text) 
1.37      matthew  1759: 
1.185     www      1760: Translate $text to allow it to be output as a 'comma separated values' 
1.37      matthew  1761: format.
                   1762: 
                   1763: =cut
                   1764: 
1.180     matthew  1765: ###############################################################
                   1766: ###############################################################
1.37      matthew  1767: sub csv_translate {
                   1768:     my $text = shift;
                   1769:     $text =~ s/\"/\"\"/g;
1.209     albertel 1770:     $text =~ s/\n/ /g;
1.37      matthew  1771:     return $text;
                   1772: }
1.180     matthew  1773: 
                   1774: ###############################################################
                   1775: ###############################################################
                   1776: 
                   1777: =pod
                   1778: 
1.648     raeburn  1779: =item * &define_excel_formats()
1.180     matthew  1780: 
                   1781: Define some commonly used Excel cell formats.
                   1782: 
                   1783: Currently supported formats:
                   1784: 
                   1785: =over 4
                   1786: 
                   1787: =item header
                   1788: 
                   1789: =item bold
                   1790: 
                   1791: =item h1
                   1792: 
                   1793: =item h2
                   1794: 
                   1795: =item h3
                   1796: 
1.256     matthew  1797: =item h4
                   1798: 
                   1799: =item i
                   1800: 
1.180     matthew  1801: =item date
                   1802: 
                   1803: =back
                   1804: 
                   1805: Inputs: $workbook
                   1806: 
                   1807: Returns: $format, a hash reference.
                   1808: 
1.1057    foxr     1809: 
1.180     matthew  1810: =cut
                   1811: 
                   1812: ###############################################################
                   1813: ###############################################################
                   1814: sub define_excel_formats {
                   1815:     my ($workbook) = @_;
                   1816:     my $format;
                   1817:     $format->{'header'} = $workbook->add_format(bold      => 1, 
                   1818:                                                 bottom    => 1,
                   1819:                                                 align     => 'center');
                   1820:     $format->{'bold'} = $workbook->add_format(bold=>1);
                   1821:     $format->{'h1'}   = $workbook->add_format(bold=>1, size=>18);
                   1822:     $format->{'h2'}   = $workbook->add_format(bold=>1, size=>16);
                   1823:     $format->{'h3'}   = $workbook->add_format(bold=>1, size=>14);
1.255     matthew  1824:     $format->{'h4'}   = $workbook->add_format(bold=>1, size=>12);
1.246     matthew  1825:     $format->{'i'}    = $workbook->add_format(italic=>1);
1.180     matthew  1826:     $format->{'date'} = $workbook->add_format(num_format=>
1.207     matthew  1827:                                             'mm/dd/yyyy hh:mm:ss');
1.180     matthew  1828:     return $format;
                   1829: }
                   1830: 
                   1831: ###############################################################
                   1832: ###############################################################
1.113     bowersj2 1833: 
                   1834: =pod
                   1835: 
1.648     raeburn  1836: =item * &create_workbook()
1.255     matthew  1837: 
                   1838: Create an Excel worksheet.  If it fails, output message on the
                   1839: request object and return undefs.
                   1840: 
                   1841: Inputs: Apache request object
                   1842: 
                   1843: Returns (undef) on failure, 
                   1844:     Excel worksheet object, scalar with filename, and formats 
                   1845:     from &Apache::loncommon::define_excel_formats on success
                   1846: 
                   1847: =cut
                   1848: 
                   1849: ###############################################################
                   1850: ###############################################################
                   1851: sub create_workbook {
                   1852:     my ($r) = @_;
                   1853:         #
                   1854:     # Create the excel spreadsheet
                   1855:     my $filename = '/prtspool/'.
1.258     albertel 1856:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255     matthew  1857:         time.'_'.rand(1000000000).'.xls';
                   1858:     my $workbook  = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
                   1859:     if (! defined($workbook)) {
                   1860:         $r->log_error("Error creating excel spreadsheet $filename: $!");
1.928     bisitz   1861:         $r->print(
                   1862:             '<p class="LC_error">'
                   1863:            .&mt('Problems occurred in creating the new Excel file.')
                   1864:            .' '.&mt('This error has been logged.')
                   1865:            .' '.&mt('Please alert your LON-CAPA administrator.')
                   1866:            .'</p>'
                   1867:         );
1.255     matthew  1868:         return (undef);
                   1869:     }
                   1870:     #
1.1014    foxr     1871:     $workbook->set_tempdir(LONCAPA::tempdir());
1.255     matthew  1872:     #
                   1873:     my $format = &Apache::loncommon::define_excel_formats($workbook);
                   1874:     return ($workbook,$filename,$format);
                   1875: }
                   1876: 
                   1877: ###############################################################
                   1878: ###############################################################
                   1879: 
                   1880: =pod
                   1881: 
1.648     raeburn  1882: =item * &create_text_file()
1.113     bowersj2 1883: 
1.542     raeburn  1884: Create a file to write to and eventually make available to the user.
1.256     matthew  1885: If file creation fails, outputs an error message on the request object and 
                   1886: return undefs.
1.113     bowersj2 1887: 
1.256     matthew  1888: Inputs: Apache request object, and file suffix
1.113     bowersj2 1889: 
1.256     matthew  1890: Returns (undef) on failure, 
                   1891:     Filehandle and filename on success.
1.113     bowersj2 1892: 
                   1893: =cut
                   1894: 
1.256     matthew  1895: ###############################################################
                   1896: ###############################################################
                   1897: sub create_text_file {
                   1898:     my ($r,$suffix) = @_;
                   1899:     if (! defined($suffix)) { $suffix = 'txt'; };
                   1900:     my $fh;
                   1901:     my $filename = '/prtspool/'.
1.258     albertel 1902:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256     matthew  1903:         time.'_'.rand(1000000000).'.'.$suffix;
                   1904:     $fh = Apache::File->new('>/home/httpd'.$filename);
                   1905:     if (! defined($fh)) {
                   1906:         $r->log_error("Couldn't open $filename for output $!");
1.928     bisitz   1907:         $r->print(
                   1908:             '<p class="LC_error">'
                   1909:            .&mt('Problems occurred in creating the output file.')
                   1910:            .' '.&mt('This error has been logged.')
                   1911:            .' '.&mt('Please alert your LON-CAPA administrator.')
                   1912:            .'</p>'
                   1913:         );
1.113     bowersj2 1914:     }
1.256     matthew  1915:     return ($fh,$filename)
1.113     bowersj2 1916: }
                   1917: 
                   1918: 
1.256     matthew  1919: =pod 
1.113     bowersj2 1920: 
                   1921: =back
                   1922: 
                   1923: =cut
1.37      matthew  1924: 
                   1925: ###############################################################
1.33      matthew  1926: ##        Home server <option> list generating code          ##
                   1927: ###############################################################
1.35      matthew  1928: 
1.169     www      1929: # ------------------------------------------
                   1930: 
                   1931: sub domain_select {
                   1932:     my ($name,$value,$multiple)=@_;
                   1933:     my %domains=map { 
1.514     albertel 1934: 	$_ => $_.' '. &Apache::lonnet::domain($_,'description') 
1.512     albertel 1935:     } &Apache::lonnet::all_domains();
1.169     www      1936:     if ($multiple) {
                   1937: 	$domains{''}=&mt('Any domain');
1.550     albertel 1938: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287     albertel 1939: 	return &multiple_select_form($name,$value,4,\%domains);
1.169     www      1940:     } else {
1.550     albertel 1941: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.970     raeburn  1942: 	return &select_form($name,$value,\%domains);
1.169     www      1943:     }
                   1944: }
                   1945: 
1.282     albertel 1946: #-------------------------------------------
                   1947: 
                   1948: =pod
                   1949: 
1.519     raeburn  1950: =head1 Routines for form select boxes
                   1951: 
                   1952: =over 4
                   1953: 
1.648     raeburn  1954: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282     albertel 1955: 
                   1956: Returns a string containing a <select> element int multiple mode
                   1957: 
                   1958: 
                   1959: Args:
                   1960:   $name - name of the <select> element
1.506     raeburn  1961:   $value - scalar or array ref of values that should already be selected
1.282     albertel 1962:   $size - number of rows long the select element is
1.283     albertel 1963:   $hash - the elements should be 'option' => 'shown text'
1.282     albertel 1964:           (shown text should already have been &mt())
1.506     raeburn  1965:   $order - (optional) array ref of the order to show the elements in
1.283     albertel 1966: 
1.282     albertel 1967: =cut
                   1968: 
                   1969: #-------------------------------------------
1.169     www      1970: sub multiple_select_form {
1.284     albertel 1971:     my ($name,$value,$size,$hash,$order)=@_;
1.169     www      1972:     my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
                   1973:     my $output='';
1.191     matthew  1974:     if (! defined($size)) {
                   1975:         $size = 4;
1.283     albertel 1976:         if (scalar(keys(%$hash))<4) {
                   1977:             $size = scalar(keys(%$hash));
1.191     matthew  1978:         }
                   1979:     }
1.734     bisitz   1980:     $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501     banghart 1981:     my @order;
1.506     raeburn  1982:     if (ref($order) eq 'ARRAY')  {
                   1983:         @order = @{$order};
                   1984:     } else {
                   1985:         @order = sort(keys(%$hash));
1.501     banghart 1986:     }
                   1987:     if (exists($$hash{'select_form_order'})) {
                   1988:         @order = @{$$hash{'select_form_order'}};
                   1989:     }
                   1990:         
1.284     albertel 1991:     foreach my $key (@order) {
1.356     albertel 1992:         $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284     albertel 1993:         $output.='selected="selected" ' if ($selected{$key});
                   1994:         $output.='>'.$hash->{$key}."</option>\n";
1.169     www      1995:     }
                   1996:     $output.="</select>\n";
                   1997:     return $output;
                   1998: }
                   1999: 
1.88      www      2000: #-------------------------------------------
                   2001: 
                   2002: =pod
                   2003: 
1.970     raeburn  2004: =item * &select_form($defdom,$name,$hashref,$onchange)
1.88      www      2005: 
                   2006: Returns a string containing a <select name='$name' size='1'> form to 
1.970     raeburn  2007: allow a user to select options from a ref to a hash containing:
                   2008: option_name => displayed text. An optional $onchange can include
                   2009: a javascript onchange item, e.g., onchange="this.form.submit();"  
                   2010: 
1.88      www      2011: See lonrights.pm for an example invocation and use.
                   2012: 
                   2013: =cut
                   2014: 
                   2015: #-------------------------------------------
                   2016: sub select_form {
1.970     raeburn  2017:     my ($def,$name,$hashref,$onchange) = @_;
                   2018:     return unless (ref($hashref) eq 'HASH');
                   2019:     if ($onchange) {
                   2020:         $onchange = ' onchange="'.$onchange.'"';
                   2021:     }
                   2022:     my $selectform = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.128     albertel 2023:     my @keys;
1.970     raeburn  2024:     if (exists($hashref->{'select_form_order'})) {
                   2025: 	@keys=@{$hashref->{'select_form_order'}};
1.128     albertel 2026:     } else {
1.970     raeburn  2027: 	@keys=sort(keys(%{$hashref}));
1.128     albertel 2028:     }
1.356     albertel 2029:     foreach my $key (@keys) {
                   2030:         $selectform.=
                   2031: 	    '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
                   2032:             ($key eq $def ? 'selected="selected" ' : '').
1.970     raeburn  2033:                 ">".$hashref->{$key}."</option>\n";
1.88      www      2034:     }
                   2035:     $selectform.="</select>";
                   2036:     return $selectform;
                   2037: }
                   2038: 
1.475     www      2039: # For display filters
                   2040: 
                   2041: sub display_filter {
1.1074    raeburn  2042:     my ($context) = @_;
1.475     www      2043:     if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477     www      2044:     if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.1074    raeburn  2045:     my $phraseinput = 'hidden';
                   2046:     my $includeinput = 'hidden';
                   2047:     my ($checked,$includetypestext);
                   2048:     if ($env{'form.displayfilter'} eq 'containing') {
                   2049:         $phraseinput = 'text'; 
                   2050:         if ($context eq 'parmslog') {
                   2051:             $includeinput = 'checkbox';
                   2052:             if ($env{'form.includetypes'}) {
                   2053:                 $checked = ' checked="checked"';
                   2054:             }
                   2055:             $includetypestext = &mt('Include parameter types');
                   2056:         }
                   2057:     } else {
                   2058:         $includetypestext = '&nbsp;';
                   2059:     }
                   2060:     my ($additional,$secondid,$thirdid);
                   2061:     if ($context eq 'parmslog') {
                   2062:         $additional = 
                   2063:             '<label><input type="'.$includeinput.'" name="includetypes"'. 
                   2064:             $checked.' name="includetypes" value="1" id="includetypes" />'.
                   2065:             '&nbsp;<span id="includetypestext">'.$includetypestext.'</span>'.
                   2066:             '</label>';
                   2067:         $secondid = 'includetypes';
                   2068:         $thirdid = 'includetypestext';
                   2069:     }
                   2070:     my $onchange = "javascript:toggleHistoryOptions(this,'containingphrase','$context',
                   2071:                                                     '$secondid','$thirdid')";
                   2072:     return '<span class="LC_nobreak"><label>'.&mt('Records: [_1]',
1.475     www      2073: 			       &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
                   2074: 							   (&mt('all'),10,20,50,100,1000,10000))).
1.714     bisitz   2075: 	   '</label></span> <span class="LC_nobreak">'.
1.1074    raeburn  2076:            &mt('Filter: [_1]',
1.477     www      2077: 	   &select_form($env{'form.displayfilter'},
                   2078: 			'displayfilter',
1.970     raeburn  2079: 			{'currentfolder' => 'Current folder/page',
1.477     www      2080: 			 'containing' => 'Containing phrase',
1.1074    raeburn  2081: 			 'none' => 'None'},$onchange)).'&nbsp;'.
                   2082: 			 '<input type="'.$phraseinput.'" name="containingphrase" id="containingphrase" size="30" value="'.
                   2083:                          &HTML::Entities::encode($env{'form.containingphrase'}).
                   2084:                          '" />'.$additional;
                   2085: }
                   2086: 
                   2087: sub display_filter_js {
                   2088:     my $includetext = &mt('Include parameter types');
                   2089:     return <<"ENDJS";
                   2090:   
                   2091: function toggleHistoryOptions(setter,firstid,context,secondid,thirdid) {
                   2092:     var firstType = 'hidden';
                   2093:     if (setter.options[setter.selectedIndex].value == 'containing') {
                   2094:         firstType = 'text';
                   2095:     }
                   2096:     firstObject = document.getElementById(firstid);
                   2097:     if (typeof(firstObject) == 'object') {
                   2098:         if (firstObject.type != firstType) {
                   2099:             changeInputType(firstObject,firstType);
                   2100:         }
                   2101:     }
                   2102:     if (context == 'parmslog') {
                   2103:         var secondType = 'hidden';
                   2104:         if (firstType == 'text') {
                   2105:             secondType = 'checkbox';
                   2106:         }
                   2107:         secondObject = document.getElementById(secondid);  
                   2108:         if (typeof(secondObject) == 'object') {
                   2109:             if (secondObject.type != secondType) {
                   2110:                 changeInputType(secondObject,secondType);
                   2111:             }
                   2112:         }
                   2113:         var textItem = document.getElementById(thirdid);
                   2114:         var currtext = textItem.innerHTML;
                   2115:         var newtext;
                   2116:         if (firstType == 'text') {
                   2117:             newtext = '$includetext';
                   2118:         } else {
                   2119:             newtext = '&nbsp;';
                   2120:         }
                   2121:         if (currtext != newtext) {
                   2122:             textItem.innerHTML = newtext;
                   2123:         }
                   2124:     }
                   2125:     return;
                   2126: }
                   2127: 
                   2128: function changeInputType(oldObject,newType) {
                   2129:     var newObject = document.createElement('input');
                   2130:     newObject.type = newType;
                   2131:     if (oldObject.size) {
                   2132:         newObject.size = oldObject.size;
                   2133:     }
                   2134:     if (oldObject.value) {
                   2135:         newObject.value = oldObject.value;
                   2136:     }
                   2137:     if (oldObject.name) {
                   2138:         newObject.name = oldObject.name;
                   2139:     }
                   2140:     if (oldObject.id) {
                   2141:         newObject.id = oldObject.id;
                   2142:     }
                   2143:     oldObject.parentNode.replaceChild(newObject,oldObject);
                   2144:     return;
                   2145: }
                   2146: 
                   2147: ENDJS
1.475     www      2148: }
                   2149: 
1.167     www      2150: sub gradeleveldescription {
                   2151:     my $gradelevel=shift;
                   2152:     my %gradelevels=(0 => 'Not specified',
                   2153: 		     1 => 'Grade 1',
                   2154: 		     2 => 'Grade 2',
                   2155: 		     3 => 'Grade 3',
                   2156: 		     4 => 'Grade 4',
                   2157: 		     5 => 'Grade 5',
                   2158: 		     6 => 'Grade 6',
                   2159: 		     7 => 'Grade 7',
                   2160: 		     8 => 'Grade 8',
                   2161: 		     9 => 'Grade 9',
                   2162: 		     10 => 'Grade 10',
                   2163: 		     11 => 'Grade 11',
                   2164: 		     12 => 'Grade 12',
                   2165: 		     13 => 'Grade 13',
                   2166: 		     14 => '100 Level',
                   2167: 		     15 => '200 Level',
                   2168: 		     16 => '300 Level',
                   2169: 		     17 => '400 Level',
                   2170: 		     18 => 'Graduate Level');
                   2171:     return &mt($gradelevels{$gradelevel});
                   2172: }
                   2173: 
1.163     www      2174: sub select_level_form {
                   2175:     my ($deflevel,$name)=@_;
                   2176:     unless ($deflevel) { $deflevel=0; }
1.167     www      2177:     my $selectform = "<select name=\"$name\" size=\"1\">\n";
                   2178:     for (my $i=0; $i<=18; $i++) {
                   2179:         $selectform.="<option value=\"$i\" ".
1.253     albertel 2180:             ($i==$deflevel ? 'selected="selected" ' : '').
1.167     www      2181:                 ">".&gradeleveldescription($i)."</option>\n";
                   2182:     }
                   2183:     $selectform.="</select>";
                   2184:     return $selectform;
1.163     www      2185: }
1.167     www      2186: 
1.35      matthew  2187: #-------------------------------------------
                   2188: 
1.45      matthew  2189: =pod
                   2190: 
1.1075.2.42  raeburn  2191: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms)
1.35      matthew  2192: 
                   2193: Returns a string containing a <select name='$name' size='1'> form to 
                   2194: allow a user to select the domain to preform an operation in.  
                   2195: See loncreateuser.pm for an example invocation and use.
                   2196: 
1.90      www      2197: If the $includeempty flag is set, it also includes an empty choice ("no domain
                   2198: selected");
                   2199: 
1.743     raeburn  2200: If the $showdomdesc flag is set, the domain name is followed by the domain description.
                   2201: 
1.910     raeburn  2202: 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.
                   2203: 
1.1075.2.36  raeburn  2204: The optional $incdoms is a reference to an array of domains which will be the only available options.
                   2205: 
                   2206: The optional $excdoms is a reference to an array of domains which will be excluded from the available options. 
1.563     raeburn  2207: 
1.35      matthew  2208: =cut
                   2209: 
                   2210: #-------------------------------------------
1.34      matthew  2211: sub select_dom_form {
1.1075.2.36  raeburn  2212:     my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms) = @_;
1.872     raeburn  2213:     if ($onchange) {
1.874     raeburn  2214:         $onchange = ' onchange="'.$onchange.'"';
1.743     raeburn  2215:     }
1.1075.2.36  raeburn  2216:     my (@domains,%exclude);
1.910     raeburn  2217:     if (ref($incdoms) eq 'ARRAY') {
                   2218:         @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
                   2219:     } else {
                   2220:         @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
                   2221:     }
1.90      www      2222:     if ($includeempty) { @domains=('',@domains); }
1.1075.2.36  raeburn  2223:     if (ref($excdoms) eq 'ARRAY') {
                   2224:         map { $exclude{$_} = 1; } @{$excdoms};
                   2225:     }
1.743     raeburn  2226:     my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.356     albertel 2227:     foreach my $dom (@domains) {
1.1075.2.36  raeburn  2228:         next if ($exclude{$dom});
1.356     albertel 2229:         $selectdomain.="<option value=\"$dom\" ".
1.563     raeburn  2230:             ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
                   2231:         if ($showdomdesc) {
                   2232:             if ($dom ne '') {
                   2233:                 my $domdesc = &Apache::lonnet::domain($dom,'description');
                   2234:                 if ($domdesc ne '') {
                   2235:                     $selectdomain .= ' ('.$domdesc.')';
                   2236:                 }
                   2237:             } 
                   2238:         }
                   2239:         $selectdomain .= "</option>\n";
1.34      matthew  2240:     }
                   2241:     $selectdomain.="</select>";
                   2242:     return $selectdomain;
                   2243: }
                   2244: 
1.35      matthew  2245: #-------------------------------------------
                   2246: 
1.45      matthew  2247: =pod
                   2248: 
1.648     raeburn  2249: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35      matthew  2250: 
1.586     raeburn  2251: input: 4 arguments (two required, two optional) - 
                   2252:     $domain - domain of new user
                   2253:     $name - name of form element
                   2254:     $default - Value of 'default' causes a default item to be first 
                   2255:                             option, and selected by default. 
                   2256:     $hide - Value of 'hide' causes hiding of the name of the server, 
                   2257:                             if 1 server found, or default, if 0 found.
1.594     raeburn  2258: output: returns 2 items: 
1.586     raeburn  2259: (a) form element which contains either:
                   2260:    (i) <select name="$name">
                   2261:         <option value="$hostid1">$hostid $servers{$hostid}</option>
                   2262:         <option value="$hostid2">$hostid $servers{$hostid}</option>       
                   2263:        </select>
                   2264:        form item if there are multiple library servers in $domain, or
                   2265:    (ii) an <input type="hidden" name="$name" value="$hostid" /> form item 
                   2266:        if there is only one library server in $domain.
                   2267: 
                   2268: (b) number of library servers found.
                   2269: 
                   2270: See loncreateuser.pm for example of use.
1.35      matthew  2271: 
                   2272: =cut
                   2273: 
                   2274: #-------------------------------------------
1.586     raeburn  2275: sub home_server_form_item {
                   2276:     my ($domain,$name,$default,$hide) = @_;
1.513     albertel 2277:     my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586     raeburn  2278:     my $result;
                   2279:     my $numlib = keys(%servers);
                   2280:     if ($numlib > 1) {
                   2281:         $result .= '<select name="'.$name.'" />'."\n";
                   2282:         if ($default) {
1.804     bisitz   2283:             $result .= '<option value="default" selected="selected">'.&mt('default').
1.586     raeburn  2284:                        '</option>'."\n";
                   2285:         }
                   2286:         foreach my $hostid (sort(keys(%servers))) {
                   2287:             $result.= '<option value="'.$hostid.'">'.
                   2288: 	              $hostid.' '.$servers{$hostid}."</option>\n";
                   2289:         }
                   2290:         $result .= '</select>'."\n";
                   2291:     } elsif ($numlib == 1) {
                   2292:         my $hostid;
                   2293:         foreach my $item (keys(%servers)) {
                   2294:             $hostid = $item;
                   2295:         }
                   2296:         $result .= '<input type="hidden" name="'.$name.'" value="'.
                   2297:                    $hostid.'" />';
                   2298:                    if (!$hide) {
                   2299:                        $result .= $hostid.' '.$servers{$hostid};
                   2300:                    }
                   2301:                    $result .= "\n";
                   2302:     } elsif ($default) {
                   2303:         $result .= '<input type="hidden" name="'.$name.
                   2304:                    '" value="default" />';
                   2305:                    if (!$hide) {
                   2306:                        $result .= &mt('default');
                   2307:                    }
                   2308:                    $result .= "\n";
1.33      matthew  2309:     }
1.586     raeburn  2310:     return ($result,$numlib);
1.33      matthew  2311: }
1.112     bowersj2 2312: 
                   2313: =pod
                   2314: 
1.534     albertel 2315: =back 
                   2316: 
1.112     bowersj2 2317: =cut
1.87      matthew  2318: 
                   2319: ###############################################################
1.112     bowersj2 2320: ##                  Decoding User Agent                      ##
1.87      matthew  2321: ###############################################################
                   2322: 
                   2323: =pod
                   2324: 
1.112     bowersj2 2325: =head1 Decoding the User Agent
                   2326: 
                   2327: =over 4
                   2328: 
                   2329: =item * &decode_user_agent()
1.87      matthew  2330: 
                   2331: Inputs: $r
                   2332: 
                   2333: Outputs:
                   2334: 
                   2335: =over 4
                   2336: 
1.112     bowersj2 2337: =item * $httpbrowser
1.87      matthew  2338: 
1.112     bowersj2 2339: =item * $clientbrowser
1.87      matthew  2340: 
1.112     bowersj2 2341: =item * $clientversion
1.87      matthew  2342: 
1.112     bowersj2 2343: =item * $clientmathml
1.87      matthew  2344: 
1.112     bowersj2 2345: =item * $clientunicode
1.87      matthew  2346: 
1.112     bowersj2 2347: =item * $clientos
1.87      matthew  2348: 
1.1075.2.42  raeburn  2349: =item * $clientmobile
                   2350: 
                   2351: =item * $clientinfo
                   2352: 
1.1075.2.77  raeburn  2353: =item * $clientosversion
                   2354: 
1.87      matthew  2355: =back
                   2356: 
1.157     matthew  2357: =back 
                   2358: 
1.87      matthew  2359: =cut
                   2360: 
                   2361: ###############################################################
                   2362: ###############################################################
                   2363: sub decode_user_agent {
1.247     albertel 2364:     my ($r)=@_;
1.87      matthew  2365:     my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
                   2366:     my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
                   2367:     my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247     albertel 2368:     if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87      matthew  2369:     my $clientbrowser='unknown';
                   2370:     my $clientversion='0';
                   2371:     my $clientmathml='';
                   2372:     my $clientunicode='0';
1.1075.2.42  raeburn  2373:     my $clientmobile=0;
1.1075.2.77  raeburn  2374:     my $clientosversion='';
1.87      matthew  2375:     for (my $i=0;$i<=$#browsertype;$i++) {
1.1075.2.76  raeburn  2376:         my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\%/,$browsertype[$i]);
1.87      matthew  2377: 	if (($httpbrowser=~/$match/i)  && ($httpbrowser!~/$notmatch/i)) {
                   2378: 	    $clientbrowser=$bname;
                   2379:             $httpbrowser=~/$vreg/i;
                   2380: 	    $clientversion=$1;
                   2381:             $clientmathml=($clientversion>=$minv);
                   2382:             $clientunicode=($clientversion>=$univ);
                   2383: 	}
                   2384:     }
                   2385:     my $clientos='unknown';
1.1075.2.42  raeburn  2386:     my $clientinfo;
1.87      matthew  2387:     if (($httpbrowser=~/linux/i) ||
                   2388:         ($httpbrowser=~/unix/i) ||
                   2389:         ($httpbrowser=~/ux/i) ||
                   2390:         ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
                   2391:     if (($httpbrowser=~/vax/i) ||
                   2392:         ($httpbrowser=~/vms/i)) { $clientos='vms'; }
                   2393:     if ($httpbrowser=~/next/i) { $clientos='next'; }
                   2394:     if (($httpbrowser=~/mac/i) ||
                   2395:         ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
1.1075.2.77  raeburn  2396:     if ($httpbrowser=~/win/i) {
                   2397:         $clientos='win';
                   2398:         if ($httpbrowser =~/Windows\s+NT\s+(\d+\.\d+)/i) {
                   2399:             $clientosversion = $1;
                   2400:         }
                   2401:     }
1.87      matthew  2402:     if ($httpbrowser=~/embed/i) { $clientos='pda'; }
1.1075.2.42  raeburn  2403:     if ($httpbrowser=~/(Android|iPod|iPad|iPhone|webOS|Blackberry|Windows Phone|Opera m(?:ob|in)|Fennec)/i) {
                   2404:         $clientmobile=lc($1);
                   2405:     }
                   2406:     if ($httpbrowser=~ m{Firefox/(\d+\.\d+)}) {
                   2407:         $clientinfo = 'firefox-'.$1;
                   2408:     } elsif ($httpbrowser=~ m{chromeframe/(\d+\.\d+)\.}) {
                   2409:         $clientinfo = 'chromeframe-'.$1;
                   2410:     }
1.87      matthew  2411:     return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
1.1075.2.77  raeburn  2412:             $clientunicode,$clientos,$clientmobile,$clientinfo,
                   2413:             $clientosversion);
1.87      matthew  2414: }
                   2415: 
1.32      matthew  2416: ###############################################################
                   2417: ##    Authentication changing form generation subroutines    ##
                   2418: ###############################################################
                   2419: ##
                   2420: ## All of the authform_xxxxxxx subroutines take their inputs in a
                   2421: ## hash, and have reasonable default values.
                   2422: ##
                   2423: ##    formname = the name given in the <form> tag.
1.35      matthew  2424: #-------------------------------------------
                   2425: 
1.45      matthew  2426: =pod
                   2427: 
1.112     bowersj2 2428: =head1 Authentication Routines
                   2429: 
                   2430: =over 4
                   2431: 
1.648     raeburn  2432: =item * &authform_xxxxxx()
1.35      matthew  2433: 
                   2434: The authform_xxxxxx subroutines provide javascript and html forms which 
                   2435: handle some of the conveniences required for authentication forms.  
                   2436: This is not an optimal method, but it works.  
                   2437: 
                   2438: =over 4
                   2439: 
1.112     bowersj2 2440: =item * authform_header
1.35      matthew  2441: 
1.112     bowersj2 2442: =item * authform_authorwarning
1.35      matthew  2443: 
1.112     bowersj2 2444: =item * authform_nochange
1.35      matthew  2445: 
1.112     bowersj2 2446: =item * authform_kerberos
1.35      matthew  2447: 
1.112     bowersj2 2448: =item * authform_internal
1.35      matthew  2449: 
1.112     bowersj2 2450: =item * authform_filesystem
1.35      matthew  2451: 
                   2452: =back
                   2453: 
1.648     raeburn  2454: See loncreateuser.pm for invocation and use examples.
1.157     matthew  2455: 
1.35      matthew  2456: =cut
                   2457: 
                   2458: #-------------------------------------------
1.32      matthew  2459: sub authform_header{  
                   2460:     my %in = (
                   2461:         formname => 'cu',
1.80      albertel 2462:         kerb_def_dom => '',
1.32      matthew  2463:         @_,
                   2464:     );
                   2465:     $in{'formname'} = 'document.' . $in{'formname'};
                   2466:     my $result='';
1.80      albertel 2467: 
                   2468: #---------------------------------------------- Code for upper case translation
                   2469:     my $Javascript_toUpperCase;
                   2470:     unless ($in{kerb_def_dom}) {
                   2471:         $Javascript_toUpperCase =<<"END";
                   2472:         switch (choice) {
                   2473:            case 'krb': currentform.elements[choicearg].value =
                   2474:                currentform.elements[choicearg].value.toUpperCase();
                   2475:                break;
                   2476:            default:
                   2477:         }
                   2478: END
                   2479:     } else {
                   2480:         $Javascript_toUpperCase = "";
                   2481:     }
                   2482: 
1.165     raeburn  2483:     my $radioval = "'nochange'";
1.591     raeburn  2484:     if (defined($in{'curr_authtype'})) {
                   2485:         if ($in{'curr_authtype'} ne '') {
                   2486:             $radioval = "'".$in{'curr_authtype'}."arg'";
                   2487:         }
1.174     matthew  2488:     }
1.165     raeburn  2489:     my $argfield = 'null';
1.591     raeburn  2490:     if (defined($in{'mode'})) {
1.165     raeburn  2491:         if ($in{'mode'} eq 'modifycourse')  {
1.591     raeburn  2492:             if (defined($in{'curr_autharg'})) {
                   2493:                 if ($in{'curr_autharg'} ne '') {
1.165     raeburn  2494:                     $argfield = "'$in{'curr_autharg'}'";
                   2495:                 }
                   2496:             }
                   2497:         }
                   2498:     }
                   2499: 
1.32      matthew  2500:     $result.=<<"END";
                   2501: var current = new Object();
1.165     raeburn  2502: current.radiovalue = $radioval;
                   2503: current.argfield = $argfield;
1.32      matthew  2504: 
                   2505: function changed_radio(choice,currentform) {
                   2506:     var choicearg = choice + 'arg';
                   2507:     // If a radio button in changed, we need to change the argfield
                   2508:     if (current.radiovalue != choice) {
                   2509:         current.radiovalue = choice;
                   2510:         if (current.argfield != null) {
                   2511:             currentform.elements[current.argfield].value = '';
                   2512:         }
                   2513:         if (choice == 'nochange') {
                   2514:             current.argfield = null;
                   2515:         } else {
                   2516:             current.argfield = choicearg;
                   2517:             switch(choice) {
                   2518:                 case 'krb': 
                   2519:                     currentform.elements[current.argfield].value = 
                   2520:                         "$in{'kerb_def_dom'}";
                   2521:                 break;
                   2522:               default:
                   2523:                 break;
                   2524:             }
                   2525:         }
                   2526:     }
                   2527:     return;
                   2528: }
1.22      www      2529: 
1.32      matthew  2530: function changed_text(choice,currentform) {
                   2531:     var choicearg = choice + 'arg';
                   2532:     if (currentform.elements[choicearg].value !='') {
1.80      albertel 2533:         $Javascript_toUpperCase
1.32      matthew  2534:         // clear old field
                   2535:         if ((current.argfield != choicearg) && (current.argfield != null)) {
                   2536:             currentform.elements[current.argfield].value = '';
                   2537:         }
                   2538:         current.argfield = choicearg;
                   2539:     }
                   2540:     set_auth_radio_buttons(choice,currentform);
                   2541:     return;
1.20      www      2542: }
1.32      matthew  2543: 
                   2544: function set_auth_radio_buttons(newvalue,currentform) {
1.986     raeburn  2545:     var numauthchoices = currentform.login.length;
                   2546:     if (typeof numauthchoices  == "undefined") {
                   2547:         return;
                   2548:     } 
1.32      matthew  2549:     var i=0;
1.986     raeburn  2550:     while (i < numauthchoices) {
1.32      matthew  2551:         if (currentform.login[i].value == newvalue) { break; }
                   2552:         i++;
                   2553:     }
1.986     raeburn  2554:     if (i == numauthchoices) {
1.32      matthew  2555:         return;
                   2556:     }
                   2557:     current.radiovalue = newvalue;
                   2558:     currentform.login[i].checked = true;
                   2559:     return;
                   2560: }
                   2561: END
                   2562:     return $result;
                   2563: }
                   2564: 
1.1075.2.20  raeburn  2565: sub authform_authorwarning {
1.32      matthew  2566:     my $result='';
1.144     matthew  2567:     $result='<i>'.
                   2568:         &mt('As a general rule, only authors or co-authors should be '.
                   2569:             'filesystem authenticated '.
                   2570:             '(which allows access to the server filesystem).')."</i>\n";
1.32      matthew  2571:     return $result;
                   2572: }
                   2573: 
1.1075.2.20  raeburn  2574: sub authform_nochange {
1.32      matthew  2575:     my %in = (
                   2576:               formname => 'document.cu',
                   2577:               kerb_def_dom => 'MSU.EDU',
                   2578:               @_,
                   2579:           );
1.1075.2.20  raeburn  2580:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'}); 
1.586     raeburn  2581:     my $result;
1.1075.2.20  raeburn  2582:     if (!$authnum) {
                   2583:         $result = &mt('Under your current role you are not permitted to change login settings for this user');
1.586     raeburn  2584:     } else {
                   2585:         $result = '<label>'.&mt('[_1] Do not change login data',
                   2586:                   '<input type="radio" name="login" value="nochange" '.
                   2587:                   'checked="checked" onclick="'.
1.281     albertel 2588:             "javascript:changed_radio('nochange',$in{'formname'});".'" />').
                   2589: 	    '</label>';
1.586     raeburn  2590:     }
1.32      matthew  2591:     return $result;
                   2592: }
                   2593: 
1.591     raeburn  2594: sub authform_kerberos {
1.32      matthew  2595:     my %in = (
                   2596:               formname => 'document.cu',
                   2597:               kerb_def_dom => 'MSU.EDU',
1.80      albertel 2598:               kerb_def_auth => 'krb4',
1.32      matthew  2599:               @_,
                   2600:               );
1.586     raeburn  2601:     my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
                   2602:         $autharg,$jscall);
1.1075.2.20  raeburn  2603:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.80      albertel 2604:     if ($in{'kerb_def_auth'} eq 'krb5') {
1.772     bisitz   2605:        $check5 = ' checked="checked"';
1.80      albertel 2606:     } else {
1.772     bisitz   2607:        $check4 = ' checked="checked"';
1.80      albertel 2608:     }
1.165     raeburn  2609:     $krbarg = $in{'kerb_def_dom'};
1.591     raeburn  2610:     if (defined($in{'curr_authtype'})) {
                   2611:         if ($in{'curr_authtype'} eq 'krb') {
1.772     bisitz   2612:             $krbcheck = ' checked="checked"';
1.623     raeburn  2613:             if (defined($in{'mode'})) {
                   2614:                 if ($in{'mode'} eq 'modifyuser') {
                   2615:                     $krbcheck = '';
                   2616:                 }
                   2617:             }
1.591     raeburn  2618:             if (defined($in{'curr_kerb_ver'})) {
                   2619:                 if ($in{'curr_krb_ver'} eq '5') {
1.772     bisitz   2620:                     $check5 = ' checked="checked"';
1.591     raeburn  2621:                     $check4 = '';
                   2622:                 } else {
1.772     bisitz   2623:                     $check4 = ' checked="checked"';
1.591     raeburn  2624:                     $check5 = '';
                   2625:                 }
1.586     raeburn  2626:             }
1.591     raeburn  2627:             if (defined($in{'curr_autharg'})) {
1.165     raeburn  2628:                 $krbarg = $in{'curr_autharg'};
                   2629:             }
1.586     raeburn  2630:             if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591     raeburn  2631:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2632:                     $result = 
                   2633:     &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
                   2634:         $in{'curr_autharg'},$krbver);
                   2635:                 } else {
                   2636:                     $result =
                   2637:     &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
                   2638:                 }
                   2639:                 return $result; 
                   2640:             }
                   2641:         }
                   2642:     } else {
                   2643:         if ($authnum == 1) {
1.784     bisitz   2644:             $authtype = '<input type="hidden" name="login" value="krb" />';
1.165     raeburn  2645:         }
                   2646:     }
1.586     raeburn  2647:     if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
                   2648:         return;
1.587     raeburn  2649:     } elsif ($authtype eq '') {
1.591     raeburn  2650:         if (defined($in{'mode'})) {
1.587     raeburn  2651:             if ($in{'mode'} eq 'modifycourse') {
                   2652:                 if ($authnum == 1) {
1.1075.2.20  raeburn  2653:                     $authtype = '<input type="radio" name="login" value="krb" />';
1.587     raeburn  2654:                 }
                   2655:             }
                   2656:         }
1.586     raeburn  2657:     }
                   2658:     $jscall = "javascript:changed_radio('krb',$in{'formname'});";
                   2659:     if ($authtype eq '') {
                   2660:         $authtype = '<input type="radio" name="login" value="krb" '.
                   2661:                     'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
                   2662:                     $krbcheck.' />';
                   2663:     }
                   2664:     if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
1.1075.2.20  raeburn  2665:         ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
1.586     raeburn  2666:          $in{'curr_authtype'} eq 'krb5') ||
1.1075.2.20  raeburn  2667:         (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
1.586     raeburn  2668:          $in{'curr_authtype'} eq 'krb4')) {
                   2669:         $result .= &mt
1.144     matthew  2670:         ('[_1] Kerberos authenticated with domain [_2] '.
1.281     albertel 2671:          '[_3] Version 4 [_4] Version 5 [_5]',
1.586     raeburn  2672:          '<label>'.$authtype,
1.281     albertel 2673:          '</label><input type="text" size="10" name="krbarg" '.
1.165     raeburn  2674:              'value="'.$krbarg.'" '.
1.144     matthew  2675:              'onchange="'.$jscall.'" />',
1.281     albertel 2676:          '<label><input type="radio" name="krbver" value="4" '.$check4.' />',
                   2677:          '</label><label><input type="radio" name="krbver" value="5" '.$check5.' />',
                   2678: 	 '</label>');
1.586     raeburn  2679:     } elsif ($can_assign{'krb4'}) {
                   2680:         $result .= &mt
                   2681:         ('[_1] Kerberos authenticated with domain [_2] '.
                   2682:          '[_3] Version 4 [_4]',
                   2683:          '<label>'.$authtype,
                   2684:          '</label><input type="text" size="10" name="krbarg" '.
                   2685:              'value="'.$krbarg.'" '.
                   2686:              'onchange="'.$jscall.'" />',
                   2687:          '<label><input type="hidden" name="krbver" value="4" />',
                   2688:          '</label>');
                   2689:     } elsif ($can_assign{'krb5'}) {
                   2690:         $result .= &mt
                   2691:         ('[_1] Kerberos authenticated with domain [_2] '.
                   2692:          '[_3] Version 5 [_4]',
                   2693:          '<label>'.$authtype,
                   2694:          '</label><input type="text" size="10" name="krbarg" '.
                   2695:              'value="'.$krbarg.'" '.
                   2696:              'onchange="'.$jscall.'" />',
                   2697:          '<label><input type="hidden" name="krbver" value="5" />',
                   2698:          '</label>');
                   2699:     }
1.32      matthew  2700:     return $result;
                   2701: }
                   2702: 
1.1075.2.20  raeburn  2703: sub authform_internal {
1.586     raeburn  2704:     my %in = (
1.32      matthew  2705:                 formname => 'document.cu',
                   2706:                 kerb_def_dom => 'MSU.EDU',
                   2707:                 @_,
                   2708:                 );
1.586     raeburn  2709:     my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall);
1.1075.2.20  raeburn  2710:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591     raeburn  2711:     if (defined($in{'curr_authtype'})) {
                   2712:         if ($in{'curr_authtype'} eq 'int') {
1.586     raeburn  2713:             if ($can_assign{'int'}) {
1.772     bisitz   2714:                 $intcheck = 'checked="checked" ';
1.623     raeburn  2715:                 if (defined($in{'mode'})) {
                   2716:                     if ($in{'mode'} eq 'modifyuser') {
                   2717:                         $intcheck = '';
                   2718:                     }
                   2719:                 }
1.591     raeburn  2720:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2721:                     $intarg = $in{'curr_autharg'};
                   2722:                 }
                   2723:             } else {
                   2724:                 $result = &mt('Currently internally authenticated.');
                   2725:                 return $result;
1.165     raeburn  2726:             }
                   2727:         }
1.586     raeburn  2728:     } else {
                   2729:         if ($authnum == 1) {
1.784     bisitz   2730:             $authtype = '<input type="hidden" name="login" value="int" />';
1.586     raeburn  2731:         }
                   2732:     }
                   2733:     if (!$can_assign{'int'}) {
                   2734:         return;
1.587     raeburn  2735:     } elsif ($authtype eq '') {
1.591     raeburn  2736:         if (defined($in{'mode'})) {
1.587     raeburn  2737:             if ($in{'mode'} eq 'modifycourse') {
                   2738:                 if ($authnum == 1) {
1.1075.2.20  raeburn  2739:                     $authtype = '<input type="radio" name="login" value="int" />';
1.587     raeburn  2740:                 }
                   2741:             }
                   2742:         }
1.165     raeburn  2743:     }
1.586     raeburn  2744:     $jscall = "javascript:changed_radio('int',$in{'formname'});";
                   2745:     if ($authtype eq '') {
                   2746:         $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
                   2747:                     ' onchange="'.$jscall.'" onclick="'.$jscall.'" />';
                   2748:     }
1.605     bisitz   2749:     $autharg = '<input type="password" size="10" name="intarg" value="'.
1.586     raeburn  2750:                $intarg.'" onchange="'.$jscall.'" />';
                   2751:     $result = &mt
1.144     matthew  2752:         ('[_1] Internally authenticated (with initial password [_2])',
1.586     raeburn  2753:          '<label>'.$authtype,'</label>'.$autharg);
1.824     bisitz   2754:     $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  2755:     return $result;
                   2756: }
                   2757: 
1.1075.2.20  raeburn  2758: sub authform_local {
1.32      matthew  2759:     my %in = (
                   2760:               formname => 'document.cu',
                   2761:               kerb_def_dom => 'MSU.EDU',
                   2762:               @_,
                   2763:               );
1.586     raeburn  2764:     my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall);
1.1075.2.20  raeburn  2765:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591     raeburn  2766:     if (defined($in{'curr_authtype'})) {
                   2767:         if ($in{'curr_authtype'} eq 'loc') {
1.586     raeburn  2768:             if ($can_assign{'loc'}) {
1.772     bisitz   2769:                 $loccheck = 'checked="checked" ';
1.623     raeburn  2770:                 if (defined($in{'mode'})) {
                   2771:                     if ($in{'mode'} eq 'modifyuser') {
                   2772:                         $loccheck = '';
                   2773:                     }
                   2774:                 }
1.591     raeburn  2775:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2776:                     $locarg = $in{'curr_autharg'};
                   2777:                 }
                   2778:             } else {
                   2779:                 $result = &mt('Currently using local (institutional) authentication.');
                   2780:                 return $result;
1.165     raeburn  2781:             }
                   2782:         }
1.586     raeburn  2783:     } else {
                   2784:         if ($authnum == 1) {
1.784     bisitz   2785:             $authtype = '<input type="hidden" name="login" value="loc" />';
1.586     raeburn  2786:         }
                   2787:     }
                   2788:     if (!$can_assign{'loc'}) {
                   2789:         return;
1.587     raeburn  2790:     } elsif ($authtype eq '') {
1.591     raeburn  2791:         if (defined($in{'mode'})) {
1.587     raeburn  2792:             if ($in{'mode'} eq 'modifycourse') {
                   2793:                 if ($authnum == 1) {
1.1075.2.20  raeburn  2794:                     $authtype = '<input type="radio" name="login" value="loc" />';
1.587     raeburn  2795:                 }
                   2796:             }
                   2797:         }
1.165     raeburn  2798:     }
1.586     raeburn  2799:     $jscall = "javascript:changed_radio('loc',$in{'formname'});";
                   2800:     if ($authtype eq '') {
                   2801:         $authtype = '<input type="radio" name="login" value="loc" '.
                   2802:                     $loccheck.' onchange="'.$jscall.'" onclick="'.
                   2803:                     $jscall.'" />';
                   2804:     }
                   2805:     $autharg = '<input type="text" size="10" name="locarg" value="'.
                   2806:                $locarg.'" onchange="'.$jscall.'" />';
                   2807:     $result = &mt('[_1] Local Authentication with argument [_2]',
                   2808:                   '<label>'.$authtype,'</label>'.$autharg);
1.32      matthew  2809:     return $result;
                   2810: }
                   2811: 
1.1075.2.20  raeburn  2812: sub authform_filesystem {
1.32      matthew  2813:     my %in = (
                   2814:               formname => 'document.cu',
                   2815:               kerb_def_dom => 'MSU.EDU',
                   2816:               @_,
                   2817:               );
1.586     raeburn  2818:     my ($fsyscheck,$result,$authtype,$autharg,$jscall);
1.1075.2.20  raeburn  2819:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591     raeburn  2820:     if (defined($in{'curr_authtype'})) {
                   2821:         if ($in{'curr_authtype'} eq 'fsys') {
1.586     raeburn  2822:             if ($can_assign{'fsys'}) {
1.772     bisitz   2823:                 $fsyscheck = 'checked="checked" ';
1.623     raeburn  2824:                 if (defined($in{'mode'})) {
                   2825:                     if ($in{'mode'} eq 'modifyuser') {
                   2826:                         $fsyscheck = '';
                   2827:                     }
                   2828:                 }
1.586     raeburn  2829:             } else {
                   2830:                 $result = &mt('Currently Filesystem Authenticated.');
                   2831:                 return $result;
                   2832:             }           
                   2833:         }
                   2834:     } else {
                   2835:         if ($authnum == 1) {
1.784     bisitz   2836:             $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586     raeburn  2837:         }
                   2838:     }
                   2839:     if (!$can_assign{'fsys'}) {
                   2840:         return;
1.587     raeburn  2841:     } elsif ($authtype eq '') {
1.591     raeburn  2842:         if (defined($in{'mode'})) {
1.587     raeburn  2843:             if ($in{'mode'} eq 'modifycourse') {
                   2844:                 if ($authnum == 1) {
1.1075.2.20  raeburn  2845:                     $authtype = '<input type="radio" name="login" value="fsys" />';
1.587     raeburn  2846:                 }
                   2847:             }
                   2848:         }
1.586     raeburn  2849:     }
                   2850:     $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
                   2851:     if ($authtype eq '') {
                   2852:         $authtype = '<input type="radio" name="login" value="fsys" '.
                   2853:                     $fsyscheck.' onchange="'.$jscall.'" onclick="'.
                   2854:                     $jscall.'" />';
                   2855:     }
                   2856:     $autharg = '<input type="text" size="10" name="fsysarg" value=""'.
                   2857:                ' onchange="'.$jscall.'" />';
                   2858:     $result = &mt
1.144     matthew  2859:         ('[_1] Filesystem Authenticated (with initial password [_2])',
1.281     albertel 2860:          '<label><input type="radio" name="login" value="fsys" '.
1.586     raeburn  2861:          $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
1.605     bisitz   2862:          '</label><input type="password" size="10" name="fsysarg" value="" '.
1.144     matthew  2863:                   'onchange="'.$jscall.'" />');
1.32      matthew  2864:     return $result;
                   2865: }
                   2866: 
1.586     raeburn  2867: sub get_assignable_auth {
                   2868:     my ($dom) = @_;
                   2869:     if ($dom eq '') {
                   2870:         $dom = $env{'request.role.domain'};
                   2871:     }
                   2872:     my %can_assign = (
                   2873:                           krb4 => 1,
                   2874:                           krb5 => 1,
                   2875:                           int  => 1,
                   2876:                           loc  => 1,
                   2877:                      );
                   2878:     my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
                   2879:     if (ref($domconfig{'usercreation'}) eq 'HASH') {
                   2880:         if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
                   2881:             my $authhash = $domconfig{'usercreation'}{'authtypes'};
                   2882:             my $context;
                   2883:             if ($env{'request.role'} =~ /^au/) {
                   2884:                 $context = 'author';
                   2885:             } elsif ($env{'request.role'} =~ /^dc/) {
                   2886:                 $context = 'domain';
                   2887:             } elsif ($env{'request.course.id'}) {
                   2888:                 $context = 'course';
                   2889:             }
                   2890:             if ($context) {
                   2891:                 if (ref($authhash->{$context}) eq 'HASH') {
                   2892:                    %can_assign = %{$authhash->{$context}}; 
                   2893:                 }
                   2894:             }
                   2895:         }
                   2896:     }
                   2897:     my $authnum = 0;
                   2898:     foreach my $key (keys(%can_assign)) {
                   2899:         if ($can_assign{$key}) {
                   2900:             $authnum ++;
                   2901:         }
                   2902:     }
                   2903:     if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
                   2904:         $authnum --;
                   2905:     }
                   2906:     return ($authnum,%can_assign);
                   2907: }
                   2908: 
1.80      albertel 2909: ###############################################################
                   2910: ##    Get Kerberos Defaults for Domain                 ##
                   2911: ###############################################################
                   2912: ##
                   2913: ## Returns default kerberos version and an associated argument
                   2914: ## as listed in file domain.tab. If not listed, provides
                   2915: ## appropriate default domain and kerberos version.
                   2916: ##
                   2917: #-------------------------------------------
                   2918: 
                   2919: =pod
                   2920: 
1.648     raeburn  2921: =item * &get_kerberos_defaults()
1.80      albertel 2922: 
                   2923: get_kerberos_defaults($target_domain) returns the default kerberos
1.641     raeburn  2924: version and domain. If not found, it defaults to version 4 and the 
                   2925: domain of the server.
1.80      albertel 2926: 
1.648     raeburn  2927: =over 4
                   2928: 
1.80      albertel 2929: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
                   2930: 
1.648     raeburn  2931: =back
                   2932: 
                   2933: =back
                   2934: 
1.80      albertel 2935: =cut
                   2936: 
                   2937: #-------------------------------------------
                   2938: sub get_kerberos_defaults {
                   2939:     my $domain=shift;
1.641     raeburn  2940:     my ($krbdef,$krbdefdom);
                   2941:     my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
                   2942:     if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
                   2943:         $krbdef = $domdefaults{'auth_def'};
                   2944:         $krbdefdom = $domdefaults{'auth_arg_def'};
                   2945:     } else {
1.80      albertel 2946:         $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
                   2947:         my $krbdefdom=$1;
                   2948:         $krbdefdom=~tr/a-z/A-Z/;
                   2949:         $krbdef = "krb4";
                   2950:     }
                   2951:     return ($krbdef,$krbdefdom);
                   2952: }
1.112     bowersj2 2953: 
1.32      matthew  2954: 
1.46      matthew  2955: ###############################################################
                   2956: ##                Thesaurus Functions                        ##
                   2957: ###############################################################
1.20      www      2958: 
1.46      matthew  2959: =pod
1.20      www      2960: 
1.112     bowersj2 2961: =head1 Thesaurus Functions
                   2962: 
                   2963: =over 4
                   2964: 
1.648     raeburn  2965: =item * &initialize_keywords()
1.46      matthew  2966: 
                   2967: Initializes the package variable %Keywords if it is empty.  Uses the
                   2968: package variable $thesaurus_db_file.
                   2969: 
                   2970: =cut
                   2971: 
                   2972: ###################################################
                   2973: 
                   2974: sub initialize_keywords {
                   2975:     return 1 if (scalar keys(%Keywords));
                   2976:     # If we are here, %Keywords is empty, so fill it up
                   2977:     #   Make sure the file we need exists...
                   2978:     if (! -e $thesaurus_db_file) {
                   2979:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
                   2980:                                  " failed because it does not exist");
                   2981:         return 0;
                   2982:     }
                   2983:     #   Set up the hash as a database
                   2984:     my %thesaurus_db;
                   2985:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 2986:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  2987:         &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
                   2988:                                  $thesaurus_db_file);
                   2989:         return 0;
                   2990:     } 
                   2991:     #  Get the average number of appearances of a word.
                   2992:     my $avecount = $thesaurus_db{'average.count'};
                   2993:     #  Put keywords (those that appear > average) into %Keywords
                   2994:     while (my ($word,$data)=each (%thesaurus_db)) {
                   2995:         my ($count,undef) = split /:/,$data;
                   2996:         $Keywords{$word}++ if ($count > $avecount);
                   2997:     }
                   2998:     untie %thesaurus_db;
                   2999:     # Remove special values from %Keywords.
1.356     albertel 3000:     foreach my $value ('total.count','average.count') {
                   3001:         delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586     raeburn  3002:   }
1.46      matthew  3003:     return 1;
                   3004: }
                   3005: 
                   3006: ###################################################
                   3007: 
                   3008: =pod
                   3009: 
1.648     raeburn  3010: =item * &keyword($word)
1.46      matthew  3011: 
                   3012: Returns true if $word is a keyword.  A keyword is a word that appears more 
                   3013: than the average number of times in the thesaurus database.  Calls 
                   3014: &initialize_keywords
                   3015: 
                   3016: =cut
                   3017: 
                   3018: ###################################################
1.20      www      3019: 
                   3020: sub keyword {
1.46      matthew  3021:     return if (!&initialize_keywords());
                   3022:     my $word=lc(shift());
                   3023:     $word=~s/\W//g;
                   3024:     return exists($Keywords{$word});
1.20      www      3025: }
1.46      matthew  3026: 
                   3027: ###############################################################
                   3028: 
                   3029: =pod 
1.20      www      3030: 
1.648     raeburn  3031: =item * &get_related_words()
1.46      matthew  3032: 
1.160     matthew  3033: Look up a word in the thesaurus.  Takes a scalar argument and returns
1.46      matthew  3034: an array of words.  If the keyword is not in the thesaurus, an empty array
                   3035: will be returned.  The order of the words returned is determined by the
                   3036: database which holds them.
                   3037: 
                   3038: Uses global $thesaurus_db_file.
                   3039: 
1.1057    foxr     3040: 
1.46      matthew  3041: =cut
                   3042: 
                   3043: ###############################################################
                   3044: sub get_related_words {
                   3045:     my $keyword = shift;
                   3046:     my %thesaurus_db;
                   3047:     if (! -e $thesaurus_db_file) {
                   3048:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
                   3049:                                  "failed because the file does not exist");
                   3050:         return ();
                   3051:     }
                   3052:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 3053:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  3054:         return ();
                   3055:     } 
                   3056:     my @Words=();
1.429     www      3057:     my $count=0;
1.46      matthew  3058:     if (exists($thesaurus_db{$keyword})) {
1.356     albertel 3059: 	# The first element is the number of times
                   3060: 	# the word appears.  We do not need it now.
1.429     www      3061: 	my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
                   3062: 	my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
                   3063: 	my $threshold=$mostfrequentcount/10;
                   3064:         foreach my $possibleword (@RelatedWords) {
                   3065:             my ($word,$wordcount)=split(/\,/,$possibleword);
                   3066:             if ($wordcount>$threshold) {
                   3067: 		push(@Words,$word);
                   3068:                 $count++;
                   3069:                 if ($count>10) { last; }
                   3070: 	    }
1.20      www      3071:         }
                   3072:     }
1.46      matthew  3073:     untie %thesaurus_db;
                   3074:     return @Words;
1.14      harris41 3075: }
1.46      matthew  3076: 
1.112     bowersj2 3077: =pod
                   3078: 
                   3079: =back
                   3080: 
                   3081: =cut
1.61      www      3082: 
                   3083: # -------------------------------------------------------------- Plaintext name
1.81      albertel 3084: =pod
                   3085: 
1.112     bowersj2 3086: =head1 User Name Functions
                   3087: 
                   3088: =over 4
                   3089: 
1.648     raeburn  3090: =item * &plainname($uname,$udom,$first)
1.81      albertel 3091: 
1.112     bowersj2 3092: Takes a users logon name and returns it as a string in
1.226     albertel 3093: "first middle last generation" form 
                   3094: if $first is set to 'lastname' then it returns it as
                   3095: 'lastname generation, firstname middlename' if their is a lastname
1.81      albertel 3096: 
                   3097: =cut
1.61      www      3098: 
1.295     www      3099: 
1.81      albertel 3100: ###############################################################
1.61      www      3101: sub plainname {
1.226     albertel 3102:     my ($uname,$udom,$first)=@_;
1.537     albertel 3103:     return if (!defined($uname) || !defined($udom));
1.295     www      3104:     my %names=&getnames($uname,$udom);
1.226     albertel 3105:     my $name=&Apache::lonnet::format_name($names{'firstname'},
                   3106: 					  $names{'middlename'},
                   3107: 					  $names{'lastname'},
                   3108: 					  $names{'generation'},$first);
                   3109:     $name=~s/^\s+//;
1.62      www      3110:     $name=~s/\s+$//;
                   3111:     $name=~s/\s+/ /g;
1.353     albertel 3112:     if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62      www      3113:     return $name;
1.61      www      3114: }
1.66      www      3115: 
                   3116: # -------------------------------------------------------------------- Nickname
1.81      albertel 3117: =pod
                   3118: 
1.648     raeburn  3119: =item * &nickname($uname,$udom)
1.81      albertel 3120: 
                   3121: Gets a users name and returns it as a string as
                   3122: 
                   3123: "&quot;nickname&quot;"
1.66      www      3124: 
1.81      albertel 3125: if the user has a nickname or
                   3126: 
                   3127: "first middle last generation"
                   3128: 
                   3129: if the user does not
                   3130: 
                   3131: =cut
1.66      www      3132: 
                   3133: sub nickname {
                   3134:     my ($uname,$udom)=@_;
1.537     albertel 3135:     return if (!defined($uname) || !defined($udom));
1.295     www      3136:     my %names=&getnames($uname,$udom);
1.68      albertel 3137:     my $name=$names{'nickname'};
1.66      www      3138:     if ($name) {
                   3139:        $name='&quot;'.$name.'&quot;'; 
                   3140:     } else {
                   3141:        $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
                   3142: 	     $names{'lastname'}.' '.$names{'generation'};
                   3143:        $name=~s/\s+$//;
                   3144:        $name=~s/\s+/ /g;
                   3145:     }
                   3146:     return $name;
                   3147: }
                   3148: 
1.295     www      3149: sub getnames {
                   3150:     my ($uname,$udom)=@_;
1.537     albertel 3151:     return if (!defined($uname) || !defined($udom));
1.433     albertel 3152:     if ($udom eq 'public' && $uname eq 'public') {
                   3153: 	return ('lastname' => &mt('Public'));
                   3154:     }
1.295     www      3155:     my $id=$uname.':'.$udom;
                   3156:     my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
                   3157:     if ($cached) {
                   3158: 	return %{$names};
                   3159:     } else {
                   3160: 	my %loadnames=&Apache::lonnet::get('environment',
                   3161:                     ['firstname','middlename','lastname','generation','nickname'],
                   3162: 					 $udom,$uname);
                   3163: 	&Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
                   3164: 	return %loadnames;
                   3165:     }
                   3166: }
1.61      www      3167: 
1.542     raeburn  3168: # -------------------------------------------------------------------- getemails
1.648     raeburn  3169: 
1.542     raeburn  3170: =pod
                   3171: 
1.648     raeburn  3172: =item * &getemails($uname,$udom)
1.542     raeburn  3173: 
                   3174: Gets a user's email information and returns it as a hash with keys:
                   3175: notification, critnotification, permanentemail
                   3176: 
                   3177: For notification and critnotification, values are comma-separated lists 
1.648     raeburn  3178: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542     raeburn  3179:  
1.648     raeburn  3180: 
1.542     raeburn  3181: =cut
                   3182: 
1.648     raeburn  3183: 
1.466     albertel 3184: sub getemails {
                   3185:     my ($uname,$udom)=@_;
                   3186:     if ($udom eq 'public' && $uname eq 'public') {
                   3187: 	return;
                   3188:     }
1.467     www      3189:     if (!$udom) { $udom=$env{'user.domain'}; }
                   3190:     if (!$uname) { $uname=$env{'user.name'}; }
1.466     albertel 3191:     my $id=$uname.':'.$udom;
                   3192:     my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
                   3193:     if ($cached) {
                   3194: 	return %{$names};
                   3195:     } else {
                   3196: 	my %loadnames=&Apache::lonnet::get('environment',
                   3197:                     			   ['notification','critnotification',
                   3198: 					    'permanentemail'],
                   3199: 					   $udom,$uname);
                   3200: 	&Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
                   3201: 	return %loadnames;
                   3202:     }
                   3203: }
                   3204: 
1.551     albertel 3205: sub flush_email_cache {
                   3206:     my ($uname,$udom)=@_;
                   3207:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3208:     if (!$uname) { $uname=$env{'user.name'};   }
                   3209:     return if ($udom eq 'public' && $uname eq 'public');
                   3210:     my $id=$uname.':'.$udom;
                   3211:     &Apache::lonnet::devalidate_cache_new('emailscache',$id);
                   3212: }
                   3213: 
1.728     raeburn  3214: # -------------------------------------------------------------------- getlangs
                   3215: 
                   3216: =pod
                   3217: 
                   3218: =item * &getlangs($uname,$udom)
                   3219: 
                   3220: Gets a user's language preference and returns it as a hash with key:
                   3221: language.
                   3222: 
                   3223: =cut
                   3224: 
                   3225: 
                   3226: sub getlangs {
                   3227:     my ($uname,$udom) = @_;
                   3228:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3229:     if (!$uname) { $uname=$env{'user.name'};   }
                   3230:     my $id=$uname.':'.$udom;
                   3231:     my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
                   3232:     if ($cached) {
                   3233:         return %{$langs};
                   3234:     } else {
                   3235:         my %loadlangs=&Apache::lonnet::get('environment',['languages'],
                   3236:                                            $udom,$uname);
                   3237:         &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
                   3238:         return %loadlangs;
                   3239:     }
                   3240: }
                   3241: 
                   3242: sub flush_langs_cache {
                   3243:     my ($uname,$udom)=@_;
                   3244:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3245:     if (!$uname) { $uname=$env{'user.name'};   }
                   3246:     return if ($udom eq 'public' && $uname eq 'public');
                   3247:     my $id=$uname.':'.$udom;
                   3248:     &Apache::lonnet::devalidate_cache_new('userlangs',$id);
                   3249: }
                   3250: 
1.61      www      3251: # ------------------------------------------------------------------ Screenname
1.81      albertel 3252: 
                   3253: =pod
                   3254: 
1.648     raeburn  3255: =item * &screenname($uname,$udom)
1.81      albertel 3256: 
                   3257: Gets a users screenname and returns it as a string
                   3258: 
                   3259: =cut
1.61      www      3260: 
                   3261: sub screenname {
                   3262:     my ($uname,$udom)=@_;
1.258     albertel 3263:     if ($uname eq $env{'user.name'} &&
                   3264: 	$udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212     albertel 3265:     my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68      albertel 3266:     return $names{'screenname'};
1.62      www      3267: }
                   3268: 
1.212     albertel 3269: 
1.802     bisitz   3270: # ------------------------------------------------------------- Confirm Wrapper
                   3271: =pod
                   3272: 
1.1075.2.42  raeburn  3273: =item * &confirmwrapper($message)
1.802     bisitz   3274: 
                   3275: Wrap messages about completion of operation in box
                   3276: 
                   3277: =cut
                   3278: 
                   3279: sub confirmwrapper {
                   3280:     my ($message)=@_;
                   3281:     if ($message) {
                   3282:         return "\n".'<div class="LC_confirm_box">'."\n"
                   3283:                .$message."\n"
                   3284:                .'</div>'."\n";
                   3285:     } else {
                   3286:         return $message;
                   3287:     }
                   3288: }
                   3289: 
1.62      www      3290: # ------------------------------------------------------------- Message Wrapper
                   3291: 
                   3292: sub messagewrapper {
1.369     www      3293:     my ($link,$username,$domain,$subject,$text)=@_;
1.62      www      3294:     return 
1.441     albertel 3295:         '<a href="/adm/email?compose=individual&amp;'.
                   3296:         'recname='.$username.'&amp;recdom='.$domain.
                   3297: 	'&amp;subject='.&escape($subject).'&amp;text='.&escape($text).'" '.
1.200     matthew  3298:         'title="'.&mt('Send message').'">'.$link.'</a>';
1.74      www      3299: }
1.802     bisitz   3300: 
1.74      www      3301: # --------------------------------------------------------------- Notes Wrapper
                   3302: 
                   3303: sub noteswrapper {
                   3304:     my ($link,$un,$do)=@_;
                   3305:     return 
1.896     amueller 3306: "<a href='/adm/email?recordftf=retrieve&amp;recname=$un&amp;recdom=$do'>$link</a>";
1.62      www      3307: }
1.802     bisitz   3308: 
1.62      www      3309: # ------------------------------------------------------------- Aboutme Wrapper
                   3310: 
                   3311: sub aboutmewrapper {
1.1070    raeburn  3312:     my ($link,$username,$domain,$target,$class)=@_;
1.447     raeburn  3313:     if (!defined($username)  && !defined($domain)) {
                   3314:         return;
                   3315:     }
1.1075.2.15  raeburn  3316:     return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
1.1070    raeburn  3317: 	($target?' target="'.$target.'"':'').($class?' class="'.$class.'"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62      www      3318: }
                   3319: 
                   3320: # ------------------------------------------------------------ Syllabus Wrapper
                   3321: 
                   3322: sub syllabuswrapper {
1.707     bisitz   3323:     my ($linktext,$coursedir,$domain)=@_;
1.208     matthew  3324:     return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61      www      3325: }
1.14      harris41 3326: 
1.802     bisitz   3327: # -----------------------------------------------------------------------------
                   3328: 
1.208     matthew  3329: sub track_student_link {
1.887     raeburn  3330:     my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268     albertel 3331:     my $link ="/adm/trackstudent?";
1.208     matthew  3332:     my $title = 'View recent activity';
                   3333:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   3334:         defined($sdom)  && $sdom  !~ /^\s*$/) {
1.268     albertel 3335:         $link .= "selected_student=$sname:$sdom";
1.208     matthew  3336:         $title .= ' of this student';
1.268     albertel 3337:     } 
1.208     matthew  3338:     if (defined($target) && $target !~ /^\s*$/) {
                   3339:         $target = qq{target="$target"};
                   3340:     } else {
                   3341:         $target = '';
                   3342:     }
1.268     albertel 3343:     if ($start) { $link.='&amp;start='.$start; }
1.887     raeburn  3344:     if ($only_body) { $link .= '&amp;only_body=1'; }
1.554     albertel 3345:     $title = &mt($title);
                   3346:     $linktext = &mt($linktext);
1.448     albertel 3347:     return qq{<a href="$link" title="$title" $target>$linktext</a>}.
                   3348: 	&help_open_topic('View_recent_activity');
1.208     matthew  3349: }
                   3350: 
1.781     raeburn  3351: sub slot_reservations_link {
                   3352:     my ($linktext,$sname,$sdom,$target) = @_;
                   3353:     my $link ="/adm/slotrequest?command=showresv&amp;origin=aboutme";
                   3354:     my $title = 'View slot reservation history';
                   3355:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   3356:         defined($sdom)  && $sdom  !~ /^\s*$/) {
                   3357:         $link .= "&amp;uname=$sname&amp;udom=$sdom";
                   3358:         $title .= ' of this student';
                   3359:     }
                   3360:     if (defined($target) && $target !~ /^\s*$/) {
                   3361:         $target = qq{target="$target"};
                   3362:     } else {
                   3363:         $target = '';
                   3364:     }
                   3365:     $title = &mt($title);
                   3366:     $linktext = &mt($linktext);
                   3367:     return qq{<a href="$link" title="$title" $target>$linktext</a>};
                   3368: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
                   3369: 
                   3370: }
                   3371: 
1.508     www      3372: # ===================================================== Display a student photo
                   3373: 
                   3374: 
1.509     albertel 3375: sub student_image_tag {
1.508     www      3376:     my ($domain,$user)=@_;
                   3377:     my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
                   3378:     if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
                   3379: 	return '<img src="'.$imgsrc.'" align="right" />';
                   3380:     } else {
                   3381: 	return '';
                   3382:     }
                   3383: }
                   3384: 
1.112     bowersj2 3385: =pod
                   3386: 
                   3387: =back
                   3388: 
                   3389: =head1 Access .tab File Data
                   3390: 
                   3391: =over 4
                   3392: 
1.648     raeburn  3393: =item * &languageids() 
1.112     bowersj2 3394: 
                   3395: returns list of all language ids
                   3396: 
                   3397: =cut
                   3398: 
1.14      harris41 3399: sub languageids {
1.16      harris41 3400:     return sort(keys(%language));
1.14      harris41 3401: }
                   3402: 
1.112     bowersj2 3403: =pod
                   3404: 
1.648     raeburn  3405: =item * &languagedescription() 
1.112     bowersj2 3406: 
                   3407: returns description of a specified language id
                   3408: 
                   3409: =cut
                   3410: 
1.14      harris41 3411: sub languagedescription {
1.125     www      3412:     my $code=shift;
                   3413:     return  ($supported_language{$code}?'* ':'').
                   3414:             $language{$code}.
1.126     www      3415: 	    ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145     www      3416: }
                   3417: 
1.1048    foxr     3418: =pod
                   3419: 
                   3420: =item * &plainlanguagedescription
                   3421: 
                   3422: Returns both the plain language description (e.g. 'Creoles and Pidgins, English-based (Other)')
                   3423: and the language character encoding (e.g. ISO) separated by a ' - ' string.
                   3424: 
                   3425: =cut
                   3426: 
1.145     www      3427: sub plainlanguagedescription {
                   3428:     my $code=shift;
                   3429:     return $language{$code};
                   3430: }
                   3431: 
1.1048    foxr     3432: =pod
                   3433: 
                   3434: =item * &supportedlanguagecode
                   3435: 
                   3436: Returns the supported language code (e.g. sptutf maps to pt) given a language
                   3437: code.
                   3438: 
                   3439: =cut
                   3440: 
1.145     www      3441: sub supportedlanguagecode {
                   3442:     my $code=shift;
                   3443:     return $supported_language{$code};
1.97      www      3444: }
                   3445: 
1.112     bowersj2 3446: =pod
                   3447: 
1.1048    foxr     3448: =item * &latexlanguage()
                   3449: 
                   3450: Given a language key code returns the correspondnig language to use
                   3451: to select the correct hyphenation on LaTeX printouts.  This is undef if there
                   3452: is no supported hyphenation for the language code.
                   3453: 
                   3454: =cut
                   3455: 
                   3456: sub latexlanguage {
                   3457:     my $code = shift;
                   3458:     return $latex_language{$code};
                   3459: }
                   3460: 
                   3461: =pod
                   3462: 
                   3463: =item * &latexhyphenation()
                   3464: 
                   3465: Same as above but what's supplied is the language as it might be stored
                   3466: in the metadata.
                   3467: 
                   3468: =cut
                   3469: 
                   3470: sub latexhyphenation {
                   3471:     my $key = shift;
                   3472:     return $latex_language_bykey{$key};
                   3473: }
                   3474: 
                   3475: =pod
                   3476: 
1.648     raeburn  3477: =item * &copyrightids() 
1.112     bowersj2 3478: 
                   3479: returns list of all copyrights
                   3480: 
                   3481: =cut
                   3482: 
                   3483: sub copyrightids {
                   3484:     return sort(keys(%cprtag));
                   3485: }
                   3486: 
                   3487: =pod
                   3488: 
1.648     raeburn  3489: =item * &copyrightdescription() 
1.112     bowersj2 3490: 
                   3491: returns description of a specified copyright id
                   3492: 
                   3493: =cut
                   3494: 
                   3495: sub copyrightdescription {
1.166     www      3496:     return &mt($cprtag{shift(@_)});
1.112     bowersj2 3497: }
1.197     matthew  3498: 
                   3499: =pod
                   3500: 
1.648     raeburn  3501: =item * &source_copyrightids() 
1.192     taceyjo1 3502: 
                   3503: returns list of all source copyrights
                   3504: 
                   3505: =cut
                   3506: 
                   3507: sub source_copyrightids {
                   3508:     return sort(keys(%scprtag));
                   3509: }
                   3510: 
                   3511: =pod
                   3512: 
1.648     raeburn  3513: =item * &source_copyrightdescription() 
1.192     taceyjo1 3514: 
                   3515: returns description of a specified source copyright id
                   3516: 
                   3517: =cut
                   3518: 
                   3519: sub source_copyrightdescription {
                   3520:     return &mt($scprtag{shift(@_)});
                   3521: }
1.112     bowersj2 3522: 
                   3523: =pod
                   3524: 
1.648     raeburn  3525: =item * &filecategories() 
1.112     bowersj2 3526: 
                   3527: returns list of all file categories
                   3528: 
                   3529: =cut
                   3530: 
                   3531: sub filecategories {
                   3532:     return sort(keys(%category_extensions));
                   3533: }
                   3534: 
                   3535: =pod
                   3536: 
1.648     raeburn  3537: =item * &filecategorytypes() 
1.112     bowersj2 3538: 
                   3539: returns list of file types belonging to a given file
                   3540: category
                   3541: 
                   3542: =cut
                   3543: 
                   3544: sub filecategorytypes {
1.356     albertel 3545:     my ($cat) = @_;
                   3546:     return @{$category_extensions{lc($cat)}};
1.112     bowersj2 3547: }
                   3548: 
                   3549: =pod
                   3550: 
1.648     raeburn  3551: =item * &fileembstyle() 
1.112     bowersj2 3552: 
                   3553: returns embedding style for a specified file type
                   3554: 
                   3555: =cut
                   3556: 
                   3557: sub fileembstyle {
                   3558:     return $fe{lc(shift(@_))};
1.169     www      3559: }
                   3560: 
1.351     www      3561: sub filemimetype {
                   3562:     return $fm{lc(shift(@_))};
                   3563: }
                   3564: 
1.169     www      3565: 
                   3566: sub filecategoryselect {
                   3567:     my ($name,$value)=@_;
1.189     matthew  3568:     return &select_form($value,$name,
1.970     raeburn  3569:                         {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});
1.112     bowersj2 3570: }
                   3571: 
                   3572: =pod
                   3573: 
1.648     raeburn  3574: =item * &filedescription() 
1.112     bowersj2 3575: 
                   3576: returns description for a specified file type
                   3577: 
                   3578: =cut
                   3579: 
                   3580: sub filedescription {
1.188     matthew  3581:     my $file_description = $fd{lc(shift())};
                   3582:     $file_description =~ s:([\[\]]):~$1:g;
                   3583:     return &mt($file_description);
1.112     bowersj2 3584: }
                   3585: 
                   3586: =pod
                   3587: 
1.648     raeburn  3588: =item * &filedescriptionex() 
1.112     bowersj2 3589: 
                   3590: returns description for a specified file type with
                   3591: extra formatting
                   3592: 
                   3593: =cut
                   3594: 
                   3595: sub filedescriptionex {
                   3596:     my $ex=shift;
1.188     matthew  3597:     my $file_description = $fd{lc($ex)};
                   3598:     $file_description =~ s:([\[\]]):~$1:g;
                   3599:     return '.'.$ex.' '.&mt($file_description);
1.112     bowersj2 3600: }
                   3601: 
                   3602: # End of .tab access
                   3603: =pod
                   3604: 
                   3605: =back
                   3606: 
                   3607: =cut
                   3608: 
                   3609: # ------------------------------------------------------------------ File Types
                   3610: sub fileextensions {
                   3611:     return sort(keys(%fe));
                   3612: }
                   3613: 
1.97      www      3614: # ----------------------------------------------------------- Display Languages
                   3615: # returns a hash with all desired display languages
                   3616: #
                   3617: 
                   3618: sub display_languages {
                   3619:     my %languages=();
1.695     raeburn  3620:     foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356     albertel 3621: 	$languages{$lang}=1;
1.97      www      3622:     }
                   3623:     &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258     albertel 3624:     if ($env{'form.displaylanguage'}) {
1.356     albertel 3625: 	foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
                   3626: 	    $languages{$lang}=1;
1.97      www      3627:         }
                   3628:     }
                   3629:     return %languages;
1.14      harris41 3630: }
                   3631: 
1.582     albertel 3632: sub languages {
                   3633:     my ($possible_langs) = @_;
1.695     raeburn  3634:     my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582     albertel 3635:     if (!ref($possible_langs)) {
                   3636: 	if( wantarray ) {
                   3637: 	    return @preferred_langs;
                   3638: 	} else {
                   3639: 	    return $preferred_langs[0];
                   3640: 	}
                   3641:     }
                   3642:     my %possibilities = map { $_ => 1 } (@$possible_langs);
                   3643:     my @preferred_possibilities;
                   3644:     foreach my $preferred_lang (@preferred_langs) {
                   3645: 	if (exists($possibilities{$preferred_lang})) {
                   3646: 	    push(@preferred_possibilities, $preferred_lang);
                   3647: 	}
                   3648:     }
                   3649:     if( wantarray ) {
                   3650: 	return @preferred_possibilities;
                   3651:     }
                   3652:     return $preferred_possibilities[0];
                   3653: }
                   3654: 
1.742     raeburn  3655: sub user_lang {
                   3656:     my ($touname,$toudom,$fromcid) = @_;
                   3657:     my @userlangs;
                   3658:     if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
                   3659:         @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
                   3660:                     $env{'course.'.$fromcid.'.languages'}));
                   3661:     } else {
                   3662:         my %langhash = &getlangs($touname,$toudom);
                   3663:         if ($langhash{'languages'} ne '') {
                   3664:             @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
                   3665:         } else {
                   3666:             my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
                   3667:             if ($domdefs{'lang_def'} ne '') {
                   3668:                 @userlangs = ($domdefs{'lang_def'});
                   3669:             }
                   3670:         }
                   3671:     }
                   3672:     my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
                   3673:     my $user_lh = Apache::localize->get_handle(@languages);
                   3674:     return $user_lh;
                   3675: }
                   3676: 
                   3677: 
1.112     bowersj2 3678: ###############################################################
                   3679: ##               Student Answer Attempts                     ##
                   3680: ###############################################################
                   3681: 
                   3682: =pod
                   3683: 
                   3684: =head1 Alternate Problem Views
                   3685: 
                   3686: =over 4
                   3687: 
1.648     raeburn  3688: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.1075.2.86  raeburn  3689:     $getattempt, $regexp, $gradesub, $usec, $identifier)
1.112     bowersj2 3690: 
                   3691: Return string with previous attempt on problem. Arguments:
                   3692: 
                   3693: =over 4
                   3694: 
                   3695: =item * $symb: Problem, including path
                   3696: 
                   3697: =item * $username: username of the desired student
                   3698: 
                   3699: =item * $domain: domain of the desired student
1.14      harris41 3700: 
1.112     bowersj2 3701: =item * $course: Course ID
1.14      harris41 3702: 
1.112     bowersj2 3703: =item * $getattempt: Leave blank for all attempts, otherwise put
                   3704:     something
1.14      harris41 3705: 
1.112     bowersj2 3706: =item * $regexp: if string matches this regexp, the string will be
                   3707:     sent to $gradesub
1.14      harris41 3708: 
1.112     bowersj2 3709: =item * $gradesub: routine that processes the string if it matches $regexp
1.14      harris41 3710: 
1.1075.2.86  raeburn  3711: =item * $usec: section of the desired student
                   3712: 
                   3713: =item * $identifier: counter for student (multiple students one problem) or
                   3714:     problem (one student; whole sequence).
                   3715: 
1.112     bowersj2 3716: =back
1.14      harris41 3717: 
1.112     bowersj2 3718: The output string is a table containing all desired attempts, if any.
1.16      harris41 3719: 
1.112     bowersj2 3720: =cut
1.1       albertel 3721: 
                   3722: sub get_previous_attempt {
1.1075.2.86  raeburn  3723:   my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub,$usec,$identifier)=@_;
1.1       albertel 3724:   my $prevattempts='';
1.43      ng       3725:   no strict 'refs';
1.1       albertel 3726:   if ($symb) {
1.3       albertel 3727:     my (%returnhash)=
                   3728:       &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1       albertel 3729:     if ($returnhash{'version'}) {
                   3730:       my %lasthash=();
                   3731:       my $version;
                   3732:       for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1075.2.91  raeburn  3733:         foreach my $key (reverse(sort(split(/\:/,$returnhash{$version.':keys'})))) {
                   3734:             if ($key =~ /\.rawrndseed$/) {
                   3735:                 my ($id) = ($key =~ /^(.+)\.rawrndseed$/);
                   3736:                 $lasthash{$id.'.rndseed'} = $returnhash{$version.':'.$key};
                   3737:             } else {
                   3738:                 $lasthash{$key}=$returnhash{$version.':'.$key};
                   3739:             }
1.19      harris41 3740:         }
1.1       albertel 3741:       }
1.596     albertel 3742:       $prevattempts=&start_data_table().&start_data_table_header_row();
                   3743:       $prevattempts.='<th>'.&mt('History').'</th>';
1.1075.2.86  raeburn  3744:       my (%typeparts,%lasthidden,%regraded,%hidestatus);
1.945     raeburn  3745:       my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356     albertel 3746:       foreach my $key (sort(keys(%lasthash))) {
                   3747: 	my ($ign,@parts) = split(/\./,$key);
1.41      ng       3748: 	if ($#parts > 0) {
1.31      albertel 3749: 	  my $data=$parts[-1];
1.989     raeburn  3750:           next if ($data eq 'foilorder');
1.31      albertel 3751: 	  pop(@parts);
1.1010    www      3752:           $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.'&nbsp;</th>';
1.945     raeburn  3753:           if ($data eq 'type') {
                   3754:               unless ($showsurv) {
                   3755:                   my $id = join(',',@parts);
                   3756:                   $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978     raeburn  3757:                   if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
                   3758:                       $lasthidden{$ign.'.'.$id} = 1;
                   3759:                   }
1.945     raeburn  3760:               }
1.1075.2.86  raeburn  3761:               if ($identifier ne '') {
                   3762:                   my $id = join(',',@parts);
                   3763:                   if (&Apache::lonnet::EXT("resource.$id.problemstatus",$symb,
                   3764:                                                $domain,$username,$usec,undef,$course) =~ /^no/) {
                   3765:                       $hidestatus{$ign.'.'.$id} = 1;
                   3766:                   }
                   3767:               }
                   3768:           } elsif ($data eq 'regrader') {
                   3769:               if (($identifier ne '') && (@parts)) {
                   3770:                   my $id = join(',',@parts);
                   3771:                   $regraded{$ign.'.'.$id} = 1;
                   3772:               }
1.1010    www      3773:           } 
1.31      albertel 3774: 	} else {
1.41      ng       3775: 	  if ($#parts == 0) {
                   3776: 	    $prevattempts.='<th>'.$parts[0].'</th>';
                   3777: 	  } else {
                   3778: 	    $prevattempts.='<th>'.$ign.'</th>';
                   3779: 	  }
1.31      albertel 3780: 	}
1.16      harris41 3781:       }
1.596     albertel 3782:       $prevattempts.=&end_data_table_header_row();
1.40      ng       3783:       if ($getattempt eq '') {
1.1075.2.86  raeburn  3784:         my (%solved,%resets,%probstatus);
                   3785:         if (($identifier ne '') && (keys(%regraded) > 0)) {
                   3786:             for ($version=1;$version<=$returnhash{'version'};$version++) {
                   3787:                 foreach my $id (keys(%regraded)) {
                   3788:                     if (($returnhash{$version.':'.$id.'.regrader'}) &&
                   3789:                         ($returnhash{$version.':'.$id.'.tries'} eq '') &&
                   3790:                         ($returnhash{$version.':'.$id.'.award'} eq '')) {
                   3791:                         push(@{$resets{$id}},$version);
                   3792:                     }
                   3793:                 }
                   3794:             }
                   3795:         }
1.40      ng       3796: 	for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1075.2.86  raeburn  3797:             my (@hidden,@unsolved);
1.945     raeburn  3798:             if (%typeparts) {
                   3799:                 foreach my $id (keys(%typeparts)) {
1.1075.2.86  raeburn  3800:                     if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') ||
                   3801:                         ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
1.945     raeburn  3802:                         push(@hidden,$id);
1.1075.2.86  raeburn  3803:                     } elsif ($identifier ne '') {
                   3804:                         unless (($returnhash{$version.':'.$id.'.type'} eq 'survey') ||
                   3805:                                 ($returnhash{$version.':'.$id.'.type'} eq 'surveycred') ||
                   3806:                                 ($hidestatus{$id})) {
                   3807:                             next if ((ref($resets{$id}) eq 'ARRAY') && grep(/^\Q$version\E$/,@{$resets{$id}}));
                   3808:                             if ($returnhash{$version.':'.$id.'.solved'} eq 'correct_by_student') {
                   3809:                                 push(@{$solved{$id}},$version);
                   3810:                             } elsif (($returnhash{$version.':'.$id.'.solved'} ne '') &&
                   3811:                                      (ref($solved{$id}) eq 'ARRAY')) {
                   3812:                                 my $skip;
                   3813:                                 if (ref($resets{$id}) eq 'ARRAY') {
                   3814:                                     foreach my $reset (@{$resets{$id}}) {
                   3815:                                         if ($reset > $solved{$id}[-1]) {
                   3816:                                             $skip=1;
                   3817:                                             last;
                   3818:                                         }
                   3819:                                     }
                   3820:                                 }
                   3821:                                 unless ($skip) {
                   3822:                                     my ($ign,$partslist) = split(/\./,$id,2);
                   3823:                                     push(@unsolved,$partslist);
                   3824:                                 }
                   3825:                             }
                   3826:                         }
1.945     raeburn  3827:                     }
                   3828:                 }
                   3829:             }
                   3830:             $prevattempts.=&start_data_table_row().
1.1075.2.86  raeburn  3831:                            '<td>'.&mt('Transaction [_1]',$version);
                   3832:             if (@unsolved) {
                   3833:                 $prevattempts .= '<span class="LC_nobreak"><label>'.
                   3834:                                  '<input type="checkbox" name="HIDE'.$identifier.'" value="'.$version.':'.join('_',@unsolved).'" />'.
                   3835:                                  &mt('Hide').'</label></span>';
                   3836:             }
                   3837:             $prevattempts .= '</td>';
1.945     raeburn  3838:             if (@hidden) {
                   3839:                 foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3840:                     next if ($key =~ /\.foilorder$/);
1.945     raeburn  3841:                     my $hide;
                   3842:                     foreach my $id (@hidden) {
                   3843:                         if ($key =~ /^\Q$id\E/) {
                   3844:                             $hide = 1;
                   3845:                             last;
                   3846:                         }
                   3847:                     }
                   3848:                     if ($hide) {
                   3849:                         my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   3850:                         if (($data eq 'award') || ($data eq 'awarddetail')) {
                   3851:                             my $value = &format_previous_attempt_value($key,
                   3852:                                              $returnhash{$version.':'.$key});
                   3853:                             $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3854:                         } else {
                   3855:                             $prevattempts.='<td>&nbsp;</td>';
                   3856:                         }
                   3857:                     } else {
                   3858:                         if ($key =~ /\./) {
1.1075.2.91  raeburn  3859:                             my $value = $returnhash{$version.':'.$key};
                   3860:                             if ($key =~ /\.rndseed$/) {
                   3861:                                 my ($id) = ($key =~ /^(.+)\.rndseed$/);
                   3862:                                 if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
                   3863:                                     $value = $returnhash{$version.':'.$id.'.rawrndseed'};
                   3864:                                 }
                   3865:                             }
                   3866:                             $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
                   3867:                                            '&nbsp;</td>';
1.945     raeburn  3868:                         } else {
                   3869:                             $prevattempts.='<td>&nbsp;</td>';
                   3870:                         }
                   3871:                     }
                   3872:                 }
                   3873:             } else {
                   3874: 	        foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3875:                     next if ($key =~ /\.foilorder$/);
1.1075.2.91  raeburn  3876:                     my $value = $returnhash{$version.':'.$key};
                   3877:                     if ($key =~ /\.rndseed$/) {
                   3878:                         my ($id) = ($key =~ /^(.+)\.rndseed$/);
                   3879:                         if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
                   3880:                             $value = $returnhash{$version.':'.$id.'.rawrndseed'};
                   3881:                         }
                   3882:                     }
                   3883:                     $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
                   3884:                                    '&nbsp;</td>';
1.945     raeburn  3885: 	        }
                   3886:             }
                   3887: 	    $prevattempts.=&end_data_table_row();
1.40      ng       3888: 	 }
1.1       albertel 3889:       }
1.945     raeburn  3890:       my @currhidden = keys(%lasthidden);
1.596     albertel 3891:       $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356     albertel 3892:       foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3893:           next if ($key =~ /\.foilorder$/);
1.945     raeburn  3894:           if (%typeparts) {
                   3895:               my $hidden;
                   3896:               foreach my $id (@currhidden) {
                   3897:                   if ($key =~ /^\Q$id\E/) {
                   3898:                       $hidden = 1;
                   3899:                       last;
                   3900:                   }
                   3901:               }
                   3902:               if ($hidden) {
                   3903:                   my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   3904:                   if (($data eq 'award') || ($data eq 'awarddetail')) {
                   3905:                       my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   3906:                       if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   3907:                           $value = &$gradesub($value);
                   3908:                       }
                   3909:                       $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3910:                   } else {
                   3911:                       $prevattempts.='<td>&nbsp;</td>';
                   3912:                   }
                   3913:               } else {
                   3914:                   my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   3915:                   if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   3916:                       $value = &$gradesub($value);
                   3917:                   }
                   3918:                   $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3919:               }
                   3920:           } else {
                   3921: 	      my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   3922: 	      if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   3923:                   $value = &$gradesub($value);
                   3924:               }
                   3925: 	      $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3926:           }
1.16      harris41 3927:       }
1.596     albertel 3928:       $prevattempts.= &end_data_table_row().&end_data_table();
1.1       albertel 3929:     } else {
1.596     albertel 3930:       $prevattempts=
                   3931: 	  &start_data_table().&start_data_table_row().
                   3932: 	  '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
                   3933: 	  &end_data_table_row().&end_data_table();
1.1       albertel 3934:     }
                   3935:   } else {
1.596     albertel 3936:     $prevattempts=
                   3937: 	  &start_data_table().&start_data_table_row().
                   3938: 	  '<td>'.&mt('No data.').'</td>'.
                   3939: 	  &end_data_table_row().&end_data_table();
1.1       albertel 3940:   }
1.10      albertel 3941: }
                   3942: 
1.581     albertel 3943: sub format_previous_attempt_value {
                   3944:     my ($key,$value) = @_;
1.1011    www      3945:     if (($key =~ /timestamp/) || ($key=~/duedate/)) {
1.581     albertel 3946: 	$value = &Apache::lonlocal::locallocaltime($value);
                   3947:     } elsif (ref($value) eq 'ARRAY') {
                   3948: 	$value = '('.join(', ', @{ $value }).')';
1.988     raeburn  3949:     } elsif ($key =~ /answerstring$/) {
                   3950:         my %answers = &Apache::lonnet::str2hash($value);
                   3951:         my @anskeys = sort(keys(%answers));
                   3952:         if (@anskeys == 1) {
                   3953:             my $answer = $answers{$anskeys[0]};
1.1001    raeburn  3954:             if ($answer =~ m{\0}) {
                   3955:                 $answer =~ s{\0}{,}g;
1.988     raeburn  3956:             }
                   3957:             my $tag_internal_answer_name = 'INTERNAL';
                   3958:             if ($anskeys[0] eq $tag_internal_answer_name) {
                   3959:                 $value = $answer; 
                   3960:             } else {
                   3961:                 $value = $anskeys[0].'='.$answer;
                   3962:             }
                   3963:         } else {
                   3964:             foreach my $ans (@anskeys) {
                   3965:                 my $answer = $answers{$ans};
1.1001    raeburn  3966:                 if ($answer =~ m{\0}) {
                   3967:                     $answer =~ s{\0}{,}g;
1.988     raeburn  3968:                 }
                   3969:                 $value .=  $ans.'='.$answer.'<br />';;
                   3970:             } 
                   3971:         }
1.581     albertel 3972:     } else {
                   3973: 	$value = &unescape($value);
                   3974:     }
                   3975:     return $value;
                   3976: }
                   3977: 
                   3978: 
1.107     albertel 3979: sub relative_to_absolute {
                   3980:     my ($url,$output)=@_;
                   3981:     my $parser=HTML::TokeParser->new(\$output);
                   3982:     my $token;
                   3983:     my $thisdir=$url;
                   3984:     my @rlinks=();
                   3985:     while ($token=$parser->get_token) {
                   3986: 	if ($token->[0] eq 'S') {
                   3987: 	    if ($token->[1] eq 'a') {
                   3988: 		if ($token->[2]->{'href'}) {
                   3989: 		    $rlinks[$#rlinks+1]=$token->[2]->{'href'};
                   3990: 		}
                   3991: 	    } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
                   3992: 		$rlinks[$#rlinks+1]=$token->[2]->{'src'};
                   3993: 	    } elsif ($token->[1] eq 'base') {
                   3994: 		$thisdir=$token->[2]->{'href'};
                   3995: 	    }
                   3996: 	}
                   3997:     }
                   3998:     $thisdir=~s-/[^/]*$--;
1.356     albertel 3999:     foreach my $link (@rlinks) {
1.726     raeburn  4000: 	unless (($link=~/^https?\:\/\//i) ||
1.356     albertel 4001: 		($link=~/^\//) ||
                   4002: 		($link=~/^javascript:/i) ||
                   4003: 		($link=~/^mailto:/i) ||
                   4004: 		($link=~/^\#/)) {
                   4005: 	    my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
                   4006: 	    $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107     albertel 4007: 	}
                   4008:     }
                   4009: # -------------------------------------------------- Deal with Applet codebases
                   4010:     $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
                   4011:     return $output;
                   4012: }
                   4013: 
1.112     bowersj2 4014: =pod
                   4015: 
1.648     raeburn  4016: =item * &get_student_view()
1.112     bowersj2 4017: 
                   4018: show a snapshot of what student was looking at
                   4019: 
                   4020: =cut
                   4021: 
1.10      albertel 4022: sub get_student_view {
1.186     albertel 4023:   my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114     www      4024:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 4025:   my (%form);
1.10      albertel 4026:   my @elements=('symb','courseid','domain','username');
                   4027:   foreach my $element (@elements) {
1.186     albertel 4028:       $form{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 4029:   }
1.186     albertel 4030:   if (defined($moreenv)) {
                   4031:       %form=(%form,%{$moreenv});
                   4032:   }
1.236     albertel 4033:   if (defined($target)) { $form{'grade_target'} = $target; }
1.107     albertel 4034:   $feedurl=&Apache::lonnet::clutter($feedurl);
1.650     www      4035:   my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11      albertel 4036:   $userview=~s/\<body[^\>]*\>//gi;
                   4037:   $userview=~s/\<\/body\>//gi;
                   4038:   $userview=~s/\<html\>//gi;
                   4039:   $userview=~s/\<\/html\>//gi;
                   4040:   $userview=~s/\<head\>//gi;
                   4041:   $userview=~s/\<\/head\>//gi;
                   4042:   $userview=~s/action\s*\=/would_be_action\=/gi;
1.107     albertel 4043:   $userview=&relative_to_absolute($feedurl,$userview);
1.650     www      4044:   if (wantarray) {
                   4045:      return ($userview,$response);
                   4046:   } else {
                   4047:      return $userview;
                   4048:   }
                   4049: }
                   4050: 
                   4051: sub get_student_view_with_retries {
                   4052:   my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
                   4053: 
                   4054:     my $ok = 0;                 # True if we got a good response.
                   4055:     my $content;
                   4056:     my $response;
                   4057: 
                   4058:     # Try to get the student_view done. within the retries count:
                   4059:     
                   4060:     do {
                   4061:          ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
                   4062:          $ok      = $response->is_success;
                   4063:          if (!$ok) {
                   4064:             &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
                   4065:          }
                   4066:          $retries--;
                   4067:     } while (!$ok && ($retries > 0));
                   4068:     
                   4069:     if (!$ok) {
                   4070:        $content = '';          # On error return an empty content.
                   4071:     }
1.651     www      4072:     if (wantarray) {
                   4073:        return ($content, $response);
                   4074:     } else {
                   4075:        return $content;
                   4076:     }
1.11      albertel 4077: }
                   4078: 
1.112     bowersj2 4079: =pod
                   4080: 
1.648     raeburn  4081: =item * &get_student_answers() 
1.112     bowersj2 4082: 
                   4083: show a snapshot of how student was answering problem
                   4084: 
                   4085: =cut
                   4086: 
1.11      albertel 4087: sub get_student_answers {
1.100     sakharuk 4088:   my ($symb,$username,$domain,$courseid,%form) = @_;
1.114     www      4089:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 4090:   my (%moreenv);
1.11      albertel 4091:   my @elements=('symb','courseid','domain','username');
                   4092:   foreach my $element (@elements) {
1.186     albertel 4093:     $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 4094:   }
1.186     albertel 4095:   $moreenv{'grade_target'}='answer';
                   4096:   %moreenv=(%form,%moreenv);
1.497     raeburn  4097:   $feedurl = &Apache::lonnet::clutter($feedurl);
                   4098:   my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10      albertel 4099:   return $userview;
1.1       albertel 4100: }
1.116     albertel 4101: 
                   4102: =pod
                   4103: 
                   4104: =item * &submlink()
                   4105: 
1.242     albertel 4106: Inputs: $text $uname $udom $symb $target
1.116     albertel 4107: 
                   4108: Returns: A link to grades.pm such as to see the SUBM view of a student
                   4109: 
                   4110: =cut
                   4111: 
                   4112: ###############################################
                   4113: sub submlink {
1.242     albertel 4114:     my ($text,$uname,$udom,$symb,$target)=@_;
1.116     albertel 4115:     if (!($uname && $udom)) {
                   4116: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 4117: 	    &Apache::lonnet::whichuser($symb);
1.116     albertel 4118: 	if (!$symb) { $symb=$cursymb; }
                   4119:     }
1.254     matthew  4120:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      4121:     $symb=&escape($symb);
1.960     bisitz   4122:     if ($target) { $target=" target=\"$target\""; }
                   4123:     return
                   4124:         '<a href="/adm/grades?command=submission'.
                   4125:         '&amp;symb='.$symb.
                   4126:         '&amp;student='.$uname.
                   4127:         '&amp;userdom='.$udom.'"'.
                   4128:         $target.'>'.$text.'</a>';
1.242     albertel 4129: }
                   4130: ##############################################
                   4131: 
                   4132: =pod
                   4133: 
                   4134: =item * &pgrdlink()
                   4135: 
                   4136: Inputs: $text $uname $udom $symb $target
                   4137: 
                   4138: Returns: A link to grades.pm such as to see the PGRD view of a student
                   4139: 
                   4140: =cut
                   4141: 
                   4142: ###############################################
                   4143: sub pgrdlink {
                   4144:     my $link=&submlink(@_);
                   4145:     $link=~s/(&command=submission)/$1&showgrading=yes/;
                   4146:     return $link;
                   4147: }
                   4148: ##############################################
                   4149: 
                   4150: =pod
                   4151: 
                   4152: =item * &pprmlink()
                   4153: 
                   4154: Inputs: $text $uname $udom $symb $target
                   4155: 
                   4156: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283     albertel 4157: student and a specific resource
1.242     albertel 4158: 
                   4159: =cut
                   4160: 
                   4161: ###############################################
                   4162: sub pprmlink {
                   4163:     my ($text,$uname,$udom,$symb,$target)=@_;
                   4164:     if (!($uname && $udom)) {
                   4165: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 4166: 	    &Apache::lonnet::whichuser($symb);
1.242     albertel 4167: 	if (!$symb) { $symb=$cursymb; }
                   4168:     }
1.254     matthew  4169:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      4170:     $symb=&escape($symb);
1.242     albertel 4171:     if ($target) { $target="target=\"$target\""; }
1.595     albertel 4172:     return '<a href="/adm/parmset?command=set&amp;'.
                   4173: 	'symb='.$symb.'&amp;uname='.$uname.
                   4174: 	'&amp;udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116     albertel 4175: }
                   4176: ##############################################
1.37      matthew  4177: 
1.112     bowersj2 4178: =pod
                   4179: 
                   4180: =back
                   4181: 
                   4182: =cut
                   4183: 
1.37      matthew  4184: ###############################################
1.51      www      4185: 
                   4186: 
                   4187: sub timehash {
1.687     raeburn  4188:     my ($thistime) = @_;
                   4189:     my $timezone = &Apache::lonlocal::gettimezone();
                   4190:     my $dt = DateTime->from_epoch(epoch => $thistime)
                   4191:                      ->set_time_zone($timezone);
                   4192:     my $wday = $dt->day_of_week();
                   4193:     if ($wday == 7) { $wday = 0; }
                   4194:     return ( 'second' => $dt->second(),
                   4195:              'minute' => $dt->minute(),
                   4196:              'hour'   => $dt->hour(),
                   4197:              'day'     => $dt->day_of_month(),
                   4198:              'month'   => $dt->month(),
                   4199:              'year'    => $dt->year(),
                   4200:              'weekday' => $wday,
                   4201:              'dayyear' => $dt->day_of_year(),
                   4202:              'dlsav'   => $dt->is_dst() );
1.51      www      4203: }
                   4204: 
1.370     www      4205: sub utc_string {
                   4206:     my ($date)=@_;
1.371     www      4207:     return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370     www      4208: }
                   4209: 
1.51      www      4210: sub maketime {
                   4211:     my %th=@_;
1.687     raeburn  4212:     my ($epoch_time,$timezone,$dt);
                   4213:     $timezone = &Apache::lonlocal::gettimezone();
                   4214:     eval {
                   4215:         $dt = DateTime->new( year   => $th{'year'},
                   4216:                              month  => $th{'month'},
                   4217:                              day    => $th{'day'},
                   4218:                              hour   => $th{'hour'},
                   4219:                              minute => $th{'minute'},
                   4220:                              second => $th{'second'},
                   4221:                              time_zone => $timezone,
                   4222:                          );
                   4223:     };
                   4224:     if (!$@) {
                   4225:         $epoch_time = $dt->epoch;
                   4226:         if ($epoch_time) {
                   4227:             return $epoch_time;
                   4228:         }
                   4229:     }
1.51      www      4230:     return POSIX::mktime(
                   4231:         ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210     www      4232:          $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70      www      4233: }
                   4234: 
                   4235: #########################################
1.51      www      4236: 
                   4237: sub findallcourses {
1.482     raeburn  4238:     my ($roles,$uname,$udom) = @_;
1.355     albertel 4239:     my %roles;
                   4240:     if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348     albertel 4241:     my %courses;
1.51      www      4242:     my $now=time;
1.482     raeburn  4243:     if (!defined($uname)) {
                   4244:         $uname = $env{'user.name'};
                   4245:     }
                   4246:     if (!defined($udom)) {
                   4247:         $udom = $env{'user.domain'};
                   4248:     }
                   4249:     if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.1073    raeburn  4250:         my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
1.482     raeburn  4251:         if (!%roles) {
                   4252:             %roles = (
                   4253:                        cc => 1,
1.907     raeburn  4254:                        co => 1,
1.482     raeburn  4255:                        in => 1,
                   4256:                        ep => 1,
                   4257:                        ta => 1,
                   4258:                        cr => 1,
                   4259:                        st => 1,
                   4260:              );
                   4261:         }
                   4262:         foreach my $entry (keys(%roleshash)) {
                   4263:             my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
                   4264:             if ($trole =~ /^cr/) { 
                   4265:                 next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
                   4266:             } else {
                   4267:                 next if (!exists($roles{$trole}));
                   4268:             }
                   4269:             if ($tend) {
                   4270:                 next if ($tend < $now);
                   4271:             }
                   4272:             if ($tstart) {
                   4273:                 next if ($tstart > $now);
                   4274:             }
1.1058    raeburn  4275:             my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role);
1.482     raeburn  4276:             (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
1.1058    raeburn  4277:             my $value = $trole.'/'.$cdom.'/';
1.482     raeburn  4278:             if ($secpart eq '') {
                   4279:                 ($cnum,$role) = split(/_/,$cnumpart); 
                   4280:                 $sec = 'none';
1.1058    raeburn  4281:                 $value .= $cnum.'/';
1.482     raeburn  4282:             } else {
                   4283:                 $cnum = $cnumpart;
                   4284:                 ($sec,$role) = split(/_/,$secpart);
1.1058    raeburn  4285:                 $value .= $cnum.'/'.$sec;
                   4286:             }
                   4287:             if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
                   4288:                 unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
                   4289:                     push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
                   4290:                 }
                   4291:             } else {
                   4292:                 @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.490     raeburn  4293:             }
1.482     raeburn  4294:         }
                   4295:     } else {
                   4296:         foreach my $key (keys(%env)) {
1.483     albertel 4297: 	    if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
                   4298:                  $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482     raeburn  4299: 	        my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
                   4300: 	        next if ($role eq 'ca' || $role eq 'aa');
                   4301: 	        next if (%roles && !exists($roles{$role}));
                   4302: 	        my ($starttime,$endtime)=split(/\./,$env{$key});
                   4303:                 my $active=1;
                   4304:                 if ($starttime) {
                   4305: 		    if ($now<$starttime) { $active=0; }
                   4306:                 }
                   4307:                 if ($endtime) {
                   4308:                     if ($now>$endtime) { $active=0; }
                   4309:                 }
                   4310:                 if ($active) {
1.1058    raeburn  4311:                     my $value = $role.'/'.$cdom.'/'.$cnum.'/';
1.482     raeburn  4312:                     if ($sec eq '') {
                   4313:                         $sec = 'none';
1.1058    raeburn  4314:                     } else {
                   4315:                         $value .= $sec;
                   4316:                     }
                   4317:                     if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
                   4318:                         unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
                   4319:                             push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
                   4320:                         }
                   4321:                     } else {
                   4322:                         @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.482     raeburn  4323:                     }
1.474     raeburn  4324:                 }
                   4325:             }
1.51      www      4326:         }
                   4327:     }
1.474     raeburn  4328:     return %courses;
1.51      www      4329: }
1.37      matthew  4330: 
1.54      www      4331: ###############################################
1.474     raeburn  4332: 
                   4333: sub blockcheck {
1.1075.2.73  raeburn  4334:     my ($setters,$activity,$uname,$udom,$url,$is_course) = @_;
1.490     raeburn  4335: 
1.1075.2.73  raeburn  4336:     if (defined($udom) && defined($uname)) {
                   4337:         # If uname and udom are for a course, check for blocks in the course.
                   4338:         if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) {
                   4339:             my ($startblock,$endblock,$triggerblock) =
                   4340:                 &get_blocks($setters,$activity,$udom,$uname,$url);
                   4341:             return ($startblock,$endblock,$triggerblock);
                   4342:         }
                   4343:     } else {
1.490     raeburn  4344:         $udom = $env{'user.domain'};
                   4345:         $uname = $env{'user.name'};
                   4346:     }
                   4347: 
1.502     raeburn  4348:     my $startblock = 0;
                   4349:     my $endblock = 0;
1.1062    raeburn  4350:     my $triggerblock = '';
1.482     raeburn  4351:     my %live_courses = &findallcourses(undef,$uname,$udom);
1.474     raeburn  4352: 
1.490     raeburn  4353:     # If uname is for a user, and activity is course-specific, i.e.,
                   4354:     # boards, chat or groups, check for blocking in current course only.
1.474     raeburn  4355: 
1.490     raeburn  4356:     if (($activity eq 'boards' || $activity eq 'chat' ||
1.1075.2.73  raeburn  4357:          $activity eq 'groups' || $activity eq 'printout') &&
                   4358:         ($env{'request.course.id'})) {
1.490     raeburn  4359:         foreach my $key (keys(%live_courses)) {
                   4360:             if ($key ne $env{'request.course.id'}) {
                   4361:                 delete($live_courses{$key});
                   4362:             }
                   4363:         }
                   4364:     }
                   4365: 
                   4366:     my $otheruser = 0;
                   4367:     my %own_courses;
                   4368:     if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
                   4369:         # Resource belongs to user other than current user.
                   4370:         $otheruser = 1;
                   4371:         # Gather courses for current user
                   4372:         %own_courses = 
                   4373:             &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
                   4374:     }
                   4375: 
                   4376:     # Gather active course roles - course coordinator, instructor, 
                   4377:     # exam proctor, ta, student, or custom role.
1.474     raeburn  4378: 
                   4379:     foreach my $course (keys(%live_courses)) {
1.482     raeburn  4380:         my ($cdom,$cnum);
                   4381:         if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
                   4382:             $cdom = $env{'course.'.$course.'.domain'};
                   4383:             $cnum = $env{'course.'.$course.'.num'};
                   4384:         } else {
1.490     raeburn  4385:             ($cdom,$cnum) = split(/_/,$course); 
1.482     raeburn  4386:         }
                   4387:         my $no_ownblock = 0;
                   4388:         my $no_userblock = 0;
1.533     raeburn  4389:         if ($otheruser && $activity ne 'com') {
1.490     raeburn  4390:             # Check if current user has 'evb' priv for this
                   4391:             if (defined($own_courses{$course})) {
                   4392:                 foreach my $sec (keys(%{$own_courses{$course}})) {
                   4393:                     my $checkrole = 'cm./'.$cdom.'/'.$cnum;
                   4394:                     if ($sec ne 'none') {
                   4395:                         $checkrole .= '/'.$sec;
                   4396:                     }
                   4397:                     if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   4398:                         $no_ownblock = 1;
                   4399:                         last;
                   4400:                     }
                   4401:                 }
                   4402:             }
                   4403:             # if they have 'evb' priv and are currently not playing student
                   4404:             next if (($no_ownblock) &&
                   4405:                  ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
                   4406:         }
1.474     raeburn  4407:         foreach my $sec (keys(%{$live_courses{$course}})) {
1.482     raeburn  4408:             my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474     raeburn  4409:             if ($sec ne 'none') {
1.482     raeburn  4410:                 $checkrole .= '/'.$sec;
1.474     raeburn  4411:             }
1.490     raeburn  4412:             if ($otheruser) {
                   4413:                 # Resource belongs to user other than current user.
                   4414:                 # Assemble privs for that user, and check for 'evb' priv.
1.1058    raeburn  4415:                 my (%allroles,%userroles);
                   4416:                 if (ref($live_courses{$course}{$sec}) eq 'ARRAY') {
                   4417:                     foreach my $entry (@{$live_courses{$course}{$sec}}) { 
                   4418:                         my ($trole,$tdom,$tnum,$tsec);
                   4419:                         if ($entry =~ /^cr/) {
                   4420:                             ($trole,$tdom,$tnum,$tsec) = 
                   4421:                                 ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
                   4422:                         } else {
                   4423:                            ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
                   4424:                         }
                   4425:                         my ($spec,$area,$trest);
                   4426:                         $area = '/'.$tdom.'/'.$tnum;
                   4427:                         $trest = $tnum;
                   4428:                         if ($tsec ne '') {
                   4429:                             $area .= '/'.$tsec;
                   4430:                             $trest .= '/'.$tsec;
                   4431:                         }
                   4432:                         $spec = $trole.'.'.$area;
                   4433:                         if ($trole =~ /^cr/) {
                   4434:                             &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
                   4435:                                                               $tdom,$spec,$trest,$area);
                   4436:                         } else {
                   4437:                             &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
                   4438:                                                                 $tdom,$spec,$trest,$area);
                   4439:                         }
                   4440:                     }
                   4441:                     my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
                   4442:                     if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
                   4443:                         if ($1) {
                   4444:                             $no_userblock = 1;
                   4445:                             last;
                   4446:                         }
1.486     raeburn  4447:                     }
                   4448:                 }
1.490     raeburn  4449:             } else {
                   4450:                 # Resource belongs to current user
                   4451:                 # Check for 'evb' priv via lonnet::allowed().
1.482     raeburn  4452:                 if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   4453:                     $no_ownblock = 1;
                   4454:                     last;
                   4455:                 }
1.474     raeburn  4456:             }
                   4457:         }
                   4458:         # if they have the evb priv and are currently not playing student
1.482     raeburn  4459:         next if (($no_ownblock) &&
1.491     albertel 4460:                  ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482     raeburn  4461:         next if ($no_userblock);
1.474     raeburn  4462: 
1.866     kalberla 4463:         # Retrieve blocking times and identity of locker for course
1.490     raeburn  4464:         # of specified user, unless user has 'evb' privilege.
1.502     raeburn  4465:         
1.1062    raeburn  4466:         my ($start,$end,$trigger) = 
                   4467:             &get_blocks($setters,$activity,$cdom,$cnum,$url);
1.502     raeburn  4468:         if (($start != 0) && 
                   4469:             (($startblock == 0) || ($startblock > $start))) {
                   4470:             $startblock = $start;
1.1062    raeburn  4471:             if ($trigger ne '') {
                   4472:                 $triggerblock = $trigger;
                   4473:             }
1.502     raeburn  4474:         }
                   4475:         if (($end != 0)  &&
                   4476:             (($endblock == 0) || ($endblock < $end))) {
                   4477:             $endblock = $end;
1.1062    raeburn  4478:             if ($trigger ne '') {
                   4479:                 $triggerblock = $trigger;
                   4480:             }
1.502     raeburn  4481:         }
1.490     raeburn  4482:     }
1.1062    raeburn  4483:     return ($startblock,$endblock,$triggerblock);
1.490     raeburn  4484: }
                   4485: 
                   4486: sub get_blocks {
1.1062    raeburn  4487:     my ($setters,$activity,$cdom,$cnum,$url) = @_;
1.490     raeburn  4488:     my $startblock = 0;
                   4489:     my $endblock = 0;
1.1062    raeburn  4490:     my $triggerblock = '';
1.490     raeburn  4491:     my $course = $cdom.'_'.$cnum;
                   4492:     $setters->{$course} = {};
                   4493:     $setters->{$course}{'staff'} = [];
                   4494:     $setters->{$course}{'times'} = [];
1.1062    raeburn  4495:     $setters->{$course}{'triggers'} = [];
                   4496:     my (@blockers,%triggered);
                   4497:     my $now = time;
                   4498:     my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
                   4499:     if ($activity eq 'docs') {
                   4500:         @blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks);
                   4501:         foreach my $block (@blockers) {
                   4502:             if ($block =~ /^firstaccess____(.+)$/) {
                   4503:                 my $item = $1;
                   4504:                 my $type = 'map';
                   4505:                 my $timersymb = $item;
                   4506:                 if ($item eq 'course') {
                   4507:                     $type = 'course';
                   4508:                 } elsif ($item =~ /___\d+___/) {
                   4509:                     $type = 'resource';
                   4510:                 } else {
                   4511:                     $timersymb = &Apache::lonnet::symbread($item);
                   4512:                 }
                   4513:                 my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
                   4514:                 my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
                   4515:                 $triggered{$block} = {
                   4516:                                        start => $start,
                   4517:                                        end   => $end,
                   4518:                                        type  => $type,
                   4519:                                      };
                   4520:             }
                   4521:         }
                   4522:     } else {
                   4523:         foreach my $block (keys(%commblocks)) {
                   4524:             if ($block =~ m/^(\d+)____(\d+)$/) { 
                   4525:                 my ($start,$end) = ($1,$2);
                   4526:                 if ($start <= time && $end >= time) {
                   4527:                     if (ref($commblocks{$block}) eq 'HASH') {
                   4528:                         if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
                   4529:                             if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
                   4530:                                 unless(grep(/^\Q$block\E$/,@blockers)) {
                   4531:                                     push(@blockers,$block);
                   4532:                                 }
                   4533:                             }
                   4534:                         }
                   4535:                     }
                   4536:                 }
                   4537:             } elsif ($block =~ /^firstaccess____(.+)$/) {
                   4538:                 my $item = $1;
                   4539:                 my $timersymb = $item; 
                   4540:                 my $type = 'map';
                   4541:                 if ($item eq 'course') {
                   4542:                     $type = 'course';
                   4543:                 } elsif ($item =~ /___\d+___/) {
                   4544:                     $type = 'resource';
                   4545:                 } else {
                   4546:                     $timersymb = &Apache::lonnet::symbread($item);
                   4547:                 }
                   4548:                 my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
                   4549:                 my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb}; 
                   4550:                 if ($start && $end) {
                   4551:                     if (($start <= time) && ($end >= time)) {
                   4552:                         unless (grep(/^\Q$block\E$/,@blockers)) {
                   4553:                             push(@blockers,$block);
                   4554:                             $triggered{$block} = {
                   4555:                                                    start => $start,
                   4556:                                                    end   => $end,
                   4557:                                                    type  => $type,
                   4558:                                                  };
                   4559:                         }
                   4560:                     }
1.490     raeburn  4561:                 }
1.1062    raeburn  4562:             }
                   4563:         }
                   4564:     }
                   4565:     foreach my $blocker (@blockers) {
                   4566:         my ($staff_name,$staff_dom,$title,$blocks) =
                   4567:             &parse_block_record($commblocks{$blocker});
                   4568:         push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
                   4569:         my ($start,$end,$triggertype);
                   4570:         if ($blocker =~ m/^(\d+)____(\d+)$/) {
                   4571:             ($start,$end) = ($1,$2);
                   4572:         } elsif (ref($triggered{$blocker}) eq 'HASH') {
                   4573:             $start = $triggered{$blocker}{'start'};
                   4574:             $end = $triggered{$blocker}{'end'};
                   4575:             $triggertype = $triggered{$blocker}{'type'};
                   4576:         }
                   4577:         if ($start) {
                   4578:             push(@{$$setters{$course}{'times'}}, [$start,$end]);
                   4579:             if ($triggertype) {
                   4580:                 push(@{$$setters{$course}{'triggers'}},$triggertype);
                   4581:             } else {
                   4582:                 push(@{$$setters{$course}{'triggers'}},0);
                   4583:             }
                   4584:             if ( ($startblock == 0) || ($startblock > $start) ) {
                   4585:                 $startblock = $start;
                   4586:                 if ($triggertype) {
                   4587:                     $triggerblock = $blocker;
1.474     raeburn  4588:                 }
                   4589:             }
1.1062    raeburn  4590:             if ( ($endblock == 0) || ($endblock < $end) ) {
                   4591:                $endblock = $end;
                   4592:                if ($triggertype) {
                   4593:                    $triggerblock = $blocker;
                   4594:                }
                   4595:             }
1.474     raeburn  4596:         }
                   4597:     }
1.1062    raeburn  4598:     return ($startblock,$endblock,$triggerblock);
1.474     raeburn  4599: }
                   4600: 
                   4601: sub parse_block_record {
                   4602:     my ($record) = @_;
                   4603:     my ($setuname,$setudom,$title,$blocks);
                   4604:     if (ref($record) eq 'HASH') {
                   4605:         ($setuname,$setudom) = split(/:/,$record->{'setter'});
                   4606:         $title = &unescape($record->{'event'});
                   4607:         $blocks = $record->{'blocks'};
                   4608:     } else {
                   4609:         my @data = split(/:/,$record,3);
                   4610:         if (scalar(@data) eq 2) {
                   4611:             $title = $data[1];
                   4612:             ($setuname,$setudom) = split(/@/,$data[0]);
                   4613:         } else {
                   4614:             ($setuname,$setudom,$title) = @data;
                   4615:         }
                   4616:         $blocks = { 'com' => 'on' };
                   4617:     }
                   4618:     return ($setuname,$setudom,$title,$blocks);
                   4619: }
                   4620: 
1.854     kalberla 4621: sub blocking_status {
1.1075.2.73  raeburn  4622:     my ($activity,$uname,$udom,$url,$is_course) = @_;
1.1061    raeburn  4623:     my %setters;
1.890     droeschl 4624: 
1.1061    raeburn  4625: # check for active blocking
1.1062    raeburn  4626:     my ($startblock,$endblock,$triggerblock) = 
1.1075.2.73  raeburn  4627:         &blockcheck(\%setters,$activity,$uname,$udom,$url,$is_course);
1.1062    raeburn  4628:     my $blocked = 0;
                   4629:     if ($startblock && $endblock) {
                   4630:         $blocked = 1;
                   4631:     }
1.890     droeschl 4632: 
1.1061    raeburn  4633: # caller just wants to know whether a block is active
                   4634:     if (!wantarray) { return $blocked; }
                   4635: 
                   4636: # build a link to a popup window containing the details
                   4637:     my $querystring  = "?activity=$activity";
                   4638: # $uname and $udom decide whose portfolio the user is trying to look at
1.1075.2.97  raeburn  4639:     if (($activity eq 'port') || ($activity eq 'passwd')) {
                   4640:         $querystring .= "&amp;udom=$udom"      if ($udom =~ /^$match_domain$/);
                   4641:         $querystring .= "&amp;uname=$uname"    if ($uname =~ /^$match_username$/);
1.1062    raeburn  4642:     } elsif ($activity eq 'docs') {
                   4643:         $querystring .= '&amp;url='.&HTML::Entities::encode($url,'&"');
                   4644:     }
1.1061    raeburn  4645: 
                   4646:     my $output .= <<'END_MYBLOCK';
                   4647: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
                   4648:     var options = "width=" + w + ",height=" + h + ",";
                   4649:     options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
                   4650:     options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
                   4651:     var newWin = window.open(url, wdwName, options);
                   4652:     newWin.focus();
                   4653: }
1.890     droeschl 4654: END_MYBLOCK
1.854     kalberla 4655: 
1.1061    raeburn  4656:     $output = Apache::lonhtmlcommon::scripttag($output);
1.890     droeschl 4657:   
1.1061    raeburn  4658:     my $popupUrl = "/adm/blockingstatus/$querystring";
1.1062    raeburn  4659:     my $text = &mt('Communication Blocked');
1.1075.2.93  raeburn  4660:     my $class = 'LC_comblock';
1.1062    raeburn  4661:     if ($activity eq 'docs') {
                   4662:         $text = &mt('Content Access Blocked');
1.1075.2.93  raeburn  4663:         $class = '';
1.1063    raeburn  4664:     } elsif ($activity eq 'printout') {
                   4665:         $text = &mt('Printing Blocked');
1.1075.2.97  raeburn  4666:     } elsif ($activity eq 'passwd') {
                   4667:         $text = &mt('Password Changing Blocked');
1.1062    raeburn  4668:     }
1.1061    raeburn  4669:     $output .= <<"END_BLOCK";
1.1075.2.93  raeburn  4670: <div class='$class'>
1.869     kalberla 4671:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890     droeschl 4672:   title='$text'>
                   4673:   <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869     kalberla 4674:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring' 
1.890     droeschl 4675:   title='$text'>$text</a>
1.867     kalberla 4676: </div>
                   4677: 
                   4678: END_BLOCK
1.474     raeburn  4679: 
1.1061    raeburn  4680:     return ($blocked, $output);
1.854     kalberla 4681: }
1.490     raeburn  4682: 
1.60      matthew  4683: ###############################################
                   4684: 
1.682     raeburn  4685: sub check_ip_acc {
                   4686:     my ($acc)=@_;
                   4687:     &Apache::lonxml::debug("acc is $acc");
                   4688:     if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
                   4689:         return 1;
                   4690:     }
                   4691:     my $allowed=0;
                   4692:     my $ip=$env{'request.host'} || $ENV{'REMOTE_ADDR'};
                   4693: 
                   4694:     my $name;
                   4695:     foreach my $pattern (split(',',$acc)) {
                   4696:         $pattern =~ s/^\s*//;
                   4697:         $pattern =~ s/\s*$//;
                   4698:         if ($pattern =~ /\*$/) {
                   4699:             #35.8.*
                   4700:             $pattern=~s/\*//;
                   4701:             if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
                   4702:         } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
                   4703:             #35.8.3.[34-56]
                   4704:             my $low=$2;
                   4705:             my $high=$3;
                   4706:             $pattern=$1;
                   4707:             if ($ip =~ /^\Q$pattern\E/) {
                   4708:                 my $last=(split(/\./,$ip))[3];
                   4709:                 if ($last <=$high && $last >=$low) { $allowed=1; }
                   4710:             }
                   4711:         } elsif ($pattern =~ /^\*/) {
                   4712:             #*.msu.edu
                   4713:             $pattern=~s/\*//;
                   4714:             if (!defined($name)) {
                   4715:                 use Socket;
                   4716:                 my $netaddr=inet_aton($ip);
                   4717:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   4718:             }
                   4719:             if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
                   4720:         } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
                   4721:             #127.0.0.1
                   4722:             if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
                   4723:         } else {
                   4724:             #some.name.com
                   4725:             if (!defined($name)) {
                   4726:                 use Socket;
                   4727:                 my $netaddr=inet_aton($ip);
                   4728:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   4729:             }
                   4730:             if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
                   4731:         }
                   4732:         if ($allowed) { last; }
                   4733:     }
                   4734:     return $allowed;
                   4735: }
                   4736: 
                   4737: ###############################################
                   4738: 
1.60      matthew  4739: =pod
                   4740: 
1.112     bowersj2 4741: =head1 Domain Template Functions
                   4742: 
                   4743: =over 4
                   4744: 
                   4745: =item * &determinedomain()
1.60      matthew  4746: 
                   4747: Inputs: $domain (usually will be undef)
                   4748: 
1.63      www      4749: Returns: Determines which domain should be used for designs
1.60      matthew  4750: 
                   4751: =cut
1.54      www      4752: 
1.60      matthew  4753: ###############################################
1.63      www      4754: sub determinedomain {
                   4755:     my $domain=shift;
1.531     albertel 4756:     if (! $domain) {
1.60      matthew  4757:         # Determine domain if we have not been given one
1.893     raeburn  4758:         $domain = &Apache::lonnet::default_login_domain();
1.258     albertel 4759:         if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
                   4760:         if ($env{'request.role.domain'}) { 
                   4761:             $domain=$env{'request.role.domain'}; 
1.60      matthew  4762:         }
                   4763:     }
1.63      www      4764:     return $domain;
                   4765: }
                   4766: ###############################################
1.517     raeburn  4767: 
1.518     albertel 4768: sub devalidate_domconfig_cache {
                   4769:     my ($udom)=@_;
                   4770:     &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
                   4771: }
                   4772: 
                   4773: # ---------------------- Get domain configuration for a domain
                   4774: sub get_domainconf {
                   4775:     my ($udom) = @_;
                   4776:     my $cachetime=1800;
                   4777:     my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
                   4778:     if (defined($cached)) { return %{$result}; }
                   4779: 
                   4780:     my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948     raeburn  4781: 					     ['login','rolecolors','autoenroll'],$udom);
1.632     raeburn  4782:     my (%designhash,%legacy);
1.518     albertel 4783:     if (keys(%domconfig) > 0) {
                   4784:         if (ref($domconfig{'login'}) eq 'HASH') {
1.632     raeburn  4785:             if (keys(%{$domconfig{'login'}})) {
                   4786:                 foreach my $key (keys(%{$domconfig{'login'}})) {
1.699     raeburn  4787:                     if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.1075.2.87  raeburn  4788:                         if (($key eq 'loginvia') || ($key eq 'headtag')) {
                   4789:                             if (ref($domconfig{'login'}{$key}) eq 'HASH') {
                   4790:                                 foreach my $hostname (keys(%{$domconfig{'login'}{$key}})) {
                   4791:                                     if (ref($domconfig{'login'}{$key}{$hostname}) eq 'HASH') {
                   4792:                                         if ($key eq 'loginvia') {
                   4793:                                             if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
                   4794:                                                 my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
                   4795:                                                 $designhash{$udom.'.login.loginvia'} = $server;
                   4796:                                                 if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
                   4797:                                                     $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
                   4798:                                                 } else {
                   4799:                                                     $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
                   4800:                                                 }
1.948     raeburn  4801:                                             }
1.1075.2.87  raeburn  4802:                                         } elsif ($key eq 'headtag') {
                   4803:                                             if ($domconfig{'login'}{'headtag'}{$hostname}{'url'}) {
                   4804:                                                 $designhash{$udom.'.login.headtag_'.$hostname} = $domconfig{'login'}{'headtag'}{$hostname}{'url'};
1.948     raeburn  4805:                                             }
1.946     raeburn  4806:                                         }
1.1075.2.87  raeburn  4807:                                         if ($domconfig{'login'}{$key}{$hostname}{'exempt'}) {
                   4808:                                             $designhash{$udom.'.login.'.$key.'_exempt_'.$hostname} = $domconfig{'login'}{$key}{$hostname}{'exempt'};
                   4809:                                         }
1.946     raeburn  4810:                                     }
                   4811:                                 }
                   4812:                             }
                   4813:                         } else {
                   4814:                             foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
                   4815:                                 $designhash{$udom.'.login.'.$key.'_'.$img} = 
                   4816:                                     $domconfig{'login'}{$key}{$img};
                   4817:                             }
1.699     raeburn  4818:                         }
                   4819:                     } else {
                   4820:                         $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
                   4821:                     }
1.632     raeburn  4822:                 }
                   4823:             } else {
                   4824:                 $legacy{'login'} = 1;
1.518     albertel 4825:             }
1.632     raeburn  4826:         } else {
                   4827:             $legacy{'login'} = 1;
1.518     albertel 4828:         }
                   4829:         if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632     raeburn  4830:             if (keys(%{$domconfig{'rolecolors'}})) {
                   4831:                 foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
                   4832:                     if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
                   4833:                         foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
                   4834:                             $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
                   4835:                         }
1.518     albertel 4836:                     }
                   4837:                 }
1.632     raeburn  4838:             } else {
                   4839:                 $legacy{'rolecolors'} = 1;
1.518     albertel 4840:             }
1.632     raeburn  4841:         } else {
                   4842:             $legacy{'rolecolors'} = 1;
1.518     albertel 4843:         }
1.948     raeburn  4844:         if (ref($domconfig{'autoenroll'}) eq 'HASH') {
                   4845:             if ($domconfig{'autoenroll'}{'co-owners'}) {
                   4846:                 $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
                   4847:             }
                   4848:         }
1.632     raeburn  4849:         if (keys(%legacy) > 0) {
                   4850:             my %legacyhash = &get_legacy_domconf($udom);
                   4851:             foreach my $item (keys(%legacyhash)) {
                   4852:                 if ($item =~ /^\Q$udom\E\.login/) {
                   4853:                     if ($legacy{'login'}) { 
                   4854:                         $designhash{$item} = $legacyhash{$item};
                   4855:                     }
                   4856:                 } else {
                   4857:                     if ($legacy{'rolecolors'}) {
                   4858:                         $designhash{$item} = $legacyhash{$item};
                   4859:                     }
1.518     albertel 4860:                 }
                   4861:             }
                   4862:         }
1.632     raeburn  4863:     } else {
                   4864:         %designhash = &get_legacy_domconf($udom); 
1.518     albertel 4865:     }
                   4866:     &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
                   4867: 				  $cachetime);
                   4868:     return %designhash;
                   4869: }
                   4870: 
1.632     raeburn  4871: sub get_legacy_domconf {
                   4872:     my ($udom) = @_;
                   4873:     my %legacyhash;
                   4874:     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
                   4875:     my $designfile =  $designdir.'/'.$udom.'.tab';
                   4876:     if (-e $designfile) {
                   4877:         if ( open (my $fh,"<$designfile") ) {
                   4878:             while (my $line = <$fh>) {
                   4879:                 next if ($line =~ /^\#/);
                   4880:                 chomp($line);
                   4881:                 my ($key,$val)=(split(/\=/,$line));
                   4882:                 if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
                   4883:             }
                   4884:             close($fh);
                   4885:         }
                   4886:     }
1.1026    raeburn  4887:     if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
1.632     raeburn  4888:         $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
                   4889:     }
                   4890:     return %legacyhash;
                   4891: }
                   4892: 
1.63      www      4893: =pod
                   4894: 
1.112     bowersj2 4895: =item * &domainlogo()
1.63      www      4896: 
                   4897: Inputs: $domain (usually will be undef)
                   4898: 
                   4899: Returns: A link to a domain logo, if the domain logo exists.
                   4900: If the domain logo does not exist, a description of the domain.
                   4901: 
                   4902: =cut
1.112     bowersj2 4903: 
1.63      www      4904: ###############################################
                   4905: sub domainlogo {
1.517     raeburn  4906:     my $domain = &determinedomain(shift);
1.518     albertel 4907:     my %designhash = &get_domainconf($domain);    
1.517     raeburn  4908:     # See if there is a logo
                   4909:     if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519     raeburn  4910:         my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538     albertel 4911:         if ($imgsrc =~ m{^/(adm|res)/}) {
                   4912: 	    if ($imgsrc =~ m{^/res/}) {
                   4913: 		my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
                   4914: 		&Apache::lonnet::repcopy($local_name);
                   4915: 	    }
                   4916: 	   $imgsrc = &lonhttpdurl($imgsrc);
1.519     raeburn  4917:         } 
                   4918:         return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514     albertel 4919:     } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
                   4920:         return &Apache::lonnet::domain($domain,'description');
1.59      www      4921:     } else {
1.60      matthew  4922:         return '';
1.59      www      4923:     }
                   4924: }
1.63      www      4925: ##############################################
                   4926: 
                   4927: =pod
                   4928: 
1.112     bowersj2 4929: =item * &designparm()
1.63      www      4930: 
                   4931: Inputs: $which parameter; $domain (usually will be undef)
                   4932: 
                   4933: Returns: value of designparamter $which
                   4934: 
                   4935: =cut
1.112     bowersj2 4936: 
1.397     albertel 4937: 
1.400     albertel 4938: ##############################################
1.397     albertel 4939: sub designparm {
                   4940:     my ($which,$domain)=@_;
                   4941:     if (exists($env{'environment.color.'.$which})) {
1.817     bisitz   4942:         return $env{'environment.color.'.$which};
1.96      www      4943:     }
1.63      www      4944:     $domain=&determinedomain($domain);
1.1016    raeburn  4945:     my %domdesign;
                   4946:     unless ($domain eq 'public') {
                   4947:         %domdesign = &get_domainconf($domain);
                   4948:     }
1.520     raeburn  4949:     my $output;
1.517     raeburn  4950:     if ($domdesign{$domain.'.'.$which} ne '') {
1.817     bisitz   4951:         $output = $domdesign{$domain.'.'.$which};
1.63      www      4952:     } else {
1.520     raeburn  4953:         $output = $defaultdesign{$which};
                   4954:     }
                   4955:     if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635     raeburn  4956:         ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538     albertel 4957:         if ($output =~ m{^/(adm|res)/}) {
1.817     bisitz   4958:             if ($output =~ m{^/res/}) {
                   4959:                 my $local_name = &Apache::lonnet::filelocation('',$output);
                   4960:                 &Apache::lonnet::repcopy($local_name);
                   4961:             }
1.520     raeburn  4962:             $output = &lonhttpdurl($output);
                   4963:         }
1.63      www      4964:     }
1.520     raeburn  4965:     return $output;
1.63      www      4966: }
1.59      www      4967: 
1.822     bisitz   4968: ##############################################
                   4969: =pod
                   4970: 
1.832     bisitz   4971: =item * &authorspace()
                   4972: 
1.1028    raeburn  4973: Inputs: $url (usually will be undef).
1.832     bisitz   4974: 
1.1075.2.40  raeburn  4975: Returns: Path to Authoring Space containing the resource or 
1.1028    raeburn  4976:          directory being viewed (or for which action is being taken). 
                   4977:          If $url is provided, and begins /priv/<domain>/<uname>
                   4978:          the path will be that portion of the $context argument.
                   4979:          Otherwise the path will be for the author space of the current
                   4980:          user when the current role is author, or for that of the 
                   4981:          co-author/assistant co-author space when the current role 
                   4982:          is co-author or assistant co-author.
1.832     bisitz   4983: 
                   4984: =cut
                   4985: 
                   4986: sub authorspace {
1.1028    raeburn  4987:     my ($url) = @_;
                   4988:     if ($url ne '') {
                   4989:         if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
                   4990:            return $1;
                   4991:         }
                   4992:     }
1.832     bisitz   4993:     my $caname = '';
1.1024    www      4994:     my $cadom = '';
1.1028    raeburn  4995:     if ($env{'request.role'} =~ /^(?:ca|aa)/) {
1.1024    www      4996:         ($cadom,$caname) =
1.832     bisitz   4997:             ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
1.1028    raeburn  4998:     } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
1.832     bisitz   4999:         $caname = $env{'user.name'};
1.1024    www      5000:         $cadom = $env{'user.domain'};
1.832     bisitz   5001:     }
1.1028    raeburn  5002:     if (($caname ne '') && ($cadom ne '')) {
                   5003:         return "/priv/$cadom/$caname/";
                   5004:     }
                   5005:     return;
1.832     bisitz   5006: }
                   5007: 
                   5008: ##############################################
                   5009: =pod
                   5010: 
1.822     bisitz   5011: =item * &head_subbox()
                   5012: 
                   5013: Inputs: $content (contains HTML code with page functions, etc.)
                   5014: 
                   5015: Returns: HTML div with $content
                   5016:          To be included in page header
                   5017: 
                   5018: =cut
                   5019: 
                   5020: sub head_subbox {
                   5021:     my ($content)=@_;
                   5022:     my $output =
1.993     raeburn  5023:         '<div class="LC_head_subbox">'
1.822     bisitz   5024:        .$content
                   5025:        .'</div>'
                   5026: }
                   5027: 
                   5028: ##############################################
                   5029: =pod
                   5030: 
                   5031: =item * &CSTR_pageheader()
                   5032: 
1.1026    raeburn  5033: Input: (optional) filename from which breadcrumb trail is built.
                   5034:        In most cases no input as needed, as $env{'request.filename'}
                   5035:        is appropriate for use in building the breadcrumb trail.
1.822     bisitz   5036: 
                   5037: Returns: HTML div with CSTR path and recent box
1.1075.2.40  raeburn  5038:          To be included on Authoring Space pages
1.822     bisitz   5039: 
                   5040: =cut
                   5041: 
                   5042: sub CSTR_pageheader {
1.1026    raeburn  5043:     my ($trailfile) = @_;
                   5044:     if ($trailfile eq '') {
                   5045:         $trailfile = $env{'request.filename'};
                   5046:     }
                   5047: 
                   5048: # this is for resources; directories have customtitle, and crumbs
                   5049: # and select recent are created in lonpubdir.pm
                   5050: 
                   5051:     my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.1022    www      5052:     my ($udom,$uname,$thisdisfn)=
1.1075.2.29  raeburn  5053:         ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)(?:|/(.*))$});
1.1026    raeburn  5054:     my $formaction = "/priv/$udom/$uname/$thisdisfn";
                   5055:     $formaction =~ s{/+}{/}g;
1.822     bisitz   5056: 
                   5057:     my $parentpath = '';
                   5058:     my $lastitem = '';
                   5059:     if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
                   5060:         $parentpath = $1;
                   5061:         $lastitem = $2;
                   5062:     } else {
                   5063:         $lastitem = $thisdisfn;
                   5064:     }
1.921     bisitz   5065: 
                   5066:     my $output =
1.822     bisitz   5067:          '<div>'
                   5068:         .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
1.1075.2.40  raeburn  5069:         .'<b>'.&mt('Authoring Space:').'</b> '
1.822     bisitz   5070:         .'<form name="dirs" method="post" action="'.$formaction
1.921     bisitz   5071:         .'" target="_top">' #FIXME lonpubdir: target="_parent"
1.1024    www      5072:         .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef);
1.921     bisitz   5073: 
                   5074:     if ($lastitem) {
                   5075:         $output .=
                   5076:              '<span class="LC_filename">'
                   5077:             .$lastitem
                   5078:             .'</span>';
                   5079:     }
                   5080:     $output .=
                   5081:          '<br />'
1.822     bisitz   5082:         #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."</b></tt><br />"
                   5083:         .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
                   5084:         .'</form>'
                   5085:         .&Apache::lonmenu::constspaceform()
                   5086:         .'</div>';
1.921     bisitz   5087: 
                   5088:     return $output;
1.822     bisitz   5089: }
                   5090: 
1.60      matthew  5091: ###############################################
                   5092: ###############################################
                   5093: 
                   5094: =pod
                   5095: 
1.112     bowersj2 5096: =back
                   5097: 
1.549     albertel 5098: =head1 HTML Helpers
1.112     bowersj2 5099: 
                   5100: =over 4
                   5101: 
                   5102: =item * &bodytag()
1.60      matthew  5103: 
                   5104: Returns a uniform header for LON-CAPA web pages.
                   5105: 
                   5106: Inputs: 
                   5107: 
1.112     bowersj2 5108: =over 4
                   5109: 
                   5110: =item * $title, A title to be displayed on the page.
                   5111: 
                   5112: =item * $function, the current role (can be undef).
                   5113: 
                   5114: =item * $addentries, extra parameters for the <body> tag.
                   5115: 
                   5116: =item * $bodyonly, if defined, only return the <body> tag.
                   5117: 
                   5118: =item * $domain, if defined, force a given domain.
                   5119: 
                   5120: =item * $forcereg, if page should register as content page (relevant for 
1.86      www      5121:             text interface only)
1.60      matthew  5122: 
1.814     bisitz   5123: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
                   5124:                      navigational links
1.317     albertel 5125: 
1.338     albertel 5126: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
                   5127: 
1.1075.2.12  raeburn  5128: =item * $no_inline_link, if true and in remote mode, don't show the
                   5129:          'Switch To Inline Menu' link
                   5130: 
1.460     albertel 5131: =item * $args, optional argument valid values are
                   5132:             no_auto_mt_title -> prevents &mt()ing the title arg
                   5133: 
1.1075.2.15  raeburn  5134: =item * $advtoolsref, optional argument, ref to an array containing
                   5135:             inlineremote items to be added in "Functions" menu below
                   5136:             breadcrumbs.
                   5137: 
1.112     bowersj2 5138: =back
                   5139: 
1.60      matthew  5140: Returns: A uniform header for LON-CAPA web pages.  
                   5141: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
                   5142: If $bodyonly is undef or zero, an html string containing a <body> tag and 
                   5143: other decorations will be returned.
                   5144: 
                   5145: =cut
                   5146: 
1.54      www      5147: sub bodytag {
1.831     bisitz   5148:     my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.1075.2.15  raeburn  5149:         $no_nav_bar,$bgcolor,$no_inline_link,$args,$advtoolsref)=@_;
1.339     albertel 5150: 
1.954     raeburn  5151:     my $public;
                   5152:     if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
                   5153:         || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
                   5154:         $public = 1;
                   5155:     }
1.460     albertel 5156:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.1075.2.52  raeburn  5157:     my $httphost = $args->{'use_absolute'};
1.339     albertel 5158: 
1.183     matthew  5159:     $function = &get_users_function() if (!$function);
1.339     albertel 5160:     my $img =    &designparm($function.'.img',$domain);
                   5161:     my $font =   &designparm($function.'.font',$domain);
                   5162:     my $pgbg   = $bgcolor || &designparm($function.'.pgbg',$domain);
                   5163: 
1.803     bisitz   5164:     my %design = ( 'style'   => 'margin-top: 0',
1.535     albertel 5165: 		   'bgcolor' => $pgbg,
1.339     albertel 5166: 		   'text'    => $font,
                   5167:                    'alink'   => &designparm($function.'.alink',$domain),
                   5168: 		   'vlink'   => &designparm($function.'.vlink',$domain),
                   5169: 		   'link'    => &designparm($function.'.link',$domain),);
1.438     albertel 5170:     @design{keys(%$addentries)} = @$addentries{keys(%$addentries)}; 
1.339     albertel 5171: 
1.63      www      5172:  # role and realm
1.1075.2.68  raeburn  5173:     my ($role,$realm) = split(m{\./},$env{'request.role'},2);
                   5174:     if ($realm) {
                   5175:         $realm = '/'.$realm;
                   5176:     }
1.378     raeburn  5177:     if ($role  eq 'ca') {
1.479     albertel 5178:         my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500     albertel 5179:         $realm = &plainname($rname,$rdom);
1.378     raeburn  5180:     } 
1.55      www      5181: # realm
1.258     albertel 5182:     if ($env{'request.course.id'}) {
1.378     raeburn  5183:         if ($env{'request.role'} !~ /^cr/) {
                   5184:             $role = &Apache::lonnet::plaintext($role,&course_type());
                   5185:         }
1.898     raeburn  5186:         if ($env{'request.course.sec'}) {
                   5187:             $role .= ('&nbsp;'x2).'-&nbsp;'.&mt('section:').'&nbsp;'.$env{'request.course.sec'};
                   5188:         }   
1.359     albertel 5189: 	$realm = $env{'course.'.$env{'request.course.id'}.'.description'};
1.378     raeburn  5190:     } else {
                   5191:         $role = &Apache::lonnet::plaintext($role);
1.54      www      5192:     }
1.433     albertel 5193: 
1.359     albertel 5194:     if (!$realm) { $realm='&nbsp;'; }
1.330     albertel 5195: 
1.438     albertel 5196:     my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329     albertel 5197: 
1.101     www      5198: # construct main body tag
1.359     albertel 5199:     my $bodytag = "<body $extra_body_attr>".
1.1075.2.100  raeburn  5200: 	&Apache::lontexconvert::init_math_support();
1.252     albertel 5201: 
1.1075.2.38  raeburn  5202:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   5203: 
                   5204:     if (($bodyonly) || ($no_nav_bar) || ($env{'form.inhibitmenu'} eq 'yes')) {
1.60      matthew  5205:         return $bodytag;
1.1075.2.38  raeburn  5206:     }
1.359     albertel 5207: 
1.954     raeburn  5208:     if ($public) {
1.433     albertel 5209: 	undef($role);
                   5210:     }
1.359     albertel 5211:     
1.762     bisitz   5212:     my $titleinfo = '<h1>'.$title.'</h1>';
1.359     albertel 5213:     #
                   5214:     # Extra info if you are the DC
                   5215:     my $dc_info = '';
                   5216:     if ($env{'user.adv'} && exists($env{'user.role.dc./'.
                   5217:                         $env{'course.'.$env{'request.course.id'}.
                   5218:                                  '.domain'}.'/'})) {
                   5219:         my $cid = $env{'request.course.id'};
1.917     raeburn  5220:         $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380     www      5221:         $dc_info =~ s/\s+$//;
1.359     albertel 5222:     }
                   5223: 
1.898     raeburn  5224:     $role = '<span class="LC_nobreak">('.$role.')</span>' if $role;
1.903     droeschl 5225: 
1.1075.2.13  raeburn  5226:     if ($env{'request.state'} eq 'construct') { $forcereg=1; }
                   5227: 
1.1075.2.38  raeburn  5228: 
                   5229: 
1.1075.2.21  raeburn  5230:     my $funclist;
                   5231:     if (($env{'environment.remote'} eq 'on') && ($env{'request.state'} ne 'construct')) {
1.1075.2.52  raeburn  5232:         $bodytag .= Apache::lonhtmlcommon::scripttag(Apache::lonmenu::utilityfunctions($httphost), 'start')."\n".
1.1075.2.21  raeburn  5233:                     Apache::lonmenu::serverform();
                   5234:         my $forbodytag;
                   5235:         &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
                   5236:                                             $forcereg,$args->{'group'},
                   5237:                                             $args->{'bread_crumbs'},
                   5238:                                             $advtoolsref,'',\$forbodytag);
                   5239:         unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {
                   5240:             $funclist = $forbodytag;
                   5241:         }
                   5242:     } else {
1.903     droeschl 5243: 
                   5244:         #    if ($env{'request.state'} eq 'construct') {
                   5245:         #        $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
                   5246:         #    }
                   5247: 
1.1075.2.38  raeburn  5248:         $bodytag .= Apache::lonhtmlcommon::scripttag(
1.1075.2.52  raeburn  5249:             Apache::lonmenu::utilityfunctions($httphost), 'start');
1.359     albertel 5250: 
1.1075.2.38  raeburn  5251:         my ($left,$right) = Apache::lonmenu::primary_menu();
1.1075.2.2  raeburn  5252: 
1.916     droeschl 5253:         if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
1.1075.2.22  raeburn  5254:             if ($dc_info) {
                   5255:                  $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
1.1075.2.1  raeburn  5256:             }
1.1075.2.38  raeburn  5257:             $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />
1.1075.2.22  raeburn  5258:                            <em>$realm</em> $dc_info</div>|;
1.903     droeschl 5259:             return $bodytag;
                   5260:         }
1.894     droeschl 5261: 
1.927     raeburn  5262:         unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
1.1075.2.38  raeburn  5263:             $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;
1.927     raeburn  5264:         }
1.916     droeschl 5265: 
1.1075.2.38  raeburn  5266:         $bodytag .= $right;
1.852     droeschl 5267: 
1.917     raeburn  5268:         if ($dc_info) {
                   5269:             $dc_info = &dc_courseid_toggle($dc_info);
                   5270:         }
                   5271:         $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.916     droeschl 5272: 
1.1075.2.61  raeburn  5273:         #if directed to not display the secondary menu, don't.
                   5274:         if ($args->{'no_secondary_menu'}) {
                   5275:             return $bodytag;
                   5276:         }
1.903     droeschl 5277:         #don't show menus for public users
1.954     raeburn  5278:         if (!$public){
1.1075.2.52  raeburn  5279:             $bodytag .= Apache::lonmenu::secondary_menu($httphost);
1.903     droeschl 5280:             $bodytag .= Apache::lonmenu::serverform();
1.920     raeburn  5281:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
                   5282:             if ($env{'request.state'} eq 'construct') {
1.962     droeschl 5283:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.920     raeburn  5284:                                 $args->{'bread_crumbs'});
                   5285:             } elsif ($forcereg) { 
1.1075.2.22  raeburn  5286:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
                   5287:                                                             $args->{'group'});
1.1075.2.15  raeburn  5288:             } else {
1.1075.2.21  raeburn  5289:                 my $forbodytag;
                   5290:                 &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
                   5291:                                                     $forcereg,$args->{'group'},
                   5292:                                                     $args->{'bread_crumbs'},
                   5293:                                                     $advtoolsref,'',\$forbodytag);
                   5294:                 unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {
                   5295:                     $bodytag .= $forbodytag;
                   5296:                 }
1.920     raeburn  5297:             }
1.903     droeschl 5298:         }else{
                   5299:             # this is to seperate menu from content when there's no secondary
                   5300:             # menu. Especially needed for public accessible ressources.
                   5301:             $bodytag .= '<hr style="clear:both" />';
                   5302:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end'); 
1.235     raeburn  5303:         }
1.903     droeschl 5304: 
1.235     raeburn  5305:         return $bodytag;
1.1075.2.12  raeburn  5306:     }
                   5307: 
                   5308: #
                   5309: # Top frame rendering, Remote is up
                   5310: #
                   5311: 
                   5312:     my $imgsrc = $img;
                   5313:     if ($img =~ /^\/adm/) {
                   5314:         $imgsrc = &lonhttpdurl($img);
                   5315:     }
                   5316:     my $upperleft='<img src="'.$imgsrc.'" alt="'.$function.'" />';
                   5317: 
1.1075.2.60  raeburn  5318:     my $help=($no_inline_link?''
                   5319:               :&Apache::loncommon::top_nav_help('Help'));
                   5320: 
1.1075.2.12  raeburn  5321:     # Explicit link to get inline menu
                   5322:     my $menu= ($no_inline_link?''
                   5323:                :'<a href="/adm/remote?action=collapse" target="_top">'.&mt('Switch to Inline Menu Mode').'</a>');
                   5324: 
                   5325:     if ($dc_info) {
                   5326:         $dc_info = qq|<span class="LC_cusr_subheading">($dc_info)</span>|;
                   5327:     }
                   5328: 
1.1075.2.38  raeburn  5329:     my $name = &plainname($env{'user.name'},$env{'user.domain'});
                   5330:     unless ($public) {
                   5331:         $name = &aboutmewrapper($name,$env{'user.name'},$env{'user.domain'},
                   5332:                                 undef,'LC_menubuttons_link');
                   5333:     }
                   5334: 
1.1075.2.12  raeburn  5335:     unless ($env{'form.inhibitmenu'}) {
                   5336:         $bodytag .= qq|<div id="LC_nav_bar">$name $role</div>
1.1075.2.38  raeburn  5337:                        <ol class="LC_primary_menu LC_floatright LC_right">
1.1075.2.60  raeburn  5338:                        <li>$help</li>
1.1075.2.12  raeburn  5339:                        <li>$menu</li>
                   5340:                        </ol><div id="LC_realm"> $realm $dc_info</div>|;
                   5341:     }
1.1075.2.13  raeburn  5342:     if ($env{'request.state'} eq 'construct') {
                   5343:         if (!$public){
                   5344:             if ($env{'request.state'} eq 'construct') {
                   5345:                 $funclist = &Apache::lonhtmlcommon::scripttag(
1.1075.2.52  raeburn  5346:                                 &Apache::lonmenu::utilityfunctions($httphost), 'start').
1.1075.2.13  raeburn  5347:                             &Apache::lonhtmlcommon::scripttag('','end').
                   5348:                             &Apache::lonmenu::innerregister($forcereg,
                   5349:                                                             $args->{'bread_crumbs'});
                   5350:             }
                   5351:         }
                   5352:     }
1.1075.2.21  raeburn  5353:     return $bodytag."\n".$funclist;
1.182     matthew  5354: }
                   5355: 
1.917     raeburn  5356: sub dc_courseid_toggle {
                   5357:     my ($dc_info) = @_;
1.980     raeburn  5358:     return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.1069    raeburn  5359:            '<a href="javascript:showCourseID();" class="LC_menubuttons_link">'.
1.917     raeburn  5360:            &mt('(More ...)').'</a></span>'.
                   5361:            '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
                   5362: }
                   5363: 
1.330     albertel 5364: sub make_attr_string {
                   5365:     my ($register,$attr_ref) = @_;
                   5366: 
                   5367:     if ($attr_ref && !ref($attr_ref)) {
                   5368: 	die("addentries Must be a hash ref ".
                   5369: 	    join(':',caller(1))." ".
                   5370: 	    join(':',caller(0))." ");
                   5371:     }
                   5372: 
                   5373:     if ($register) {
1.339     albertel 5374: 	my ($on_load,$on_unload);
                   5375: 	foreach my $key (keys(%{$attr_ref})) {
                   5376: 	    if      (lc($key) eq 'onload') {
                   5377: 		$on_load.=$attr_ref->{$key}.';';
                   5378: 		delete($attr_ref->{$key});
                   5379: 
                   5380: 	    } elsif (lc($key) eq 'onunload') {
                   5381: 		$on_unload.=$attr_ref->{$key}.';';
                   5382: 		delete($attr_ref->{$key});
                   5383: 	    }
                   5384: 	}
1.1075.2.12  raeburn  5385:         if ($env{'environment.remote'} eq 'on') {
                   5386:             $attr_ref->{'onload'}  =
                   5387:                 &Apache::lonmenu::loadevents().  $on_load;
                   5388:             $attr_ref->{'onunload'}=
                   5389:                 &Apache::lonmenu::unloadevents().$on_unload;
                   5390:         } else {  
                   5391: 	    $attr_ref->{'onload'}  = $on_load;
                   5392: 	    $attr_ref->{'onunload'}= $on_unload;
                   5393:         }
1.330     albertel 5394:     }
1.339     albertel 5395: 
1.330     albertel 5396:     my $attr_string;
1.1075.2.56  raeburn  5397:     foreach my $attr (sort(keys(%$attr_ref))) {
1.330     albertel 5398: 	$attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
                   5399:     }
                   5400:     return $attr_string;
                   5401: }
                   5402: 
                   5403: 
1.182     matthew  5404: ###############################################
1.251     albertel 5405: ###############################################
                   5406: 
                   5407: =pod
                   5408: 
                   5409: =item * &endbodytag()
                   5410: 
                   5411: Returns a uniform footer for LON-CAPA web pages.
                   5412: 
1.635     raeburn  5413: Inputs: 1 - optional reference to an args hash
                   5414: If in the hash, key for noredirectlink has a value which evaluates to true,
                   5415: a 'Continue' link is not displayed if the page contains an
                   5416: internal redirect in the <head></head> section,
                   5417: i.e., $env{'internal.head.redirect'} exists   
1.251     albertel 5418: 
                   5419: =cut
                   5420: 
                   5421: sub endbodytag {
1.635     raeburn  5422:     my ($args) = @_;
1.1075.2.6  raeburn  5423:     my $endbodytag;
                   5424:     unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
                   5425:         $endbodytag='</body>';
                   5426:     }
1.315     albertel 5427:     if ( exists( $env{'internal.head.redirect'} ) ) {
1.635     raeburn  5428:         if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
                   5429: 	    $endbodytag=
                   5430: 	        "<br /><a href=\"$env{'internal.head.redirect'}\">".
                   5431: 	        &mt('Continue').'</a>'.
                   5432: 	        $endbodytag;
                   5433:         }
1.315     albertel 5434:     }
1.251     albertel 5435:     return $endbodytag;
                   5436: }
                   5437: 
1.352     albertel 5438: =pod
                   5439: 
                   5440: =item * &standard_css()
                   5441: 
                   5442: Returns a style sheet
                   5443: 
                   5444: Inputs: (all optional)
                   5445:             domain         -> force to color decorate a page for a specific
                   5446:                                domain
                   5447:             function       -> force usage of a specific rolish color scheme
                   5448:             bgcolor        -> override the default page bgcolor
                   5449: 
                   5450: =cut
                   5451: 
1.343     albertel 5452: sub standard_css {
1.345     albertel 5453:     my ($function,$domain,$bgcolor) = @_;
1.352     albertel 5454:     $function  = &get_users_function() if (!$function);
                   5455:     my $img    = &designparm($function.'.img',   $domain);
                   5456:     my $tabbg  = &designparm($function.'.tabbg', $domain);
                   5457:     my $font   = &designparm($function.'.font',  $domain);
1.801     tempelho 5458:     my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791     tempelho 5459: #second colour for later usage
1.345     albertel 5460:     my $sidebg = &designparm($function.'.sidebg',$domain);
1.382     albertel 5461:     my $pgbg_or_bgcolor =
                   5462: 	         $bgcolor ||
1.352     albertel 5463: 	         &designparm($function.'.pgbg',  $domain);
1.382     albertel 5464:     my $pgbg   = &designparm($function.'.pgbg',  $domain);
1.352     albertel 5465:     my $alink  = &designparm($function.'.alink', $domain);
                   5466:     my $vlink  = &designparm($function.'.vlink', $domain);
                   5467:     my $link   = &designparm($function.'.link',  $domain);
                   5468: 
1.602     albertel 5469:     my $sans                 = 'Verdana,Arial,Helvetica,sans-serif';
1.395     albertel 5470:     my $mono                 = 'monospace';
1.850     bisitz   5471:     my $data_table_head      = $sidebg;
                   5472:     my $data_table_light     = '#FAFAFA';
1.1060    bisitz   5473:     my $data_table_dark      = '#E0E0E0';
1.470     banghart 5474:     my $data_table_darker    = '#CCCCCC';
1.349     albertel 5475:     my $data_table_highlight = '#FFFF00';
1.352     albertel 5476:     my $mail_new             = '#FFBB77';
                   5477:     my $mail_new_hover       = '#DD9955';
                   5478:     my $mail_read            = '#BBBB77';
                   5479:     my $mail_read_hover      = '#999944';
                   5480:     my $mail_replied         = '#AAAA88';
                   5481:     my $mail_replied_hover   = '#888855';
                   5482:     my $mail_other           = '#99BBBB';
                   5483:     my $mail_other_hover     = '#669999';
1.391     albertel 5484:     my $table_header         = '#DDDDDD';
1.489     raeburn  5485:     my $feedback_link_bg     = '#BBBBBB';
1.911     bisitz   5486:     my $lg_border_color      = '#C8C8C8';
1.952     onken    5487:     my $button_hover         = '#BF2317';
1.392     albertel 5488: 
1.608     albertel 5489:     my $border = ($env{'browser.type'} eq 'explorer' ||
1.911     bisitz   5490:       $env{'browser.type'} eq 'safari'     ) ? '0 2px 0 2px'
                   5491:                                              : '0 3px 0 4px';
1.448     albertel 5492: 
1.523     albertel 5493: 
1.343     albertel 5494:     return <<END;
1.947     droeschl 5495: 
                   5496: /* needed for iframe to allow 100% height in FF */
                   5497: body, html { 
                   5498:     margin: 0;
                   5499:     padding: 0 0.5%;
                   5500:     height: 99%; /* to avoid scrollbars */
                   5501: }
                   5502: 
1.795     www      5503: body {
1.911     bisitz   5504:   font-family: $sans;
                   5505:   line-height:130%;
                   5506:   font-size:0.83em;
                   5507:   color:$font;
1.795     www      5508: }
                   5509: 
1.959     onken    5510: a:focus,
                   5511: a:focus img {
1.795     www      5512:   color: red;
                   5513: }
1.698     harmsja  5514: 
1.911     bisitz   5515: form, .inline {
                   5516:   display: inline;
1.795     www      5517: }
1.721     harmsja  5518: 
1.795     www      5519: .LC_right {
1.911     bisitz   5520:   text-align:right;
1.795     www      5521: }
                   5522: 
                   5523: .LC_middle {
1.911     bisitz   5524:   vertical-align:middle;
1.795     www      5525: }
1.721     harmsja  5526: 
1.1075.2.38  raeburn  5527: .LC_floatleft {
                   5528:   float: left;
                   5529: }
                   5530: 
                   5531: .LC_floatright {
                   5532:   float: right;
                   5533: }
                   5534: 
1.911     bisitz   5535: .LC_400Box {
                   5536:   width:400px;
                   5537: }
1.721     harmsja  5538: 
1.947     droeschl 5539: .LC_iframecontainer {
                   5540:     width: 98%;
                   5541:     margin: 0;
                   5542:     position: fixed;
                   5543:     top: 8.5em;
                   5544:     bottom: 0;
                   5545: }
                   5546: 
                   5547: .LC_iframecontainer iframe{
                   5548:     border: none;
                   5549:     width: 100%;
                   5550:     height: 100%;
                   5551: }
                   5552: 
1.778     bisitz   5553: .LC_filename {
                   5554:   font-family: $mono;
                   5555:   white-space:pre;
1.921     bisitz   5556:   font-size: 120%;
1.778     bisitz   5557: }
                   5558: 
                   5559: .LC_fileicon {
                   5560:   border: none;
                   5561:   height: 1.3em;
                   5562:   vertical-align: text-bottom;
                   5563:   margin-right: 0.3em;
                   5564:   text-decoration:none;
                   5565: }
                   5566: 
1.1008    www      5567: .LC_setting {
                   5568:   text-decoration:underline;
                   5569: }
                   5570: 
1.350     albertel 5571: .LC_error {
                   5572:   color: red;
                   5573: }
1.795     www      5574: 
1.1075.2.15  raeburn  5575: .LC_warning {
                   5576:   color: darkorange;
                   5577: }
                   5578: 
1.457     albertel 5579: .LC_diff_removed {
1.733     bisitz   5580:   color: red;
1.394     albertel 5581: }
1.532     albertel 5582: 
                   5583: .LC_info,
1.457     albertel 5584: .LC_success,
                   5585: .LC_diff_added {
1.350     albertel 5586:   color: green;
                   5587: }
1.795     www      5588: 
1.802     bisitz   5589: div.LC_confirm_box {
                   5590:   background-color: #FAFAFA;
                   5591:   border: 1px solid $lg_border_color;
                   5592:   margin-right: 0;
                   5593:   padding: 5px;
                   5594: }
                   5595: 
                   5596: div.LC_confirm_box .LC_error img,
                   5597: div.LC_confirm_box .LC_success img {
                   5598:   vertical-align: middle;
                   5599: }
                   5600: 
1.440     albertel 5601: .LC_icon {
1.771     droeschl 5602:   border: none;
1.790     droeschl 5603:   vertical-align: middle;
1.771     droeschl 5604: }
                   5605: 
1.543     albertel 5606: .LC_docs_spacer {
                   5607:   width: 25px;
                   5608:   height: 1px;
1.771     droeschl 5609:   border: none;
1.543     albertel 5610: }
1.346     albertel 5611: 
1.532     albertel 5612: .LC_internal_info {
1.735     bisitz   5613:   color: #999999;
1.532     albertel 5614: }
                   5615: 
1.794     www      5616: .LC_discussion {
1.1050    www      5617:   background: $data_table_dark;
1.911     bisitz   5618:   border: 1px solid black;
                   5619:   margin: 2px;
1.794     www      5620: }
                   5621: 
                   5622: .LC_disc_action_left {
1.1050    www      5623:   background: $sidebg;
1.911     bisitz   5624:   text-align: left;
1.1050    www      5625:   padding: 4px;
                   5626:   margin: 2px;
1.794     www      5627: }
                   5628: 
                   5629: .LC_disc_action_right {
1.1050    www      5630:   background: $sidebg;
1.911     bisitz   5631:   text-align: right;
1.1050    www      5632:   padding: 4px;
                   5633:   margin: 2px;
1.794     www      5634: }
                   5635: 
                   5636: .LC_disc_new_item {
1.911     bisitz   5637:   background: white;
                   5638:   border: 2px solid red;
1.1050    www      5639:   margin: 4px;
                   5640:   padding: 4px;
1.794     www      5641: }
                   5642: 
                   5643: .LC_disc_old_item {
1.911     bisitz   5644:   background: white;
1.1050    www      5645:   margin: 4px;
                   5646:   padding: 4px;
1.794     www      5647: }
                   5648: 
1.458     albertel 5649: table.LC_pastsubmission {
                   5650:   border: 1px solid black;
                   5651:   margin: 2px;
                   5652: }
                   5653: 
1.924     bisitz   5654: table#LC_menubuttons {
1.345     albertel 5655:   width: 100%;
                   5656:   background: $pgbg;
1.392     albertel 5657:   border: 2px;
1.402     albertel 5658:   border-collapse: separate;
1.803     bisitz   5659:   padding: 0;
1.345     albertel 5660: }
1.392     albertel 5661: 
1.801     tempelho 5662: table#LC_title_bar a {
                   5663:   color: $fontmenu;
                   5664: }
1.836     bisitz   5665: 
1.807     droeschl 5666: table#LC_title_bar {
1.819     tempelho 5667:   clear: both;
1.836     bisitz   5668:   display: none;
1.807     droeschl 5669: }
                   5670: 
1.795     www      5671: table#LC_title_bar,
1.933     droeschl 5672: table.LC_breadcrumbs, /* obsolete? */
1.393     albertel 5673: table#LC_title_bar.LC_with_remote {
1.359     albertel 5674:   width: 100%;
1.392     albertel 5675:   border-color: $pgbg;
                   5676:   border-style: solid;
                   5677:   border-width: $border;
1.379     albertel 5678:   background: $pgbg;
1.801     tempelho 5679:   color: $fontmenu;
1.392     albertel 5680:   border-collapse: collapse;
1.803     bisitz   5681:   padding: 0;
1.819     tempelho 5682:   margin: 0;
1.359     albertel 5683: }
1.795     www      5684: 
1.933     droeschl 5685: ul.LC_breadcrumb_tools_outerlist {
1.913     droeschl 5686:     margin: 0;
                   5687:     padding: 0;
1.933     droeschl 5688:     position: relative;
                   5689:     list-style: none;
1.913     droeschl 5690: }
1.933     droeschl 5691: ul.LC_breadcrumb_tools_outerlist li {
1.913     droeschl 5692:     display: inline;
                   5693: }
1.933     droeschl 5694: 
                   5695: .LC_breadcrumb_tools_navigation {
1.913     droeschl 5696:     padding: 0;
1.933     droeschl 5697:     margin: 0;
                   5698:     float: left;
1.913     droeschl 5699: }
1.933     droeschl 5700: .LC_breadcrumb_tools_tools {
                   5701:     padding: 0;
                   5702:     margin: 0;
1.913     droeschl 5703:     float: right;
                   5704: }
                   5705: 
1.359     albertel 5706: table#LC_title_bar td {
                   5707:   background: $tabbg;
                   5708: }
1.795     www      5709: 
1.911     bisitz   5710: table#LC_menubuttons img {
1.803     bisitz   5711:   border: none;
1.346     albertel 5712: }
1.795     www      5713: 
1.842     droeschl 5714: .LC_breadcrumbs_component {
1.911     bisitz   5715:   float: right;
                   5716:   margin: 0 1em;
1.357     albertel 5717: }
1.842     droeschl 5718: .LC_breadcrumbs_component img {
1.911     bisitz   5719:   vertical-align: middle;
1.777     tempelho 5720: }
1.795     www      5721: 
1.383     albertel 5722: td.LC_table_cell_checkbox {
                   5723:   text-align: center;
                   5724: }
1.795     www      5725: 
                   5726: .LC_fontsize_small {
1.911     bisitz   5727:   font-size: 70%;
1.705     tempelho 5728: }
                   5729: 
1.844     bisitz   5730: #LC_breadcrumbs {
1.911     bisitz   5731:   clear:both;
                   5732:   background: $sidebg;
                   5733:   border-bottom: 1px solid $lg_border_color;
                   5734:   line-height: 2.5em;
1.933     droeschl 5735:   overflow: hidden;
1.911     bisitz   5736:   margin: 0;
                   5737:   padding: 0;
1.995     raeburn  5738:   text-align: left;
1.819     tempelho 5739: }
1.862     bisitz   5740: 
1.1075.2.16  raeburn  5741: .LC_head_subbox, .LC_actionbox {
1.911     bisitz   5742:   clear:both;
                   5743:   background: #F8F8F8; /* $sidebg; */
1.915     droeschl 5744:   border: 1px solid $sidebg;
1.1075.2.16  raeburn  5745:   margin: 0 0 10px 0;
1.966     bisitz   5746:   padding: 3px;
1.995     raeburn  5747:   text-align: left;
1.822     bisitz   5748: }
                   5749: 
1.795     www      5750: .LC_fontsize_medium {
1.911     bisitz   5751:   font-size: 85%;
1.705     tempelho 5752: }
                   5753: 
1.795     www      5754: .LC_fontsize_large {
1.911     bisitz   5755:   font-size: 120%;
1.705     tempelho 5756: }
                   5757: 
1.346     albertel 5758: .LC_menubuttons_inline_text {
                   5759:   color: $font;
1.698     harmsja  5760:   font-size: 90%;
1.701     harmsja  5761:   padding-left:3px;
1.346     albertel 5762: }
                   5763: 
1.934     droeschl 5764: .LC_menubuttons_inline_text img{
                   5765:   vertical-align: middle;
                   5766: }
                   5767: 
1.1051    www      5768: li.LC_menubuttons_inline_text img {
1.951     onken    5769:   cursor:pointer;
1.1002    droeschl 5770:   text-decoration: none;
1.951     onken    5771: }
                   5772: 
1.526     www      5773: .LC_menubuttons_link {
                   5774:   text-decoration: none;
                   5775: }
1.795     www      5776: 
1.522     albertel 5777: .LC_menubuttons_category {
1.521     www      5778:   color: $font;
1.526     www      5779:   background: $pgbg;
1.521     www      5780:   font-size: larger;
                   5781:   font-weight: bold;
                   5782: }
                   5783: 
1.346     albertel 5784: td.LC_menubuttons_text {
1.911     bisitz   5785:   color: $font;
1.346     albertel 5786: }
1.706     harmsja  5787: 
1.346     albertel 5788: .LC_current_location {
                   5789:   background: $tabbg;
                   5790: }
1.795     www      5791: 
1.938     bisitz   5792: table.LC_data_table {
1.347     albertel 5793:   border: 1px solid #000000;
1.402     albertel 5794:   border-collapse: separate;
1.426     albertel 5795:   border-spacing: 1px;
1.610     albertel 5796:   background: $pgbg;
1.347     albertel 5797: }
1.795     www      5798: 
1.422     albertel 5799: .LC_data_table_dense {
                   5800:   font-size: small;
                   5801: }
1.795     www      5802: 
1.507     raeburn  5803: table.LC_nested_outer {
                   5804:   border: 1px solid #000000;
1.589     raeburn  5805:   border-collapse: collapse;
1.803     bisitz   5806:   border-spacing: 0;
1.507     raeburn  5807:   width: 100%;
                   5808: }
1.795     www      5809: 
1.879     raeburn  5810: table.LC_innerpickbox,
1.507     raeburn  5811: table.LC_nested {
1.803     bisitz   5812:   border: none;
1.589     raeburn  5813:   border-collapse: collapse;
1.803     bisitz   5814:   border-spacing: 0;
1.507     raeburn  5815:   width: 100%;
                   5816: }
1.795     www      5817: 
1.911     bisitz   5818: table.LC_data_table tr th,
                   5819: table.LC_calendar tr th,
1.879     raeburn  5820: table.LC_prior_tries tr th,
                   5821: table.LC_innerpickbox tr th {
1.349     albertel 5822:   font-weight: bold;
                   5823:   background-color: $data_table_head;
1.801     tempelho 5824:   color:$fontmenu;
1.701     harmsja  5825:   font-size:90%;
1.347     albertel 5826: }
1.795     www      5827: 
1.879     raeburn  5828: table.LC_innerpickbox tr th,
                   5829: table.LC_innerpickbox tr td {
                   5830:   vertical-align: top;
                   5831: }
                   5832: 
1.711     raeburn  5833: table.LC_data_table tr.LC_info_row > td {
1.735     bisitz   5834:   background-color: #CCCCCC;
1.711     raeburn  5835:   font-weight: bold;
                   5836:   text-align: left;
                   5837: }
1.795     www      5838: 
1.912     bisitz   5839: table.LC_data_table tr.LC_odd_row > td {
                   5840:   background-color: $data_table_light;
                   5841:   padding: 2px;
                   5842:   vertical-align: top;
                   5843: }
                   5844: 
1.809     bisitz   5845: table.LC_pick_box tr > td.LC_odd_row {
1.349     albertel 5846:   background-color: $data_table_light;
1.912     bisitz   5847:   vertical-align: top;
                   5848: }
                   5849: 
                   5850: table.LC_data_table tr.LC_even_row > td {
                   5851:   background-color: $data_table_dark;
1.425     albertel 5852:   padding: 2px;
1.900     bisitz   5853:   vertical-align: top;
1.347     albertel 5854: }
1.795     www      5855: 
1.809     bisitz   5856: table.LC_pick_box tr > td.LC_even_row {
1.349     albertel 5857:   background-color: $data_table_dark;
1.900     bisitz   5858:   vertical-align: top;
1.347     albertel 5859: }
1.795     www      5860: 
1.425     albertel 5861: table.LC_data_table tr.LC_data_table_highlight td {
                   5862:   background-color: $data_table_darker;
                   5863: }
1.795     www      5864: 
1.639     raeburn  5865: table.LC_data_table tr td.LC_leftcol_header {
                   5866:   background-color: $data_table_head;
                   5867:   font-weight: bold;
                   5868: }
1.795     www      5869: 
1.451     albertel 5870: table.LC_data_table tr.LC_empty_row td,
1.507     raeburn  5871: table.LC_nested tr.LC_empty_row td {
1.421     albertel 5872:   font-weight: bold;
                   5873:   font-style: italic;
                   5874:   text-align: center;
                   5875:   padding: 8px;
1.347     albertel 5876: }
1.795     www      5877: 
1.1075.2.30  raeburn  5878: table.LC_data_table tr.LC_empty_row td,
                   5879: table.LC_data_table tr.LC_footer_row td {
1.940     bisitz   5880:   background-color: $sidebg;
                   5881: }
                   5882: 
                   5883: table.LC_nested tr.LC_empty_row td {
                   5884:   background-color: #FFFFFF;
                   5885: }
                   5886: 
1.890     droeschl 5887: table.LC_caption {
                   5888: }
                   5889: 
1.507     raeburn  5890: table.LC_nested tr.LC_empty_row td {
1.465     albertel 5891:   padding: 4ex
                   5892: }
1.795     www      5893: 
1.507     raeburn  5894: table.LC_nested_outer tr th {
                   5895:   font-weight: bold;
1.801     tempelho 5896:   color:$fontmenu;
1.507     raeburn  5897:   background-color: $data_table_head;
1.701     harmsja  5898:   font-size: small;
1.507     raeburn  5899:   border-bottom: 1px solid #000000;
                   5900: }
1.795     www      5901: 
1.507     raeburn  5902: table.LC_nested_outer tr td.LC_subheader {
                   5903:   background-color: $data_table_head;
                   5904:   font-weight: bold;
                   5905:   font-size: small;
                   5906:   border-bottom: 1px solid #000000;
                   5907:   text-align: right;
1.451     albertel 5908: }
1.795     www      5909: 
1.507     raeburn  5910: table.LC_nested tr.LC_info_row td {
1.735     bisitz   5911:   background-color: #CCCCCC;
1.451     albertel 5912:   font-weight: bold;
                   5913:   font-size: small;
1.507     raeburn  5914:   text-align: center;
                   5915: }
1.795     www      5916: 
1.589     raeburn  5917: table.LC_nested tr.LC_info_row td.LC_left_item,
                   5918: table.LC_nested_outer tr th.LC_left_item {
1.507     raeburn  5919:   text-align: left;
1.451     albertel 5920: }
1.795     www      5921: 
1.507     raeburn  5922: table.LC_nested td {
1.735     bisitz   5923:   background-color: #FFFFFF;
1.451     albertel 5924:   font-size: small;
1.507     raeburn  5925: }
1.795     www      5926: 
1.507     raeburn  5927: table.LC_nested_outer tr th.LC_right_item,
                   5928: table.LC_nested tr.LC_info_row td.LC_right_item,
                   5929: table.LC_nested tr.LC_odd_row td.LC_right_item,
                   5930: table.LC_nested tr td.LC_right_item {
1.451     albertel 5931:   text-align: right;
                   5932: }
                   5933: 
1.507     raeburn  5934: table.LC_nested tr.LC_odd_row td {
1.735     bisitz   5935:   background-color: #EEEEEE;
1.451     albertel 5936: }
                   5937: 
1.473     raeburn  5938: table.LC_createuser {
                   5939: }
                   5940: 
                   5941: table.LC_createuser tr.LC_section_row td {
1.701     harmsja  5942:   font-size: small;
1.473     raeburn  5943: }
                   5944: 
                   5945: table.LC_createuser tr.LC_info_row td  {
1.735     bisitz   5946:   background-color: #CCCCCC;
1.473     raeburn  5947:   font-weight: bold;
                   5948:   text-align: center;
                   5949: }
                   5950: 
1.349     albertel 5951: table.LC_calendar {
                   5952:   border: 1px solid #000000;
                   5953:   border-collapse: collapse;
1.917     raeburn  5954:   width: 98%;
1.349     albertel 5955: }
1.795     www      5956: 
1.349     albertel 5957: table.LC_calendar_pickdate {
                   5958:   font-size: xx-small;
                   5959: }
1.795     www      5960: 
1.349     albertel 5961: table.LC_calendar tr td {
                   5962:   border: 1px solid #000000;
                   5963:   vertical-align: top;
1.917     raeburn  5964:   width: 14%;
1.349     albertel 5965: }
1.795     www      5966: 
1.349     albertel 5967: table.LC_calendar tr td.LC_calendar_day_empty {
                   5968:   background-color: $data_table_dark;
                   5969: }
1.795     www      5970: 
1.779     bisitz   5971: table.LC_calendar tr td.LC_calendar_day_current {
                   5972:   background-color: $data_table_highlight;
1.777     tempelho 5973: }
1.795     www      5974: 
1.938     bisitz   5975: table.LC_data_table tr td.LC_mail_new {
1.349     albertel 5976:   background-color: $mail_new;
                   5977: }
1.795     www      5978: 
1.938     bisitz   5979: table.LC_data_table tr.LC_mail_new:hover {
1.349     albertel 5980:   background-color: $mail_new_hover;
                   5981: }
1.795     www      5982: 
1.938     bisitz   5983: table.LC_data_table tr td.LC_mail_read {
1.349     albertel 5984:   background-color: $mail_read;
                   5985: }
1.795     www      5986: 
1.938     bisitz   5987: /*
                   5988: table.LC_data_table tr.LC_mail_read:hover {
1.349     albertel 5989:   background-color: $mail_read_hover;
                   5990: }
1.938     bisitz   5991: */
1.795     www      5992: 
1.938     bisitz   5993: table.LC_data_table tr td.LC_mail_replied {
1.349     albertel 5994:   background-color: $mail_replied;
                   5995: }
1.795     www      5996: 
1.938     bisitz   5997: /*
                   5998: table.LC_data_table tr.LC_mail_replied:hover {
1.349     albertel 5999:   background-color: $mail_replied_hover;
                   6000: }
1.938     bisitz   6001: */
1.795     www      6002: 
1.938     bisitz   6003: table.LC_data_table tr td.LC_mail_other {
1.349     albertel 6004:   background-color: $mail_other;
                   6005: }
1.795     www      6006: 
1.938     bisitz   6007: /*
                   6008: table.LC_data_table tr.LC_mail_other:hover {
1.349     albertel 6009:   background-color: $mail_other_hover;
                   6010: }
1.938     bisitz   6011: */
1.494     raeburn  6012: 
1.777     tempelho 6013: table.LC_data_table tr > td.LC_browser_file,
                   6014: table.LC_data_table tr > td.LC_browser_file_published {
1.899     bisitz   6015:   background: #AAEE77;
1.389     albertel 6016: }
1.795     www      6017: 
1.777     tempelho 6018: table.LC_data_table tr > td.LC_browser_file_locked,
                   6019: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389     albertel 6020:   background: #FFAA99;
1.387     albertel 6021: }
1.795     www      6022: 
1.777     tempelho 6023: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899     bisitz   6024:   background: #888888;
1.779     bisitz   6025: }
1.795     www      6026: 
1.777     tempelho 6027: table.LC_data_table tr > td.LC_browser_file_modified,
1.779     bisitz   6028: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899     bisitz   6029:   background: #F8F866;
1.777     tempelho 6030: }
1.795     www      6031: 
1.696     bisitz   6032: table.LC_data_table tr.LC_browser_folder > td {
1.899     bisitz   6033:   background: #E0E8FF;
1.387     albertel 6034: }
1.696     bisitz   6035: 
1.707     bisitz   6036: table.LC_data_table tr > td.LC_roles_is {
1.911     bisitz   6037:   /* background: #77FF77; */
1.707     bisitz   6038: }
1.795     www      6039: 
1.707     bisitz   6040: table.LC_data_table tr > td.LC_roles_future {
1.939     bisitz   6041:   border-right: 8px solid #FFFF77;
1.707     bisitz   6042: }
1.795     www      6043: 
1.707     bisitz   6044: table.LC_data_table tr > td.LC_roles_will {
1.939     bisitz   6045:   border-right: 8px solid #FFAA77;
1.707     bisitz   6046: }
1.795     www      6047: 
1.707     bisitz   6048: table.LC_data_table tr > td.LC_roles_expired {
1.939     bisitz   6049:   border-right: 8px solid #FF7777;
1.707     bisitz   6050: }
1.795     www      6051: 
1.707     bisitz   6052: table.LC_data_table tr > td.LC_roles_will_not {
1.939     bisitz   6053:   border-right: 8px solid #AAFF77;
1.707     bisitz   6054: }
1.795     www      6055: 
1.707     bisitz   6056: table.LC_data_table tr > td.LC_roles_selected {
1.939     bisitz   6057:   border-right: 8px solid #11CC55;
1.707     bisitz   6058: }
                   6059: 
1.388     albertel 6060: span.LC_current_location {
1.701     harmsja  6061:   font-size:larger;
1.388     albertel 6062:   background: $pgbg;
                   6063: }
1.387     albertel 6064: 
1.1029    www      6065: span.LC_current_nav_location {
                   6066:   font-weight:bold;
                   6067:   background: $sidebg;
                   6068: }
                   6069: 
1.395     albertel 6070: span.LC_parm_menu_item {
                   6071:   font-size: larger;
                   6072: }
1.795     www      6073: 
1.395     albertel 6074: span.LC_parm_scope_all {
                   6075:   color: red;
                   6076: }
1.795     www      6077: 
1.395     albertel 6078: span.LC_parm_scope_folder {
                   6079:   color: green;
                   6080: }
1.795     www      6081: 
1.395     albertel 6082: span.LC_parm_scope_resource {
                   6083:   color: orange;
                   6084: }
1.795     www      6085: 
1.395     albertel 6086: span.LC_parm_part {
                   6087:   color: blue;
                   6088: }
1.795     www      6089: 
1.911     bisitz   6090: span.LC_parm_folder,
                   6091: span.LC_parm_symb {
1.395     albertel 6092:   font-size: x-small;
                   6093:   font-family: $mono;
                   6094:   color: #AAAAAA;
                   6095: }
                   6096: 
1.977     bisitz   6097: ul.LC_parm_parmlist li {
                   6098:   display: inline-block;
                   6099:   padding: 0.3em 0.8em;
                   6100:   vertical-align: top;
                   6101:   width: 150px;
                   6102:   border-top:1px solid $lg_border_color;
                   6103: }
                   6104: 
1.795     www      6105: td.LC_parm_overview_level_menu,
                   6106: td.LC_parm_overview_map_menu,
                   6107: td.LC_parm_overview_parm_selectors,
                   6108: td.LC_parm_overview_restrictions  {
1.396     albertel 6109:   border: 1px solid black;
                   6110:   border-collapse: collapse;
                   6111: }
1.795     www      6112: 
1.396     albertel 6113: table.LC_parm_overview_restrictions td {
                   6114:   border-width: 1px 4px 1px 4px;
                   6115:   border-style: solid;
                   6116:   border-color: $pgbg;
                   6117:   text-align: center;
                   6118: }
1.795     www      6119: 
1.396     albertel 6120: table.LC_parm_overview_restrictions th {
                   6121:   background: $tabbg;
                   6122:   border-width: 1px 4px 1px 4px;
                   6123:   border-style: solid;
                   6124:   border-color: $pgbg;
                   6125: }
1.795     www      6126: 
1.398     albertel 6127: table#LC_helpmenu {
1.803     bisitz   6128:   border: none;
1.398     albertel 6129:   height: 55px;
1.803     bisitz   6130:   border-spacing: 0;
1.398     albertel 6131: }
                   6132: 
                   6133: table#LC_helpmenu fieldset legend {
                   6134:   font-size: larger;
                   6135: }
1.795     www      6136: 
1.397     albertel 6137: table#LC_helpmenu_links {
                   6138:   width: 100%;
                   6139:   border: 1px solid black;
                   6140:   background: $pgbg;
1.803     bisitz   6141:   padding: 0;
1.397     albertel 6142:   border-spacing: 1px;
                   6143: }
1.795     www      6144: 
1.397     albertel 6145: table#LC_helpmenu_links tr td {
                   6146:   padding: 1px;
                   6147:   background: $tabbg;
1.399     albertel 6148:   text-align: center;
                   6149:   font-weight: bold;
1.397     albertel 6150: }
1.396     albertel 6151: 
1.795     www      6152: table#LC_helpmenu_links a:link,
                   6153: table#LC_helpmenu_links a:visited,
1.397     albertel 6154: table#LC_helpmenu_links a:active {
                   6155:   text-decoration: none;
                   6156:   color: $font;
                   6157: }
1.795     www      6158: 
1.397     albertel 6159: table#LC_helpmenu_links a:hover {
                   6160:   text-decoration: underline;
                   6161:   color: $vlink;
                   6162: }
1.396     albertel 6163: 
1.417     albertel 6164: .LC_chrt_popup_exists {
                   6165:   border: 1px solid #339933;
                   6166:   margin: -1px;
                   6167: }
1.795     www      6168: 
1.417     albertel 6169: .LC_chrt_popup_up {
                   6170:   border: 1px solid yellow;
                   6171:   margin: -1px;
                   6172: }
1.795     www      6173: 
1.417     albertel 6174: .LC_chrt_popup {
                   6175:   border: 1px solid #8888FF;
                   6176:   background: #CCCCFF;
                   6177: }
1.795     www      6178: 
1.421     albertel 6179: table.LC_pick_box {
                   6180:   border-collapse: separate;
                   6181:   background: white;
                   6182:   border: 1px solid black;
                   6183:   border-spacing: 1px;
                   6184: }
1.795     www      6185: 
1.421     albertel 6186: table.LC_pick_box td.LC_pick_box_title {
1.850     bisitz   6187:   background: $sidebg;
1.421     albertel 6188:   font-weight: bold;
1.900     bisitz   6189:   text-align: left;
1.740     bisitz   6190:   vertical-align: top;
1.421     albertel 6191:   width: 184px;
                   6192:   padding: 8px;
                   6193: }
1.795     www      6194: 
1.579     raeburn  6195: table.LC_pick_box td.LC_pick_box_value {
                   6196:   text-align: left;
                   6197:   padding: 8px;
                   6198: }
1.795     www      6199: 
1.579     raeburn  6200: table.LC_pick_box td.LC_pick_box_select {
                   6201:   text-align: left;
                   6202:   padding: 8px;
                   6203: }
1.795     www      6204: 
1.424     albertel 6205: table.LC_pick_box td.LC_pick_box_separator {
1.803     bisitz   6206:   padding: 0;
1.421     albertel 6207:   height: 1px;
                   6208:   background: black;
                   6209: }
1.795     www      6210: 
1.421     albertel 6211: table.LC_pick_box td.LC_pick_box_submit {
                   6212:   text-align: right;
                   6213: }
1.795     www      6214: 
1.579     raeburn  6215: table.LC_pick_box td.LC_evenrow_value {
                   6216:   text-align: left;
                   6217:   padding: 8px;
                   6218:   background-color: $data_table_light;
                   6219: }
1.795     www      6220: 
1.579     raeburn  6221: table.LC_pick_box td.LC_oddrow_value {
                   6222:   text-align: left;
                   6223:   padding: 8px;
                   6224:   background-color: $data_table_light;
                   6225: }
1.795     www      6226: 
1.579     raeburn  6227: span.LC_helpform_receipt_cat {
                   6228:   font-weight: bold;
                   6229: }
1.795     www      6230: 
1.424     albertel 6231: table.LC_group_priv_box {
                   6232:   background: white;
                   6233:   border: 1px solid black;
                   6234:   border-spacing: 1px;
                   6235: }
1.795     www      6236: 
1.424     albertel 6237: table.LC_group_priv_box td.LC_pick_box_title {
                   6238:   background: $tabbg;
                   6239:   font-weight: bold;
                   6240:   text-align: right;
                   6241:   width: 184px;
                   6242: }
1.795     www      6243: 
1.424     albertel 6244: table.LC_group_priv_box td.LC_groups_fixed {
                   6245:   background: $data_table_light;
                   6246:   text-align: center;
                   6247: }
1.795     www      6248: 
1.424     albertel 6249: table.LC_group_priv_box td.LC_groups_optional {
                   6250:   background: $data_table_dark;
                   6251:   text-align: center;
                   6252: }
1.795     www      6253: 
1.424     albertel 6254: table.LC_group_priv_box td.LC_groups_functionality {
                   6255:   background: $data_table_darker;
                   6256:   text-align: center;
                   6257:   font-weight: bold;
                   6258: }
1.795     www      6259: 
1.424     albertel 6260: table.LC_group_priv td {
                   6261:   text-align: left;
1.803     bisitz   6262:   padding: 0;
1.424     albertel 6263: }
                   6264: 
                   6265: .LC_navbuttons {
                   6266:   margin: 2ex 0ex 2ex 0ex;
                   6267: }
1.795     www      6268: 
1.423     albertel 6269: .LC_topic_bar {
                   6270:   font-weight: bold;
                   6271:   background: $tabbg;
1.918     wenzelju 6272:   margin: 1em 0em 1em 2em;
1.805     bisitz   6273:   padding: 3px;
1.918     wenzelju 6274:   font-size: 1.2em;
1.423     albertel 6275: }
1.795     www      6276: 
1.423     albertel 6277: .LC_topic_bar span {
1.918     wenzelju 6278:   left: 0.5em;
                   6279:   position: absolute;
1.423     albertel 6280:   vertical-align: middle;
1.918     wenzelju 6281:   font-size: 1.2em;
1.423     albertel 6282: }
1.795     www      6283: 
1.423     albertel 6284: table.LC_course_group_status {
                   6285:   margin: 20px;
                   6286: }
1.795     www      6287: 
1.423     albertel 6288: table.LC_status_selector td {
                   6289:   vertical-align: top;
                   6290:   text-align: center;
1.424     albertel 6291:   padding: 4px;
                   6292: }
1.795     www      6293: 
1.599     albertel 6294: div.LC_feedback_link {
1.616     albertel 6295:   clear: both;
1.829     kalberla 6296:   background: $sidebg;
1.779     bisitz   6297:   width: 100%;
1.829     kalberla 6298:   padding-bottom: 10px;
                   6299:   border: 1px $tabbg solid;
1.833     kalberla 6300:   height: 22px;
                   6301:   line-height: 22px;
                   6302:   padding-top: 5px;
                   6303: }
                   6304: 
                   6305: div.LC_feedback_link img {
                   6306:   height: 22px;
1.867     kalberla 6307:   vertical-align:middle;
1.829     kalberla 6308: }
                   6309: 
1.911     bisitz   6310: div.LC_feedback_link a {
1.829     kalberla 6311:   text-decoration: none;
1.489     raeburn  6312: }
1.795     www      6313: 
1.867     kalberla 6314: div.LC_comblock {
1.911     bisitz   6315:   display:inline;
1.867     kalberla 6316:   color:$font;
                   6317:   font-size:90%;
                   6318: }
                   6319: 
                   6320: div.LC_feedback_link div.LC_comblock {
                   6321:   padding-left:5px;
                   6322: }
                   6323: 
                   6324: div.LC_feedback_link div.LC_comblock a {
                   6325:   color:$font;
                   6326: }
                   6327: 
1.489     raeburn  6328: span.LC_feedback_link {
1.858     bisitz   6329:   /* background: $feedback_link_bg; */
1.599     albertel 6330:   font-size: larger;
                   6331: }
1.795     www      6332: 
1.599     albertel 6333: span.LC_message_link {
1.858     bisitz   6334:   /* background: $feedback_link_bg; */
1.599     albertel 6335:   font-size: larger;
                   6336:   position: absolute;
                   6337:   right: 1em;
1.489     raeburn  6338: }
1.421     albertel 6339: 
1.515     albertel 6340: table.LC_prior_tries {
1.524     albertel 6341:   border: 1px solid #000000;
                   6342:   border-collapse: separate;
                   6343:   border-spacing: 1px;
1.515     albertel 6344: }
1.523     albertel 6345: 
1.515     albertel 6346: table.LC_prior_tries td {
1.524     albertel 6347:   padding: 2px;
1.515     albertel 6348: }
1.523     albertel 6349: 
                   6350: .LC_answer_correct {
1.795     www      6351:   background: lightgreen;
                   6352:   color: darkgreen;
                   6353:   padding: 6px;
1.523     albertel 6354: }
1.795     www      6355: 
1.523     albertel 6356: .LC_answer_charged_try {
1.797     www      6357:   background: #FFAAAA;
1.795     www      6358:   color: darkred;
                   6359:   padding: 6px;
1.523     albertel 6360: }
1.795     www      6361: 
1.779     bisitz   6362: .LC_answer_not_charged_try,
1.523     albertel 6363: .LC_answer_no_grade,
                   6364: .LC_answer_late {
1.795     www      6365:   background: lightyellow;
1.523     albertel 6366:   color: black;
1.795     www      6367:   padding: 6px;
1.523     albertel 6368: }
1.795     www      6369: 
1.523     albertel 6370: .LC_answer_previous {
1.795     www      6371:   background: lightblue;
                   6372:   color: darkblue;
                   6373:   padding: 6px;
1.523     albertel 6374: }
1.795     www      6375: 
1.779     bisitz   6376: .LC_answer_no_message {
1.777     tempelho 6377:   background: #FFFFFF;
                   6378:   color: black;
1.795     www      6379:   padding: 6px;
1.779     bisitz   6380: }
1.795     www      6381: 
1.779     bisitz   6382: .LC_answer_unknown {
                   6383:   background: orange;
                   6384:   color: black;
1.795     www      6385:   padding: 6px;
1.777     tempelho 6386: }
1.795     www      6387: 
1.529     albertel 6388: span.LC_prior_numerical,
                   6389: span.LC_prior_string,
                   6390: span.LC_prior_custom,
                   6391: span.LC_prior_reaction,
                   6392: span.LC_prior_math {
1.925     bisitz   6393:   font-family: $mono;
1.523     albertel 6394:   white-space: pre;
                   6395: }
                   6396: 
1.525     albertel 6397: span.LC_prior_string {
1.925     bisitz   6398:   font-family: $mono;
1.525     albertel 6399:   white-space: pre;
                   6400: }
                   6401: 
1.523     albertel 6402: table.LC_prior_option {
                   6403:   width: 100%;
                   6404:   border-collapse: collapse;
                   6405: }
1.795     www      6406: 
1.911     bisitz   6407: table.LC_prior_rank,
1.795     www      6408: table.LC_prior_match {
1.528     albertel 6409:   border-collapse: collapse;
                   6410: }
1.795     www      6411: 
1.528     albertel 6412: table.LC_prior_option tr td,
                   6413: table.LC_prior_rank tr td,
                   6414: table.LC_prior_match tr td {
1.524     albertel 6415:   border: 1px solid #000000;
1.515     albertel 6416: }
                   6417: 
1.855     bisitz   6418: .LC_nobreak {
1.544     albertel 6419:   white-space: nowrap;
1.519     raeburn  6420: }
                   6421: 
1.576     raeburn  6422: span.LC_cusr_emph {
                   6423:   font-style: italic;
                   6424: }
                   6425: 
1.633     raeburn  6426: span.LC_cusr_subheading {
                   6427:   font-weight: normal;
                   6428:   font-size: 85%;
                   6429: }
                   6430: 
1.861     bisitz   6431: div.LC_docs_entry_move {
1.859     bisitz   6432:   border: 1px solid #BBBBBB;
1.545     albertel 6433:   background: #DDDDDD;
1.861     bisitz   6434:   width: 22px;
1.859     bisitz   6435:   padding: 1px;
                   6436:   margin: 0;
1.545     albertel 6437: }
                   6438: 
1.861     bisitz   6439: table.LC_data_table tr > td.LC_docs_entry_commands,
                   6440: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545     albertel 6441:   font-size: x-small;
                   6442: }
1.795     www      6443: 
1.861     bisitz   6444: .LC_docs_entry_parameter {
                   6445:   white-space: nowrap;
                   6446: }
                   6447: 
1.544     albertel 6448: .LC_docs_copy {
1.545     albertel 6449:   color: #000099;
1.544     albertel 6450: }
1.795     www      6451: 
1.544     albertel 6452: .LC_docs_cut {
1.545     albertel 6453:   color: #550044;
1.544     albertel 6454: }
1.795     www      6455: 
1.544     albertel 6456: .LC_docs_rename {
1.545     albertel 6457:   color: #009900;
1.544     albertel 6458: }
1.795     www      6459: 
1.544     albertel 6460: .LC_docs_remove {
1.545     albertel 6461:   color: #990000;
                   6462: }
                   6463: 
1.547     albertel 6464: .LC_docs_reinit_warn,
                   6465: .LC_docs_ext_edit {
                   6466:   font-size: x-small;
                   6467: }
                   6468: 
1.545     albertel 6469: table.LC_docs_adddocs td,
                   6470: table.LC_docs_adddocs th {
                   6471:   border: 1px solid #BBBBBB;
                   6472:   padding: 4px;
                   6473:   background: #DDDDDD;
1.543     albertel 6474: }
                   6475: 
1.584     albertel 6476: table.LC_sty_begin {
                   6477:   background: #BBFFBB;
                   6478: }
1.795     www      6479: 
1.584     albertel 6480: table.LC_sty_end {
                   6481:   background: #FFBBBB;
                   6482: }
                   6483: 
1.589     raeburn  6484: table.LC_double_column {
1.803     bisitz   6485:   border-width: 0;
1.589     raeburn  6486:   border-collapse: collapse;
                   6487:   width: 100%;
                   6488:   padding: 2px;
                   6489: }
                   6490: 
                   6491: table.LC_double_column tr td.LC_left_col {
1.590     raeburn  6492:   top: 2px;
1.589     raeburn  6493:   left: 2px;
                   6494:   width: 47%;
                   6495:   vertical-align: top;
                   6496: }
                   6497: 
                   6498: table.LC_double_column tr td.LC_right_col {
                   6499:   top: 2px;
1.779     bisitz   6500:   right: 2px;
1.589     raeburn  6501:   width: 47%;
                   6502:   vertical-align: top;
                   6503: }
                   6504: 
1.591     raeburn  6505: div.LC_left_float {
                   6506:   float: left;
                   6507:   padding-right: 5%;
1.597     albertel 6508:   padding-bottom: 4px;
1.591     raeburn  6509: }
                   6510: 
                   6511: div.LC_clear_float_header {
1.597     albertel 6512:   padding-bottom: 2px;
1.591     raeburn  6513: }
                   6514: 
                   6515: div.LC_clear_float_footer {
1.597     albertel 6516:   padding-top: 10px;
1.591     raeburn  6517:   clear: both;
                   6518: }
                   6519: 
1.597     albertel 6520: div.LC_grade_show_user {
1.941     bisitz   6521: /*  border-left: 5px solid $sidebg; */
                   6522:   border-top: 5px solid #000000;
                   6523:   margin: 50px 0 0 0;
1.936     bisitz   6524:   padding: 15px 0 5px 10px;
1.597     albertel 6525: }
1.795     www      6526: 
1.936     bisitz   6527: div.LC_grade_show_user_odd_row {
1.941     bisitz   6528: /*  border-left: 5px solid #000000; */
                   6529: }
                   6530: 
                   6531: div.LC_grade_show_user div.LC_Box {
                   6532:   margin-right: 50px;
1.597     albertel 6533: }
                   6534: 
                   6535: div.LC_grade_submissions,
                   6536: div.LC_grade_message_center,
1.936     bisitz   6537: div.LC_grade_info_links {
1.597     albertel 6538:   margin: 5px;
                   6539:   width: 99%;
                   6540:   background: #FFFFFF;
                   6541: }
1.795     www      6542: 
1.597     albertel 6543: div.LC_grade_submissions_header,
1.936     bisitz   6544: div.LC_grade_message_center_header {
1.705     tempelho 6545:   font-weight: bold;
                   6546:   font-size: large;
1.597     albertel 6547: }
1.795     www      6548: 
1.597     albertel 6549: div.LC_grade_submissions_body,
1.936     bisitz   6550: div.LC_grade_message_center_body {
1.597     albertel 6551:   border: 1px solid black;
                   6552:   width: 99%;
                   6553:   background: #FFFFFF;
                   6554: }
1.795     www      6555: 
1.613     albertel 6556: table.LC_scantron_action {
                   6557:   width: 100%;
                   6558: }
1.795     www      6559: 
1.613     albertel 6560: table.LC_scantron_action tr th {
1.698     harmsja  6561:   font-weight:bold;
                   6562:   font-style:normal;
1.613     albertel 6563: }
1.795     www      6564: 
1.779     bisitz   6565: .LC_edit_problem_header,
1.614     albertel 6566: div.LC_edit_problem_footer {
1.705     tempelho 6567:   font-weight: normal;
                   6568:   font-size:  medium;
1.602     albertel 6569:   margin: 2px;
1.1060    bisitz   6570:   background-color: $sidebg;
1.600     albertel 6571: }
1.795     www      6572: 
1.600     albertel 6573: div.LC_edit_problem_header,
1.602     albertel 6574: div.LC_edit_problem_header div,
1.614     albertel 6575: div.LC_edit_problem_footer,
                   6576: div.LC_edit_problem_footer div,
1.602     albertel 6577: div.LC_edit_problem_editxml_header,
                   6578: div.LC_edit_problem_editxml_header div {
1.600     albertel 6579:   margin-top: 5px;
                   6580: }
1.795     www      6581: 
1.600     albertel 6582: div.LC_edit_problem_header_title {
1.705     tempelho 6583:   font-weight: bold;
                   6584:   font-size: larger;
1.602     albertel 6585:   background: $tabbg;
                   6586:   padding: 3px;
1.1060    bisitz   6587:   margin: 0 0 5px 0;
1.602     albertel 6588: }
1.795     www      6589: 
1.602     albertel 6590: table.LC_edit_problem_header_title {
                   6591:   width: 100%;
1.600     albertel 6592:   background: $tabbg;
1.602     albertel 6593: }
                   6594: 
                   6595: div.LC_edit_problem_discards {
                   6596:   float: left;
                   6597:   padding-bottom: 5px;
                   6598: }
1.795     www      6599: 
1.602     albertel 6600: div.LC_edit_problem_saves {
                   6601:   float: right;
                   6602:   padding-bottom: 5px;
1.600     albertel 6603: }
1.795     www      6604: 
1.1075.2.34  raeburn  6605: .LC_edit_opt {
                   6606:   padding-left: 1em;
                   6607:   white-space: nowrap;
                   6608: }
                   6609: 
1.1075.2.57  raeburn  6610: .LC_edit_problem_latexhelper{
                   6611:     text-align: right;
                   6612: }
                   6613: 
                   6614: #LC_edit_problem_colorful div{
                   6615:     margin-left: 40px;
                   6616: }
                   6617: 
1.911     bisitz   6618: img.stift {
1.803     bisitz   6619:   border-width: 0;
                   6620:   vertical-align: middle;
1.677     riegler  6621: }
1.680     riegler  6622: 
1.923     bisitz   6623: table td.LC_mainmenu_col_fieldset {
1.680     riegler  6624:   vertical-align: top;
1.777     tempelho 6625: }
1.795     www      6626: 
1.716     raeburn  6627: div.LC_createcourse {
1.911     bisitz   6628:   margin: 10px 10px 10px 10px;
1.716     raeburn  6629: }
                   6630: 
1.917     raeburn  6631: .LC_dccid {
1.1075.2.38  raeburn  6632:   float: right;
1.917     raeburn  6633:   margin: 0.2em 0 0 0;
                   6634:   padding: 0;
                   6635:   font-size: 90%;
                   6636:   display:none;
                   6637: }
                   6638: 
1.897     wenzelju 6639: ol.LC_primary_menu a:hover,
1.721     harmsja  6640: ol#LC_MenuBreadcrumbs a:hover,
                   6641: ol#LC_PathBreadcrumbs a:hover,
1.897     wenzelju 6642: ul#LC_secondary_menu a:hover,
1.721     harmsja  6643: .LC_FormSectionClearButton input:hover
1.795     www      6644: ul.LC_TabContent   li:hover a {
1.952     onken    6645:   color:$button_hover;
1.911     bisitz   6646:   text-decoration:none;
1.693     droeschl 6647: }
                   6648: 
1.779     bisitz   6649: h1 {
1.911     bisitz   6650:   padding: 0;
                   6651:   line-height:130%;
1.693     droeschl 6652: }
1.698     harmsja  6653: 
1.911     bisitz   6654: h2,
                   6655: h3,
                   6656: h4,
                   6657: h5,
                   6658: h6 {
                   6659:   margin: 5px 0 5px 0;
                   6660:   padding: 0;
                   6661:   line-height:130%;
1.693     droeschl 6662: }
1.795     www      6663: 
                   6664: .LC_hcell {
1.911     bisitz   6665:   padding:3px 15px 3px 15px;
                   6666:   margin: 0;
                   6667:   background-color:$tabbg;
                   6668:   color:$fontmenu;
                   6669:   border-bottom:solid 1px $lg_border_color;
1.693     droeschl 6670: }
1.795     www      6671: 
1.840     bisitz   6672: .LC_Box > .LC_hcell {
1.911     bisitz   6673:   margin: 0 -10px 10px -10px;
1.835     bisitz   6674: }
                   6675: 
1.721     harmsja  6676: .LC_noBorder {
1.911     bisitz   6677:   border: 0;
1.698     harmsja  6678: }
1.693     droeschl 6679: 
1.721     harmsja  6680: .LC_FormSectionClearButton input {
1.911     bisitz   6681:   background-color:transparent;
                   6682:   border: none;
                   6683:   cursor:pointer;
                   6684:   text-decoration:underline;
1.693     droeschl 6685: }
1.763     bisitz   6686: 
                   6687: .LC_help_open_topic {
1.911     bisitz   6688:   color: #FFFFFF;
                   6689:   background-color: #EEEEFF;
                   6690:   margin: 1px;
                   6691:   padding: 4px;
                   6692:   border: 1px solid #000033;
                   6693:   white-space: nowrap;
                   6694:   /* vertical-align: middle; */
1.759     neumanie 6695: }
1.693     droeschl 6696: 
1.911     bisitz   6697: dl,
                   6698: ul,
                   6699: div,
                   6700: fieldset {
                   6701:   margin: 10px 10px 10px 0;
                   6702:   /* overflow: hidden; */
1.693     droeschl 6703: }
1.795     www      6704: 
1.1075.2.90  raeburn  6705: article.geogebraweb div {
                   6706:     margin: 0;
                   6707: }
                   6708: 
1.838     bisitz   6709: fieldset > legend {
1.911     bisitz   6710:   font-weight: bold;
                   6711:   padding: 0 5px 0 5px;
1.838     bisitz   6712: }
                   6713: 
1.813     bisitz   6714: #LC_nav_bar {
1.911     bisitz   6715:   float: left;
1.995     raeburn  6716:   background-color: $pgbg_or_bgcolor;
1.966     bisitz   6717:   margin: 0 0 2px 0;
1.807     droeschl 6718: }
                   6719: 
1.916     droeschl 6720: #LC_realm {
                   6721:   margin: 0.2em 0 0 0;
                   6722:   padding: 0;
                   6723:   font-weight: bold;
                   6724:   text-align: center;
1.995     raeburn  6725:   background-color: $pgbg_or_bgcolor;
1.916     droeschl 6726: }
                   6727: 
1.911     bisitz   6728: #LC_nav_bar em {
                   6729:   font-weight: bold;
                   6730:   font-style: normal;
1.807     droeschl 6731: }
                   6732: 
1.897     wenzelju 6733: ol.LC_primary_menu {
1.934     droeschl 6734:   margin: 0;
1.1075.2.2  raeburn  6735:   padding: 0;
1.995     raeburn  6736:   background-color: $pgbg_or_bgcolor;
1.807     droeschl 6737: }
                   6738: 
1.852     droeschl 6739: ol#LC_PathBreadcrumbs {
1.911     bisitz   6740:   margin: 0;
1.693     droeschl 6741: }
                   6742: 
1.897     wenzelju 6743: ol.LC_primary_menu li {
1.1075.2.2  raeburn  6744:   color: RGB(80, 80, 80);
                   6745:   vertical-align: middle;
                   6746:   text-align: left;
                   6747:   list-style: none;
                   6748:   float: left;
                   6749: }
                   6750: 
                   6751: ol.LC_primary_menu li a {
                   6752:   display: block;
                   6753:   margin: 0;
                   6754:   padding: 0 5px 0 10px;
                   6755:   text-decoration: none;
                   6756: }
                   6757: 
                   6758: ol.LC_primary_menu li ul {
                   6759:   display: none;
                   6760:   width: 10em;
                   6761:   background-color: $data_table_light;
                   6762: }
                   6763: 
                   6764: ol.LC_primary_menu li:hover ul, ol.LC_primary_menu li.hover ul {
                   6765:   display: block;
                   6766:   position: absolute;
                   6767:   margin: 0;
                   6768:   padding: 0;
1.1075.2.5  raeburn  6769:   z-index: 2;
1.1075.2.2  raeburn  6770: }
                   6771: 
                   6772: ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
                   6773:   font-size: 90%;
1.911     bisitz   6774:   vertical-align: top;
1.1075.2.2  raeburn  6775:   float: none;
1.1075.2.5  raeburn  6776:   border-left: 1px solid black;
                   6777:   border-right: 1px solid black;
1.1075.2.2  raeburn  6778: }
                   6779: 
                   6780: ol.LC_primary_menu li:hover li a, ol.LC_primary_menu li.hover li a {
1.1075.2.5  raeburn  6781:   background-color:$data_table_light;
1.1075.2.2  raeburn  6782: }
                   6783: 
                   6784: ol.LC_primary_menu li li a:hover {
                   6785:    color:$button_hover;
                   6786:    background-color:$data_table_dark;
1.693     droeschl 6787: }
                   6788: 
1.897     wenzelju 6789: ol.LC_primary_menu li img {
1.911     bisitz   6790:   vertical-align: bottom;
1.934     droeschl 6791:   height: 1.1em;
1.1075.2.3  raeburn  6792:   margin: 0.2em 0 0 0;
1.693     droeschl 6793: }
                   6794: 
1.897     wenzelju 6795: ol.LC_primary_menu a {
1.911     bisitz   6796:   color: RGB(80, 80, 80);
                   6797:   text-decoration: none;
1.693     droeschl 6798: }
1.795     www      6799: 
1.949     droeschl 6800: ol.LC_primary_menu a.LC_new_message {
                   6801:   font-weight:bold;
                   6802:   color: darkred;
                   6803: }
                   6804: 
1.975     raeburn  6805: ol.LC_docs_parameters {
                   6806:   margin-left: 0;
                   6807:   padding: 0;
                   6808:   list-style: none;
                   6809: }
                   6810: 
                   6811: ol.LC_docs_parameters li {
                   6812:   margin: 0;
                   6813:   padding-right: 20px;
                   6814:   display: inline;
                   6815: }
                   6816: 
1.976     raeburn  6817: ol.LC_docs_parameters li:before {
                   6818:   content: "\\002022 \\0020";
                   6819: }
                   6820: 
                   6821: li.LC_docs_parameters_title {
                   6822:   font-weight: bold;
                   6823: }
                   6824: 
                   6825: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
                   6826:   content: "";
                   6827: }
                   6828: 
1.897     wenzelju 6829: ul#LC_secondary_menu {
1.1075.2.23  raeburn  6830:   clear: right;
1.911     bisitz   6831:   color: $fontmenu;
                   6832:   background: $tabbg;
                   6833:   list-style: none;
                   6834:   padding: 0;
                   6835:   margin: 0;
                   6836:   width: 100%;
1.995     raeburn  6837:   text-align: left;
1.1075.2.4  raeburn  6838:   float: left;
1.808     droeschl 6839: }
                   6840: 
1.897     wenzelju 6841: ul#LC_secondary_menu li {
1.911     bisitz   6842:   font-weight: bold;
                   6843:   line-height: 1.8em;
                   6844:   border-right: 1px solid black;
                   6845:   vertical-align: middle;
1.1075.2.4  raeburn  6846:   float: left;
                   6847: }
                   6848: 
                   6849: ul#LC_secondary_menu li.LC_hoverable:hover, ul#LC_secondary_menu li.hover {
                   6850:   background-color: $data_table_light;
                   6851: }
                   6852: 
                   6853: ul#LC_secondary_menu li a {
                   6854:   padding: 0 0.8em;
                   6855: }
                   6856: 
                   6857: ul#LC_secondary_menu li ul {
                   6858:   display: none;
                   6859: }
                   6860: 
                   6861: ul#LC_secondary_menu li:hover ul, ul#LC_secondary_menu li.hover ul {
                   6862:   display: block;
                   6863:   position: absolute;
                   6864:   margin: 0;
                   6865:   padding: 0;
                   6866:   list-style:none;
                   6867:   float: none;
                   6868:   background-color: $data_table_light;
1.1075.2.5  raeburn  6869:   z-index: 2;
1.1075.2.10  raeburn  6870:   margin-left: -1px;
1.1075.2.4  raeburn  6871: }
                   6872: 
                   6873: ul#LC_secondary_menu li ul li {
                   6874:   font-size: 90%;
                   6875:   vertical-align: top;
                   6876:   border-left: 1px solid black;
                   6877:   border-right: 1px solid black;
1.1075.2.33  raeburn  6878:   background-color: $data_table_light;
1.1075.2.4  raeburn  6879:   list-style:none;
                   6880:   float: none;
                   6881: }
                   6882: 
                   6883: ul#LC_secondary_menu li ul li:hover, ul#LC_secondary_menu li ul li.hover {
                   6884:   background-color: $data_table_dark;
1.807     droeschl 6885: }
                   6886: 
1.847     tempelho 6887: ul.LC_TabContent {
1.911     bisitz   6888:   display:block;
                   6889:   background: $sidebg;
                   6890:   border-bottom: solid 1px $lg_border_color;
                   6891:   list-style:none;
1.1020    raeburn  6892:   margin: -1px -10px 0 -10px;
1.911     bisitz   6893:   padding: 0;
1.693     droeschl 6894: }
                   6895: 
1.795     www      6896: ul.LC_TabContent li,
                   6897: ul.LC_TabContentBigger li {
1.911     bisitz   6898:   float:left;
1.741     harmsja  6899: }
1.795     www      6900: 
1.897     wenzelju 6901: ul#LC_secondary_menu li a {
1.911     bisitz   6902:   color: $fontmenu;
                   6903:   text-decoration: none;
1.693     droeschl 6904: }
1.795     www      6905: 
1.721     harmsja  6906: ul.LC_TabContent {
1.952     onken    6907:   min-height:20px;
1.721     harmsja  6908: }
1.795     www      6909: 
                   6910: ul.LC_TabContent li {
1.911     bisitz   6911:   vertical-align:middle;
1.959     onken    6912:   padding: 0 16px 0 10px;
1.911     bisitz   6913:   background-color:$tabbg;
                   6914:   border-bottom:solid 1px $lg_border_color;
1.1020    raeburn  6915:   border-left: solid 1px $font;
1.721     harmsja  6916: }
1.795     www      6917: 
1.847     tempelho 6918: ul.LC_TabContent .right {
1.911     bisitz   6919:   float:right;
1.847     tempelho 6920: }
                   6921: 
1.911     bisitz   6922: ul.LC_TabContent li a,
                   6923: ul.LC_TabContent li {
                   6924:   color:rgb(47,47,47);
                   6925:   text-decoration:none;
                   6926:   font-size:95%;
                   6927:   font-weight:bold;
1.952     onken    6928:   min-height:20px;
                   6929: }
                   6930: 
1.959     onken    6931: ul.LC_TabContent li a:hover,
                   6932: ul.LC_TabContent li a:focus {
1.952     onken    6933:   color: $button_hover;
1.959     onken    6934:   background:none;
                   6935:   outline:none;
1.952     onken    6936: }
                   6937: 
                   6938: ul.LC_TabContent li:hover {
                   6939:   color: $button_hover;
                   6940:   cursor:pointer;
1.721     harmsja  6941: }
1.795     www      6942: 
1.911     bisitz   6943: ul.LC_TabContent li.active {
1.952     onken    6944:   color: $font;
1.911     bisitz   6945:   background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952     onken    6946:   border-bottom:solid 1px #FFFFFF;
                   6947:   cursor: default;
1.744     ehlerst  6948: }
1.795     www      6949: 
1.959     onken    6950: ul.LC_TabContent li.active a {
                   6951:   color:$font;
                   6952:   background:#FFFFFF;
                   6953:   outline: none;
                   6954: }
1.1047    raeburn  6955: 
                   6956: ul.LC_TabContent li.goback {
                   6957:   float: left;
                   6958:   border-left: none;
                   6959: }
                   6960: 
1.870     tempelho 6961: #maincoursedoc {
1.911     bisitz   6962:   clear:both;
1.870     tempelho 6963: }
                   6964: 
                   6965: ul.LC_TabContentBigger {
1.911     bisitz   6966:   display:block;
                   6967:   list-style:none;
                   6968:   padding: 0;
1.870     tempelho 6969: }
                   6970: 
1.795     www      6971: ul.LC_TabContentBigger li {
1.911     bisitz   6972:   vertical-align:bottom;
                   6973:   height: 30px;
                   6974:   font-size:110%;
                   6975:   font-weight:bold;
                   6976:   color: #737373;
1.841     tempelho 6977: }
                   6978: 
1.957     onken    6979: ul.LC_TabContentBigger li.active {
                   6980:   position: relative;
                   6981:   top: 1px;
                   6982: }
                   6983: 
1.870     tempelho 6984: ul.LC_TabContentBigger li a {
1.911     bisitz   6985:   background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
                   6986:   height: 30px;
                   6987:   line-height: 30px;
                   6988:   text-align: center;
                   6989:   display: block;
                   6990:   text-decoration: none;
1.958     onken    6991:   outline: none;  
1.741     harmsja  6992: }
1.795     www      6993: 
1.870     tempelho 6994: ul.LC_TabContentBigger li.active a {
1.911     bisitz   6995:   background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
                   6996:   color:$font;
1.744     ehlerst  6997: }
1.795     www      6998: 
1.870     tempelho 6999: ul.LC_TabContentBigger li b {
1.911     bisitz   7000:   background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
                   7001:   display: block;
                   7002:   float: left;
                   7003:   padding: 0 30px;
1.957     onken    7004:   border-bottom: 1px solid $lg_border_color;
1.870     tempelho 7005: }
                   7006: 
1.956     onken    7007: ul.LC_TabContentBigger li:hover b {
                   7008:   color:$button_hover;
                   7009: }
                   7010: 
1.870     tempelho 7011: ul.LC_TabContentBigger li.active b {
1.911     bisitz   7012:   background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
                   7013:   color:$font;
1.957     onken    7014:   border: 0;
1.741     harmsja  7015: }
1.693     droeschl 7016: 
1.870     tempelho 7017: 
1.862     bisitz   7018: ul.LC_CourseBreadcrumbs {
                   7019:   background: $sidebg;
1.1020    raeburn  7020:   height: 2em;
1.862     bisitz   7021:   padding-left: 10px;
1.1020    raeburn  7022:   margin: 0;
1.862     bisitz   7023:   list-style-position: inside;
                   7024: }
                   7025: 
1.911     bisitz   7026: ol#LC_MenuBreadcrumbs,
1.862     bisitz   7027: ol#LC_PathBreadcrumbs {
1.911     bisitz   7028:   padding-left: 10px;
                   7029:   margin: 0;
1.933     droeschl 7030:   height: 2.5em;  /* equal to #LC_breadcrumbs line-height */
1.693     droeschl 7031: }
                   7032: 
1.911     bisitz   7033: ol#LC_MenuBreadcrumbs li,
                   7034: ol#LC_PathBreadcrumbs li,
1.862     bisitz   7035: ul.LC_CourseBreadcrumbs li {
1.911     bisitz   7036:   display: inline;
1.933     droeschl 7037:   white-space: normal;  
1.693     droeschl 7038: }
                   7039: 
1.823     bisitz   7040: ol#LC_MenuBreadcrumbs li a,
1.862     bisitz   7041: ul.LC_CourseBreadcrumbs li a {
1.911     bisitz   7042:   text-decoration: none;
                   7043:   font-size:90%;
1.693     droeschl 7044: }
1.795     www      7045: 
1.969     droeschl 7046: ol#LC_MenuBreadcrumbs h1 {
                   7047:   display: inline;
                   7048:   font-size: 90%;
                   7049:   line-height: 2.5em;
                   7050:   margin: 0;
                   7051:   padding: 0;
                   7052: }
                   7053: 
1.795     www      7054: ol#LC_PathBreadcrumbs li a {
1.911     bisitz   7055:   text-decoration:none;
                   7056:   font-size:100%;
                   7057:   font-weight:bold;
1.693     droeschl 7058: }
1.795     www      7059: 
1.840     bisitz   7060: .LC_Box {
1.911     bisitz   7061:   border: solid 1px $lg_border_color;
                   7062:   padding: 0 10px 10px 10px;
1.746     neumanie 7063: }
1.795     www      7064: 
1.1020    raeburn  7065: .LC_DocsBox {
                   7066:   border: solid 1px $lg_border_color;
                   7067:   padding: 0 0 10px 10px;
                   7068: }
                   7069: 
1.795     www      7070: .LC_AboutMe_Image {
1.911     bisitz   7071:   float:left;
                   7072:   margin-right:10px;
1.747     neumanie 7073: }
1.795     www      7074: 
                   7075: .LC_Clear_AboutMe_Image {
1.911     bisitz   7076:   clear:left;
1.747     neumanie 7077: }
1.795     www      7078: 
1.721     harmsja  7079: dl.LC_ListStyleClean dt {
1.911     bisitz   7080:   padding-right: 5px;
                   7081:   display: table-header-group;
1.693     droeschl 7082: }
                   7083: 
1.721     harmsja  7084: dl.LC_ListStyleClean dd {
1.911     bisitz   7085:   display: table-row;
1.693     droeschl 7086: }
                   7087: 
1.721     harmsja  7088: .LC_ListStyleClean,
                   7089: .LC_ListStyleSimple,
                   7090: .LC_ListStyleNormal,
1.795     www      7091: .LC_ListStyleSpecial {
1.911     bisitz   7092:   /* display:block; */
                   7093:   list-style-position: inside;
                   7094:   list-style-type: none;
                   7095:   overflow: hidden;
                   7096:   padding: 0;
1.693     droeschl 7097: }
                   7098: 
1.721     harmsja  7099: .LC_ListStyleSimple li,
                   7100: .LC_ListStyleSimple dd,
                   7101: .LC_ListStyleNormal li,
                   7102: .LC_ListStyleNormal dd,
                   7103: .LC_ListStyleSpecial li,
1.795     www      7104: .LC_ListStyleSpecial dd {
1.911     bisitz   7105:   margin: 0;
                   7106:   padding: 5px 5px 5px 10px;
                   7107:   clear: both;
1.693     droeschl 7108: }
                   7109: 
1.721     harmsja  7110: .LC_ListStyleClean li,
                   7111: .LC_ListStyleClean dd {
1.911     bisitz   7112:   padding-top: 0;
                   7113:   padding-bottom: 0;
1.693     droeschl 7114: }
                   7115: 
1.721     harmsja  7116: .LC_ListStyleSimple dd,
1.795     www      7117: .LC_ListStyleSimple li {
1.911     bisitz   7118:   border-bottom: solid 1px $lg_border_color;
1.693     droeschl 7119: }
                   7120: 
1.721     harmsja  7121: .LC_ListStyleSpecial li,
                   7122: .LC_ListStyleSpecial dd {
1.911     bisitz   7123:   list-style-type: none;
                   7124:   background-color: RGB(220, 220, 220);
                   7125:   margin-bottom: 4px;
1.693     droeschl 7126: }
                   7127: 
1.721     harmsja  7128: table.LC_SimpleTable {
1.911     bisitz   7129:   margin:5px;
                   7130:   border:solid 1px $lg_border_color;
1.795     www      7131: }
1.693     droeschl 7132: 
1.721     harmsja  7133: table.LC_SimpleTable tr {
1.911     bisitz   7134:   padding: 0;
                   7135:   border:solid 1px $lg_border_color;
1.693     droeschl 7136: }
1.795     www      7137: 
                   7138: table.LC_SimpleTable thead {
1.911     bisitz   7139:   background:rgb(220,220,220);
1.693     droeschl 7140: }
                   7141: 
1.721     harmsja  7142: div.LC_columnSection {
1.911     bisitz   7143:   display: block;
                   7144:   clear: both;
                   7145:   overflow: hidden;
                   7146:   margin: 0;
1.693     droeschl 7147: }
                   7148: 
1.721     harmsja  7149: div.LC_columnSection>* {
1.911     bisitz   7150:   float: left;
                   7151:   margin: 10px 20px 10px 0;
                   7152:   overflow:hidden;
1.693     droeschl 7153: }
1.721     harmsja  7154: 
1.795     www      7155: table em {
1.911     bisitz   7156:   font-weight: bold;
                   7157:   font-style: normal;
1.748     schulted 7158: }
1.795     www      7159: 
1.779     bisitz   7160: table.LC_tableBrowseRes,
1.795     www      7161: table.LC_tableOfContent {
1.911     bisitz   7162:   border:none;
                   7163:   border-spacing: 1px;
                   7164:   padding: 3px;
                   7165:   background-color: #FFFFFF;
                   7166:   font-size: 90%;
1.753     droeschl 7167: }
1.789     droeschl 7168: 
1.911     bisitz   7169: table.LC_tableOfContent {
                   7170:   border-collapse: collapse;
1.789     droeschl 7171: }
                   7172: 
1.771     droeschl 7173: table.LC_tableBrowseRes a,
1.768     schulted 7174: table.LC_tableOfContent a {
1.911     bisitz   7175:   background-color: transparent;
                   7176:   text-decoration: none;
1.753     droeschl 7177: }
                   7178: 
1.795     www      7179: table.LC_tableOfContent img {
1.911     bisitz   7180:   border: none;
                   7181:   height: 1.3em;
                   7182:   vertical-align: text-bottom;
                   7183:   margin-right: 0.3em;
1.753     droeschl 7184: }
1.757     schulted 7185: 
1.795     www      7186: a#LC_content_toolbar_firsthomework {
1.911     bisitz   7187:   background-image:url(/res/adm/pages/open-first-problem.gif);
1.774     ehlerst  7188: }
                   7189: 
1.795     www      7190: a#LC_content_toolbar_everything {
1.911     bisitz   7191:   background-image:url(/res/adm/pages/show-all.gif);
1.774     ehlerst  7192: }
                   7193: 
1.795     www      7194: a#LC_content_toolbar_uncompleted {
1.911     bisitz   7195:   background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774     ehlerst  7196: }
                   7197: 
1.795     www      7198: #LC_content_toolbar_clearbubbles {
1.911     bisitz   7199:   background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774     ehlerst  7200: }
                   7201: 
1.795     www      7202: a#LC_content_toolbar_changefolder {
1.911     bisitz   7203:   background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757     schulted 7204: }
                   7205: 
1.795     www      7206: a#LC_content_toolbar_changefolder_toggled {
1.911     bisitz   7207:   background-image:url(/res/adm/pages/open-all-folders.gif);
1.757     schulted 7208: }
                   7209: 
1.1043    raeburn  7210: a#LC_content_toolbar_edittoplevel {
                   7211:   background-image:url(/res/adm/pages/edittoplevel.gif);
                   7212: }
                   7213: 
1.795     www      7214: ul#LC_toolbar li a:hover {
1.911     bisitz   7215:   background-position: bottom center;
1.757     schulted 7216: }
                   7217: 
1.795     www      7218: ul#LC_toolbar {
1.911     bisitz   7219:   padding: 0;
                   7220:   margin: 2px;
                   7221:   list-style:none;
                   7222:   position:relative;
                   7223:   background-color:white;
1.1075.2.9  raeburn  7224:   overflow: auto;
1.757     schulted 7225: }
                   7226: 
1.795     www      7227: ul#LC_toolbar li {
1.911     bisitz   7228:   border:1px solid white;
                   7229:   padding: 0;
                   7230:   margin: 0;
                   7231:   float: left;
                   7232:   display:inline;
                   7233:   vertical-align:middle;
1.1075.2.9  raeburn  7234:   white-space: nowrap;
1.911     bisitz   7235: }
1.757     schulted 7236: 
1.783     amueller 7237: 
1.795     www      7238: a.LC_toolbarItem {
1.911     bisitz   7239:   display:block;
                   7240:   padding: 0;
                   7241:   margin: 0;
                   7242:   height: 32px;
                   7243:   width: 32px;
                   7244:   color:white;
                   7245:   border: none;
                   7246:   background-repeat:no-repeat;
                   7247:   background-color:transparent;
1.757     schulted 7248: }
                   7249: 
1.915     droeschl 7250: ul.LC_funclist {
                   7251:     margin: 0;
                   7252:     padding: 0.5em 1em 0.5em 0;
                   7253: }
                   7254: 
1.933     droeschl 7255: ul.LC_funclist > li:first-child {
                   7256:     font-weight:bold; 
                   7257:     margin-left:0.8em;
                   7258: }
                   7259: 
1.915     droeschl 7260: ul.LC_funclist + ul.LC_funclist {
                   7261:     /* 
                   7262:        left border as a seperator if we have more than
                   7263:        one list 
                   7264:     */
                   7265:     border-left: 1px solid $sidebg;
                   7266:     /* 
                   7267:        this hides the left border behind the border of the 
                   7268:        outer box if element is wrapped to the next 'line' 
                   7269:     */
                   7270:     margin-left: -1px;
                   7271: }
                   7272: 
1.843     bisitz   7273: ul.LC_funclist li {
1.915     droeschl 7274:   display: inline;
1.782     bisitz   7275:   white-space: nowrap;
1.915     droeschl 7276:   margin: 0 0 0 25px;
                   7277:   line-height: 150%;
1.782     bisitz   7278: }
                   7279: 
1.974     wenzelju 7280: .LC_hidden {
                   7281:   display: none;
                   7282: }
                   7283: 
1.1030    www      7284: .LCmodal-overlay {
                   7285: 		position:fixed;
                   7286: 		top:0;
                   7287: 		right:0;
                   7288: 		bottom:0;
                   7289: 		left:0;
                   7290: 		height:100%;
                   7291: 		width:100%;
                   7292: 		margin:0;
                   7293: 		padding:0;
                   7294: 		background:#999;
                   7295: 		opacity:.75;
                   7296: 		filter: alpha(opacity=75);
                   7297: 		-moz-opacity: 0.75;
                   7298: 		z-index:101;
                   7299: }
                   7300: 
                   7301: * html .LCmodal-overlay {   
                   7302: 		position: absolute;
                   7303: 		height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
                   7304: }
                   7305: 
                   7306: .LCmodal-window {
                   7307: 		position:fixed;
                   7308: 		top:50%;
                   7309: 		left:50%;
                   7310: 		margin:0;
                   7311: 		padding:0;
                   7312: 		z-index:102;
                   7313: 	}
                   7314: 
                   7315: * html .LCmodal-window {
                   7316: 		position:absolute;
                   7317: }
                   7318: 
                   7319: .LCclose-window {
                   7320: 		position:absolute;
                   7321: 		width:32px;
                   7322: 		height:32px;
                   7323: 		right:8px;
                   7324: 		top:8px;
                   7325: 		background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
                   7326: 		text-indent:-99999px;
                   7327: 		overflow:hidden;
                   7328: 		cursor:pointer;
                   7329: }
                   7330: 
1.1075.2.17  raeburn  7331: /*
                   7332:   styles used by TTH when "Default set of options to pass to tth/m
                   7333:   when converting TeX" in course settings has been set
                   7334: 
                   7335:   option passed: -t
                   7336: 
                   7337: */
                   7338: 
                   7339: td div.comp { margin-top: -0.6ex; margin-bottom: -1ex;}
                   7340: td div.comb { margin-top: -0.6ex; margin-bottom: -.6ex;}
                   7341: td div.hrcomp { line-height: 0.9; margin-top: -0.8ex; margin-bottom: -1ex;}
                   7342: td div.norm {line-height:normal;}
                   7343: 
                   7344: /*
                   7345:   option passed -y3
                   7346: */
                   7347: 
                   7348: span.roman {font-family: serif; font-style: normal; font-weight: normal;}
                   7349: span.overacc2 {position: relative;  left: .8em; top: -1.2ex;}
                   7350: span.overacc1 {position: relative;  left: .6em; top: -1.2ex;}
                   7351: 
1.343     albertel 7352: END
                   7353: }
                   7354: 
1.306     albertel 7355: =pod
                   7356: 
                   7357: =item * &headtag()
                   7358: 
                   7359: Returns a uniform footer for LON-CAPA web pages.
                   7360: 
1.307     albertel 7361: Inputs: $title - optional title for the head
                   7362:         $head_extra - optional extra HTML to put inside the <head>
1.315     albertel 7363:         $args - optional arguments
1.319     albertel 7364:             force_register - if is true call registerurl so the remote is 
                   7365:                              informed
1.415     albertel 7366:             redirect       -> array ref of
                   7367:                                    1- seconds before redirect occurs
                   7368:                                    2- url to redirect to
                   7369:                                    3- whether the side effect should occur
1.315     albertel 7370:                            (side effect of setting 
                   7371:                                $env{'internal.head.redirect'} to the url 
                   7372:                                redirected too)
1.352     albertel 7373:             domain         -> force to color decorate a page for a specific
                   7374:                                domain
                   7375:             function       -> force usage of a specific rolish color scheme
                   7376:             bgcolor        -> override the default page bgcolor
1.460     albertel 7377:             no_auto_mt_title
                   7378:                            -> prevent &mt()ing the title arg
1.464     albertel 7379: 
1.306     albertel 7380: =cut
                   7381: 
                   7382: sub headtag {
1.313     albertel 7383:     my ($title,$head_extra,$args) = @_;
1.306     albertel 7384:     
1.363     albertel 7385:     my $function = $args->{'function'} || &get_users_function();
                   7386:     my $domain   = $args->{'domain'}   || &determinedomain();
                   7387:     my $bgcolor  = $args->{'bgcolor'}  || &designparm($function.'.pgbg',$domain);
1.1075.2.52  raeburn  7388:     my $httphost = $args->{'use_absolute'};
1.418     albertel 7389:     my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458     albertel 7390: 		   $Apache::lonnet::perlvar{'lonVersion'},
1.531     albertel 7391: 		   #time(),
1.418     albertel 7392: 		   $env{'environment.color.timestamp'},
1.363     albertel 7393: 		   $function,$domain,$bgcolor);
                   7394: 
1.369     www      7395:     $url = '/adm/css/'.&escape($url).'.css';
1.363     albertel 7396: 
1.308     albertel 7397:     my $result =
                   7398: 	'<head>'.
1.1075.2.56  raeburn  7399: 	&font_settings($args);
1.319     albertel 7400: 
1.1075.2.72  raeburn  7401:     my $inhibitprint;
                   7402:     if ($args->{'print_suppress'}) {
                   7403:         $inhibitprint = &print_suppression();
                   7404:     }
1.1064    raeburn  7405: 
1.461     albertel 7406:     if (!$args->{'frameset'}) {
                   7407: 	$result .= &Apache::lonhtmlcommon::htmlareaheaders();
                   7408:     }
1.1075.2.12  raeburn  7409:     if ($args->{'force_register'}) {
                   7410:         $result .= &Apache::lonmenu::registerurl(1);
1.319     albertel 7411:     }
1.436     albertel 7412:     if (!$args->{'no_nav_bar'} 
                   7413: 	&& !$args->{'only_body'}
                   7414: 	&& !$args->{'frameset'}) {
1.1075.2.52  raeburn  7415: 	$result .= &help_menu_js($httphost);
1.1032    www      7416:         $result.=&modal_window();
1.1038    www      7417:         $result.=&togglebox_script();
1.1034    www      7418:         $result.=&wishlist_window();
1.1041    www      7419:         $result.=&LCprogressbarUpdate_script();
1.1034    www      7420:     } else {
                   7421:         if ($args->{'add_modal'}) {
                   7422:            $result.=&modal_window();
                   7423:         }
                   7424:         if ($args->{'add_wishlist'}) {
                   7425:            $result.=&wishlist_window();
                   7426:         }
1.1038    www      7427:         if ($args->{'add_togglebox'}) {
                   7428:            $result.=&togglebox_script();
                   7429:         }
1.1041    www      7430:         if ($args->{'add_progressbar'}) {
                   7431:            $result.=&LCprogressbarUpdate_script();
                   7432:         }
1.436     albertel 7433:     }
1.314     albertel 7434:     if (ref($args->{'redirect'})) {
1.414     albertel 7435: 	my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315     albertel 7436: 	$url = &Apache::lonenc::check_encrypt($url);
1.414     albertel 7437: 	if (!$inhibit_continue) {
                   7438: 	    $env{'internal.head.redirect'} = $url;
                   7439: 	}
1.313     albertel 7440: 	$result.=<<ADDMETA
                   7441: <meta http-equiv="pragma" content="no-cache" />
1.344     albertel 7442: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313     albertel 7443: ADDMETA
1.1075.2.89  raeburn  7444:     } else {
                   7445:         unless (($args->{'frameset'}) || ($args->{'js_ready'}) || ($args->{'only_body'}) || ($args->{'no_nav_bar'})) {
                   7446:             my $requrl = $env{'request.uri'};
                   7447:             if ($requrl eq '') {
                   7448:                 $requrl = $ENV{'REQUEST_URI'};
                   7449:                 $requrl =~ s/\?.+$//;
                   7450:             }
                   7451:             unless (($requrl =~ m{^/adm/(?:switchserver|login|authenticate|logout|groupsort|cleanup|helper|slotrequest|grades)(\?|$)}) ||
                   7452:                     (($requrl =~ m{^/res/}) && (($env{'form.submitted'} eq 'scantron') ||
                   7453:                      ($env{'form.grade_symb'}) || ($Apache::lonhomework::scantronmode)))) {
                   7454:                 my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};
                   7455:                 unless (&Apache::lonnet::allowed('mau',$dom_in_use)) {
                   7456:                     my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use);
                   7457:                     if (ref($domdefs{'offloadnow'}) eq 'HASH') {
                   7458:                         my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
                   7459:                         if ($domdefs{'offloadnow'}{$lonhost}) {
                   7460:                             my $newserver = &Apache::lonnet::spareserver(30000,undef,1,$dom_in_use);
                   7461:                             if (($newserver) && ($newserver ne $lonhost)) {
                   7462:                                 my $numsec = 5;
                   7463:                                 my $timeout = $numsec * 1000;
                   7464:                                 my ($newurl,$locknum,%locks,$msg);
                   7465:                                 if ($env{'request.role.adv'}) {
                   7466:                                     ($locknum,%locks) = &Apache::lonnet::get_locks();
                   7467:                                 }
                   7468:                                 my $disable_submit = 0;
                   7469:                                 if ($requrl =~ /$LONCAPA::assess_re/) {
                   7470:                                     $disable_submit = 1;
                   7471:                                 }
                   7472:                                 if ($locknum) {
                   7473:                                     my @lockinfo = sort(values(%locks));
                   7474:                                     $msg = &mt('Once the following tasks are complete: ')."\\n".
                   7475:                                            join(", ",sort(values(%locks)))."\\n".
                   7476:                                            &mt('your session will be transferred to a different server, after you click "Roles".');
                   7477:                                 } else {
                   7478:                                     if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) {
                   7479:                                         $msg = &mt('Your LON-CAPA submission has been recorded')."\\n";
                   7480:                                     }
                   7481:                                     $msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec);
                   7482:                                     $newurl = '/adm/switchserver?otherserver='.$newserver;
                   7483:                                     if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) {
                   7484:                                         $newurl .= '&role='.$env{'request.role'};
                   7485:                                     }
                   7486:                                     if ($env{'request.symb'}) {
                   7487:                                         $newurl .= '&symb='.$env{'request.symb'};
                   7488:                                     } else {
                   7489:                                         $newurl .= '&origurl='.$requrl;
                   7490:                                     }
                   7491:                                 }
1.1075.2.98  raeburn  7492:                                 &js_escape(\$msg);
1.1075.2.89  raeburn  7493:                                 $result.=<<OFFLOAD
                   7494: <meta http-equiv="pragma" content="no-cache" />
                   7495: <script type="text/javascript">
1.1075.2.92  raeburn  7496: // <![CDATA[
1.1075.2.89  raeburn  7497: function LC_Offload_Now() {
                   7498:     var dest = "$newurl";
                   7499:     if (dest != '') {
                   7500:         window.location.href="$newurl";
                   7501:     }
                   7502: }
1.1075.2.92  raeburn  7503: \$(document).ready(function () {
                   7504:     window.alert('$msg');
                   7505:     if ($disable_submit) {
1.1075.2.89  raeburn  7506:         \$(".LC_hwk_submit").prop("disabled", true);
                   7507:         \$( ".LC_textline" ).prop( "readonly", "readonly");
1.1075.2.92  raeburn  7508:     }
                   7509:     setTimeout('LC_Offload_Now()', $timeout);
                   7510: });
                   7511: // ]]>
1.1075.2.89  raeburn  7512: </script>
                   7513: OFFLOAD
                   7514:                             }
                   7515:                         }
                   7516:                     }
                   7517:                 }
                   7518:             }
                   7519:         }
1.313     albertel 7520:     }
1.306     albertel 7521:     if (!defined($title)) {
                   7522: 	$title = 'The LearningOnline Network with CAPA';
                   7523:     }
1.460     albertel 7524:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
                   7525:     $result .= '<title> LON-CAPA '.$title.'</title>'
1.1075.2.61  raeburn  7526: 	.'<link rel="stylesheet" type="text/css" href="'.$url.'"';
                   7527:     if (!$args->{'frameset'}) {
                   7528:         $result .= ' /';
                   7529:     }
                   7530:     $result .= '>'
1.1064    raeburn  7531:         .$inhibitprint
1.414     albertel 7532: 	.$head_extra;
1.1075.2.42  raeburn  7533:     if ($env{'browser.mobile'}) {
                   7534:         $result .= '
                   7535: <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0">
                   7536: <meta name="apple-mobile-web-app-capable" content="yes" />';
                   7537:     }
1.962     droeschl 7538:     return $result.'</head>';
1.306     albertel 7539: }
                   7540: 
                   7541: =pod
                   7542: 
1.340     albertel 7543: =item * &font_settings()
                   7544: 
                   7545: Returns neccessary <meta> to set the proper encoding
                   7546: 
1.1075.2.56  raeburn  7547: Inputs: optional reference to HASH -- $args passed to &headtag()
1.340     albertel 7548: 
                   7549: =cut
                   7550: 
                   7551: sub font_settings {
1.1075.2.56  raeburn  7552:     my ($args) = @_;
1.340     albertel 7553:     my $headerstring='';
1.1075.2.56  raeburn  7554:     if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) ||
                   7555:         ((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) {
1.340     albertel 7556: 	$headerstring.=
1.1075.2.61  raeburn  7557: 	    '<meta http-equiv="Content-Type" content="text/html; charset=utf-8"';
                   7558:         if (!$args->{'frameset'}) {
                   7559:             $headerstring.= ' /';
                   7560:         }
                   7561:         $headerstring .= '>'."\n";
1.340     albertel 7562:     }
                   7563:     return $headerstring;
                   7564: }
                   7565: 
1.341     albertel 7566: =pod
                   7567: 
1.1064    raeburn  7568: =item * &print_suppression()
                   7569: 
                   7570: In course context returns css which causes the body to be blank when media="print",
                   7571: if printout generation is unavailable for the current resource.
                   7572: 
                   7573: This could be because:
                   7574: 
                   7575: (a) printstartdate is in the future
                   7576: 
                   7577: (b) printenddate is in the past
                   7578: 
                   7579: (c) there is an active exam block with "printout"
                   7580: functionality blocked
                   7581: 
                   7582: Users with pav, pfo or evb privileges are exempt.
                   7583: 
                   7584: Inputs: none
                   7585: 
                   7586: =cut
                   7587: 
                   7588: 
                   7589: sub print_suppression {
                   7590:     my $noprint;
                   7591:     if ($env{'request.course.id'}) {
                   7592:         my $scope = $env{'request.course.id'};
                   7593:         if ((&Apache::lonnet::allowed('pav',$scope)) ||
                   7594:             (&Apache::lonnet::allowed('pfo',$scope))) {
                   7595:             return;
                   7596:         }
                   7597:         if ($env{'request.course.sec'} ne '') {
                   7598:             $scope .= "/$env{'request.course.sec'}";
                   7599:             if ((&Apache::lonnet::allowed('pav',$scope)) ||
                   7600:                 (&Apache::lonnet::allowed('pfo',$scope))) {
1.1065    raeburn  7601:                 return;
1.1064    raeburn  7602:             }
                   7603:         }
                   7604:         my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   7605:         my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1075.2.73  raeburn  7606:         my $blocked = &blocking_status('printout',$cnum,$cdom,undef,1);
1.1064    raeburn  7607:         if ($blocked) {
                   7608:             my $checkrole = "cm./$cdom/$cnum";
                   7609:             if ($env{'request.course.sec'} ne '') {
                   7610:                 $checkrole .= "/$env{'request.course.sec'}";
                   7611:             }
                   7612:             unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
                   7613:                     ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
                   7614:                 $noprint = 1;
                   7615:             }
                   7616:         }
                   7617:         unless ($noprint) {
                   7618:             my $symb = &Apache::lonnet::symbread();
                   7619:             if ($symb ne '') {
                   7620:                 my $navmap = Apache::lonnavmaps::navmap->new();
                   7621:                 if (ref($navmap)) {
                   7622:                     my $res = $navmap->getBySymb($symb);
                   7623:                     if (ref($res)) {
                   7624:                         if (!$res->resprintable()) {
                   7625:                             $noprint = 1;
                   7626:                         }
                   7627:                     }
                   7628:                 }
                   7629:             }
                   7630:         }
                   7631:         if ($noprint) {
                   7632:             return <<"ENDSTYLE";
                   7633: <style type="text/css" media="print">
                   7634:     body { display:none }
                   7635: </style>
                   7636: ENDSTYLE
                   7637:         }
                   7638:     }
                   7639:     return;
                   7640: }
                   7641: 
                   7642: =pod
                   7643: 
1.341     albertel 7644: =item * &xml_begin()
                   7645: 
                   7646: Returns the needed doctype and <html>
                   7647: 
                   7648: Inputs: none
                   7649: 
                   7650: =cut
                   7651: 
                   7652: sub xml_begin {
1.1075.2.61  raeburn  7653:     my ($is_frameset) = @_;
1.341     albertel 7654:     my $output='';
                   7655: 
                   7656:     if ($env{'browser.mathml'}) {
                   7657: 	$output='<?xml version="1.0"?>'
                   7658:             #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
                   7659: #            .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
                   7660:             
                   7661: #	    .'<!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">] >'
                   7662: 	    .'<!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">'
                   7663:             .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" ' 
                   7664: 	    .'xmlns="http://www.w3.org/1999/xhtml">';
1.1075.2.61  raeburn  7665:     } elsif ($is_frameset) {
                   7666:         $output='<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">'."\n".
                   7667:                 '<html>'."\n";
1.341     albertel 7668:     } else {
1.1075.2.61  raeburn  7669: 	$output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'."\n".
                   7670:                 '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'."\n";
1.341     albertel 7671:     }
                   7672:     return $output;
                   7673: }
1.340     albertel 7674: 
                   7675: =pod
                   7676: 
1.306     albertel 7677: =item * &start_page()
                   7678: 
                   7679: Returns a complete <html> .. <body> section for LON-CAPA web pages.
                   7680: 
1.648     raeburn  7681: Inputs:
                   7682: 
                   7683: =over 4
                   7684: 
                   7685: $title - optional title for the page
                   7686: 
                   7687: $head_extra - optional extra HTML to incude inside the <head>
                   7688: 
                   7689: $args - additional optional args supported are:
                   7690: 
                   7691: =over 8
                   7692: 
                   7693:              only_body      -> is true will set &bodytag() onlybodytag
1.317     albertel 7694:                                     arg on
1.814     bisitz   7695:              no_nav_bar     -> is true will set &bodytag() no_nav_bar arg on
1.648     raeburn  7696:              add_entries    -> additional attributes to add to the  <body>
                   7697:              domain         -> force to color decorate a page for a 
1.317     albertel 7698:                                     specific domain
1.648     raeburn  7699:              function       -> force usage of a specific rolish color
1.317     albertel 7700:                                     scheme
1.648     raeburn  7701:              redirect       -> see &headtag()
                   7702:              bgcolor        -> override the default page bg color
                   7703:              js_ready       -> return a string ready for being used in 
1.317     albertel 7704:                                     a javascript writeln
1.648     raeburn  7705:              html_encode    -> return a string ready for being used in 
1.320     albertel 7706:                                     a html attribute
1.648     raeburn  7707:              force_register -> if is true will turn on the &bodytag()
1.317     albertel 7708:                                     $forcereg arg
1.648     raeburn  7709:              frameset       -> if true will start with a <frameset>
1.330     albertel 7710:                                     rather than <body>
1.648     raeburn  7711:              skip_phases    -> hash ref of 
1.338     albertel 7712:                                     head -> skip the <html><head> generation
                   7713:                                     body -> skip all <body> generation
1.1075.2.12  raeburn  7714:              no_inline_link -> if true and in remote mode, don't show the
                   7715:                                     'Switch To Inline Menu' link
1.648     raeburn  7716:              no_auto_mt_title -> prevent &mt()ing the title arg
1.867     kalberla 7717:              bread_crumbs ->             Array containing breadcrumbs
1.983     raeburn  7718:              bread_crumbs_component ->  if exists show it as headline else show only the breadcrumbs
1.1075.2.15  raeburn  7719:              group          -> includes the current group, if page is for a
                   7720:                                specific group
1.361     albertel 7721: 
1.648     raeburn  7722: =back
1.460     albertel 7723: 
1.648     raeburn  7724: =back
1.562     albertel 7725: 
1.306     albertel 7726: =cut
                   7727: 
                   7728: sub start_page {
1.309     albertel 7729:     my ($title,$head_extra,$args) = @_;
1.318     albertel 7730:     #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319     albertel 7731: 
1.315     albertel 7732:     $env{'internal.start_page'}++;
1.1075.2.15  raeburn  7733:     my ($result,@advtools);
1.964     droeschl 7734: 
1.338     albertel 7735:     if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1075.2.62  raeburn  7736:         $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);
1.338     albertel 7737:     }
                   7738:     
                   7739:     if (! exists($args->{'skip_phases'}{'body'}) ) {
                   7740: 	if ($args->{'frameset'}) {
                   7741: 	    my $attr_string = &make_attr_string($args->{'force_register'},
                   7742: 						$args->{'add_entries'});
                   7743: 	    $result .= "\n<frameset $attr_string>\n";
1.831     bisitz   7744:         } else {
                   7745:             $result .=
                   7746:                 &bodytag($title, 
                   7747:                          $args->{'function'},       $args->{'add_entries'},
                   7748:                          $args->{'only_body'},      $args->{'domain'},
                   7749:                          $args->{'force_register'}, $args->{'no_nav_bar'},
1.1075.2.12  raeburn  7750:                          $args->{'bgcolor'},        $args->{'no_inline_link'},
1.1075.2.15  raeburn  7751:                          $args,                     \@advtools);
1.831     bisitz   7752:         }
1.330     albertel 7753:     }
1.338     albertel 7754: 
1.315     albertel 7755:     if ($args->{'js_ready'}) {
1.713     kaisler  7756: 		$result = &js_ready($result);
1.315     albertel 7757:     }
1.320     albertel 7758:     if ($args->{'html_encode'}) {
1.713     kaisler  7759: 		$result = &html_encode($result);
                   7760:     }
                   7761: 
1.813     bisitz   7762:     # Preparation for new and consistent functionlist at top of screen
                   7763:     # if ($args->{'functionlist'}) {
                   7764:     #            $result .= &build_functionlist();
                   7765:     #}
                   7766: 
1.964     droeschl 7767:     # Don't add anything more if only_body wanted or in const space
                   7768:     return $result if    $args->{'only_body'} 
                   7769:                       || $env{'request.state'} eq 'construct';
1.813     bisitz   7770: 
                   7771:     #Breadcrumbs
1.758     kaisler  7772:     if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
                   7773: 		&Apache::lonhtmlcommon::clear_breadcrumbs();
                   7774: 		#if any br links exists, add them to the breadcrumbs
                   7775: 		if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {         
                   7776: 			foreach my $crumb (@{$args->{'bread_crumbs'}}){
                   7777: 				&Apache::lonhtmlcommon::add_breadcrumb($crumb);
                   7778: 			}
                   7779: 		}
1.1075.2.19  raeburn  7780:                 # if @advtools array contains items add then to the breadcrumbs
                   7781:                 if (@advtools > 0) {
                   7782:                     &Apache::lonmenu::advtools_crumbs(@advtools);
                   7783:                 }
1.758     kaisler  7784: 
                   7785: 		#if bread_crumbs_component exists show it as headline else show only the breadcrumbs
                   7786: 		if(exists($args->{'bread_crumbs_component'})){
                   7787: 			$result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'});
                   7788: 		}else{
                   7789: 			$result .= &Apache::lonhtmlcommon::breadcrumbs();
                   7790: 		}
1.1075.2.24  raeburn  7791:     } elsif (($env{'environment.remote'} eq 'on') &&
                   7792:              ($env{'form.inhibitmenu'} ne 'yes') &&
                   7793:              ($env{'request.noversionuri'} =~ m{^/res/}) &&
                   7794:              ($env{'request.noversionuri'} !~ m{^/res/adm/pages/})) {
1.1075.2.21  raeburn  7795:         $result .= '<div style="padding:0;margin:0;clear:both"><hr /></div>';
1.320     albertel 7796:     }
1.315     albertel 7797:     return $result;
1.306     albertel 7798: }
                   7799: 
                   7800: sub end_page {
1.315     albertel 7801:     my ($args) = @_;
                   7802:     $env{'internal.end_page'}++;
1.330     albertel 7803:     my $result;
1.335     albertel 7804:     if ($args->{'discussion'}) {
                   7805: 	my ($target,$parser);
                   7806: 	if (ref($args->{'discussion'})) {
                   7807: 	    ($target,$parser) =($args->{'discussion'}{'target'},
                   7808: 				$args->{'discussion'}{'parser'});
                   7809: 	}
                   7810: 	$result .= &Apache::lonxml::xmlend($target,$parser);
                   7811:     }
1.330     albertel 7812:     if ($args->{'frameset'}) {
                   7813: 	$result .= '</frameset>';
                   7814:     } else {
1.635     raeburn  7815: 	$result .= &endbodytag($args);
1.330     albertel 7816:     }
1.1075.2.6  raeburn  7817:     unless ($args->{'notbody'}) {
                   7818:         $result .= "\n</html>";
                   7819:     }
1.330     albertel 7820: 
1.315     albertel 7821:     if ($args->{'js_ready'}) {
1.317     albertel 7822: 	$result = &js_ready($result);
1.315     albertel 7823:     }
1.335     albertel 7824: 
1.320     albertel 7825:     if ($args->{'html_encode'}) {
                   7826: 	$result = &html_encode($result);
                   7827:     }
1.335     albertel 7828: 
1.315     albertel 7829:     return $result;
                   7830: }
                   7831: 
1.1034    www      7832: sub wishlist_window {
                   7833:     return(<<'ENDWISHLIST');
1.1046    raeburn  7834: <script type="text/javascript">
1.1034    www      7835: // <![CDATA[
                   7836: // <!-- BEGIN LON-CAPA Internal
                   7837: function set_wishlistlink(title, path) {
                   7838:     if (!title) {
                   7839:         title = document.title;
                   7840:         title = title.replace(/^LON-CAPA /,'');
                   7841:     }
1.1075.2.65  raeburn  7842:     title = encodeURIComponent(title);
1.1075.2.83  raeburn  7843:     title = title.replace("'","\\\'");
1.1034    www      7844:     if (!path) {
                   7845:         path = location.pathname;
                   7846:     }
1.1075.2.65  raeburn  7847:     path = encodeURIComponent(path);
1.1075.2.83  raeburn  7848:     path = path.replace("'","\\\'");
1.1034    www      7849:     Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
                   7850:                       'wishlistNewLink','width=560,height=350,scrollbars=0');
                   7851: }
                   7852: // END LON-CAPA Internal -->
                   7853: // ]]>
                   7854: </script>
                   7855: ENDWISHLIST
                   7856: }
                   7857: 
1.1030    www      7858: sub modal_window {
                   7859:     return(<<'ENDMODAL');
1.1046    raeburn  7860: <script type="text/javascript">
1.1030    www      7861: // <![CDATA[
                   7862: // <!-- BEGIN LON-CAPA Internal
                   7863: var modalWindow = {
                   7864: 	parent:"body",
                   7865: 	windowId:null,
                   7866: 	content:null,
                   7867: 	width:null,
                   7868: 	height:null,
                   7869: 	close:function()
                   7870: 	{
                   7871: 	        $(".LCmodal-window").remove();
                   7872: 	        $(".LCmodal-overlay").remove();
                   7873: 	},
                   7874: 	open:function()
                   7875: 	{
                   7876: 		var modal = "";
                   7877: 		modal += "<div class=\"LCmodal-overlay\"></div>";
                   7878: 		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;\">";
                   7879: 		modal += this.content;
                   7880: 		modal += "</div>";	
                   7881: 
                   7882: 		$(this.parent).append(modal);
                   7883: 
                   7884: 		$(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
                   7885: 		$(".LCclose-window").click(function(){modalWindow.close();});
                   7886: 		$(".LCmodal-overlay").click(function(){modalWindow.close();});
                   7887: 	}
                   7888: };
1.1075.2.42  raeburn  7889: 	var openMyModal = function(source,width,height,scrolling,transparency,style)
1.1030    www      7890: 	{
1.1075.2.83  raeburn  7891:                 source = source.replace("'","&#39;");
1.1030    www      7892: 		modalWindow.windowId = "myModal";
                   7893: 		modalWindow.width = width;
                   7894: 		modalWindow.height = height;
1.1075.2.80  raeburn  7895: 		modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='"+transparency+"' src='" + source + "' style='"+style+"'></iframe>";
1.1030    www      7896: 		modalWindow.open();
1.1075.2.87  raeburn  7897: 	};
1.1030    www      7898: // END LON-CAPA Internal -->
                   7899: // ]]>
                   7900: </script>
                   7901: ENDMODAL
                   7902: }
                   7903: 
                   7904: sub modal_link {
1.1075.2.42  raeburn  7905:     my ($link,$linktext,$width,$height,$target,$scrolling,$title,$transparency,$style)=@_;
1.1030    www      7906:     unless ($width) { $width=480; }
                   7907:     unless ($height) { $height=400; }
1.1031    www      7908:     unless ($scrolling) { $scrolling='yes'; }
1.1075.2.42  raeburn  7909:     unless ($transparency) { $transparency='true'; }
                   7910: 
1.1074    raeburn  7911:     my $target_attr;
                   7912:     if (defined($target)) {
                   7913:         $target_attr = 'target="'.$target.'"';
                   7914:     }
                   7915:     return <<"ENDLINK";
1.1075.2.42  raeburn  7916: <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">
1.1074    raeburn  7917:            $linktext</a>
                   7918: ENDLINK
1.1030    www      7919: }
                   7920: 
1.1032    www      7921: sub modal_adhoc_script {
                   7922:     my ($funcname,$width,$height,$content)=@_;
                   7923:     return (<<ENDADHOC);
1.1046    raeburn  7924: <script type="text/javascript">
1.1032    www      7925: // <![CDATA[
                   7926:         var $funcname = function()
                   7927:         {
                   7928:                 modalWindow.windowId = "myModal";
                   7929:                 modalWindow.width = $width;
                   7930:                 modalWindow.height = $height;
                   7931:                 modalWindow.content = '$content';
                   7932:                 modalWindow.open();
                   7933:         };  
                   7934: // ]]>
                   7935: </script>
                   7936: ENDADHOC
                   7937: }
                   7938: 
1.1041    www      7939: sub modal_adhoc_inner {
                   7940:     my ($funcname,$width,$height,$content)=@_;
                   7941:     my $innerwidth=$width-20;
                   7942:     $content=&js_ready(
1.1042    www      7943:                &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
1.1075.2.42  raeburn  7944:                  &start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1).
                   7945:                  $content.
1.1041    www      7946:                  &end_scrollbox().
1.1075.2.42  raeburn  7947:                  &end_page()
1.1041    www      7948:              );
                   7949:     return &modal_adhoc_script($funcname,$width,$height,$content);
                   7950: }
                   7951: 
                   7952: sub modal_adhoc_window {
                   7953:     my ($funcname,$width,$height,$content,$linktext)=@_;
                   7954:     return &modal_adhoc_inner($funcname,$width,$height,$content).
                   7955:            "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
                   7956: }
                   7957: 
                   7958: sub modal_adhoc_launch {
                   7959:     my ($funcname,$width,$height,$content)=@_;
                   7960:     return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
                   7961: <script type="text/javascript">
                   7962: // <![CDATA[
                   7963: $funcname();
                   7964: // ]]>
                   7965: </script>
                   7966: ENDLAUNCH
                   7967: }
                   7968: 
                   7969: sub modal_adhoc_close {
                   7970:     return (<<ENDCLOSE);
                   7971: <script type="text/javascript">
                   7972: // <![CDATA[
                   7973: modalWindow.close();
                   7974: // ]]>
                   7975: </script>
                   7976: ENDCLOSE
                   7977: }
                   7978: 
1.1038    www      7979: sub togglebox_script {
                   7980:    return(<<ENDTOGGLE);
                   7981: <script type="text/javascript"> 
                   7982: // <![CDATA[
                   7983: function LCtoggleDisplay(id,hidetext,showtext) {
                   7984:    link = document.getElementById(id + "link").childNodes[0];
                   7985:    with (document.getElementById(id).style) {
                   7986:       if (display == "none" ) {
                   7987:           display = "inline";
                   7988:           link.nodeValue = hidetext;
                   7989:         } else {
                   7990:           display = "none";
                   7991:           link.nodeValue = showtext;
                   7992:        }
                   7993:    }
                   7994: }
                   7995: // ]]>
                   7996: </script>
                   7997: ENDTOGGLE
                   7998: }
                   7999: 
1.1039    www      8000: sub start_togglebox {
                   8001:     my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
                   8002:     unless ($heading) { $heading=''; } else { $heading.=' '; }
                   8003:     unless ($showtext) { $showtext=&mt('show'); }
                   8004:     unless ($hidetext) { $hidetext=&mt('hide'); }
                   8005:     unless ($headerbg) { $headerbg='#FFFFFF'; }
                   8006:     return &start_data_table().
                   8007:            &start_data_table_header_row().
                   8008:            '<td bgcolor="'.$headerbg.'">'.$heading.
                   8009:            '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
                   8010:            $showtext.'\')">'.$showtext.'</a>]</td>'.
                   8011:            &end_data_table_header_row().
                   8012:            '<tr id="'.$id.'" style="display:none""><td>';
                   8013: }
                   8014: 
                   8015: sub end_togglebox {
                   8016:     return '</td></tr>'.&end_data_table();
                   8017: }
                   8018: 
1.1041    www      8019: sub LCprogressbar_script {
1.1045    www      8020:    my ($id)=@_;
1.1041    www      8021:    return(<<ENDPROGRESS);
                   8022: <script type="text/javascript">
                   8023: // <![CDATA[
1.1045    www      8024: \$('#progressbar$id').progressbar({
1.1041    www      8025:   value: 0,
                   8026:   change: function(event, ui) {
                   8027:     var newVal = \$(this).progressbar('option', 'value');
                   8028:     \$('.pblabel', this).text(LCprogressTxt);
                   8029:   }
                   8030: });
                   8031: // ]]>
                   8032: </script>
                   8033: ENDPROGRESS
                   8034: }
                   8035: 
                   8036: sub LCprogressbarUpdate_script {
                   8037:    return(<<ENDPROGRESSUPDATE);
                   8038: <style type="text/css">
                   8039: .ui-progressbar { position:relative; }
                   8040: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
                   8041: </style>
                   8042: <script type="text/javascript">
                   8043: // <![CDATA[
1.1045    www      8044: var LCprogressTxt='---';
                   8045: 
                   8046: function LCupdateProgress(percent,progresstext,id) {
1.1041    www      8047:    LCprogressTxt=progresstext;
1.1045    www      8048:    \$('#progressbar'+id).progressbar('value',percent);
1.1041    www      8049: }
                   8050: // ]]>
                   8051: </script>
                   8052: ENDPROGRESSUPDATE
                   8053: }
                   8054: 
1.1042    www      8055: my $LClastpercent;
1.1045    www      8056: my $LCidcnt;
                   8057: my $LCcurrentid;
1.1042    www      8058: 
1.1041    www      8059: sub LCprogressbar {
1.1042    www      8060:     my ($r)=(@_);
                   8061:     $LClastpercent=0;
1.1045    www      8062:     $LCidcnt++;
                   8063:     $LCcurrentid=$$.'_'.$LCidcnt;
1.1041    www      8064:     my $starting=&mt('Starting');
                   8065:     my $content=(<<ENDPROGBAR);
1.1045    www      8066:   <div id="progressbar$LCcurrentid">
1.1041    www      8067:     <span class="pblabel">$starting</span>
                   8068:   </div>
                   8069: ENDPROGBAR
1.1045    www      8070:     &r_print($r,$content.&LCprogressbar_script($LCcurrentid));
1.1041    www      8071: }
                   8072: 
                   8073: sub LCprogressbarUpdate {
1.1042    www      8074:     my ($r,$val,$text)=@_;
                   8075:     unless ($val) { 
                   8076:        if ($LClastpercent) {
                   8077:            $val=$LClastpercent;
                   8078:        } else {
                   8079:            $val=0;
                   8080:        }
                   8081:     }
1.1041    www      8082:     if ($val<0) { $val=0; }
                   8083:     if ($val>100) { $val=0; }
1.1042    www      8084:     $LClastpercent=$val;
1.1041    www      8085:     unless ($text) { $text=$val.'%'; }
                   8086:     $text=&js_ready($text);
1.1044    www      8087:     &r_print($r,<<ENDUPDATE);
1.1041    www      8088: <script type="text/javascript">
                   8089: // <![CDATA[
1.1045    www      8090: LCupdateProgress($val,'$text','$LCcurrentid');
1.1041    www      8091: // ]]>
                   8092: </script>
                   8093: ENDUPDATE
1.1035    www      8094: }
                   8095: 
1.1042    www      8096: sub LCprogressbarClose {
                   8097:     my ($r)=@_;
                   8098:     $LClastpercent=0;
1.1044    www      8099:     &r_print($r,<<ENDCLOSE);
1.1042    www      8100: <script type="text/javascript">
                   8101: // <![CDATA[
1.1045    www      8102: \$("#progressbar$LCcurrentid").hide('slow'); 
1.1042    www      8103: // ]]>
                   8104: </script>
                   8105: ENDCLOSE
1.1044    www      8106: }
                   8107: 
                   8108: sub r_print {
                   8109:     my ($r,$to_print)=@_;
                   8110:     if ($r) {
                   8111:       $r->print($to_print);
                   8112:       $r->rflush();
                   8113:     } else {
                   8114:       print($to_print);
                   8115:     }
1.1042    www      8116: }
                   8117: 
1.320     albertel 8118: sub html_encode {
                   8119:     my ($result) = @_;
                   8120: 
1.322     albertel 8121:     $result = &HTML::Entities::encode($result,'<>&"');
1.320     albertel 8122:     
                   8123:     return $result;
                   8124: }
1.1044    www      8125: 
1.317     albertel 8126: sub js_ready {
                   8127:     my ($result) = @_;
                   8128: 
1.323     albertel 8129:     $result =~ s/[\n\r]/ /xmsg;
                   8130:     $result =~ s/\\/\\\\/xmsg;
                   8131:     $result =~ s/'/\\'/xmsg;
1.372     albertel 8132:     $result =~ s{</}{<\\/}xmsg;
1.317     albertel 8133:     
                   8134:     return $result;
                   8135: }
                   8136: 
1.315     albertel 8137: sub validate_page {
                   8138:     if (  exists($env{'internal.start_page'})
1.316     albertel 8139: 	  &&     $env{'internal.start_page'} > 1) {
                   8140: 	&Apache::lonnet::logthis('start_page called multiple times '.
1.318     albertel 8141: 				 $env{'internal.start_page'}.' '.
1.316     albertel 8142: 				 $ENV{'request.filename'});
1.315     albertel 8143:     }
                   8144:     if (  exists($env{'internal.end_page'})
1.316     albertel 8145: 	  &&     $env{'internal.end_page'} > 1) {
                   8146: 	&Apache::lonnet::logthis('end_page called multiple times '.
1.318     albertel 8147: 				 $env{'internal.end_page'}.' '.
1.316     albertel 8148: 				 $env{'request.filename'});
1.315     albertel 8149:     }
                   8150:     if (     exists($env{'internal.start_page'})
                   8151: 	&& ! exists($env{'internal.end_page'})) {
1.316     albertel 8152: 	&Apache::lonnet::logthis('start_page called without end_page '.
                   8153: 				 $env{'request.filename'});
1.315     albertel 8154:     }
                   8155:     if (   ! exists($env{'internal.start_page'})
                   8156: 	&&   exists($env{'internal.end_page'})) {
1.316     albertel 8157: 	&Apache::lonnet::logthis('end_page called without start_page'.
                   8158: 				 $env{'request.filename'});
1.315     albertel 8159:     }
1.306     albertel 8160: }
1.315     albertel 8161: 
1.996     www      8162: 
                   8163: sub start_scrollbox {
1.1075.2.56  raeburn  8164:     my ($outerwidth,$width,$height,$id,$bgcolor,$cursor,$needjsready) = @_;
1.998     raeburn  8165:     unless ($outerwidth) { $outerwidth='520px'; }
                   8166:     unless ($width) { $width='500px'; }
                   8167:     unless ($height) { $height='200px'; }
1.1075    raeburn  8168:     my ($table_id,$div_id,$tdcol);
1.1018    raeburn  8169:     if ($id ne '') {
1.1075.2.42  raeburn  8170:         $table_id = ' id="table_'.$id.'"';
                   8171:         $div_id = ' id="div_'.$id.'"';
1.1018    raeburn  8172:     }
1.1075    raeburn  8173:     if ($bgcolor ne '') {
                   8174:         $tdcol = "background-color: $bgcolor;";
                   8175:     }
1.1075.2.42  raeburn  8176:     my $nicescroll_js;
                   8177:     if ($env{'browser.mobile'}) {
                   8178:         $nicescroll_js = &nicescroll_javascript('div_'.$id,$cursor,$needjsready);
                   8179:     }
1.1075    raeburn  8180:     return <<"END";
1.1075.2.42  raeburn  8181: $nicescroll_js
                   8182: 
                   8183: <table style="width: $outerwidth; border: 1px solid none;"$table_id><tr><td style="width: $width;$tdcol">
1.1075.2.56  raeburn  8184: <div style="overflow:auto; width:$width; height:$height;"$div_id>
1.1075    raeburn  8185: END
1.996     www      8186: }
                   8187: 
                   8188: sub end_scrollbox {
1.1036    www      8189:     return '</div></td></tr></table>';
1.996     www      8190: }
                   8191: 
1.1075.2.42  raeburn  8192: sub nicescroll_javascript {
                   8193:     my ($id,$cursor,$needjsready,$framecheck,$location) = @_;
                   8194:     my %options;
                   8195:     if (ref($cursor) eq 'HASH') {
                   8196:         %options = %{$cursor};
                   8197:     }
                   8198:     unless ($options{'railalign'} =~ /^left|right$/) {
                   8199:         $options{'railalign'} = 'left';
                   8200:     }
                   8201:     unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
                   8202:         my $function  = &get_users_function();
                   8203:         $options{'cursorcolor'} = &designparm($function.'.sidebg',$env{'request.role.domain'});
                   8204:         unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
                   8205:             $options{'cursorcolor'} = '#00F';
                   8206:         }
                   8207:     }
                   8208:     if ($options{'cursoropacity'} =~ /^[\d.]+$/) {
                   8209:         unless ($options{'cursoropacity'} >= 0.0 && $options{'cursoropacity'} <=1.0) {
                   8210:             $options{'cursoropacity'}='1.0';
                   8211:         }
                   8212:     } else {
                   8213:         $options{'cursoropacity'}='1.0';
                   8214:     }
                   8215:     if ($options{'cursorfixedheight'} eq 'none') {
                   8216:         delete($options{'cursorfixedheight'});
                   8217:     } else {
                   8218:         unless ($options{'cursorfixedheight'} =~ /^\d+$/) { $options{'cursorfixedheight'}='50'; }
                   8219:     }
                   8220:     unless ($options{'railoffset'} =~ /^{[\w\:\d\-,]+}$/) {
                   8221:         delete($options{'railoffset'});
                   8222:     }
                   8223:     my @niceoptions;
                   8224:     while (my($key,$value) = each(%options)) {
                   8225:         if ($value =~ /^\{.+\}$/) {
                   8226:             push(@niceoptions,$key.':'.$value);
                   8227:         } else {
                   8228:             push(@niceoptions,$key.':"'.$value.'"');
                   8229:         }
                   8230:     }
                   8231:     my $nicescroll_js = '
                   8232: $(document).ready(
                   8233:       function() {
                   8234:           $("#'.$id.'").niceScroll({'.join(',',@niceoptions).'});
                   8235:       }
                   8236: );
                   8237: ';
                   8238:     if ($framecheck) {
                   8239:         $nicescroll_js .= '
                   8240: function expand_div(caller) {
                   8241:     if (top === self) {
                   8242:         document.getElementById("'.$id.'").style.width = "auto";
                   8243:         document.getElementById("'.$id.'").style.height = "auto";
                   8244:     } else {
                   8245:         try {
                   8246:             if (parent.frames) {
                   8247:                 if (parent.frames.length > 1) {
                   8248:                     var framesrc = parent.frames[1].location.href;
                   8249:                     var currsrc = framesrc.replace(/\#.*$/,"");
                   8250:                     if ((caller == "search") || (currsrc == "'.$location.'")) {
                   8251:                         document.getElementById("'.$id.'").style.width = "auto";
                   8252:                         document.getElementById("'.$id.'").style.height = "auto";
                   8253:                     }
                   8254:                 }
                   8255:             }
                   8256:         } catch (e) {
                   8257:             return;
                   8258:         }
                   8259:     }
                   8260:     return;
                   8261: }
                   8262: ';
                   8263:     }
                   8264:     if ($needjsready) {
                   8265:         $nicescroll_js = '
                   8266: <script type="text/javascript">'."\n".$nicescroll_js."\n</script>\n";
                   8267:     } else {
                   8268:         $nicescroll_js = &Apache::lonhtmlcommon::scripttag($nicescroll_js);
                   8269:     }
                   8270:     return $nicescroll_js;
                   8271: }
                   8272: 
1.318     albertel 8273: sub simple_error_page {
1.1075.2.49  raeburn  8274:     my ($r,$title,$msg,$args) = @_;
                   8275:     if (ref($args) eq 'HASH') {
                   8276:         if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); }
                   8277:     } else {
                   8278:         $msg = &mt($msg);
                   8279:     }
                   8280: 
1.318     albertel 8281:     my $page =
                   8282: 	&Apache::loncommon::start_page($title).
1.1075.2.49  raeburn  8283: 	'<p class="LC_error">'.$msg.'</p>'.
1.318     albertel 8284: 	&Apache::loncommon::end_page();
                   8285:     if (ref($r)) {
                   8286: 	$r->print($page);
1.327     albertel 8287: 	return;
1.318     albertel 8288:     }
                   8289:     return $page;
                   8290: }
1.347     albertel 8291: 
                   8292: {
1.610     albertel 8293:     my @row_count;
1.961     onken    8294: 
                   8295:     sub start_data_table_count {
                   8296:         unshift(@row_count, 0);
                   8297:         return;
                   8298:     }
                   8299: 
                   8300:     sub end_data_table_count {
                   8301:         shift(@row_count);
                   8302:         return;
                   8303:     }
                   8304: 
1.347     albertel 8305:     sub start_data_table {
1.1018    raeburn  8306: 	my ($add_class,$id) = @_;
1.422     albertel 8307: 	my $css_class = (join(' ','LC_data_table',$add_class));
1.1018    raeburn  8308:         my $table_id;
                   8309:         if (defined($id)) {
                   8310:             $table_id = ' id="'.$id.'"';
                   8311:         }
1.961     onken    8312: 	&start_data_table_count();
1.1018    raeburn  8313: 	return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347     albertel 8314:     }
                   8315: 
                   8316:     sub end_data_table {
1.961     onken    8317: 	&end_data_table_count();
1.389     albertel 8318: 	return '</table>'."\n";;
1.347     albertel 8319:     }
                   8320: 
                   8321:     sub start_data_table_row {
1.974     wenzelju 8322: 	my ($add_class, $id) = @_;
1.610     albertel 8323: 	$row_count[0]++;
                   8324: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900     bisitz   8325: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974     wenzelju 8326:         $id = (' id="'.$id.'"') unless ($id eq '');
                   8327:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347     albertel 8328:     }
1.471     banghart 8329:     
                   8330:     sub continue_data_table_row {
1.974     wenzelju 8331: 	my ($add_class, $id) = @_;
1.610     albertel 8332: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974     wenzelju 8333: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
                   8334:         $id = (' id="'.$id.'"') unless ($id eq '');
                   8335:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471     banghart 8336:     }
1.347     albertel 8337: 
                   8338:     sub end_data_table_row {
1.389     albertel 8339: 	return '</tr>'."\n";;
1.347     albertel 8340:     }
1.367     www      8341: 
1.421     albertel 8342:     sub start_data_table_empty_row {
1.707     bisitz   8343: #	$row_count[0]++;
1.421     albertel 8344: 	return  '<tr class="LC_empty_row" >'."\n";;
                   8345:     }
                   8346: 
                   8347:     sub end_data_table_empty_row {
                   8348: 	return '</tr>'."\n";;
                   8349:     }
                   8350: 
1.367     www      8351:     sub start_data_table_header_row {
1.389     albertel 8352: 	return  '<tr class="LC_header_row">'."\n";;
1.367     www      8353:     }
                   8354: 
                   8355:     sub end_data_table_header_row {
1.389     albertel 8356: 	return '</tr>'."\n";;
1.367     www      8357:     }
1.890     droeschl 8358: 
                   8359:     sub data_table_caption {
                   8360:         my $caption = shift;
                   8361:         return "<caption class=\"LC_caption\">$caption</caption>";
                   8362:     }
1.347     albertel 8363: }
                   8364: 
1.548     albertel 8365: =pod
                   8366: 
                   8367: =item * &inhibit_menu_check($arg)
                   8368: 
                   8369: Checks for a inhibitmenu state and generates output to preserve it
                   8370: 
                   8371: Inputs:         $arg - can be any of
                   8372:                      - undef - in which case the return value is a string 
                   8373:                                to add  into arguments list of a uri
                   8374:                      - 'input' - in which case the return value is a HTML
                   8375:                                  <form> <input> field of type hidden to
                   8376:                                  preserve the value
                   8377:                      - a url - in which case the return value is the url with
                   8378:                                the neccesary cgi args added to preserve the
                   8379:                                inhibitmenu state
                   8380:                      - a ref to a url - no return value, but the string is
                   8381:                                         updated to include the neccessary cgi
                   8382:                                         args to preserve the inhibitmenu state
                   8383: 
                   8384: =cut
                   8385: 
                   8386: sub inhibit_menu_check {
                   8387:     my ($arg) = @_;
                   8388:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   8389:     if ($arg eq 'input') {
                   8390: 	if ($env{'form.inhibitmenu'}) {
                   8391: 	    return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
                   8392: 	} else {
                   8393: 	    return
                   8394: 	}
                   8395:     }
                   8396:     if ($env{'form.inhibitmenu'}) {
                   8397: 	if (ref($arg)) {
                   8398: 	    $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   8399: 	} elsif ($arg eq '') {
                   8400: 	    $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
                   8401: 	} else {
                   8402: 	    $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   8403: 	}
                   8404:     }
                   8405:     if (!ref($arg)) {
                   8406: 	return $arg;
                   8407:     }
                   8408: }
                   8409: 
1.251     albertel 8410: ###############################################
1.182     matthew  8411: 
                   8412: =pod
                   8413: 
1.549     albertel 8414: =back
                   8415: 
                   8416: =head1 User Information Routines
                   8417: 
                   8418: =over 4
                   8419: 
1.405     albertel 8420: =item * &get_users_function()
1.182     matthew  8421: 
                   8422: Used by &bodytag to determine the current users primary role.
                   8423: Returns either 'student','coordinator','admin', or 'author'.
                   8424: 
                   8425: =cut
                   8426: 
                   8427: ###############################################
                   8428: sub get_users_function {
1.815     tempelho 8429:     my $function = 'norole';
1.818     tempelho 8430:     if ($env{'request.role'}=~/^(st)/) {
                   8431:         $function='student';
                   8432:     }
1.907     raeburn  8433:     if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182     matthew  8434:         $function='coordinator';
                   8435:     }
1.258     albertel 8436:     if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182     matthew  8437:         $function='admin';
                   8438:     }
1.826     bisitz   8439:     if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025    raeburn  8440:         ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182     matthew  8441:         $function='author';
                   8442:     }
                   8443:     return $function;
1.54      www      8444: }
1.99      www      8445: 
                   8446: ###############################################
                   8447: 
1.233     raeburn  8448: =pod
                   8449: 
1.821     raeburn  8450: =item * &show_course()
                   8451: 
                   8452: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
                   8453: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
                   8454: 
                   8455: Inputs:
                   8456: None
                   8457: 
                   8458: Outputs:
                   8459: Scalar: 1 if 'Course' to be used, 0 otherwise.
                   8460: 
                   8461: =cut
                   8462: 
                   8463: ###############################################
                   8464: sub show_course {
                   8465:     my $course = !$env{'user.adv'};
                   8466:     if (!$env{'user.adv'}) {
                   8467:         foreach my $env (keys(%env)) {
                   8468:             next if ($env !~ m/^user\.priv\./);
                   8469:             if ($env !~ m/^user\.priv\.(?:st|cm)/) {
                   8470:                 $course = 0;
                   8471:                 last;
                   8472:             }
                   8473:         }
                   8474:     }
                   8475:     return $course;
                   8476: }
                   8477: 
                   8478: ###############################################
                   8479: 
                   8480: =pod
                   8481: 
1.542     raeburn  8482: =item * &check_user_status()
1.274     raeburn  8483: 
                   8484: Determines current status of supplied role for a
                   8485: specific user. Roles can be active, previous or future.
                   8486: 
                   8487: Inputs: 
                   8488: user's domain, user's username, course's domain,
1.375     raeburn  8489: course's number, optional section ID.
1.274     raeburn  8490: 
                   8491: Outputs:
                   8492: role status: active, previous or future. 
                   8493: 
                   8494: =cut
                   8495: 
                   8496: sub check_user_status {
1.412     raeburn  8497:     my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.1073    raeburn  8498:     my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
1.1075.2.85  raeburn  8499:     my @uroles = keys(%userinfo);
1.274     raeburn  8500:     my $srchstr;
                   8501:     my $active_chk = 'none';
1.412     raeburn  8502:     my $now = time;
1.274     raeburn  8503:     if (@uroles > 0) {
1.908     raeburn  8504:         if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274     raeburn  8505:             $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
                   8506:         } else {
1.412     raeburn  8507:             $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
                   8508:         }
                   8509:         if (grep/^\Q$srchstr\E$/,@uroles) {
1.274     raeburn  8510:             my $role_end = 0;
                   8511:             my $role_start = 0;
                   8512:             $active_chk = 'active';
1.412     raeburn  8513:             if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
                   8514:                 $role_end = $1;
                   8515:                 if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
                   8516:                     $role_start = $1;
1.274     raeburn  8517:                 }
                   8518:             }
                   8519:             if ($role_start > 0) {
1.412     raeburn  8520:                 if ($now < $role_start) {
1.274     raeburn  8521:                     $active_chk = 'future';
                   8522:                 }
                   8523:             }
                   8524:             if ($role_end > 0) {
1.412     raeburn  8525:                 if ($now > $role_end) {
1.274     raeburn  8526:                     $active_chk = 'previous';
                   8527:                 }
                   8528:             }
                   8529:         }
                   8530:     }
                   8531:     return $active_chk;
                   8532: }
                   8533: 
                   8534: ###############################################
                   8535: 
                   8536: =pod
                   8537: 
1.405     albertel 8538: =item * &get_sections()
1.233     raeburn  8539: 
                   8540: Determines all the sections for a course including
                   8541: sections with students and sections containing other roles.
1.419     raeburn  8542: Incoming parameters: 
                   8543: 
                   8544: 1. domain
                   8545: 2. course number 
                   8546: 3. reference to array containing roles for which sections should 
                   8547: be gathered (optional).
                   8548: 4. reference to array containing status types for which sections 
                   8549: should be gathered (optional).
                   8550: 
                   8551: If the third argument is undefined, sections are gathered for any role. 
                   8552: If the fourth argument is undefined, sections are gathered for any status.
                   8553: Permissible values are 'active' or 'future' or 'previous'.
1.233     raeburn  8554:  
1.374     raeburn  8555: Returns section hash (keys are section IDs, values are
                   8556: number of users in each section), subject to the
1.419     raeburn  8557: optional roles filter, optional status filter 
1.233     raeburn  8558: 
                   8559: =cut
                   8560: 
                   8561: ###############################################
                   8562: sub get_sections {
1.419     raeburn  8563:     my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366     albertel 8564:     if (!defined($cdom) || !defined($cnum)) {
                   8565:         my $cid =  $env{'request.course.id'};
                   8566: 
                   8567: 	return if (!defined($cid));
                   8568: 
                   8569:         $cdom = $env{'course.'.$cid.'.domain'};
                   8570:         $cnum = $env{'course.'.$cid.'.num'};
                   8571:     }
                   8572: 
                   8573:     my %sectioncount;
1.419     raeburn  8574:     my $now = time;
1.240     albertel 8575: 
1.1075.2.33  raeburn  8576:     my $check_students = 1;
                   8577:     my $only_students = 0;
                   8578:     if (ref($possible_roles) eq 'ARRAY') {
                   8579:         if (grep(/^st$/,@{$possible_roles})) {
                   8580:             if (@{$possible_roles} == 1) {
                   8581:                 $only_students = 1;
                   8582:             }
                   8583:         } else {
                   8584:             $check_students = 0;
                   8585:         }
                   8586:     }
                   8587: 
                   8588:     if ($check_students) {
1.276     albertel 8589: 	my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240     albertel 8590: 	my $sec_index = &Apache::loncoursedata::CL_SECTION();
                   8591: 	my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419     raeburn  8592:         my $start_index = &Apache::loncoursedata::CL_START();
                   8593:         my $end_index = &Apache::loncoursedata::CL_END();
                   8594:         my $status;
1.366     albertel 8595: 	while (my ($student,$data) = each(%$classlist)) {
1.419     raeburn  8596: 	    my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
                   8597: 				                     $data->[$status_index],
                   8598:                                                      $data->[$start_index],
                   8599:                                                      $data->[$end_index]);
                   8600:             if ($stu_status eq 'Active') {
                   8601:                 $status = 'active';
                   8602:             } elsif ($end < $now) {
                   8603:                 $status = 'previous';
                   8604:             } elsif ($start > $now) {
                   8605:                 $status = 'future';
                   8606:             } 
                   8607: 	    if ($section ne '-1' && $section !~ /^\s*$/) {
                   8608:                 if ((!defined($possible_status)) || (($status ne '') && 
                   8609:                     (grep/^\Q$status\E$/,@{$possible_status}))) { 
                   8610: 		    $sectioncount{$section}++;
                   8611:                 }
1.240     albertel 8612: 	    }
                   8613: 	}
                   8614:     }
1.1075.2.33  raeburn  8615:     if ($only_students) {
                   8616:         return %sectioncount;
                   8617:     }
1.240     albertel 8618:     my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   8619:     foreach my $user (sort(keys(%courseroles))) {
                   8620: 	if ($user !~ /^(\w{2})/) { next; }
                   8621: 	my ($role) = ($user =~ /^(\w{2})/);
                   8622: 	if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419     raeburn  8623: 	my ($section,$status);
1.240     albertel 8624: 	if ($role eq 'cr' &&
                   8625: 	    $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
                   8626: 	    $section=$1;
                   8627: 	}
                   8628: 	if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
                   8629: 	if (!defined($section) || $section eq '-1') { next; }
1.419     raeburn  8630:         my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
                   8631:         if ($end == -1 && $start == -1) {
                   8632:             next; #deleted role
                   8633:         }
                   8634:         if (!defined($possible_status)) { 
                   8635:             $sectioncount{$section}++;
                   8636:         } else {
                   8637:             if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
                   8638:                 $status = 'active';
                   8639:             } elsif ($end < $now) {
                   8640:                 $status = 'future';
                   8641:             } elsif ($start > $now) {
                   8642:                 $status = 'previous';
                   8643:             }
                   8644:             if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
                   8645:                 $sectioncount{$section}++;
                   8646:             }
                   8647:         }
1.233     raeburn  8648:     }
1.366     albertel 8649:     return %sectioncount;
1.233     raeburn  8650: }
                   8651: 
1.274     raeburn  8652: ###############################################
1.294     raeburn  8653: 
                   8654: =pod
1.405     albertel 8655: 
                   8656: =item * &get_course_users()
                   8657: 
1.275     raeburn  8658: Retrieves usernames:domains for users in the specified course
                   8659: with specific role(s), and access status. 
                   8660: 
                   8661: Incoming parameters:
1.277     albertel 8662: 1. course domain
                   8663: 2. course number
                   8664: 3. access status: users must have - either active, 
1.275     raeburn  8665: previous, future, or all.
1.277     albertel 8666: 4. reference to array of permissible roles
1.288     raeburn  8667: 5. reference to array of section restrictions (optional)
                   8668: 6. reference to results object (hash of hashes).
                   8669: 7. reference to optional userdata hash
1.609     raeburn  8670: 8. reference to optional statushash
1.630     raeburn  8671: 9. flag if privileged users (except those set to unhide in
                   8672:    course settings) should be excluded    
1.609     raeburn  8673: Keys of top level results hash are roles.
1.275     raeburn  8674: Keys of inner hashes are username:domain, with 
                   8675: values set to access type.
1.288     raeburn  8676: Optional userdata hash returns an array with arguments in the 
                   8677: same order as loncoursedata::get_classlist() for student data.
                   8678: 
1.609     raeburn  8679: Optional statushash returns
                   8680: 
1.288     raeburn  8681: Entries for end, start, section and status are blank because
                   8682: of the possibility of multiple values for non-student roles.
                   8683: 
1.275     raeburn  8684: =cut
1.405     albertel 8685: 
1.275     raeburn  8686: ###############################################
1.405     albertel 8687: 
1.275     raeburn  8688: sub get_course_users {
1.630     raeburn  8689:     my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288     raeburn  8690:     my %idx = ();
1.419     raeburn  8691:     my %seclists;
1.288     raeburn  8692: 
                   8693:     $idx{udom} = &Apache::loncoursedata::CL_SDOM();
                   8694:     $idx{uname} =  &Apache::loncoursedata::CL_SNAME();
                   8695:     $idx{end} = &Apache::loncoursedata::CL_END();
                   8696:     $idx{start} = &Apache::loncoursedata::CL_START();
                   8697:     $idx{id} = &Apache::loncoursedata::CL_ID();
                   8698:     $idx{section} = &Apache::loncoursedata::CL_SECTION();
                   8699:     $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
                   8700:     $idx{status} = &Apache::loncoursedata::CL_STATUS();
                   8701: 
1.290     albertel 8702:     if (grep(/^st$/,@{$roles})) {
1.276     albertel 8703:         my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278     raeburn  8704:         my $now = time;
1.277     albertel 8705:         foreach my $student (keys(%{$classlist})) {
1.288     raeburn  8706:             my $match = 0;
1.412     raeburn  8707:             my $secmatch = 0;
1.419     raeburn  8708:             my $section = $$classlist{$student}[$idx{section}];
1.609     raeburn  8709:             my $status = $$classlist{$student}[$idx{status}];
1.419     raeburn  8710:             if ($section eq '') {
                   8711:                 $section = 'none';
                   8712:             }
1.291     albertel 8713:             if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 8714:                 if (grep(/^all$/,@{$sections})) {
1.412     raeburn  8715:                     $secmatch = 1;
                   8716:                 } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420     albertel 8717:                     if (grep(/^none$/,@{$sections})) {
1.412     raeburn  8718:                         $secmatch = 1;
                   8719:                     }
                   8720:                 } else {  
1.419     raeburn  8721: 		    if (grep(/^\Q$section\E$/,@{$sections})) {
1.412     raeburn  8722: 		        $secmatch = 1;
                   8723:                     }
1.290     albertel 8724: 		}
1.412     raeburn  8725:                 if (!$secmatch) {
                   8726:                     next;
                   8727:                 }
1.419     raeburn  8728:             }
1.275     raeburn  8729:             if (defined($$types{'active'})) {
1.288     raeburn  8730:                 if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275     raeburn  8731:                     push(@{$$users{st}{$student}},'active');
1.288     raeburn  8732:                     $match = 1;
1.275     raeburn  8733:                 }
                   8734:             }
                   8735:             if (defined($$types{'previous'})) {
1.609     raeburn  8736:                 if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275     raeburn  8737:                     push(@{$$users{st}{$student}},'previous');
1.288     raeburn  8738:                     $match = 1;
1.275     raeburn  8739:                 }
                   8740:             }
                   8741:             if (defined($$types{'future'})) {
1.609     raeburn  8742:                 if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275     raeburn  8743:                     push(@{$$users{st}{$student}},'future');
1.288     raeburn  8744:                     $match = 1;
1.275     raeburn  8745:                 }
                   8746:             }
1.609     raeburn  8747:             if ($match) {
                   8748:                 push(@{$seclists{$student}},$section);
                   8749:                 if (ref($userdata) eq 'HASH') {
                   8750:                     $$userdata{$student} = $$classlist{$student};
                   8751:                 }
                   8752:                 if (ref($statushash) eq 'HASH') {
                   8753:                     $statushash->{$student}{'st'}{$section} = $status;
                   8754:                 }
1.288     raeburn  8755:             }
1.275     raeburn  8756:         }
                   8757:     }
1.412     raeburn  8758:     if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439     raeburn  8759:         my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   8760:         my $now = time;
1.609     raeburn  8761:         my %displaystatus = ( previous => 'Expired',
                   8762:                               active   => 'Active',
                   8763:                               future   => 'Future',
                   8764:                             );
1.1075.2.36  raeburn  8765:         my (%nothide,@possdoms);
1.630     raeburn  8766:         if ($hidepriv) {
                   8767:             my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
                   8768:             foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
                   8769:                 if ($user !~ /:/) {
                   8770:                     $nothide{join(':',split(/[\@]/,$user))}=1;
                   8771:                 } else {
                   8772:                     $nothide{$user} = 1;
                   8773:                 }
                   8774:             }
1.1075.2.36  raeburn  8775:             my @possdoms = ($cdom);
                   8776:             if ($coursehash{'checkforpriv'}) {
                   8777:                 push(@possdoms,split(/,/,$coursehash{'checkforpriv'}));
                   8778:             }
1.630     raeburn  8779:         }
1.439     raeburn  8780:         foreach my $person (sort(keys(%coursepersonnel))) {
1.288     raeburn  8781:             my $match = 0;
1.412     raeburn  8782:             my $secmatch = 0;
1.439     raeburn  8783:             my $status;
1.412     raeburn  8784:             my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275     raeburn  8785:             $user =~ s/:$//;
1.439     raeburn  8786:             my ($end,$start) = split(/:/,$coursepersonnel{$person});
                   8787:             if ($end == -1 || $start == -1) {
                   8788:                 next;
                   8789:             }
                   8790:             if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
                   8791:                 (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412     raeburn  8792:                 my ($uname,$udom) = split(/:/,$user);
                   8793:                 if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 8794:                     if (grep(/^all$/,@{$sections})) {
1.412     raeburn  8795:                         $secmatch = 1;
                   8796:                     } elsif ($usec eq '') {
1.420     albertel 8797:                         if (grep(/^none$/,@{$sections})) {
1.412     raeburn  8798:                             $secmatch = 1;
                   8799:                         }
                   8800:                     } else {
                   8801:                         if (grep(/^\Q$usec\E$/,@{$sections})) {
                   8802:                             $secmatch = 1;
                   8803:                         }
                   8804:                     }
                   8805:                     if (!$secmatch) {
                   8806:                         next;
                   8807:                     }
1.288     raeburn  8808:                 }
1.419     raeburn  8809:                 if ($usec eq '') {
                   8810:                     $usec = 'none';
                   8811:                 }
1.275     raeburn  8812:                 if ($uname ne '' && $udom ne '') {
1.630     raeburn  8813:                     if ($hidepriv) {
1.1075.2.36  raeburn  8814:                         if ((&Apache::lonnet::privileged($uname,$udom,\@possdoms)) &&
1.630     raeburn  8815:                             (!$nothide{$uname.':'.$udom})) {
                   8816:                             next;
                   8817:                         }
                   8818:                     }
1.503     raeburn  8819:                     if ($end > 0 && $end < $now) {
1.439     raeburn  8820:                         $status = 'previous';
                   8821:                     } elsif ($start > $now) {
                   8822:                         $status = 'future';
                   8823:                     } else {
                   8824:                         $status = 'active';
                   8825:                     }
1.277     albertel 8826:                     foreach my $type (keys(%{$types})) { 
1.275     raeburn  8827:                         if ($status eq $type) {
1.420     albertel 8828:                             if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419     raeburn  8829:                                 push(@{$$users{$role}{$user}},$type);
                   8830:                             }
1.288     raeburn  8831:                             $match = 1;
                   8832:                         }
                   8833:                     }
1.419     raeburn  8834:                     if (($match) && (ref($userdata) eq 'HASH')) {
                   8835:                         if (!exists($$userdata{$uname.':'.$udom})) {
                   8836: 			    &get_user_info($udom,$uname,\%idx,$userdata);
                   8837:                         }
1.420     albertel 8838:                         if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419     raeburn  8839:                             push(@{$seclists{$uname.':'.$udom}},$usec);
                   8840:                         }
1.609     raeburn  8841:                         if (ref($statushash) eq 'HASH') {
                   8842:                             $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
                   8843:                         }
1.275     raeburn  8844:                     }
                   8845:                 }
                   8846:             }
                   8847:         }
1.290     albertel 8848:         if (grep(/^ow$/,@{$roles})) {
1.279     raeburn  8849:             if ((defined($cdom)) && (defined($cnum))) {
                   8850:                 my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
                   8851:                 if ( defined($csettings{'internal.courseowner'}) ) {
                   8852:                     my $owner = $csettings{'internal.courseowner'};
1.609     raeburn  8853:                     next if ($owner eq '');
                   8854:                     my ($ownername,$ownerdom);
                   8855:                     if ($owner =~ /^([^:]+):([^:]+)$/) {
                   8856:                         $ownername = $1;
                   8857:                         $ownerdom = $2;
                   8858:                     } else {
                   8859:                         $ownername = $owner;
                   8860:                         $ownerdom = $cdom;
                   8861:                         $owner = $ownername.':'.$ownerdom;
1.439     raeburn  8862:                     }
                   8863:                     @{$$users{'ow'}{$owner}} = 'any';
1.290     albertel 8864:                     if (defined($userdata) && 
1.609     raeburn  8865: 			!exists($$userdata{$owner})) {
                   8866: 			&get_user_info($ownerdom,$ownername,\%idx,$userdata);
                   8867:                         if (!grep(/^none$/,@{$seclists{$owner}})) {
                   8868:                             push(@{$seclists{$owner}},'none');
                   8869:                         }
                   8870:                         if (ref($statushash) eq 'HASH') {
                   8871:                             $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419     raeburn  8872:                         }
1.290     albertel 8873: 		    }
1.279     raeburn  8874:                 }
                   8875:             }
                   8876:         }
1.419     raeburn  8877:         foreach my $user (keys(%seclists)) {
                   8878:             @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
                   8879:             $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
                   8880:         }
1.275     raeburn  8881:     }
                   8882:     return;
                   8883: }
                   8884: 
1.288     raeburn  8885: sub get_user_info {
                   8886:     my ($udom,$uname,$idx,$userdata) = @_;
1.289     albertel 8887:     $$userdata{$uname.':'.$udom}[$$idx{fullname}] = 
                   8888: 	&plainname($uname,$udom,'lastname');
1.291     albertel 8889:     $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297     raeburn  8890:     $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609     raeburn  8891:     my %idhash =  &Apache::lonnet::idrget($udom,($uname));
                   8892:     $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname}; 
1.288     raeburn  8893:     return;
                   8894: }
1.275     raeburn  8895: 
1.472     raeburn  8896: ###############################################
                   8897: 
                   8898: =pod
                   8899: 
                   8900: =item * &get_user_quota()
                   8901: 
1.1075.2.41  raeburn  8902: Retrieves quota assigned for storage of user files.
                   8903: Default is to report quota for portfolio files.
1.472     raeburn  8904: 
                   8905: Incoming parameters:
                   8906: 1. user's username
                   8907: 2. user's domain
1.1075.2.41  raeburn  8908: 3. quota name - portfolio, author, or course
                   8909:    (if no quota name provided, defaults to portfolio).
1.1075.2.59  raeburn  8910: 4. crstype - official, unofficial, textbook or community, if quota name is
1.1075.2.42  raeburn  8911:    course
1.472     raeburn  8912: 
                   8913: Returns:
1.1075.2.58  raeburn  8914: 1. Disk quota (in MB) assigned to student.
1.536     raeburn  8915: 2. (Optional) Type of setting: custom or default
                   8916:    (individually assigned or default for user's 
                   8917:    institutional status).
                   8918: 3. (Optional) - User's institutional status (e.g., faculty, staff
                   8919:    or student - types as defined in localenroll::inst_usertypes 
                   8920:    for user's domain, which determines default quota for user.
                   8921: 4. (Optional) - Default quota which would apply to the user.
1.472     raeburn  8922: 
                   8923: If a value has been stored in the user's environment, 
1.536     raeburn  8924: it will return that, otherwise it returns the maximal default
1.1075.2.41  raeburn  8925: defined for the user's institutional status(es) in the domain.
1.472     raeburn  8926: 
                   8927: =cut
                   8928: 
                   8929: ###############################################
                   8930: 
                   8931: 
                   8932: sub get_user_quota {
1.1075.2.42  raeburn  8933:     my ($uname,$udom,$quotaname,$crstype) = @_;
1.536     raeburn  8934:     my ($quota,$quotatype,$settingstatus,$defquota);
1.472     raeburn  8935:     if (!defined($udom)) {
                   8936:         $udom = $env{'user.domain'};
                   8937:     }
                   8938:     if (!defined($uname)) {
                   8939:         $uname = $env{'user.name'};
                   8940:     }
                   8941:     if (($udom eq '' || $uname eq '') ||
                   8942:         ($udom eq 'public') && ($uname eq 'public')) {
                   8943:         $quota = 0;
1.536     raeburn  8944:         $quotatype = 'default';
                   8945:         $defquota = 0; 
1.472     raeburn  8946:     } else {
1.536     raeburn  8947:         my $inststatus;
1.1075.2.41  raeburn  8948:         if ($quotaname eq 'course') {
                   8949:             if (($env{'course.'.$udom.'_'.$uname.'.num'} eq $uname) &&
                   8950:                 ($env{'course.'.$udom.'_'.$uname.'.domain'} eq $udom)) {
                   8951:                 $quota = $env{'course.'.$udom.'_'.$uname.'.internal.uploadquota'};
                   8952:             } else {
                   8953:                 my %cenv = &Apache::lonnet::coursedescription("$udom/$uname");
                   8954:                 $quota = $cenv{'internal.uploadquota'};
                   8955:             }
1.536     raeburn  8956:         } else {
1.1075.2.41  raeburn  8957:             if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
                   8958:                 if ($quotaname eq 'author') {
                   8959:                     $quota = $env{'environment.authorquota'};
                   8960:                 } else {
                   8961:                     $quota = $env{'environment.portfolioquota'};
                   8962:                 }
                   8963:                 $inststatus = $env{'environment.inststatus'};
                   8964:             } else {
                   8965:                 my %userenv = 
                   8966:                     &Apache::lonnet::get('environment',['portfolioquota',
                   8967:                                          'authorquota','inststatus'],$udom,$uname);
                   8968:                 my ($tmp) = keys(%userenv);
                   8969:                 if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   8970:                     if ($quotaname eq 'author') {
                   8971:                         $quota = $userenv{'authorquota'};
                   8972:                     } else {
                   8973:                         $quota = $userenv{'portfolioquota'};
                   8974:                     }
                   8975:                     $inststatus = $userenv{'inststatus'};
                   8976:                 } else {
                   8977:                     undef(%userenv);
                   8978:                 }
                   8979:             }
                   8980:         }
                   8981:         if ($quota eq '' || wantarray) {
                   8982:             if ($quotaname eq 'course') {
                   8983:                 my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
1.1075.2.59  raeburn  8984:                 if (($crstype eq 'official') || ($crstype eq 'unofficial') ||
                   8985:                     ($crstype eq 'community') || ($crstype eq 'textbook')) {
1.1075.2.42  raeburn  8986:                     $defquota = $domdefs{$crstype.'quota'};
                   8987:                 }
                   8988:                 if ($defquota eq '') {
                   8989:                     $defquota = 500;
                   8990:                 }
1.1075.2.41  raeburn  8991:             } else {
                   8992:                 ($defquota,$settingstatus) = &default_quota($udom,$inststatus,$quotaname);
                   8993:             }
                   8994:             if ($quota eq '') {
                   8995:                 $quota = $defquota;
                   8996:                 $quotatype = 'default';
                   8997:             } else {
                   8998:                 $quotatype = 'custom';
                   8999:             }
1.472     raeburn  9000:         }
                   9001:     }
1.536     raeburn  9002:     if (wantarray) {
                   9003:         return ($quota,$quotatype,$settingstatus,$defquota);
                   9004:     } else {
                   9005:         return $quota;
                   9006:     }
1.472     raeburn  9007: }
                   9008: 
                   9009: ###############################################
                   9010: 
                   9011: =pod
                   9012: 
                   9013: =item * &default_quota()
                   9014: 
1.536     raeburn  9015: Retrieves default quota assigned for storage of user portfolio files,
                   9016: given an (optional) user's institutional status.
1.472     raeburn  9017: 
                   9018: Incoming parameters:
1.1075.2.42  raeburn  9019: 
1.472     raeburn  9020: 1. domain
1.536     raeburn  9021: 2. (Optional) institutional status(es).  This is a : separated list of 
                   9022:    status types (e.g., faculty, staff, student etc.)
                   9023:    which apply to the user for whom the default is being retrieved.
                   9024:    If the institutional status string in undefined, the domain
1.1075.2.41  raeburn  9025:    default quota will be returned.
                   9026: 3.  quota name - portfolio, author, or course
                   9027:    (if no quota name provided, defaults to portfolio).
1.472     raeburn  9028: 
                   9029: Returns:
1.1075.2.42  raeburn  9030: 
1.1075.2.58  raeburn  9031: 1. Default disk quota (in MB) for user portfolios in the domain.
1.536     raeburn  9032: 2. (Optional) institutional type which determined the value of the
                   9033:    default quota.
1.472     raeburn  9034: 
                   9035: If a value has been stored in the domain's configuration db,
                   9036: it will return that, otherwise it returns 20 (for backwards 
                   9037: compatibility with domains which have not set up a configuration
1.1075.2.58  raeburn  9038: db file; the original statically defined portfolio quota was 20 MB). 
1.472     raeburn  9039: 
1.536     raeburn  9040: If the user's status includes multiple types (e.g., staff and student),
                   9041: the largest default quota which applies to the user determines the
                   9042: default quota returned.
                   9043: 
1.472     raeburn  9044: =cut
                   9045: 
                   9046: ###############################################
                   9047: 
                   9048: 
                   9049: sub default_quota {
1.1075.2.41  raeburn  9050:     my ($udom,$inststatus,$quotaname) = @_;
1.536     raeburn  9051:     my ($defquota,$settingstatus);
                   9052:     my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622     raeburn  9053:                                             ['quotas'],$udom);
1.1075.2.41  raeburn  9054:     my $key = 'defaultquota';
                   9055:     if ($quotaname eq 'author') {
                   9056:         $key = 'authorquota';
                   9057:     }
1.622     raeburn  9058:     if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536     raeburn  9059:         if ($inststatus ne '') {
1.765     raeburn  9060:             my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536     raeburn  9061:             foreach my $item (@statuses) {
1.1075.2.41  raeburn  9062:                 if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
                   9063:                     if ($quotahash{'quotas'}{$key}{$item} ne '') {
1.711     raeburn  9064:                         if ($defquota eq '') {
1.1075.2.41  raeburn  9065:                             $defquota = $quotahash{'quotas'}{$key}{$item};
1.711     raeburn  9066:                             $settingstatus = $item;
1.1075.2.41  raeburn  9067:                         } elsif ($quotahash{'quotas'}{$key}{$item} > $defquota) {
                   9068:                             $defquota = $quotahash{'quotas'}{$key}{$item};
1.711     raeburn  9069:                             $settingstatus = $item;
                   9070:                         }
                   9071:                     }
1.1075.2.41  raeburn  9072:                 } elsif ($key eq 'defaultquota') {
1.711     raeburn  9073:                     if ($quotahash{'quotas'}{$item} ne '') {
                   9074:                         if ($defquota eq '') {
                   9075:                             $defquota = $quotahash{'quotas'}{$item};
                   9076:                             $settingstatus = $item;
                   9077:                         } elsif ($quotahash{'quotas'}{$item} > $defquota) {
                   9078:                             $defquota = $quotahash{'quotas'}{$item};
                   9079:                             $settingstatus = $item;
                   9080:                         }
1.536     raeburn  9081:                     }
                   9082:                 }
                   9083:             }
                   9084:         }
                   9085:         if ($defquota eq '') {
1.1075.2.41  raeburn  9086:             if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
                   9087:                 $defquota = $quotahash{'quotas'}{$key}{'default'};
                   9088:             } elsif ($key eq 'defaultquota') {
1.711     raeburn  9089:                 $defquota = $quotahash{'quotas'}{'default'};
                   9090:             }
1.536     raeburn  9091:             $settingstatus = 'default';
1.1075.2.42  raeburn  9092:             if ($defquota eq '') {
                   9093:                 if ($quotaname eq 'author') {
                   9094:                     $defquota = 500;
                   9095:                 }
                   9096:             }
1.536     raeburn  9097:         }
                   9098:     } else {
                   9099:         $settingstatus = 'default';
1.1075.2.41  raeburn  9100:         if ($quotaname eq 'author') {
                   9101:             $defquota = 500;
                   9102:         } else {
                   9103:             $defquota = 20;
                   9104:         }
1.536     raeburn  9105:     }
                   9106:     if (wantarray) {
                   9107:         return ($defquota,$settingstatus);
1.472     raeburn  9108:     } else {
1.536     raeburn  9109:         return $defquota;
1.472     raeburn  9110:     }
                   9111: }
                   9112: 
1.1075.2.41  raeburn  9113: ###############################################
                   9114: 
                   9115: =pod
                   9116: 
1.1075.2.42  raeburn  9117: =item * &excess_filesize_warning()
1.1075.2.41  raeburn  9118: 
                   9119: Returns warning message if upload of file to authoring space, or copying
1.1075.2.42  raeburn  9120: of existing file within authoring space will cause quota for the authoring
                   9121: space to be exceeded.
                   9122: 
                   9123: Same, if upload of a file directly to a course/community via Course Editor
                   9124: will cause quota for uploaded content for the course to be exceeded.
1.1075.2.41  raeburn  9125: 
1.1075.2.61  raeburn  9126: Inputs: 7 
1.1075.2.42  raeburn  9127: 1. username or coursenum
1.1075.2.41  raeburn  9128: 2. domain
1.1075.2.42  raeburn  9129: 3. context ('author' or 'course')
1.1075.2.41  raeburn  9130: 4. filename of file for which action is being requested
                   9131: 5. filesize (kB) of file
                   9132: 6. action being taken: copy or upload.
1.1075.2.59  raeburn  9133: 7. quotatype (in course context -- official, unofficial, community or textbook).
1.1075.2.41  raeburn  9134: 
                   9135: Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,
                   9136:          otherwise return null.
                   9137: 
1.1075.2.42  raeburn  9138: =back
                   9139: 
1.1075.2.41  raeburn  9140: =cut
                   9141: 
1.1075.2.42  raeburn  9142: sub excess_filesize_warning {
1.1075.2.59  raeburn  9143:     my ($uname,$udom,$context,$filename,$filesize,$action,$quotatype) = @_;
1.1075.2.42  raeburn  9144:     my $current_disk_usage = 0;
1.1075.2.59  raeburn  9145:     my $disk_quota = &get_user_quota($uname,$udom,$context,$quotatype); #expressed in MB
1.1075.2.42  raeburn  9146:     if ($context eq 'author') {
                   9147:         my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname";
                   9148:         $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$authorspace);
                   9149:     } else {
                   9150:         foreach my $subdir ('docs','supplemental') {
                   9151:             $current_disk_usage += &Apache::lonnet::diskusage($udom,$uname,"userfiles/$subdir",1);
                   9152:         }
                   9153:     }
1.1075.2.41  raeburn  9154:     $disk_quota = int($disk_quota * 1000);
                   9155:     if (($current_disk_usage + $filesize) > $disk_quota) {
1.1075.2.69  raeburn  9156:         return '<p class="LC_warning">'.
1.1075.2.41  raeburn  9157:                 &mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.",
1.1075.2.69  raeburn  9158:                     '<span class="LC_filename">'.$filename.'</span>',$filesize).'</p>'.
                   9159:                '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
1.1075.2.41  raeburn  9160:                             $disk_quota,$current_disk_usage).
                   9161:                '</p>';
                   9162:     }
                   9163:     return;
                   9164: }
                   9165: 
                   9166: ###############################################
                   9167: 
                   9168: 
1.384     raeburn  9169: sub get_secgrprole_info {
                   9170:     my ($cdom,$cnum,$needroles,$type)  = @_;
                   9171:     my %sections_count = &get_sections($cdom,$cnum);
                   9172:     my @sections =  (sort {$a <=> $b} keys(%sections_count));
                   9173:     my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
                   9174:     my @groups = sort(keys(%curr_groups));
                   9175:     my $allroles = [];
                   9176:     my $rolehash;
                   9177:     my $accesshash = {
                   9178:                      active => 'Currently has access',
                   9179:                      future => 'Will have future access',
                   9180:                      previous => 'Previously had access',
                   9181:                   };
                   9182:     if ($needroles) {
                   9183:         $rolehash = {'all' => 'all'};
1.385     albertel 9184:         my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   9185: 	if (&Apache::lonnet::error(%user_roles)) {
                   9186: 	    undef(%user_roles);
                   9187: 	}
                   9188:         foreach my $item (keys(%user_roles)) {
1.384     raeburn  9189:             my ($role)=split(/\:/,$item,2);
                   9190:             if ($role eq 'cr') { next; }
                   9191:             if ($role =~ /^cr/) {
                   9192:                 $$rolehash{$role} = (split('/',$role))[3];
                   9193:             } else {
                   9194:                 $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
                   9195:             }
                   9196:         }
                   9197:         foreach my $key (sort(keys(%{$rolehash}))) {
                   9198:             push(@{$allroles},$key);
                   9199:         }
                   9200:         push (@{$allroles},'st');
                   9201:         $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
                   9202:     }
                   9203:     return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
                   9204: }
                   9205: 
1.555     raeburn  9206: sub user_picker {
1.994     raeburn  9207:     my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context) = @_;
1.555     raeburn  9208:     my $currdom = $dom;
                   9209:     my %curr_selected = (
                   9210:                         srchin => 'dom',
1.580     raeburn  9211:                         srchby => 'lastname',
1.555     raeburn  9212:                       );
                   9213:     my $srchterm;
1.625     raeburn  9214:     if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555     raeburn  9215:         if ($srch->{'srchby'} ne '') {
                   9216:             $curr_selected{'srchby'} = $srch->{'srchby'};
                   9217:         }
                   9218:         if ($srch->{'srchin'} ne '') {
                   9219:             $curr_selected{'srchin'} = $srch->{'srchin'};
                   9220:         }
                   9221:         if ($srch->{'srchtype'} ne '') {
                   9222:             $curr_selected{'srchtype'} = $srch->{'srchtype'};
                   9223:         }
                   9224:         if ($srch->{'srchdomain'} ne '') {
                   9225:             $currdom = $srch->{'srchdomain'};
                   9226:         }
                   9227:         $srchterm = $srch->{'srchterm'};
                   9228:     }
1.1075.2.98  raeburn  9229:     my %html_lt=&Apache::lonlocal::texthash(
1.573     raeburn  9230:                     'usr'       => 'Search criteria',
1.563     raeburn  9231:                     'doma'      => 'Domain/institution to search',
1.558     albertel 9232:                     'uname'     => 'username',
                   9233:                     'lastname'  => 'last name',
1.555     raeburn  9234:                     'lastfirst' => 'last name, first name',
1.558     albertel 9235:                     'crs'       => 'in this course',
1.576     raeburn  9236:                     'dom'       => 'in selected LON-CAPA domain', 
1.558     albertel 9237:                     'alc'       => 'all LON-CAPA',
1.573     raeburn  9238:                     'instd'     => 'in institutional directory for selected domain',
1.558     albertel 9239:                     'exact'     => 'is',
                   9240:                     'contains'  => 'contains',
1.569     raeburn  9241:                     'begins'    => 'begins with',
1.1075.2.98  raeburn  9242:                                        );
                   9243:     my %js_lt=&Apache::lonlocal::texthash(
1.571     raeburn  9244:                     'youm'      => "You must include some text to search for.",
                   9245:                     'thte'      => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
                   9246:                     'thet'      => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
                   9247:                     'yomc'      => "You must choose a domain when using an institutional directory search.",
                   9248:                     'ymcd'      => "You must choose a domain when using a domain search.",
                   9249:                     'whus'      => "When using searching by last,first you must include a comma as separator between last name and first name.",
                   9250:                     'whse'      => "When searching by last,first you must include at least one character in the first name.",
                   9251:                      'thfo'     => "The following need to be corrected before the search can be run:",
1.555     raeburn  9252:                                        );
1.1075.2.98  raeburn  9253:     &html_escape(\%html_lt);
                   9254:     &js_escape(\%js_lt);
1.563     raeburn  9255:     my $domform = &select_dom_form($currdom,'srchdomain',1,1);
                   9256:     my $srchinsel = ' <select name="srchin">';
1.555     raeburn  9257: 
                   9258:     my @srchins = ('crs','dom','alc','instd');
                   9259: 
                   9260:     foreach my $option (@srchins) {
                   9261:         # FIXME 'alc' option unavailable until 
                   9262:         #       loncreateuser::print_user_query_page()
                   9263:         #       has been completed.
                   9264:         next if ($option eq 'alc');
1.880     raeburn  9265:         next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));  
1.555     raeburn  9266:         next if ($option eq 'crs' && !$env{'request.course.id'});
1.563     raeburn  9267:         if ($curr_selected{'srchin'} eq $option) {
                   9268:             $srchinsel .= ' 
1.1075.2.98  raeburn  9269:    <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.563     raeburn  9270:         } else {
                   9271:             $srchinsel .= '
1.1075.2.98  raeburn  9272:    <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.563     raeburn  9273:         }
1.555     raeburn  9274:     }
1.563     raeburn  9275:     $srchinsel .= "\n  </select>\n";
1.555     raeburn  9276: 
                   9277:     my $srchbysel =  ' <select name="srchby">';
1.580     raeburn  9278:     foreach my $option ('lastname','lastfirst','uname') {
1.555     raeburn  9279:         if ($curr_selected{'srchby'} eq $option) {
                   9280:             $srchbysel .= '
1.1075.2.98  raeburn  9281:    <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555     raeburn  9282:         } else {
                   9283:             $srchbysel .= '
1.1075.2.98  raeburn  9284:    <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555     raeburn  9285:          }
                   9286:     }
                   9287:     $srchbysel .= "\n  </select>\n";
                   9288: 
                   9289:     my $srchtypesel = ' <select name="srchtype">';
1.580     raeburn  9290:     foreach my $option ('begins','contains','exact') {
1.555     raeburn  9291:         if ($curr_selected{'srchtype'} eq $option) {
                   9292:             $srchtypesel .= '
1.1075.2.98  raeburn  9293:    <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555     raeburn  9294:         } else {
                   9295:             $srchtypesel .= '
1.1075.2.98  raeburn  9296:    <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555     raeburn  9297:         }
                   9298:     }
                   9299:     $srchtypesel .= "\n  </select>\n";
                   9300: 
1.558     albertel 9301:     my ($newuserscript,$new_user_create);
1.994     raeburn  9302:     my $context_dom = $env{'request.role.domain'};
                   9303:     if ($context eq 'requestcrs') {
                   9304:         if ($env{'form.coursedom'} ne '') { 
                   9305:             $context_dom = $env{'form.coursedom'};
                   9306:         }
                   9307:     }
1.556     raeburn  9308:     if ($forcenewuser) {
1.576     raeburn  9309:         if (ref($srch) eq 'HASH') {
1.994     raeburn  9310:             if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627     raeburn  9311:                 if ($cancreate) {
                   9312:                     $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>';
                   9313:                 } else {
1.799     bisitz   9314:                     my $helplink = 'javascript:helpMenu('."'display'".')';
1.627     raeburn  9315:                     my %usertypetext = (
                   9316:                         official   => 'institutional',
                   9317:                         unofficial => 'non-institutional',
                   9318:                     );
1.799     bisitz   9319:                     $new_user_create = '<p class="LC_warning">'
                   9320:                                       .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
                   9321:                                       .' '
                   9322:                                       .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
                   9323:                                           ,'<a href="'.$helplink.'">','</a>')
                   9324:                                       .'</p><br />';
1.627     raeburn  9325:                 }
1.576     raeburn  9326:             }
                   9327:         }
                   9328: 
1.556     raeburn  9329:         $newuserscript = <<"ENDSCRIPT";
                   9330: 
1.570     raeburn  9331: function setSearch(createnew,callingForm) {
1.556     raeburn  9332:     if (createnew == 1) {
1.570     raeburn  9333:         for (var i=0; i<callingForm.srchby.length; i++) {
                   9334:             if (callingForm.srchby.options[i].value == 'uname') {
                   9335:                 callingForm.srchby.selectedIndex = i;
1.556     raeburn  9336:             }
                   9337:         }
1.570     raeburn  9338:         for (var i=0; i<callingForm.srchin.length; i++) {
                   9339:             if ( callingForm.srchin.options[i].value == 'dom') {
                   9340: 		callingForm.srchin.selectedIndex = i;
1.556     raeburn  9341:             }
                   9342:         }
1.570     raeburn  9343:         for (var i=0; i<callingForm.srchtype.length; i++) {
                   9344:             if (callingForm.srchtype.options[i].value == 'exact') {
                   9345:                 callingForm.srchtype.selectedIndex = i;
1.556     raeburn  9346:             }
                   9347:         }
1.570     raeburn  9348:         for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994     raeburn  9349:             if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570     raeburn  9350:                 callingForm.srchdomain.selectedIndex = i;
1.556     raeburn  9351:             }
                   9352:         }
                   9353:     }
                   9354: }
                   9355: ENDSCRIPT
1.558     albertel 9356: 
1.556     raeburn  9357:     }
                   9358: 
1.555     raeburn  9359:     my $output = <<"END_BLOCK";
1.556     raeburn  9360: <script type="text/javascript">
1.824     bisitz   9361: // <![CDATA[
1.570     raeburn  9362: function validateEntry(callingForm) {
1.558     albertel 9363: 
1.556     raeburn  9364:     var checkok = 1;
1.558     albertel 9365:     var srchin;
1.570     raeburn  9366:     for (var i=0; i<callingForm.srchin.length; i++) {
                   9367: 	if ( callingForm.srchin[i].checked ) {
                   9368: 	    srchin = callingForm.srchin[i].value;
1.558     albertel 9369: 	}
                   9370:     }
                   9371: 
1.570     raeburn  9372:     var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
                   9373:     var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
                   9374:     var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
                   9375:     var srchterm =  callingForm.srchterm.value;
                   9376:     var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556     raeburn  9377:     var msg = "";
                   9378: 
                   9379:     if (srchterm == "") {
                   9380:         checkok = 0;
1.1075.2.98  raeburn  9381:         msg += "$js_lt{'youm'}\\n";
1.556     raeburn  9382:     }
                   9383: 
1.569     raeburn  9384:     if (srchtype== 'begins') {
                   9385:         if (srchterm.length < 2) {
                   9386:             checkok = 0;
1.1075.2.98  raeburn  9387:             msg += "$js_lt{'thte'}\\n";
1.569     raeburn  9388:         }
                   9389:     }
                   9390: 
1.556     raeburn  9391:     if (srchtype== 'contains') {
                   9392:         if (srchterm.length < 3) {
                   9393:             checkok = 0;
1.1075.2.98  raeburn  9394:             msg += "$js_lt{'thet'}\\n";
1.556     raeburn  9395:         }
                   9396:     }
                   9397:     if (srchin == 'instd') {
                   9398:         if (srchdomain == '') {
                   9399:             checkok = 0;
1.1075.2.98  raeburn  9400:             msg += "$js_lt{'yomc'}\\n";
1.556     raeburn  9401:         }
                   9402:     }
                   9403:     if (srchin == 'dom') {
                   9404:         if (srchdomain == '') {
                   9405:             checkok = 0;
1.1075.2.98  raeburn  9406:             msg += "$js_lt{'ymcd'}\\n";
1.556     raeburn  9407:         }
                   9408:     }
                   9409:     if (srchby == 'lastfirst') {
                   9410:         if (srchterm.indexOf(",") == -1) {
                   9411:             checkok = 0;
1.1075.2.98  raeburn  9412:             msg += "$js_lt{'whus'}\\n";
1.556     raeburn  9413:         }
                   9414:         if (srchterm.indexOf(",") == srchterm.length -1) {
                   9415:             checkok = 0;
1.1075.2.98  raeburn  9416:             msg += "$js_lt{'whse'}\\n";
1.556     raeburn  9417:         }
                   9418:     }
                   9419:     if (checkok == 0) {
1.1075.2.98  raeburn  9420:         alert("$js_lt{'thfo'}\\n"+msg);
1.556     raeburn  9421:         return;
                   9422:     }
                   9423:     if (checkok == 1) {
1.570     raeburn  9424:         callingForm.submit();
1.556     raeburn  9425:     }
                   9426: }
                   9427: 
                   9428: $newuserscript
                   9429: 
1.824     bisitz   9430: // ]]>
1.556     raeburn  9431: </script>
1.558     albertel 9432: 
                   9433: $new_user_create
                   9434: 
1.555     raeburn  9435: END_BLOCK
1.558     albertel 9436: 
1.876     raeburn  9437:     $output .= &Apache::lonhtmlcommon::start_pick_box().
1.1075.2.98  raeburn  9438:                &Apache::lonhtmlcommon::row_title($html_lt{'doma'}).
1.876     raeburn  9439:                $domform.
                   9440:                &Apache::lonhtmlcommon::row_closure().
1.1075.2.98  raeburn  9441:                &Apache::lonhtmlcommon::row_title($html_lt{'usr'}).
1.876     raeburn  9442:                $srchbysel.
                   9443:                $srchtypesel. 
                   9444:                '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
                   9445:                $srchinsel.
                   9446:                &Apache::lonhtmlcommon::row_closure(1). 
                   9447:                &Apache::lonhtmlcommon::end_pick_box().
                   9448:                '<br />';
1.555     raeburn  9449:     return $output;
                   9450: }
                   9451: 
1.612     raeburn  9452: sub user_rule_check {
1.615     raeburn  9453:     my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.1075.2.99  raeburn  9454:     my ($response,%inst_response);
1.612     raeburn  9455:     if (ref($usershash) eq 'HASH') {
1.1075.2.99  raeburn  9456:         if (keys(%{$usershash}) > 1) {
                   9457:             my (%by_username,%by_id,%userdoms);
                   9458:             my $checkid;
1.612     raeburn  9459:             if (ref($checks) eq 'HASH') {
1.1075.2.99  raeburn  9460:                 if ((!defined($checks->{'username'})) && (defined($checks->{'id'}))) {
                   9461:                     $checkid = 1;
                   9462:                 }
                   9463:             }
                   9464:             foreach my $user (keys(%{$usershash})) {
                   9465:                 my ($uname,$udom) = split(/:/,$user);
                   9466:                 if ($checkid) {
                   9467:                     if (ref($usershash->{$user}) eq 'HASH') {
                   9468:                         if ($usershash->{$user}->{'id'} ne '') {
                   9469:                             $by_id{$udom}{$usershash->{$user}->{'id'}} = $uname;
                   9470:                             $userdoms{$udom} = 1;
                   9471:                             if (ref($inst_results) eq 'HASH') {
                   9472:                                 $inst_results->{$uname.':'.$udom} = {};
                   9473:                             }
                   9474:                         }
                   9475:                     }
                   9476:                 } else {
                   9477:                     $by_username{$udom}{$uname} = 1;
                   9478:                     $userdoms{$udom} = 1;
                   9479:                     if (ref($inst_results) eq 'HASH') {
                   9480:                         $inst_results->{$uname.':'.$udom} = {};
                   9481:                     }
                   9482:                 }
                   9483:             }
                   9484:             foreach my $udom (keys(%userdoms)) {
                   9485:                 if (!$got_rules->{$udom}) {
                   9486:                     my %domconfig = &Apache::lonnet::get_dom('configuration',
                   9487:                                                              ['usercreation'],$udom);
                   9488:                     if (ref($domconfig{'usercreation'}) eq 'HASH') {
                   9489:                         foreach my $item ('username','id') {
                   9490:                             if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
                   9491:                                 $$curr_rules{$udom}{$item} =
                   9492:                                     $domconfig{'usercreation'}{$item.'_rule'};
                   9493:                             }
                   9494:                         }
                   9495:                     }
                   9496:                     $got_rules->{$udom} = 1;
                   9497:                 }
                   9498:             }
                   9499:             if ($checkid) {
                   9500:                 foreach my $udom (keys(%by_id)) {
                   9501:                     my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_id{$udom},'id');
                   9502:                     if ($outcome eq 'ok') {
                   9503:                         foreach my $id (keys(%{$by_id{$udom}})) {
                   9504:                             my $uname = $by_id{$udom}{$id};
                   9505:                             $inst_response{$uname.':'.$udom} = $outcome;
                   9506:                         }
                   9507:                         if (ref($results) eq 'HASH') {
                   9508:                             foreach my $uname (keys(%{$results})) {
                   9509:                                 if (exists($inst_response{$uname.':'.$udom})) {
                   9510:                                     $inst_response{$uname.':'.$udom} = $outcome;
                   9511:                                     $inst_results->{$uname.':'.$udom} = $results->{$uname};
                   9512:                                 }
                   9513:                             }
                   9514:                         }
                   9515:                     }
1.612     raeburn  9516:                 }
1.615     raeburn  9517:             } else {
1.1075.2.99  raeburn  9518:                 foreach my $udom (keys(%by_username)) {
                   9519:                     my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_username{$udom});
                   9520:                     if ($outcome eq 'ok') {
                   9521:                         foreach my $uname (keys(%{$by_username{$udom}})) {
                   9522:                             $inst_response{$uname.':'.$udom} = $outcome;
                   9523:                         }
                   9524:                         if (ref($results) eq 'HASH') {
                   9525:                             foreach my $uname (keys(%{$results})) {
                   9526:                                 $inst_results->{$uname.':'.$udom} = $results->{$uname};
                   9527:                             }
                   9528:                         }
                   9529:                     }
                   9530:                 }
1.612     raeburn  9531:             }
1.1075.2.99  raeburn  9532:         } elsif (keys(%{$usershash}) == 1) {
                   9533:             my $user = (keys(%{$usershash}))[0];
                   9534:             my ($uname,$udom) = split(/:/,$user);
                   9535:             if (($udom ne '') && ($uname ne '')) {
                   9536:                 if (ref($usershash->{$user}) eq 'HASH') {
                   9537:                     if (ref($checks) eq 'HASH') {
                   9538:                         if (defined($checks->{'username'})) {
                   9539:                             ($inst_response{$user},%{$inst_results->{$user}}) =
                   9540:                                 &Apache::lonnet::get_instuser($udom,$uname);
                   9541:                         } elsif (defined($checks->{'id'})) {
                   9542:                             if ($usershash->{$user}->{'id'} ne '') {
                   9543:                                 ($inst_response{$user},%{$inst_results->{$user}}) =
                   9544:                                     &Apache::lonnet::get_instuser($udom,undef,
                   9545:                                                                   $usershash->{$user}->{'id'});
                   9546:                             } else {
                   9547:                                 ($inst_response{$user},%{$inst_results->{$user}}) =
                   9548:                                     &Apache::lonnet::get_instuser($udom,$uname);
                   9549:                             }
                   9550:                         }
                   9551:                     } else {
                   9552:                        ($inst_response{$user},%{$inst_results->{$user}}) =
                   9553:                             &Apache::lonnet::get_instuser($udom,$uname);
                   9554:                        return;
                   9555:                     }
                   9556:                     if (!$got_rules->{$udom}) {
                   9557:                         my %domconfig = &Apache::lonnet::get_dom('configuration',
                   9558:                                                                  ['usercreation'],$udom);
                   9559:                         if (ref($domconfig{'usercreation'}) eq 'HASH') {
                   9560:                             foreach my $item ('username','id') {
                   9561:                                 if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
                   9562:                                    $$curr_rules{$udom}{$item} =
                   9563:                                        $domconfig{'usercreation'}{$item.'_rule'};
                   9564:                                 }
                   9565:                             }
1.585     raeburn  9566:                         }
1.1075.2.99  raeburn  9567:                         $got_rules->{$udom} = 1;
1.585     raeburn  9568:                     }
                   9569:                 }
1.1075.2.99  raeburn  9570:             } else {
                   9571:                 return;
                   9572:             }
                   9573:         } else {
                   9574:             return;
                   9575:         }
                   9576:         foreach my $user (keys(%{$usershash})) {
                   9577:             my ($uname,$udom) = split(/:/,$user);
                   9578:             next if (($udom eq '') || ($uname eq ''));
                   9579:             my $id;
                   9580:             if (ref($inst_results) eq 'HASH') {
                   9581:                 if (ref($inst_results->{$user}) eq 'HASH') {
                   9582:                     $id = $inst_results->{$user}->{'id'};
                   9583:                 }
                   9584:             }
                   9585:             if ($id eq '') {
                   9586:                 if (ref($usershash->{$user})) {
                   9587:                     $id = $usershash->{$user}->{'id'};
                   9588:                 }
1.585     raeburn  9589:             }
1.612     raeburn  9590:             foreach my $item (keys(%{$checks})) {
                   9591:                 if (ref($$curr_rules{$udom}) eq 'HASH') {
                   9592:                     if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
                   9593:                         if (@{$$curr_rules{$udom}{$item}} > 0) {
1.1075.2.99  raeburn  9594:                             my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,
                   9595:                                                                              $$curr_rules{$udom}{$item});
1.612     raeburn  9596:                             foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
                   9597:                                 if ($rule_check{$rule}) {
                   9598:                                     $$rulematch{$user}{$item} = $rule;
1.1075.2.99  raeburn  9599:                                     if ($inst_response{$user} eq 'ok') {
1.615     raeburn  9600:                                         if (ref($inst_results) eq 'HASH') {
                   9601:                                             if (ref($inst_results->{$user}) eq 'HASH') {
                   9602:                                                 if (keys(%{$inst_results->{$user}}) == 0) {
                   9603:                                                     $$alerts{$item}{$udom}{$uname} = 1;
1.1075.2.99  raeburn  9604:                                                 } elsif ($item eq 'id') {
                   9605:                                                     if ($inst_results->{$user}->{'id'} eq '') {
                   9606:                                                         $$alerts{$item}{$udom}{$uname} = 1;
                   9607:                                                     }
1.615     raeburn  9608:                                                 }
1.612     raeburn  9609:                                             }
                   9610:                                         }
1.615     raeburn  9611:                                     }
                   9612:                                     last;
1.585     raeburn  9613:                                 }
                   9614:                             }
                   9615:                         }
                   9616:                     }
                   9617:                 }
                   9618:             }
                   9619:         }
                   9620:     }
1.612     raeburn  9621:     return;
                   9622: }
                   9623: 
                   9624: sub user_rule_formats {
                   9625:     my ($domain,$domdesc,$curr_rules,$check) = @_;
                   9626:     my %text = ( 
                   9627:                  'username' => 'Usernames',
                   9628:                  'id'       => 'IDs',
                   9629:                );
                   9630:     my $output;
                   9631:     my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
                   9632:     if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
                   9633:         if (@{$ruleorder} > 0) {
1.1075.2.20  raeburn  9634:             $output = '<br />'.
                   9635:                       &mt($text{$check}.' with the following format(s) may [_1]only[_2] be used for verified users at [_3]:',
                   9636:                           '<span class="LC_cusr_emph">','</span>',$domdesc).
                   9637:                       ' <ul>';
1.612     raeburn  9638:             foreach my $rule (@{$ruleorder}) {
                   9639:                 if (ref($curr_rules) eq 'ARRAY') {
                   9640:                     if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
                   9641:                         if (ref($rules->{$rule}) eq 'HASH') {
                   9642:                             $output .= '<li>'.$rules->{$rule}{'name'}.': '.
                   9643:                                         $rules->{$rule}{'desc'}.'</li>';
                   9644:                         }
                   9645:                     }
                   9646:                 }
                   9647:             }
                   9648:             $output .= '</ul>';
                   9649:         }
                   9650:     }
                   9651:     return $output;
                   9652: }
                   9653: 
                   9654: sub instrule_disallow_msg {
1.615     raeburn  9655:     my ($checkitem,$domdesc,$count,$mode) = @_;
1.612     raeburn  9656:     my $response;
                   9657:     my %text = (
                   9658:                   item   => 'username',
                   9659:                   items  => 'usernames',
                   9660:                   match  => 'matches',
                   9661:                   do     => 'does',
                   9662:                   action => 'a username',
                   9663:                   one    => 'one',
                   9664:                );
                   9665:     if ($count > 1) {
                   9666:         $text{'item'} = 'usernames';
                   9667:         $text{'match'} ='match';
                   9668:         $text{'do'} = 'do';
                   9669:         $text{'action'} = 'usernames',
                   9670:         $text{'one'} = 'ones';
                   9671:     }
                   9672:     if ($checkitem eq 'id') {
                   9673:         $text{'items'} = 'IDs';
                   9674:         $text{'item'} = 'ID';
                   9675:         $text{'action'} = 'an ID';
1.615     raeburn  9676:         if ($count > 1) {
                   9677:             $text{'item'} = 'IDs';
                   9678:             $text{'action'} = 'IDs';
                   9679:         }
1.612     raeburn  9680:     }
1.674     bisitz   9681:     $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  9682:     if ($mode eq 'upload') {
                   9683:         if ($checkitem eq 'username') {
                   9684:             $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'}.");
                   9685:         } elsif ($checkitem eq 'id') {
1.674     bisitz   9686:             $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  9687:         }
1.669     raeburn  9688:     } elsif ($mode eq 'selfcreate') {
                   9689:         if ($checkitem eq 'id') {
                   9690:             $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.");
                   9691:         }
1.615     raeburn  9692:     } else {
                   9693:         if ($checkitem eq 'username') {
                   9694:             $response .= &mt("You must choose $text{'action'} with a different format --  $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
                   9695:         } elsif ($checkitem eq 'id') {
                   9696:             $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.");
                   9697:         }
1.612     raeburn  9698:     }
                   9699:     return $response;
1.585     raeburn  9700: }
                   9701: 
1.624     raeburn  9702: sub personal_data_fieldtitles {
                   9703:     my %fieldtitles = &Apache::lonlocal::texthash (
                   9704:                         id => 'Student/Employee ID',
                   9705:                         permanentemail => 'E-mail address',
                   9706:                         lastname => 'Last Name',
                   9707:                         firstname => 'First Name',
                   9708:                         middlename => 'Middle Name',
                   9709:                         generation => 'Generation',
                   9710:                         gen => 'Generation',
1.765     raeburn  9711:                         inststatus => 'Affiliation',
1.624     raeburn  9712:                    );
                   9713:     return %fieldtitles;
                   9714: }
                   9715: 
1.642     raeburn  9716: sub sorted_inst_types {
                   9717:     my ($dom) = @_;
1.1075.2.70  raeburn  9718:     my ($usertypes,$order);
                   9719:     my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
                   9720:     if (ref($domdefaults{'inststatus'}) eq 'HASH') {
                   9721:         $usertypes = $domdefaults{'inststatus'}{'inststatustypes'};
                   9722:         $order = $domdefaults{'inststatus'}{'inststatusorder'};
                   9723:     } else {
                   9724:         ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
                   9725:     }
1.642     raeburn  9726:     my $othertitle = &mt('All users');
                   9727:     if ($env{'request.course.id'}) {
1.668     raeburn  9728:         $othertitle  = &mt('Any users');
1.642     raeburn  9729:     }
                   9730:     my @types;
                   9731:     if (ref($order) eq 'ARRAY') {
                   9732:         @types = @{$order};
                   9733:     }
                   9734:     if (@types == 0) {
                   9735:         if (ref($usertypes) eq 'HASH') {
                   9736:             @types = sort(keys(%{$usertypes}));
                   9737:         }
                   9738:     }
                   9739:     if (keys(%{$usertypes}) > 0) {
                   9740:         $othertitle = &mt('Other users');
                   9741:     }
                   9742:     return ($othertitle,$usertypes,\@types);
                   9743: }
                   9744: 
1.645     raeburn  9745: sub get_institutional_codes {
                   9746:     my ($settings,$allcourses,$LC_code) = @_;
                   9747: # Get complete list of course sections to update
                   9748:     my @currsections = ();
                   9749:     my @currxlists = ();
                   9750:     my $coursecode = $$settings{'internal.coursecode'};
                   9751: 
                   9752:     if ($$settings{'internal.sectionnums'} ne '') {
                   9753:         @currsections = split(/,/,$$settings{'internal.sectionnums'});
                   9754:     }
                   9755: 
                   9756:     if ($$settings{'internal.crosslistings'} ne '') {
                   9757:         @currxlists = split(/,/,$$settings{'internal.crosslistings'});
                   9758:     }
                   9759: 
                   9760:     if (@currxlists > 0) {
                   9761:         foreach (@currxlists) {
                   9762:             if (m/^([^:]+):(\w*)$/) {
                   9763:                 unless (grep/^$1$/,@{$allcourses}) {
                   9764:                     push @{$allcourses},$1;
                   9765:                     $$LC_code{$1} = $2;
                   9766:                 }
                   9767:             }
                   9768:         }
                   9769:     }
                   9770:  
                   9771:     if (@currsections > 0) {
                   9772:         foreach (@currsections) {
                   9773:             if (m/^(\w+):(\w*)$/) {
                   9774:                 my $sec = $coursecode.$1;
                   9775:                 my $lc_sec = $2;
                   9776:                 unless (grep/^$sec$/,@{$allcourses}) {
                   9777:                     push @{$allcourses},$sec;
                   9778:                     $$LC_code{$sec} = $lc_sec;
                   9779:                 }
                   9780:             }
                   9781:         }
                   9782:     }
                   9783:     return;
                   9784: }
                   9785: 
1.971     raeburn  9786: sub get_standard_codeitems {
                   9787:     return ('Year','Semester','Department','Number','Section');
                   9788: }
                   9789: 
1.112     bowersj2 9790: =pod
                   9791: 
1.780     raeburn  9792: =head1 Slot Helpers
                   9793: 
                   9794: =over 4
                   9795: 
                   9796: =item * sorted_slots()
                   9797: 
1.1040    raeburn  9798: Sorts an array of slot names in order of an optional sort key,
                   9799: default sort is by slot start time (earliest first). 
1.780     raeburn  9800: 
                   9801: Inputs:
                   9802: 
                   9803: =over 4
                   9804: 
                   9805: slotsarr  - Reference to array of unsorted slot names.
                   9806: 
                   9807: slots     - Reference to hash of hash, where outer hash keys are slot names.
                   9808: 
1.1040    raeburn  9809: sortkey   - Name of key in inner hash to be sorted on (e.g., starttime).
                   9810: 
1.549     albertel 9811: =back
                   9812: 
1.780     raeburn  9813: Returns:
                   9814: 
                   9815: =over 4
                   9816: 
1.1040    raeburn  9817: sorted   - An array of slot names sorted by a specified sort key 
                   9818:            (default sort key is start time of the slot).
1.780     raeburn  9819: 
                   9820: =back
                   9821: 
                   9822: =cut
                   9823: 
                   9824: 
                   9825: sub sorted_slots {
1.1040    raeburn  9826:     my ($slotsarr,$slots,$sortkey) = @_;
                   9827:     if ($sortkey eq '') {
                   9828:         $sortkey = 'starttime';
                   9829:     }
1.780     raeburn  9830:     my @sorted;
                   9831:     if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
                   9832:         @sorted =
                   9833:             sort {
                   9834:                      if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040    raeburn  9835:                          return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780     raeburn  9836:                      }
                   9837:                      if (ref($slots->{$a})) { return -1;}
                   9838:                      if (ref($slots->{$b})) { return 1;}
                   9839:                      return 0;
                   9840:                  } @{$slotsarr};
                   9841:     }
                   9842:     return @sorted;
                   9843: }
                   9844: 
1.1040    raeburn  9845: =pod
                   9846: 
                   9847: =item * get_future_slots()
                   9848: 
                   9849: Inputs:
                   9850: 
                   9851: =over 4
                   9852: 
                   9853: cnum - course number
                   9854: 
                   9855: cdom - course domain
                   9856: 
                   9857: now - current UNIX time
                   9858: 
                   9859: symb - optional symb
                   9860: 
                   9861: =back
                   9862: 
                   9863: Returns:
                   9864: 
                   9865: =over 4
                   9866: 
                   9867: sorted_reservable - ref to array of student_schedulable slots currently 
                   9868:                     reservable, ordered by end date of reservation period.
                   9869: 
                   9870: reservable_now - ref to hash of student_schedulable slots currently
                   9871:                  reservable.
                   9872: 
                   9873:     Keys in inner hash are:
                   9874:     (a) symb: either blank or symb to which slot use is restricted.
                   9875:     (b) endreserve: end date of reservation period. 
                   9876: 
                   9877: sorted_future - ref to array of student_schedulable slots reservable in
                   9878:                 the future, ordered by start date of reservation period.
                   9879: 
                   9880: future_reservable - ref to hash of student_schedulable slots reservable
                   9881:                     in the future.
                   9882: 
                   9883:     Keys in inner hash are:
                   9884:     (a) symb: either blank or symb to which slot use is restricted.
                   9885:     (b) startreserve:  start date of reservation period.
                   9886: 
                   9887: =back
                   9888: 
                   9889: =cut
                   9890: 
                   9891: sub get_future_slots {
                   9892:     my ($cnum,$cdom,$now,$symb) = @_;
                   9893:     my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
                   9894:     my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
                   9895:     foreach my $slot (keys(%slots)) {
                   9896:         next unless($slots{$slot}->{'type'} eq 'schedulable_student');
                   9897:         if ($symb) {
                   9898:             next if (($slots{$slot}->{'symb'} ne '') && 
                   9899:                      ($slots{$slot}->{'symb'} ne $symb));
                   9900:         }
                   9901:         if (($slots{$slot}->{'starttime'} > $now) &&
                   9902:             ($slots{$slot}->{'endtime'} > $now)) {
                   9903:             if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
                   9904:                 my $userallowed = 0;
                   9905:                 if ($slots{$slot}->{'allowedsections'}) {
                   9906:                     my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
                   9907:                     if (!defined($env{'request.role.sec'})
                   9908:                         && grep(/^No section assigned$/,@allowed_sec)) {
                   9909:                         $userallowed=1;
                   9910:                     } else {
                   9911:                         if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
                   9912:                             $userallowed=1;
                   9913:                         }
                   9914:                     }
                   9915:                     unless ($userallowed) {
                   9916:                         if (defined($env{'request.course.groups'})) {
                   9917:                             my @groups = split(/:/,$env{'request.course.groups'});
                   9918:                             foreach my $group (@groups) {
                   9919:                                 if (grep(/^\Q$group\E$/,@allowed_sec)) {
                   9920:                                     $userallowed=1;
                   9921:                                     last;
                   9922:                                 }
                   9923:                             }
                   9924:                         }
                   9925:                     }
                   9926:                 }
                   9927:                 if ($slots{$slot}->{'allowedusers'}) {
                   9928:                     my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
                   9929:                     my $user = $env{'user.name'}.':'.$env{'user.domain'};
                   9930:                     if (grep(/^\Q$user\E$/,@allowed_users)) {
                   9931:                         $userallowed = 1;
                   9932:                     }
                   9933:                 }
                   9934:                 next unless($userallowed);
                   9935:             }
                   9936:             my $startreserve = $slots{$slot}->{'startreserve'};
                   9937:             my $endreserve = $slots{$slot}->{'endreserve'};
                   9938:             my $symb = $slots{$slot}->{'symb'};
                   9939:             if (($startreserve < $now) &&
                   9940:                 (!$endreserve || $endreserve > $now)) {
                   9941:                 my $lastres = $endreserve;
                   9942:                 if (!$lastres) {
                   9943:                     $lastres = $slots{$slot}->{'starttime'};
                   9944:                 }
                   9945:                 $reservable_now{$slot} = {
                   9946:                                            symb       => $symb,
                   9947:                                            endreserve => $lastres
                   9948:                                          };
                   9949:             } elsif (($startreserve > $now) &&
                   9950:                      (!$endreserve || $endreserve > $startreserve)) {
                   9951:                 $future_reservable{$slot} = {
                   9952:                                               symb         => $symb,
                   9953:                                               startreserve => $startreserve
                   9954:                                             };
                   9955:             }
                   9956:         }
                   9957:     }
                   9958:     my @unsorted_reservable = keys(%reservable_now);
                   9959:     if (@unsorted_reservable > 0) {
                   9960:         @sorted_reservable = 
                   9961:             &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
                   9962:     }
                   9963:     my @unsorted_future = keys(%future_reservable);
                   9964:     if (@unsorted_future > 0) {
                   9965:         @sorted_future =
                   9966:             &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
                   9967:     }
                   9968:     return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
                   9969: }
1.780     raeburn  9970: 
                   9971: =pod
                   9972: 
1.1057    foxr     9973: =back
                   9974: 
1.549     albertel 9975: =head1 HTTP Helpers
                   9976: 
                   9977: =over 4
                   9978: 
1.648     raeburn  9979: =item * &get_unprocessed_cgi($query,$possible_names)
1.112     bowersj2 9980: 
1.258     albertel 9981: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112     bowersj2 9982: $query.  The parameters listed in $possible_names (an array reference),
1.258     albertel 9983: will be set in $env{'form.name'} if they do not already exist.
1.112     bowersj2 9984: 
                   9985: Typically called with $ENV{'QUERY_STRING'} as the first parameter.  
                   9986: $possible_names is an ref to an array of form element names.  As an example:
                   9987: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258     albertel 9988: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112     bowersj2 9989: 
                   9990: =cut
1.1       albertel 9991: 
1.6       albertel 9992: sub get_unprocessed_cgi {
1.25      albertel 9993:   my ($query,$possible_names)= @_;
1.26      matthew  9994:   # $Apache::lonxml::debug=1;
1.356     albertel 9995:   foreach my $pair (split(/&/,$query)) {
                   9996:     my ($name, $value) = split(/=/,$pair);
1.369     www      9997:     $name = &unescape($name);
1.25      albertel 9998:     if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
                   9999:       $value =~ tr/+/ /;
                   10000:       $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258     albertel 10001:       unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25      albertel 10002:     }
1.16      harris41 10003:   }
1.6       albertel 10004: }
                   10005: 
1.112     bowersj2 10006: =pod
                   10007: 
1.648     raeburn  10008: =item * &cacheheader() 
1.112     bowersj2 10009: 
                   10010: returns cache-controlling header code
                   10011: 
                   10012: =cut
                   10013: 
1.7       albertel 10014: sub cacheheader {
1.258     albertel 10015:     unless ($env{'request.method'} eq 'GET') { return ''; }
1.216     albertel 10016:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
                   10017:     my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7       albertel 10018:                 <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
                   10019:                 <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216     albertel 10020:     return $output;
1.7       albertel 10021: }
                   10022: 
1.112     bowersj2 10023: =pod
                   10024: 
1.648     raeburn  10025: =item * &no_cache($r) 
1.112     bowersj2 10026: 
                   10027: specifies header code to not have cache
                   10028: 
                   10029: =cut
                   10030: 
1.9       albertel 10031: sub no_cache {
1.216     albertel 10032:     my ($r) = @_;
                   10033:     if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258     albertel 10034: 	$env{'request.method'} ne 'GET') { return ''; }
1.216     albertel 10035:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
                   10036:     $r->no_cache(1);
                   10037:     $r->header_out("Expires" => $date);
                   10038:     $r->header_out("Pragma" => "no-cache");
1.123     www      10039: }
                   10040: 
                   10041: sub content_type {
1.181     albertel 10042:     my ($r,$type,$charset) = @_;
1.299     foxr     10043:     if ($r) {
                   10044: 	#  Note that printout.pl calls this with undef for $r.
                   10045: 	&no_cache($r);
                   10046:     }
1.258     albertel 10047:     if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181     albertel 10048:     unless ($charset) {
                   10049: 	$charset=&Apache::lonlocal::current_encoding;
                   10050:     }
                   10051:     if ($charset) { $type.='; charset='.$charset; }
                   10052:     if ($r) {
                   10053: 	$r->content_type($type);
                   10054:     } else {
                   10055: 	print("Content-type: $type\n\n");
                   10056:     }
1.9       albertel 10057: }
1.25      albertel 10058: 
1.112     bowersj2 10059: =pod
                   10060: 
1.648     raeburn  10061: =item * &add_to_env($name,$value) 
1.112     bowersj2 10062: 
1.258     albertel 10063: adds $name to the %env hash with value
1.112     bowersj2 10064: $value, if $name already exists, the entry is converted to an array
                   10065: reference and $value is added to the array.
                   10066: 
                   10067: =cut
                   10068: 
1.25      albertel 10069: sub add_to_env {
                   10070:   my ($name,$value)=@_;
1.258     albertel 10071:   if (defined($env{$name})) {
                   10072:     if (ref($env{$name})) {
1.25      albertel 10073:       #already have multiple values
1.258     albertel 10074:       push(@{ $env{$name} },$value);
1.25      albertel 10075:     } else {
                   10076:       #first time seeing multiple values, convert hash entry to an arrayref
1.258     albertel 10077:       my $first=$env{$name};
                   10078:       undef($env{$name});
                   10079:       push(@{ $env{$name} },$first,$value);
1.25      albertel 10080:     }
                   10081:   } else {
1.258     albertel 10082:     $env{$name}=$value;
1.25      albertel 10083:   }
1.31      albertel 10084: }
1.149     albertel 10085: 
                   10086: =pod
                   10087: 
1.648     raeburn  10088: =item * &get_env_multiple($name) 
1.149     albertel 10089: 
1.258     albertel 10090: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149     albertel 10091: values may be defined and end up as an array ref.
                   10092: 
                   10093: returns an array of values
                   10094: 
                   10095: =cut
                   10096: 
                   10097: sub get_env_multiple {
                   10098:     my ($name) = @_;
                   10099:     my @values;
1.258     albertel 10100:     if (defined($env{$name})) {
1.149     albertel 10101:         # exists is it an array
1.258     albertel 10102:         if (ref($env{$name})) {
                   10103:             @values=@{ $env{$name} };
1.149     albertel 10104:         } else {
1.258     albertel 10105:             $values[0]=$env{$name};
1.149     albertel 10106:         }
                   10107:     }
                   10108:     return(@values);
                   10109: }
                   10110: 
1.660     raeburn  10111: sub ask_for_embedded_content {
                   10112:     my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071    raeburn  10113:     my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
1.1075.2.11  raeburn  10114:         %currsubfile,%unused,$rem);
1.1071    raeburn  10115:     my $counter = 0;
                   10116:     my $numnew = 0;
1.987     raeburn  10117:     my $numremref = 0;
                   10118:     my $numinvalid = 0;
                   10119:     my $numpathchg = 0;
                   10120:     my $numexisting = 0;
1.1071    raeburn  10121:     my $numunused = 0;
                   10122:     my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
1.1075.2.53  raeburn  10123:         $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path,$navmap);
1.1071    raeburn  10124:     my $heading = &mt('Upload embedded files');
                   10125:     my $buttontext = &mt('Upload');
                   10126: 
1.1075.2.11  raeburn  10127:     if ($env{'request.course.id'}) {
1.1075.2.35  raeburn  10128:         if ($actionurl eq '/adm/dependencies') {
                   10129:             $navmap = Apache::lonnavmaps::navmap->new();
                   10130:         }
                   10131:         $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   10132:         $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1075.2.11  raeburn  10133:     }
1.1075.2.35  raeburn  10134:     if (($actionurl eq '/adm/portfolio') ||
                   10135:         ($actionurl eq '/adm/coursegrp_portfolio')) {
1.984     raeburn  10136:         my $current_path='/';
                   10137:         if ($env{'form.currentpath'}) {
                   10138:             $current_path = $env{'form.currentpath'};
                   10139:         }
                   10140:         if ($actionurl eq '/adm/coursegrp_portfolio') {
1.1075.2.35  raeburn  10141:             $udom = $cdom;
                   10142:             $uname = $cnum;
1.984     raeburn  10143:             $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
                   10144:         } else {
                   10145:             $udom = $env{'user.domain'};
                   10146:             $uname = $env{'user.name'};
                   10147:             $url = '/userfiles/portfolio';
                   10148:         }
1.987     raeburn  10149:         $toplevel = $url.'/';
1.984     raeburn  10150:         $url .= $current_path;
                   10151:         $getpropath = 1;
1.987     raeburn  10152:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
                   10153:              ($actionurl eq '/adm/imsimport')) { 
1.1022    www      10154:         my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026    raeburn  10155:         $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987     raeburn  10156:         $toplevel = $url;
1.984     raeburn  10157:         if ($rest ne '') {
1.987     raeburn  10158:             $url .= $rest;
                   10159:         }
                   10160:     } elsif ($actionurl eq '/adm/coursedocs') {
                   10161:         if (ref($args) eq 'HASH') {
1.1071    raeburn  10162:             $url = $args->{'docs_url'};
                   10163:             $toplevel = $url;
1.1075.2.11  raeburn  10164:             if ($args->{'context'} eq 'paste') {
                   10165:                 ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
                   10166:                 ($path) =
                   10167:                     ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
                   10168:                 $fileloc = &Apache::lonnet::filelocation('',$toplevel);
                   10169:                 $fileloc =~ s{^/}{};
                   10170:             }
1.1071    raeburn  10171:         }
                   10172:     } elsif ($actionurl eq '/adm/dependencies') {
                   10173:         if ($env{'request.course.id'} ne '') {
                   10174:             if (ref($args) eq 'HASH') {
                   10175:                 $url = $args->{'docs_url'};
                   10176:                 $title = $args->{'docs_title'};
1.1075.2.35  raeburn  10177:                 $toplevel = $url;
                   10178:                 unless ($toplevel =~ m{^/}) {
                   10179:                     $toplevel = "/$url";
                   10180:                 }
1.1075.2.11  raeburn  10181:                 ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
1.1075.2.35  raeburn  10182:                 if ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E)}) {
                   10183:                     $path = $1;
                   10184:                 } else {
                   10185:                     ($path) =
                   10186:                         ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
                   10187:                 }
1.1075.2.79  raeburn  10188:                 if ($toplevel=~/^\/*(uploaded|editupload)/) {
                   10189:                     $fileloc = $toplevel;
                   10190:                     $fileloc=~ s/^\s*(\S+)\s*$/$1/;
                   10191:                     my ($udom,$uname,$fname) =
                   10192:                         ($fileloc=~ m{^/+(?:uploaded|editupload)/+($match_domain)/+($match_name)/+(.*)$});
                   10193:                     $fileloc = propath($udom,$uname).'/userfiles/'.$fname;
                   10194:                 } else {
                   10195:                     $fileloc = &Apache::lonnet::filelocation('',$toplevel);
                   10196:                 }
1.1071    raeburn  10197:                 $fileloc =~ s{^/}{};
                   10198:                 ($filename) = ($fileloc =~ m{.+/([^/]+)$});
                   10199:                 $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
                   10200:             }
1.987     raeburn  10201:         }
1.1075.2.35  raeburn  10202:     } elsif ($actionurl eq "/public/$cdom/$cnum/syllabus") {
                   10203:         $udom = $cdom;
                   10204:         $uname = $cnum;
                   10205:         $url = "/uploaded/$cdom/$cnum/portfolio/syllabus";
                   10206:         $toplevel = $url;
                   10207:         $path = $url;
                   10208:         $fileloc = &Apache::lonnet::filelocation('',$toplevel).'/';
                   10209:         $fileloc =~ s{^/}{};
                   10210:     }
                   10211:     foreach my $file (keys(%{$allfiles})) {
                   10212:         my $embed_file;
                   10213:         if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) {
                   10214:             $embed_file = $1;
                   10215:         } else {
                   10216:             $embed_file = $file;
                   10217:         }
1.1075.2.55  raeburn  10218:         my ($absolutepath,$cleaned_file);
                   10219:         if ($embed_file =~ m{^\w+://}) {
                   10220:             $cleaned_file = $embed_file;
1.1075.2.47  raeburn  10221:             $newfiles{$cleaned_file} = 1;
                   10222:             $mapping{$cleaned_file} = $embed_file;
1.987     raeburn  10223:         } else {
1.1075.2.55  raeburn  10224:             $cleaned_file = &clean_path($embed_file);
1.987     raeburn  10225:             if ($embed_file =~ m{^/}) {
                   10226:                 $absolutepath = $embed_file;
                   10227:             }
1.1075.2.47  raeburn  10228:             if ($cleaned_file =~ m{/}) {
                   10229:                 my ($path,$fname) = ($cleaned_file =~ m{^(.+)/([^/]*)$});
1.987     raeburn  10230:                 $path = &check_for_traversal($path,$url,$toplevel);
                   10231:                 my $item = $fname;
                   10232:                 if ($path ne '') {
                   10233:                     $item = $path.'/'.$fname;
                   10234:                     $subdependencies{$path}{$fname} = 1;
                   10235:                 } else {
                   10236:                     $dependencies{$item} = 1;
                   10237:                 }
                   10238:                 if ($absolutepath) {
                   10239:                     $mapping{$item} = $absolutepath;
                   10240:                 } else {
                   10241:                     $mapping{$item} = $embed_file;
                   10242:                 }
                   10243:             } else {
                   10244:                 $dependencies{$embed_file} = 1;
                   10245:                 if ($absolutepath) {
1.1075.2.47  raeburn  10246:                     $mapping{$cleaned_file} = $absolutepath;
1.987     raeburn  10247:                 } else {
1.1075.2.47  raeburn  10248:                     $mapping{$cleaned_file} = $embed_file;
1.987     raeburn  10249:                 }
                   10250:             }
1.984     raeburn  10251:         }
                   10252:     }
1.1071    raeburn  10253:     my $dirptr = 16384;
1.984     raeburn  10254:     foreach my $path (keys(%subdependencies)) {
1.1071    raeburn  10255:         $currsubfile{$path} = {};
1.1075.2.35  raeburn  10256:         if (($actionurl eq '/adm/portfolio') ||
                   10257:             ($actionurl eq '/adm/coursegrp_portfolio')) { 
1.1021    raeburn  10258:             my ($sublistref,$listerror) =
                   10259:                 &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
                   10260:             if (ref($sublistref) eq 'ARRAY') {
                   10261:                 foreach my $line (@{$sublistref}) {
                   10262:                     my ($file_name,$rest) = split(/\&/,$line,2);
1.1071    raeburn  10263:                     $currsubfile{$path}{$file_name} = 1;
1.1021    raeburn  10264:                 }
1.984     raeburn  10265:             }
1.987     raeburn  10266:         } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  10267:             if (opendir(my $dir,$url.'/'.$path)) {
                   10268:                 my @subdir_list = grep(!/^\./,readdir($dir));
1.1071    raeburn  10269:                 map {$currsubfile{$path}{$_} = 1;} @subdir_list;
                   10270:             }
1.1075.2.11  raeburn  10271:         } elsif (($actionurl eq '/adm/dependencies') ||
                   10272:                  (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1075.2.35  raeburn  10273:                   ($args->{'context'} eq 'paste')) ||
                   10274:                  ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071    raeburn  10275:             if ($env{'request.course.id'} ne '') {
1.1075.2.35  raeburn  10276:                 my $dir;
                   10277:                 if ($actionurl eq "/public/$cdom/$cnum/syllabus") {
                   10278:                     $dir = $fileloc;
                   10279:                 } else {
                   10280:                     ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
                   10281:                 }
1.1071    raeburn  10282:                 if ($dir ne '') {
                   10283:                     my ($sublistref,$listerror) =
                   10284:                         &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
                   10285:                     if (ref($sublistref) eq 'ARRAY') {
                   10286:                         foreach my $line (@{$sublistref}) {
                   10287:                             my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
                   10288:                                 undef,$mtime)=split(/\&/,$line,12);
                   10289:                             unless (($testdir&$dirptr) ||
                   10290:                                     ($file_name =~ /^\.\.?$/)) {
                   10291:                                 $currsubfile{$path}{$file_name} = [$size,$mtime];
                   10292:                             }
                   10293:                         }
                   10294:                     }
                   10295:                 }
1.984     raeburn  10296:             }
                   10297:         }
                   10298:         foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071    raeburn  10299:             if (exists($currsubfile{$path}{$file})) {
1.987     raeburn  10300:                 my $item = $path.'/'.$file;
                   10301:                 unless ($mapping{$item} eq $item) {
                   10302:                     $pathchanges{$item} = 1;
                   10303:                 }
                   10304:                 $existing{$item} = 1;
                   10305:                 $numexisting ++;
                   10306:             } else {
                   10307:                 $newfiles{$path.'/'.$file} = 1;
1.984     raeburn  10308:             }
                   10309:         }
1.1071    raeburn  10310:         if ($actionurl eq '/adm/dependencies') {
                   10311:             foreach my $path (keys(%currsubfile)) {
                   10312:                 if (ref($currsubfile{$path}) eq 'HASH') {
                   10313:                     foreach my $file (keys(%{$currsubfile{$path}})) {
                   10314:                          unless ($subdependencies{$path}{$file}) {
1.1075.2.11  raeburn  10315:                              next if (($rem ne '') &&
                   10316:                                       (($env{"httpref.$rem"."$path/$file"} ne '') ||
                   10317:                                        (ref($navmap) &&
                   10318:                                        (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
                   10319:                                         (($file =~ /^(.*\.s?html?)\.bak$/i) &&
                   10320:                                          ($navmap->getResourceByUrl($rem."$path/$1")))))));
1.1071    raeburn  10321:                              $unused{$path.'/'.$file} = 1; 
                   10322:                          }
                   10323:                     }
                   10324:                 }
                   10325:             }
                   10326:         }
1.984     raeburn  10327:     }
1.987     raeburn  10328:     my %currfile;
1.1075.2.35  raeburn  10329:     if (($actionurl eq '/adm/portfolio') ||
                   10330:         ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021    raeburn  10331:         my ($dirlistref,$listerror) =
                   10332:             &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
                   10333:         if (ref($dirlistref) eq 'ARRAY') {
                   10334:             foreach my $line (@{$dirlistref}) {
                   10335:                 my ($file_name,$rest) = split(/\&/,$line,2);
                   10336:                 $currfile{$file_name} = 1;
                   10337:             }
1.984     raeburn  10338:         }
1.987     raeburn  10339:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  10340:         if (opendir(my $dir,$url)) {
1.987     raeburn  10341:             my @dir_list = grep(!/^\./,readdir($dir));
1.984     raeburn  10342:             map {$currfile{$_} = 1;} @dir_list;
                   10343:         }
1.1075.2.11  raeburn  10344:     } elsif (($actionurl eq '/adm/dependencies') ||
                   10345:              (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1075.2.35  raeburn  10346:               ($args->{'context'} eq 'paste')) ||
                   10347:              ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071    raeburn  10348:         if ($env{'request.course.id'} ne '') {
                   10349:             my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
                   10350:             if ($dir ne '') {
                   10351:                 my ($dirlistref,$listerror) =
                   10352:                     &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
                   10353:                 if (ref($dirlistref) eq 'ARRAY') {
                   10354:                     foreach my $line (@{$dirlistref}) {
                   10355:                         my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
                   10356:                             $size,undef,$mtime)=split(/\&/,$line,12);
                   10357:                         unless (($testdir&$dirptr) ||
                   10358:                                 ($file_name =~ /^\.\.?$/)) {
                   10359:                             $currfile{$file_name} = [$size,$mtime];
                   10360:                         }
                   10361:                     }
                   10362:                 }
                   10363:             }
                   10364:         }
1.984     raeburn  10365:     }
                   10366:     foreach my $file (keys(%dependencies)) {
1.1071    raeburn  10367:         if (exists($currfile{$file})) {
1.987     raeburn  10368:             unless ($mapping{$file} eq $file) {
                   10369:                 $pathchanges{$file} = 1;
                   10370:             }
                   10371:             $existing{$file} = 1;
                   10372:             $numexisting ++;
                   10373:         } else {
1.984     raeburn  10374:             $newfiles{$file} = 1;
                   10375:         }
                   10376:     }
1.1071    raeburn  10377:     foreach my $file (keys(%currfile)) {
                   10378:         unless (($file eq $filename) ||
                   10379:                 ($file eq $filename.'.bak') ||
                   10380:                 ($dependencies{$file})) {
1.1075.2.11  raeburn  10381:             if ($actionurl eq '/adm/dependencies') {
1.1075.2.35  raeburn  10382:                 unless ($toplevel =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E}) {
                   10383:                     next if (($rem ne '') &&
                   10384:                              (($env{"httpref.$rem".$file} ne '') ||
                   10385:                               (ref($navmap) &&
                   10386:                               (($navmap->getResourceByUrl($rem.$file) ne '') ||
                   10387:                                (($file =~ /^(.*\.s?html?)\.bak$/i) &&
                   10388:                                 ($navmap->getResourceByUrl($rem.$1)))))));
                   10389:                 }
1.1075.2.11  raeburn  10390:             }
1.1071    raeburn  10391:             $unused{$file} = 1;
                   10392:         }
                   10393:     }
1.1075.2.11  raeburn  10394:     if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
                   10395:         ($args->{'context'} eq 'paste')) {
                   10396:         $counter = scalar(keys(%existing));
                   10397:         $numpathchg = scalar(keys(%pathchanges));
                   10398:         return ($output,$counter,$numpathchg,\%existing);
1.1075.2.35  raeburn  10399:     } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") &&
                   10400:              (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {
                   10401:         $counter = scalar(keys(%existing));
                   10402:         $numpathchg = scalar(keys(%pathchanges));
                   10403:         return ($output,$counter,$numpathchg,\%existing,\%mapping);
1.1075.2.11  raeburn  10404:     }
1.984     raeburn  10405:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071    raeburn  10406:         if ($actionurl eq '/adm/dependencies') {
                   10407:             next if ($embed_file =~ m{^\w+://});
                   10408:         }
1.660     raeburn  10409:         $upload_output .= &start_data_table_row().
1.1075.2.35  raeburn  10410:                           '<td valign="top"><img src="'.&icon($embed_file).'" />&nbsp;'.
1.1071    raeburn  10411:                           '<span class="LC_filename">'.$embed_file.'</span>';
1.987     raeburn  10412:         unless ($mapping{$embed_file} eq $embed_file) {
1.1075.2.35  raeburn  10413:             $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.
                   10414:                               &mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
1.987     raeburn  10415:         }
1.1075.2.35  raeburn  10416:         $upload_output .= '</td>';
1.1071    raeburn  10417:         if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) { 
1.1075.2.35  raeburn  10418:             $upload_output.='<td align="right">'.
                   10419:                             '<span class="LC_info LC_fontsize_medium">'.
                   10420:                             &mt("URL points to web address").'</span>';
1.987     raeburn  10421:             $numremref++;
1.660     raeburn  10422:         } elsif ($args->{'error_on_invalid_names'}
                   10423:             && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
1.1075.2.35  raeburn  10424:             $upload_output.='<td align="right"><span class="LC_warning">'.
                   10425:                             &mt('Invalid characters').'</span>';
1.987     raeburn  10426:             $numinvalid++;
1.660     raeburn  10427:         } else {
1.1075.2.35  raeburn  10428:             $upload_output .= '<td>'.
                   10429:                               &embedded_file_element('upload_embedded',$counter,
1.987     raeburn  10430:                                                      $embed_file,\%mapping,
1.1071    raeburn  10431:                                                      $allfiles,$codebase,'upload');
                   10432:             $counter ++;
                   10433:             $numnew ++;
1.987     raeburn  10434:         }
                   10435:         $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
                   10436:     }
                   10437:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071    raeburn  10438:         if ($actionurl eq '/adm/dependencies') {
                   10439:             my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
                   10440:             $modify_output .= &start_data_table_row().
                   10441:                               '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
                   10442:                               '<img src="'.&icon($embed_file).'" border="0" />'.
                   10443:                               '&nbsp;<span class="LC_filename">'.$embed_file.'</span></a></td>'.
                   10444:                               '<td>'.$size.'</td>'.
                   10445:                               '<td>'.$mtime.'</td>'.
                   10446:                               '<td><label><input type="checkbox" name="mod_upload_dep" '.
                   10447:                               'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
                   10448:                               $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
                   10449:                               '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
                   10450:                               &embedded_file_element('upload_embedded',$counter,
                   10451:                                                      $embed_file,\%mapping,
                   10452:                                                      $allfiles,$codebase,'modify').
                   10453:                               '</div></td>'.
                   10454:                               &end_data_table_row()."\n";
                   10455:             $counter ++;
                   10456:         } else {
                   10457:             $upload_output .= &start_data_table_row().
1.1075.2.35  raeburn  10458:                               '<td valign="top"><img src="'.&icon($embed_file).'" />&nbsp;'.
                   10459:                               '<span class="LC_filename">'.$embed_file.'</span></td>'.
                   10460:                               '<td align="right"><span class="LC_info LC_fontsize_medium">'.&mt('Already exists').'</span></td>'.
1.1071    raeburn  10461:                               &Apache::loncommon::end_data_table_row()."\n";
                   10462:         }
                   10463:     }
                   10464:     my $delidx = $counter;
                   10465:     foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
                   10466:         my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
                   10467:         $delete_output .= &start_data_table_row().
                   10468:                           '<td><img src="'.&icon($oldfile).'" />'.
                   10469:                           '&nbsp;<span class="LC_filename">'.$oldfile.'</span></td>'.
                   10470:                           '<td>'.$size.'</td>'.
                   10471:                           '<td>'.$mtime.'</td>'.
                   10472:                           '<td><label><input type="checkbox" name="del_upload_dep" '.
                   10473:                           ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
                   10474:                           &embedded_file_element('upload_embedded',$delidx,
                   10475:                                                  $oldfile,\%mapping,$allfiles,
                   10476:                                                  $codebase,'delete').'</td>'.
                   10477:                           &end_data_table_row()."\n"; 
                   10478:         $numunused ++;
                   10479:         $delidx ++;
1.987     raeburn  10480:     }
                   10481:     if ($upload_output) {
                   10482:         $upload_output = &start_data_table().
                   10483:                          $upload_output.
                   10484:                          &end_data_table()."\n";
                   10485:     }
1.1071    raeburn  10486:     if ($modify_output) {
                   10487:         $modify_output = &start_data_table().
                   10488:                          &start_data_table_header_row().
                   10489:                          '<th>'.&mt('File').'</th>'.
                   10490:                          '<th>'.&mt('Size (KB)').'</th>'.
                   10491:                          '<th>'.&mt('Modified').'</th>'.
                   10492:                          '<th>'.&mt('Upload replacement?').'</th>'.
                   10493:                          &end_data_table_header_row().
                   10494:                          $modify_output.
                   10495:                          &end_data_table()."\n";
                   10496:     }
                   10497:     if ($delete_output) {
                   10498:         $delete_output = &start_data_table().
                   10499:                          &start_data_table_header_row().
                   10500:                          '<th>'.&mt('File').'</th>'.
                   10501:                          '<th>'.&mt('Size (KB)').'</th>'.
                   10502:                          '<th>'.&mt('Modified').'</th>'.
                   10503:                          '<th>'.&mt('Delete?').'</th>'.
                   10504:                          &end_data_table_header_row().
                   10505:                          $delete_output.
                   10506:                          &end_data_table()."\n";
                   10507:     }
1.987     raeburn  10508:     my $applies = 0;
                   10509:     if ($numremref) {
                   10510:         $applies ++;
                   10511:     }
                   10512:     if ($numinvalid) {
                   10513:         $applies ++;
                   10514:     }
                   10515:     if ($numexisting) {
                   10516:         $applies ++;
                   10517:     }
1.1071    raeburn  10518:     if ($counter || $numunused) {
1.987     raeburn  10519:         $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
                   10520:                   ' method="post" enctype="multipart/form-data">'."\n".
1.1071    raeburn  10521:                   $state.'<h3>'.$heading.'</h3>'; 
                   10522:         if ($actionurl eq '/adm/dependencies') {
                   10523:             if ($numnew) {
                   10524:                 $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
                   10525:                            '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
                   10526:                            $upload_output.'<br />'."\n";
                   10527:             }
                   10528:             if ($numexisting) {
                   10529:                 $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
                   10530:                            '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
                   10531:                            $modify_output.'<br />'."\n";
                   10532:                            $buttontext = &mt('Save changes');
                   10533:             }
                   10534:             if ($numunused) {
                   10535:                 $output .= '<h4>'.&mt('Unused files').'</h4>'.
                   10536:                            '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
                   10537:                            $delete_output.'<br />'."\n";
                   10538:                            $buttontext = &mt('Save changes');
                   10539:             }
                   10540:         } else {
                   10541:             $output .= $upload_output.'<br />'."\n";
                   10542:         }
                   10543:         $output .= '<input type ="hidden" name="number_embedded_items" value="'.
                   10544:                    $counter.'" />'."\n";
                   10545:         if ($actionurl eq '/adm/dependencies') { 
                   10546:             $output .= '<input type ="hidden" name="number_newemb_items" value="'.
                   10547:                        $numnew.'" />'."\n";
                   10548:         } elsif ($actionurl eq '') {
1.987     raeburn  10549:             $output .=  '<input type="hidden" name="phase" value="three" />';
                   10550:         }
                   10551:     } elsif ($applies) {
                   10552:         $output = '<b>'.&mt('Referenced files').'</b>:<br />';
                   10553:         if ($applies > 1) {
                   10554:             $output .=  
1.1075.2.35  raeburn  10555:                 &mt('No dependencies need to be uploaded, as one of the following applies to each reference:').'<ul>';
1.987     raeburn  10556:             if ($numremref) {
                   10557:                 $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
                   10558:             }
                   10559:             if ($numinvalid) {
                   10560:                 $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
                   10561:             }
                   10562:             if ($numexisting) {
                   10563:                 $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
                   10564:             }
                   10565:             $output .= '</ul><br />';
                   10566:         } elsif ($numremref) {
                   10567:             $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
                   10568:         } elsif ($numinvalid) {
                   10569:             $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
                   10570:         } elsif ($numexisting) {
                   10571:             $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
                   10572:         }
                   10573:         $output .= $upload_output.'<br />';
                   10574:     }
                   10575:     my ($pathchange_output,$chgcount);
1.1071    raeburn  10576:     $chgcount = $counter;
1.987     raeburn  10577:     if (keys(%pathchanges) > 0) {
                   10578:         foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071    raeburn  10579:             if ($counter) {
1.987     raeburn  10580:                 $output .= &embedded_file_element('pathchange',$chgcount,
                   10581:                                                   $embed_file,\%mapping,
1.1071    raeburn  10582:                                                   $allfiles,$codebase,'change');
1.987     raeburn  10583:             } else {
                   10584:                 $pathchange_output .= 
                   10585:                     &start_data_table_row().
                   10586:                     '<td><input type ="checkbox" name="namechange" value="'.
                   10587:                     $chgcount.'" checked="checked" /></td>'.
                   10588:                     '<td>'.$mapping{$embed_file}.'</td>'.
                   10589:                     '<td>'.$embed_file.
                   10590:                     &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071    raeburn  10591:                                            \%mapping,$allfiles,$codebase,'change').
1.987     raeburn  10592:                     '</td>'.&end_data_table_row();
1.660     raeburn  10593:             }
1.987     raeburn  10594:             $numpathchg ++;
                   10595:             $chgcount ++;
1.660     raeburn  10596:         }
                   10597:     }
1.1075.2.35  raeburn  10598:     if (($counter) || ($numunused)) {
1.987     raeburn  10599:         if ($numpathchg) {
                   10600:             $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
                   10601:                        $numpathchg.'" />'."\n";
                   10602:         }
                   10603:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') || 
                   10604:             ($actionurl eq '/adm/imsimport')) {
                   10605:             $output .= '<input type="hidden" name="phase" value="three" />'."\n";
                   10606:         } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
                   10607:             $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071    raeburn  10608:         } elsif ($actionurl eq '/adm/dependencies') {
                   10609:             $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987     raeburn  10610:         }
1.1075.2.35  raeburn  10611:         $output .= '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987     raeburn  10612:     } elsif ($numpathchg) {
                   10613:         my %pathchange = ();
                   10614:         $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
                   10615:         if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   10616:             $output .= '<p>'.&mt('or').'</p>'; 
1.1075.2.35  raeburn  10617:         }
1.987     raeburn  10618:     }
1.1071    raeburn  10619:     return ($output,$counter,$numpathchg);
1.987     raeburn  10620: }
                   10621: 
1.1075.2.47  raeburn  10622: =pod
                   10623: 
                   10624: =item * clean_path($name)
                   10625: 
                   10626: Performs clean-up of directories, subdirectories and filename in an
                   10627: embedded object, referenced in an HTML file which is being uploaded
                   10628: to a course or portfolio, where
                   10629: "Upload embedded images/multimedia files if HTML file" checkbox was
                   10630: checked.
                   10631: 
                   10632: Clean-up is similar to replacements in lonnet::clean_filename()
                   10633: except each / between sub-directory and next level is preserved.
                   10634: 
                   10635: =cut
                   10636: 
                   10637: sub clean_path {
                   10638:     my ($embed_file) = @_;
                   10639:     $embed_file =~s{^/+}{};
                   10640:     my @contents;
                   10641:     if ($embed_file =~ m{/}) {
                   10642:         @contents = split(/\//,$embed_file);
                   10643:     } else {
                   10644:         @contents = ($embed_file);
                   10645:     }
                   10646:     my $lastidx = scalar(@contents)-1;
                   10647:     for (my $i=0; $i<=$lastidx; $i++) {
                   10648:         $contents[$i]=~s{\\}{/}g;
                   10649:         $contents[$i]=~s/\s+/\_/g;
                   10650:         $contents[$i]=~s{[^/\w\.\-]}{}g;
                   10651:         if ($i == $lastidx) {
                   10652:             $contents[$i]=~s/\.(\d+)(?=\.)/_$1/g;
                   10653:         }
                   10654:     }
                   10655:     if ($lastidx > 0) {
                   10656:         return join('/',@contents);
                   10657:     } else {
                   10658:         return $contents[0];
                   10659:     }
                   10660: }
                   10661: 
1.987     raeburn  10662: sub embedded_file_element {
1.1071    raeburn  10663:     my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987     raeburn  10664:     return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
                   10665:                    (ref($codebase) eq 'HASH'));
                   10666:     my $output;
1.1071    raeburn  10667:     if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987     raeburn  10668:        $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
                   10669:     }
                   10670:     $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
                   10671:                &escape($embed_file).'" />';
                   10672:     unless (($context eq 'upload_embedded') && 
                   10673:             ($mapping->{$embed_file} eq $embed_file)) {
                   10674:         $output .='
                   10675:         <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
                   10676:     }
                   10677:     my $attrib;
                   10678:     if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
                   10679:         $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
                   10680:     }
                   10681:     $output .=
                   10682:         "\n\t\t".
                   10683:         '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
                   10684:         $attrib.'" />';
                   10685:     if (exists($codebase->{$mapping->{$embed_file}})) {
                   10686:         $output .=
                   10687:             "\n\t\t".
                   10688:             '<input name="codebase_'.$num.'" type="hidden" value="'.
                   10689:             &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984     raeburn  10690:     }
1.987     raeburn  10691:     return $output;
1.660     raeburn  10692: }
                   10693: 
1.1071    raeburn  10694: sub get_dependency_details {
                   10695:     my ($currfile,$currsubfile,$embed_file) = @_;
                   10696:     my ($size,$mtime,$showsize,$showmtime);
                   10697:     if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
                   10698:         if ($embed_file =~ m{/}) {
                   10699:             my ($path,$fname) = split(/\//,$embed_file);
                   10700:             if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
                   10701:                 ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
                   10702:             }
                   10703:         } else {
                   10704:             if (ref($currfile->{$embed_file}) eq 'ARRAY') {
                   10705:                 ($size,$mtime) = @{$currfile->{$embed_file}};
                   10706:             }
                   10707:         }
                   10708:         $showsize = $size/1024.0;
                   10709:         $showsize = sprintf("%.1f",$showsize);
                   10710:         if ($mtime > 0) {
                   10711:             $showmtime = &Apache::lonlocal::locallocaltime($mtime);
                   10712:         }
                   10713:     }
                   10714:     return ($showsize,$showmtime);
                   10715: }
                   10716: 
                   10717: sub ask_embedded_js {
                   10718:     return <<"END";
                   10719: <script type="text/javascript"">
                   10720: // <![CDATA[
                   10721: function toggleBrowse(counter) {
                   10722:     var chkboxid = document.getElementById('mod_upload_dep_'+counter);
                   10723:     var fileid = document.getElementById('embedded_item_'+counter);
                   10724:     var uploaddivid = document.getElementById('moduploaddep_'+counter);
                   10725:     if (chkboxid.checked == true) {
                   10726:         uploaddivid.style.display='block';
                   10727:     } else {
                   10728:         uploaddivid.style.display='none';
                   10729:         fileid.value = '';
                   10730:     }
                   10731: }
                   10732: // ]]>
                   10733: </script>
                   10734: 
                   10735: END
                   10736: }
                   10737: 
1.661     raeburn  10738: sub upload_embedded {
                   10739:     my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987     raeburn  10740:         $current_disk_usage,$hiddenstate,$actionurl) = @_;
                   10741:     my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661     raeburn  10742:     for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
                   10743:         next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
                   10744:         my $orig_uploaded_filename =
                   10745:             $env{'form.embedded_item_'.$i.'.filename'};
1.987     raeburn  10746:         foreach my $type ('orig','ref','attrib','codebase') {
                   10747:             if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
                   10748:                 $env{'form.embedded_'.$type.'_'.$i} =
                   10749:                     &unescape($env{'form.embedded_'.$type.'_'.$i});
                   10750:             }
                   10751:         }
1.661     raeburn  10752:         my ($path,$fname) =
                   10753:             ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
                   10754:         # no path, whole string is fname
                   10755:         if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
                   10756:         $fname = &Apache::lonnet::clean_filename($fname);
                   10757:         # See if there is anything left
                   10758:         next if ($fname eq '');
                   10759: 
                   10760:         # Check if file already exists as a file or directory.
                   10761:         my ($state,$msg);
                   10762:         if ($context eq 'portfolio') {
                   10763:             my $port_path = $dirpath;
                   10764:             if ($group ne '') {
                   10765:                 $port_path = "groups/$group/$port_path";
                   10766:             }
1.987     raeburn  10767:             ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
                   10768:                                               $fname,$group,'embedded_item_'.$i,
1.661     raeburn  10769:                                               $dir_root,$port_path,$disk_quota,
                   10770:                                               $current_disk_usage,$uname,$udom);
                   10771:             if ($state eq 'will_exceed_quota'
1.984     raeburn  10772:                 || $state eq 'file_locked') {
1.661     raeburn  10773:                 $output .= $msg;
                   10774:                 next;
                   10775:             }
                   10776:         } elsif (($context eq 'author') || ($context eq 'testbank')) {
                   10777:             ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
                   10778:             if ($state eq 'exists') {
                   10779:                 $output .= $msg;
                   10780:                 next;
                   10781:             }
                   10782:         }
                   10783:         # Check if extension is valid
                   10784:         if (($fname =~ /\.(\w+)$/) &&
                   10785:             (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.1075.2.53  raeburn  10786:             $output .= &mt('Invalid file extension ([_1]) - reserved for internal use.',$1)
                   10787:                       .' '.&mt('Rename the file with a different extension and re-upload.').'<br />';
1.661     raeburn  10788:             next;
                   10789:         } elsif (($fname =~ /\.(\w+)$/) &&
                   10790:                  (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987     raeburn  10791:             $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661     raeburn  10792:             next;
                   10793:         } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.1075.2.34  raeburn  10794:             $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  10795:             next;
                   10796:         }
                   10797:         $env{'form.embedded_item_'.$i.'.filename'}=$fname;
1.1075.2.35  raeburn  10798:         my $subdir = $path;
                   10799:         $subdir =~ s{/+$}{};
1.661     raeburn  10800:         if ($context eq 'portfolio') {
1.984     raeburn  10801:             my $result;
                   10802:             if ($state eq 'existingfile') {
                   10803:                 $result=
                   10804:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.1075.2.35  raeburn  10805:                                                     $dirpath.$env{'form.currentpath'}.$subdir);
1.661     raeburn  10806:             } else {
1.984     raeburn  10807:                 $result=
                   10808:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987     raeburn  10809:                                                     $dirpath.
1.1075.2.35  raeburn  10810:                                                     $env{'form.currentpath'}.$subdir);
1.984     raeburn  10811:                 if ($result !~ m|^/uploaded/|) {
                   10812:                     $output .= '<span class="LC_error">'
                   10813:                                .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   10814:                                ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   10815:                                .'</span><br />';
                   10816:                     next;
                   10817:                 } else {
1.987     raeburn  10818:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   10819:                                $path.$fname.'</span>').'<br />';     
1.984     raeburn  10820:                 }
1.661     raeburn  10821:             }
1.1075.2.35  raeburn  10822:         } elsif (($context eq 'coursedoc') || ($context eq 'syllabus')) {
                   10823:             my $extendedsubdir = $dirpath.'/'.$subdir;
                   10824:             $extendedsubdir =~ s{/+$}{};
1.987     raeburn  10825:             my $result =
1.1075.2.35  raeburn  10826:                 &Apache::lonnet::userfileupload('embedded_item_'.$i,$context,$extendedsubdir);
1.987     raeburn  10827:             if ($result !~ m|^/uploaded/|) {
                   10828:                 $output .= '<span class="LC_error">'
                   10829:                            .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   10830:                            ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   10831:                            .'</span><br />';
                   10832:                     next;
                   10833:             } else {
                   10834:                 $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   10835:                            $path.$fname.'</span>').'<br />';
1.1075.2.35  raeburn  10836:                 if ($context eq 'syllabus') {
                   10837:                     &Apache::lonnet::make_public_indefinitely($result);
                   10838:                 }
1.987     raeburn  10839:             }
1.661     raeburn  10840:         } else {
                   10841: # Save the file
                   10842:             my $target = $env{'form.embedded_item_'.$i};
                   10843:             my $fullpath = $dir_root.$dirpath.'/'.$path;
                   10844:             my $dest = $fullpath.$fname;
                   10845:             my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027    raeburn  10846:             my @parts=split(/\//,"$dirpath/$path");
1.661     raeburn  10847:             my $count;
                   10848:             my $filepath = $dir_root;
1.1027    raeburn  10849:             foreach my $subdir (@parts) {
                   10850:                 $filepath .= "/$subdir";
                   10851:                 if (!-e $filepath) {
1.661     raeburn  10852:                     mkdir($filepath,0770);
                   10853:                 }
                   10854:             }
                   10855:             my $fh;
                   10856:             if (!open($fh,'>'.$dest)) {
                   10857:                 &Apache::lonnet::logthis('Failed to create '.$dest);
                   10858:                 $output .= '<span class="LC_error">'.
1.1071    raeburn  10859:                            &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
                   10860:                                $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661     raeburn  10861:                            '</span><br />';
                   10862:             } else {
                   10863:                 if (!print $fh $env{'form.embedded_item_'.$i}) {
                   10864:                     &Apache::lonnet::logthis('Failed to write to '.$dest);
                   10865:                     $output .= '<span class="LC_error">'.
1.1071    raeburn  10866:                               &mt('An error occurred while writing the file [_1] for embedded element [_2].',
                   10867:                                   $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661     raeburn  10868:                               '</span><br />';
                   10869:                 } else {
1.987     raeburn  10870:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   10871:                                $url.'</span>').'<br />';
                   10872:                     unless ($context eq 'testbank') {
                   10873:                         $footer .= &mt('View embedded file: [_1]',
                   10874:                                        '<a href="'.$url.'">'.$fname.'</a>').'<br />';
                   10875:                     }
                   10876:                 }
                   10877:                 close($fh);
                   10878:             }
                   10879:         }
                   10880:         if ($env{'form.embedded_ref_'.$i}) {
                   10881:             $pathchange{$i} = 1;
                   10882:         }
                   10883:     }
                   10884:     if ($output) {
                   10885:         $output = '<p>'.$output.'</p>';
                   10886:     }
                   10887:     $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
                   10888:     $returnflag = 'ok';
1.1071    raeburn  10889:     my $numpathchgs = scalar(keys(%pathchange));
                   10890:     if ($numpathchgs > 0) {
1.987     raeburn  10891:         if ($context eq 'portfolio') {
                   10892:             $output .= '<p>'.&mt('or').'</p>';
                   10893:         } elsif ($context eq 'testbank') {
1.1071    raeburn  10894:             $output .=  '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
                   10895:                                   '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987     raeburn  10896:             $returnflag = 'modify_orightml';
                   10897:         }
                   10898:     }
1.1071    raeburn  10899:     return ($output.$footer,$returnflag,$numpathchgs);
1.987     raeburn  10900: }
                   10901: 
                   10902: sub modify_html_form {
                   10903:     my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
                   10904:     my $end = 0;
                   10905:     my $modifyform;
                   10906:     if ($context eq 'upload_embedded') {
                   10907:         return unless (ref($pathchange) eq 'HASH');
                   10908:         if ($env{'form.number_embedded_items'}) {
                   10909:             $end += $env{'form.number_embedded_items'};
                   10910:         }
                   10911:         if ($env{'form.number_pathchange_items'}) {
                   10912:             $end += $env{'form.number_pathchange_items'};
                   10913:         }
                   10914:         if ($end) {
                   10915:             for (my $i=0; $i<$end; $i++) {
                   10916:                 if ($i < $env{'form.number_embedded_items'}) {
                   10917:                     next unless($pathchange->{$i});
                   10918:                 }
                   10919:                 $modifyform .=
                   10920:                     &start_data_table_row().
                   10921:                     '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
                   10922:                     'checked="checked" /></td>'.
                   10923:                     '<td>'.$env{'form.embedded_ref_'.$i}.
                   10924:                     '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
                   10925:                     &escape($env{'form.embedded_ref_'.$i}).'" />'.
                   10926:                     '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
                   10927:                     &escape($env{'form.embedded_codebase_'.$i}).'" />'.
                   10928:                     '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
                   10929:                     &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
                   10930:                     '<td>'.$env{'form.embedded_orig_'.$i}.
                   10931:                     '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
                   10932:                     &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
                   10933:                     &end_data_table_row();
1.1071    raeburn  10934:             }
1.987     raeburn  10935:         }
                   10936:     } else {
                   10937:         $modifyform = $pathchgtable;
                   10938:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
                   10939:             $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
                   10940:         } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   10941:             $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
                   10942:         }
                   10943:     }
                   10944:     if ($modifyform) {
1.1071    raeburn  10945:         if ($actionurl eq '/adm/dependencies') {
                   10946:             $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
                   10947:         }
1.987     raeburn  10948:         return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
                   10949:                '<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".
                   10950:                '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
                   10951:                '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
                   10952:                '</ol></p>'."\n".'<p>'.
                   10953:                &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
                   10954:                '<form method="post" name="refchanger" action="'.$actionurl.'">'.
                   10955:                &start_data_table()."\n".
                   10956:                &start_data_table_header_row().
                   10957:                '<th>'.&mt('Change?').'</th>'.
                   10958:                '<th>'.&mt('Current reference').'</th>'.
                   10959:                '<th>'.&mt('Required reference').'</th>'.
                   10960:                &end_data_table_header_row()."\n".
                   10961:                $modifyform.
                   10962:                &end_data_table().'<br />'."\n".$hiddenstate.
                   10963:                '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
                   10964:                '</form>'."\n";
                   10965:     }
                   10966:     return;
                   10967: }
                   10968: 
                   10969: sub modify_html_refs {
1.1075.2.35  raeburn  10970:     my ($context,$dirpath,$uname,$udom,$dir_root,$url) = @_;
1.987     raeburn  10971:     my $container;
                   10972:     if ($context eq 'portfolio') {
                   10973:         $container = $env{'form.container'};
                   10974:     } elsif ($context eq 'coursedoc') {
                   10975:         $container = $env{'form.primaryurl'};
1.1071    raeburn  10976:     } elsif ($context eq 'manage_dependencies') {
                   10977:         (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
                   10978:         $container = "/$container";
1.1075.2.35  raeburn  10979:     } elsif ($context eq 'syllabus') {
                   10980:         $container = $url;
1.987     raeburn  10981:     } else {
1.1027    raeburn  10982:         $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987     raeburn  10983:     }
                   10984:     my (%allfiles,%codebase,$output,$content);
                   10985:     my @changes = &get_env_multiple('form.namechange');
1.1075.2.35  raeburn  10986:     unless ((@changes > 0)  || ($context eq 'syllabus')) {
1.1071    raeburn  10987:         if (wantarray) {
                   10988:             return ('',0,0); 
                   10989:         } else {
                   10990:             return;
                   10991:         }
                   10992:     }
                   10993:     if (($context eq 'portfolio') || ($context eq 'coursedoc') || 
1.1075.2.35  raeburn  10994:         ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.1071    raeburn  10995:         unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
                   10996:             if (wantarray) {
                   10997:                 return ('',0,0);
                   10998:             } else {
                   10999:                 return;
                   11000:             }
                   11001:         } 
1.987     raeburn  11002:         $content = &Apache::lonnet::getfile($container);
1.1071    raeburn  11003:         if ($content eq '-1') {
                   11004:             if (wantarray) {
                   11005:                 return ('',0,0);
                   11006:             } else {
                   11007:                 return;
                   11008:             }
                   11009:         }
1.987     raeburn  11010:     } else {
1.1071    raeburn  11011:         unless ($container =~ /^\Q$dir_root\E/) {
                   11012:             if (wantarray) {
                   11013:                 return ('',0,0);
                   11014:             } else {
                   11015:                 return;
                   11016:             }
                   11017:         } 
1.987     raeburn  11018:         if (open(my $fh,"<$container")) {
                   11019:             $content = join('', <$fh>);
                   11020:             close($fh);
                   11021:         } else {
1.1071    raeburn  11022:             if (wantarray) {
                   11023:                 return ('',0,0);
                   11024:             } else {
                   11025:                 return;
                   11026:             }
1.987     raeburn  11027:         }
                   11028:     }
                   11029:     my ($count,$codebasecount) = (0,0);
                   11030:     my $mm = new File::MMagic;
                   11031:     my $mime_type = $mm->checktype_contents($content);
                   11032:     if ($mime_type eq 'text/html') {
                   11033:         my $parse_result = 
                   11034:             &Apache::lonnet::extract_embedded_items($container,\%allfiles,
                   11035:                                                     \%codebase,\$content);
                   11036:         if ($parse_result eq 'ok') {
                   11037:             foreach my $i (@changes) {
                   11038:                 my $orig = &unescape($env{'form.embedded_orig_'.$i});
                   11039:                 my $ref = &unescape($env{'form.embedded_ref_'.$i});
                   11040:                 if ($allfiles{$ref}) {
                   11041:                     my $newname =  $orig;
                   11042:                     my ($attrib_regexp,$codebase);
1.1006    raeburn  11043:                     $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987     raeburn  11044:                     if ($attrib_regexp =~ /:/) {
                   11045:                         $attrib_regexp =~ s/\:/|/g;
                   11046:                     }
                   11047:                     if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
                   11048:                         my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
                   11049:                         $count += $numchg;
1.1075.2.35  raeburn  11050:                         $allfiles{$newname} = $allfiles{$ref};
1.1075.2.48  raeburn  11051:                         delete($allfiles{$ref});
1.987     raeburn  11052:                     }
                   11053:                     if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006    raeburn  11054:                         $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987     raeburn  11055:                         my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
                   11056:                         $codebasecount ++;
                   11057:                     }
                   11058:                 }
                   11059:             }
1.1075.2.35  raeburn  11060:             my $skiprewrites;
1.987     raeburn  11061:             if ($count || $codebasecount) {
                   11062:                 my $saveresult;
1.1071    raeburn  11063:                 if (($context eq 'portfolio') || ($context eq 'coursedoc') || 
1.1075.2.35  raeburn  11064:                     ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.987     raeburn  11065:                     my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
                   11066:                     if ($url eq $container) {
                   11067:                         my ($fname) = ($container =~ m{/([^/]+)$});
                   11068:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   11069:                                             $count,'<span class="LC_filename">'.
1.1071    raeburn  11070:                                             $fname.'</span>').'</p>';
1.987     raeburn  11071:                     } else {
                   11072:                          $output = '<p class="LC_error">'.
                   11073:                                    &mt('Error: update failed for: [_1].',
                   11074:                                    '<span class="LC_filename">'.
                   11075:                                    $container.'</span>').'</p>';
                   11076:                     }
1.1075.2.35  raeburn  11077:                     if ($context eq 'syllabus') {
                   11078:                         unless ($saveresult eq 'ok') {
                   11079:                             $skiprewrites = 1;
                   11080:                         }
                   11081:                     }
1.987     raeburn  11082:                 } else {
                   11083:                     if (open(my $fh,">$container")) {
                   11084:                         print $fh $content;
                   11085:                         close($fh);
                   11086:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   11087:                                   $count,'<span class="LC_filename">'.
                   11088:                                   $container.'</span>').'</p>';
1.661     raeburn  11089:                     } else {
1.987     raeburn  11090:                          $output = '<p class="LC_error">'.
                   11091:                                    &mt('Error: could not update [_1].',
                   11092:                                    '<span class="LC_filename">'.
                   11093:                                    $container.'</span>').'</p>';
1.661     raeburn  11094:                     }
                   11095:                 }
                   11096:             }
1.1075.2.35  raeburn  11097:             if (($context eq 'syllabus') && (!$skiprewrites)) {
                   11098:                 my ($actionurl,$state);
                   11099:                 $actionurl = "/public/$udom/$uname/syllabus";
                   11100:                 my ($ignore,$num,$numpathchanges,$existing,$mapping) =
                   11101:                     &ask_for_embedded_content($actionurl,$state,\%allfiles,
                   11102:                                               \%codebase,
                   11103:                                               {'context' => 'rewrites',
                   11104:                                                'ignore_remote_references' => 1,});
                   11105:                 if (ref($mapping) eq 'HASH') {
                   11106:                     my $rewrites = 0;
                   11107:                     foreach my $key (keys(%{$mapping})) {
                   11108:                         next if ($key =~ m{^https?://});
                   11109:                         my $ref = $mapping->{$key};
                   11110:                         my $newname = "/uploaded/$udom/$uname/portfolio/syllabus/$key";
                   11111:                         my $attrib;
                   11112:                         if (ref($allfiles{$mapping->{$key}}) eq 'ARRAY') {
                   11113:                             $attrib = join('|',@{$allfiles{$mapping->{$key}}});
                   11114:                         }
                   11115:                         if ($content =~ m{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
                   11116:                             my $numchg = ($content =~ s{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
                   11117:                             $rewrites += $numchg;
                   11118:                         }
                   11119:                     }
                   11120:                     if ($rewrites) {
                   11121:                         my $saveresult;
                   11122:                         my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
                   11123:                         if ($url eq $container) {
                   11124:                             my ($fname) = ($container =~ m{/([^/]+)$});
                   11125:                             $output .= '<p>'.&mt('Rewrote [quant,_1,link] as [quant,_1,absolute link] in [_2].',
                   11126:                                             $count,'<span class="LC_filename">'.
                   11127:                                             $fname.'</span>').'</p>';
                   11128:                         } else {
                   11129:                             $output .= '<p class="LC_error">'.
                   11130:                                        &mt('Error: could not update links in [_1].',
                   11131:                                        '<span class="LC_filename">'.
                   11132:                                        $container.'</span>').'</p>';
                   11133: 
                   11134:                         }
                   11135:                     }
                   11136:                 }
                   11137:             }
1.987     raeburn  11138:         } else {
                   11139:             &logthis('Failed to parse '.$container.
                   11140:                      ' to modify references: '.$parse_result);
1.661     raeburn  11141:         }
                   11142:     }
1.1071    raeburn  11143:     if (wantarray) {
                   11144:         return ($output,$count,$codebasecount);
                   11145:     } else {
                   11146:         return $output;
                   11147:     }
1.661     raeburn  11148: }
                   11149: 
                   11150: sub check_for_existing {
                   11151:     my ($path,$fname,$element) = @_;
                   11152:     my ($state,$msg);
                   11153:     if (-d $path.'/'.$fname) {
                   11154:         $state = 'exists';
                   11155:         $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   11156:     } elsif (-e $path.'/'.$fname) {
                   11157:         $state = 'exists';
                   11158:         $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   11159:     }
                   11160:     if ($state eq 'exists') {
                   11161:         $msg = '<span class="LC_error">'.$msg.'</span><br />';
                   11162:     }
                   11163:     return ($state,$msg);
                   11164: }
                   11165: 
                   11166: sub check_for_upload {
                   11167:     my ($path,$fname,$group,$element,$portfolio_root,$port_path,
                   11168:         $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985     raeburn  11169:     my $filesize = length($env{'form.'.$element});
                   11170:     if (!$filesize) {
                   11171:         my $msg = '<span class="LC_error">'.
                   11172:                   &mt('Unable to upload [_1]. (size = [_2] bytes)', 
                   11173:                       '<span class="LC_filename">'.$fname.'</span>',
                   11174:                       $filesize).'<br />'.
1.1007    raeburn  11175:                   &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985     raeburn  11176:                   '</span>';
                   11177:         return ('zero_bytes',$msg);
                   11178:     }
                   11179:     $filesize =  $filesize/1000; #express in k (1024?)
1.661     raeburn  11180:     my $getpropath = 1;
1.1021    raeburn  11181:     my ($dirlistref,$listerror) =
                   11182:          &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661     raeburn  11183:     my $found_file = 0;
                   11184:     my $locked_file = 0;
1.991     raeburn  11185:     my @lockers;
                   11186:     my $navmap;
                   11187:     if ($env{'request.course.id'}) {
                   11188:         $navmap = Apache::lonnavmaps::navmap->new();
                   11189:     }
1.1021    raeburn  11190:     if (ref($dirlistref) eq 'ARRAY') {
                   11191:         foreach my $line (@{$dirlistref}) {
                   11192:             my ($file_name,$rest)=split(/\&/,$line,2);
                   11193:             if ($file_name eq $fname){
                   11194:                 $file_name = $path.$file_name;
                   11195:                 if ($group ne '') {
                   11196:                     $file_name = $group.$file_name;
                   11197:                 }
                   11198:                 $found_file = 1;
                   11199:                 if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
                   11200:                     foreach my $lock (@lockers) {
                   11201:                         if (ref($lock) eq 'ARRAY') {
                   11202:                             my ($symb,$crsid) = @{$lock};
                   11203:                             if ($crsid eq $env{'request.course.id'}) {
                   11204:                                 if (ref($navmap)) {
                   11205:                                     my $res = $navmap->getBySymb($symb);
                   11206:                                     foreach my $part (@{$res->parts()}) { 
                   11207:                                         my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
                   11208:                                         unless (($slot_status == $res->RESERVED) ||
                   11209:                                                 ($slot_status == $res->RESERVED_LOCATION)) {
                   11210:                                             $locked_file = 1;
                   11211:                                         }
1.991     raeburn  11212:                                     }
1.1021    raeburn  11213:                                 } else {
                   11214:                                     $locked_file = 1;
1.991     raeburn  11215:                                 }
                   11216:                             } else {
                   11217:                                 $locked_file = 1;
                   11218:                             }
                   11219:                         }
1.1021    raeburn  11220:                    }
                   11221:                 } else {
                   11222:                     my @info = split(/\&/,$rest);
                   11223:                     my $currsize = $info[6]/1000;
                   11224:                     if ($currsize < $filesize) {
                   11225:                         my $extra = $filesize - $currsize;
                   11226:                         if (($current_disk_usage + $extra) > $disk_quota) {
1.1075.2.69  raeburn  11227:                             my $msg = '<p class="LC_warning">'.
1.1021    raeburn  11228:                                       &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  11229:                                           '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</p>'.
                   11230:                                       '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
                   11231:                                                    $disk_quota,$current_disk_usage).'</p>';
1.1021    raeburn  11232:                             return ('will_exceed_quota',$msg);
                   11233:                         }
1.984     raeburn  11234:                     }
                   11235:                 }
1.661     raeburn  11236:             }
                   11237:         }
                   11238:     }
                   11239:     if (($current_disk_usage + $filesize) > $disk_quota){
1.1075.2.69  raeburn  11240:         my $msg = '<p class="LC_warning">'.
                   11241:                 &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</p>'.
                   11242:                   '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage).'</p>';
1.661     raeburn  11243:         return ('will_exceed_quota',$msg);
                   11244:     } elsif ($found_file) {
                   11245:         if ($locked_file) {
1.1075.2.69  raeburn  11246:             my $msg = '<p class="LC_warning">';
1.661     raeburn  11247:             $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  11248:             $msg .= '</p>';
1.661     raeburn  11249:             $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
                   11250:             return ('file_locked',$msg);
                   11251:         } else {
1.1075.2.69  raeburn  11252:             my $msg = '<p class="LC_error">';
1.984     raeburn  11253:             $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  11254:             $msg .= '</p>';
1.984     raeburn  11255:             return ('existingfile',$msg);
1.661     raeburn  11256:         }
                   11257:     }
                   11258: }
                   11259: 
1.987     raeburn  11260: sub check_for_traversal {
                   11261:     my ($path,$url,$toplevel) = @_;
                   11262:     my @parts=split(/\//,$path);
                   11263:     my $cleanpath;
                   11264:     my $fullpath = $url;
                   11265:     for (my $i=0;$i<@parts;$i++) {
                   11266:         next if ($parts[$i] eq '.');
                   11267:         if ($parts[$i] eq '..') {
                   11268:             $fullpath =~ s{([^/]+/)$}{};
                   11269:         } else {
                   11270:             $fullpath .= $parts[$i].'/';
                   11271:         }
                   11272:     }
                   11273:     if ($fullpath =~ /^\Q$url\E(.*)$/) {
                   11274:         $cleanpath = $1;
                   11275:     } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
                   11276:         my $curr_toprel = $1;
                   11277:         my @parts = split(/\//,$curr_toprel);
                   11278:         my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
                   11279:         my @urlparts = split(/\//,$url_toprel);
                   11280:         my $doubledots;
                   11281:         my $startdiff = -1;
                   11282:         for (my $i=0; $i<@urlparts; $i++) {
                   11283:             if ($startdiff == -1) {
                   11284:                 unless ($urlparts[$i] eq $parts[$i]) {
                   11285:                     $startdiff = $i;
                   11286:                     $doubledots .= '../';
                   11287:                 }
                   11288:             } else {
                   11289:                 $doubledots .= '../';
                   11290:             }
                   11291:         }
                   11292:         if ($startdiff > -1) {
                   11293:             $cleanpath = $doubledots;
                   11294:             for (my $i=$startdiff; $i<@parts; $i++) {
                   11295:                 $cleanpath .= $parts[$i].'/';
                   11296:             }
                   11297:         }
                   11298:     }
                   11299:     $cleanpath =~ s{(/)$}{};
                   11300:     return $cleanpath;
                   11301: }
1.31      albertel 11302: 
1.1053    raeburn  11303: sub is_archive_file {
                   11304:     my ($mimetype) = @_;
                   11305:     if (($mimetype eq 'application/octet-stream') ||
                   11306:         ($mimetype eq 'application/x-stuffit') ||
                   11307:         ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
                   11308:         return 1;
                   11309:     }
                   11310:     return;
                   11311: }
                   11312: 
                   11313: sub decompress_form {
1.1065    raeburn  11314:     my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053    raeburn  11315:     my %lt = &Apache::lonlocal::texthash (
                   11316:         this => 'This file is an archive file.',
1.1067    raeburn  11317:         camt => 'This file is a Camtasia archive file.',
1.1065    raeburn  11318:         itsc => 'Its contents are as follows:',
1.1053    raeburn  11319:         youm => 'You may wish to extract its contents.',
                   11320:         extr => 'Extract contents',
1.1067    raeburn  11321:         auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
                   11322:         proa => 'Process automatically?',
1.1053    raeburn  11323:         yes  => 'Yes',
                   11324:         no   => 'No',
1.1067    raeburn  11325:         fold => 'Title for folder containing movie',
                   11326:         movi => 'Title for page containing embedded movie', 
1.1053    raeburn  11327:     );
1.1065    raeburn  11328:     my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067    raeburn  11329:     my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065    raeburn  11330:     my $info = &list_archive_contents($fileloc,\@paths);
                   11331:     if (@paths) {
                   11332:         foreach my $path (@paths) {
                   11333:             $path =~ s{^/}{};
1.1067    raeburn  11334:             if ($path =~ m{^([^/]+)/$}) {
                   11335:                 $topdir = $1;
                   11336:             }
1.1065    raeburn  11337:             if ($path =~ m{^([^/]+)/}) {
                   11338:                 $toplevel{$1} = $path;
                   11339:             } else {
                   11340:                 $toplevel{$path} = $path;
                   11341:             }
                   11342:         }
                   11343:     }
1.1067    raeburn  11344:     if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
1.1075.2.59  raeburn  11345:         my @camtasia6 = ("$topdir/","$topdir/index.html",
1.1067    raeburn  11346:                         "$topdir/media/",
                   11347:                         "$topdir/media/$topdir.mp4",
                   11348:                         "$topdir/media/FirstFrame.png",
                   11349:                         "$topdir/media/player.swf",
                   11350:                         "$topdir/media/swfobject.js",
                   11351:                         "$topdir/media/expressInstall.swf");
1.1075.2.81  raeburn  11352:         my @camtasia8_1 = ("$topdir/","$topdir/$topdir.html",
1.1075.2.59  raeburn  11353:                          "$topdir/$topdir.mp4",
                   11354:                          "$topdir/$topdir\_config.xml",
                   11355:                          "$topdir/$topdir\_controller.swf",
                   11356:                          "$topdir/$topdir\_embed.css",
                   11357:                          "$topdir/$topdir\_First_Frame.png",
                   11358:                          "$topdir/$topdir\_player.html",
                   11359:                          "$topdir/$topdir\_Thumbnails.png",
                   11360:                          "$topdir/playerProductInstall.swf",
                   11361:                          "$topdir/scripts/",
                   11362:                          "$topdir/scripts/config_xml.js",
                   11363:                          "$topdir/scripts/handlebars.js",
                   11364:                          "$topdir/scripts/jquery-1.7.1.min.js",
                   11365:                          "$topdir/scripts/jquery-ui-1.8.15.custom.min.js",
                   11366:                          "$topdir/scripts/modernizr.js",
                   11367:                          "$topdir/scripts/player-min.js",
                   11368:                          "$topdir/scripts/swfobject.js",
                   11369:                          "$topdir/skins/",
                   11370:                          "$topdir/skins/configuration_express.xml",
                   11371:                          "$topdir/skins/express_show/",
                   11372:                          "$topdir/skins/express_show/player-min.css",
                   11373:                          "$topdir/skins/express_show/spritesheet.png");
1.1075.2.81  raeburn  11374:         my @camtasia8_4 = ("$topdir/","$topdir/$topdir.html",
                   11375:                          "$topdir/$topdir.mp4",
                   11376:                          "$topdir/$topdir\_config.xml",
                   11377:                          "$topdir/$topdir\_controller.swf",
                   11378:                          "$topdir/$topdir\_embed.css",
                   11379:                          "$topdir/$topdir\_First_Frame.png",
                   11380:                          "$topdir/$topdir\_player.html",
                   11381:                          "$topdir/$topdir\_Thumbnails.png",
                   11382:                          "$topdir/playerProductInstall.swf",
                   11383:                          "$topdir/scripts/",
                   11384:                          "$topdir/scripts/config_xml.js",
                   11385:                          "$topdir/scripts/techsmith-smart-player.min.js",
                   11386:                          "$topdir/skins/",
                   11387:                          "$topdir/skins/configuration_express.xml",
                   11388:                          "$topdir/skins/express_show/",
                   11389:                          "$topdir/skins/express_show/spritesheet.min.css",
                   11390:                          "$topdir/skins/express_show/spritesheet.png",
                   11391:                          "$topdir/skins/express_show/techsmith-smart-player.min.css");
1.1075.2.59  raeburn  11392:         my @diffs = &compare_arrays(\@paths,\@camtasia6);
1.1067    raeburn  11393:         if (@diffs == 0) {
1.1075.2.59  raeburn  11394:             $is_camtasia = 6;
                   11395:         } else {
1.1075.2.81  raeburn  11396:             @diffs = &compare_arrays(\@paths,\@camtasia8_1);
1.1075.2.59  raeburn  11397:             if (@diffs == 0) {
                   11398:                 $is_camtasia = 8;
1.1075.2.81  raeburn  11399:             } else {
                   11400:                 @diffs = &compare_arrays(\@paths,\@camtasia8_4);
                   11401:                 if (@diffs == 0) {
                   11402:                     $is_camtasia = 8;
                   11403:                 }
1.1075.2.59  raeburn  11404:             }
1.1067    raeburn  11405:         }
                   11406:     }
                   11407:     my $output;
                   11408:     if ($is_camtasia) {
                   11409:         $output = <<"ENDCAM";
                   11410: <script type="text/javascript" language="Javascript">
                   11411: // <![CDATA[
                   11412: 
                   11413: function camtasiaToggle() {
                   11414:     for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
                   11415:         if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
1.1075.2.59  raeburn  11416:             if (document.uploaded_decompress.autoextract_camtasia[i].value == $is_camtasia) {
1.1067    raeburn  11417:                 document.getElementById('camtasia_titles').style.display='block';
                   11418:             } else {
                   11419:                 document.getElementById('camtasia_titles').style.display='none';
                   11420:             }
                   11421:         }
                   11422:     }
                   11423:     return;
                   11424: }
                   11425: 
                   11426: // ]]>
                   11427: </script>
                   11428: <p>$lt{'camt'}</p>
                   11429: ENDCAM
1.1065    raeburn  11430:     } else {
1.1067    raeburn  11431:         $output = '<p>'.$lt{'this'};
                   11432:         if ($info eq '') {
                   11433:             $output .= ' '.$lt{'youm'}.'</p>'."\n";
                   11434:         } else {
                   11435:             $output .= ' '.$lt{'itsc'}.'</p>'."\n".
                   11436:                        '<div><pre>'.$info.'</pre></div>';
                   11437:         }
1.1065    raeburn  11438:     }
1.1067    raeburn  11439:     $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065    raeburn  11440:     my $duplicates;
                   11441:     my $num = 0;
                   11442:     if (ref($dirlist) eq 'ARRAY') {
                   11443:         foreach my $item (@{$dirlist}) {
                   11444:             if (ref($item) eq 'ARRAY') {
                   11445:                 if (exists($toplevel{$item->[0]})) {
                   11446:                     $duplicates .= 
                   11447:                         &start_data_table_row().
                   11448:                         '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
                   11449:                         'value="0" checked="checked" />'.&mt('No').'</label>'.
                   11450:                         '&nbsp;<label><input type="radio" name="archive_overwrite_'.$num.'" '.
                   11451:                         'value="1" />'.&mt('Yes').'</label>'.
                   11452:                         '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
                   11453:                         '<td>'.$item->[0].'</td>';
                   11454:                     if ($item->[2]) {
                   11455:                         $duplicates .= '<td>'.&mt('Directory').'</td>';
                   11456:                     } else {
                   11457:                         $duplicates .= '<td>'.&mt('File').'</td>';
                   11458:                     }
                   11459:                     $duplicates .= '<td>'.$item->[3].'</td>'.
                   11460:                                    '<td>'.
                   11461:                                    &Apache::lonlocal::locallocaltime($item->[4]).
                   11462:                                    '</td>'.
                   11463:                                    &end_data_table_row();
                   11464:                     $num ++;
                   11465:                 }
                   11466:             }
                   11467:         }
                   11468:     }
                   11469:     my $itemcount;
                   11470:     if (@paths > 0) {
                   11471:         $itemcount = scalar(@paths);
                   11472:     } else {
                   11473:         $itemcount = 1;
                   11474:     }
1.1067    raeburn  11475:     if ($is_camtasia) {
                   11476:         $output .= $lt{'auto'}.'<br />'.
                   11477:                    '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
1.1075.2.59  raeburn  11478:                    '<input type="radio" name="autoextract_camtasia" value="'.$is_camtasia.'" onclick="javascript:camtasiaToggle();" checked="checked" />'.
1.1067    raeburn  11479:                    $lt{'yes'}.'</label>&nbsp;<label>'.
                   11480:                    '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
                   11481:                    $lt{'no'}.'</label></span><br />'.
                   11482:                    '<div id="camtasia_titles" style="display:block">'.
                   11483:                    &Apache::lonhtmlcommon::start_pick_box().
                   11484:                    &Apache::lonhtmlcommon::row_title($lt{'fold'}).
                   11485:                    '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
                   11486:                    &Apache::lonhtmlcommon::row_closure().
                   11487:                    &Apache::lonhtmlcommon::row_title($lt{'movi'}).
                   11488:                    '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
                   11489:                    &Apache::lonhtmlcommon::row_closure(1).
                   11490:                    &Apache::lonhtmlcommon::end_pick_box().
                   11491:                    '</div>';
                   11492:     }
1.1065    raeburn  11493:     $output .= 
                   11494:         '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067    raeburn  11495:         '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
                   11496:         "\n";
1.1065    raeburn  11497:     if ($duplicates ne '') {
                   11498:         $output .= '<p><span class="LC_warning">'.
                   11499:                    &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.  
                   11500:                    &start_data_table().
                   11501:                    &start_data_table_header_row().
                   11502:                    '<th>'.&mt('Overwrite?').'</th>'.
                   11503:                    '<th>'.&mt('Name').'</th>'.
                   11504:                    '<th>'.&mt('Type').'</th>'.
                   11505:                    '<th>'.&mt('Size').'</th>'.
                   11506:                    '<th>'.&mt('Last modified').'</th>'.
                   11507:                    &end_data_table_header_row().
                   11508:                    $duplicates.
                   11509:                    &end_data_table().
                   11510:                    '</p>';
                   11511:     }
1.1067    raeburn  11512:     $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053    raeburn  11513:     if (ref($hiddenelements) eq 'HASH') {
                   11514:         foreach my $hidden (sort(keys(%{$hiddenelements}))) {
                   11515:             $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
                   11516:         }
                   11517:     }
                   11518:     $output .= <<"END";
1.1067    raeburn  11519: <br />
1.1053    raeburn  11520: <input type="submit" name="decompress" value="$lt{'extr'}" />
                   11521: </form>
                   11522: $noextract
                   11523: END
                   11524:     return $output;
                   11525: }
                   11526: 
1.1065    raeburn  11527: sub decompression_utility {
                   11528:     my ($program) = @_;
                   11529:     my @utilities = ('tar','gunzip','bunzip2','unzip'); 
                   11530:     my $location;
                   11531:     if (grep(/^\Q$program\E$/,@utilities)) { 
                   11532:         foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
                   11533:                          '/usr/sbin/') {
                   11534:             if (-x $dir.$program) {
                   11535:                 $location = $dir.$program;
                   11536:                 last;
                   11537:             }
                   11538:         }
                   11539:     }
                   11540:     return $location;
                   11541: }
                   11542: 
                   11543: sub list_archive_contents {
                   11544:     my ($file,$pathsref) = @_;
                   11545:     my (@cmd,$output);
                   11546:     my $needsregexp;
                   11547:     if ($file =~ /\.zip$/) {
                   11548:         @cmd = (&decompression_utility('unzip'),"-l");
                   11549:         $needsregexp = 1;
                   11550:     } elsif (($file =~ m/\.tar\.gz$/) ||
                   11551:              ($file =~ /\.tgz$/)) {
                   11552:         @cmd = (&decompression_utility('tar'),"-ztf");
                   11553:     } elsif ($file =~ /\.tar\.bz2$/) {
                   11554:         @cmd = (&decompression_utility('tar'),"-jtf");
                   11555:     } elsif ($file =~ m|\.tar$|) {
                   11556:         @cmd = (&decompression_utility('tar'),"-tf");
                   11557:     }
                   11558:     if (@cmd) {
                   11559:         undef($!);
                   11560:         undef($@);
                   11561:         if (open(my $fh,"-|", @cmd, $file)) {
                   11562:             while (my $line = <$fh>) {
                   11563:                 $output .= $line;
                   11564:                 chomp($line);
                   11565:                 my $item;
                   11566:                 if ($needsregexp) {
                   11567:                     ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/); 
                   11568:                 } else {
                   11569:                     $item = $line;
                   11570:                 }
                   11571:                 if ($item ne '') {
                   11572:                     unless (grep(/^\Q$item\E$/,@{$pathsref})) {
                   11573:                         push(@{$pathsref},$item);
                   11574:                     } 
                   11575:                 }
                   11576:             }
                   11577:             close($fh);
                   11578:         }
                   11579:     }
                   11580:     return $output;
                   11581: }
                   11582: 
1.1053    raeburn  11583: sub decompress_uploaded_file {
                   11584:     my ($file,$dir) = @_;
                   11585:     &Apache::lonnet::appenv({'cgi.file' => $file});
                   11586:     &Apache::lonnet::appenv({'cgi.dir' => $dir});
                   11587:     my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
                   11588:     my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
                   11589:     my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
                   11590:     &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
                   11591:     my $decompressed = $env{'cgi.decompressed'};
                   11592:     &Apache::lonnet::delenv('cgi.file');
                   11593:     &Apache::lonnet::delenv('cgi.dir');
                   11594:     &Apache::lonnet::delenv('cgi.decompressed');
                   11595:     return ($decompressed,$result);
                   11596: }
                   11597: 
1.1055    raeburn  11598: sub process_decompression {
                   11599:     my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
                   11600:     my ($dir,$error,$warning,$output);
1.1075.2.69  raeburn  11601:     if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) {
1.1075.2.34  raeburn  11602:         $error = &mt('Filename not a supported archive file type.').
                   11603:                  '<br />'.&mt('Filename should end with one of: [_1].',
1.1055    raeburn  11604:                               '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
                   11605:     } else {
                   11606:         my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
                   11607:         if ($docuhome eq 'no_host') {
                   11608:             $error = &mt('Could not determine home server for course.');
                   11609:         } else {
                   11610:             my @ids=&Apache::lonnet::current_machine_ids();
                   11611:             my $currdir = "$dir_root/$destination";
                   11612:             if (grep(/^\Q$docuhome\E$/,@ids)) {
                   11613:                 $dir = &LONCAPA::propath($docudom,$docuname).
                   11614:                        "$dir_root/$destination";
                   11615:             } else {
                   11616:                 $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
                   11617:                        "$dir_root/$docudom/$docuname/$destination";
                   11618:                 unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
                   11619:                     $error = &mt('Archive file not found.');
                   11620:                 }
                   11621:             }
1.1065    raeburn  11622:             my (@to_overwrite,@to_skip);
                   11623:             if ($env{'form.archive_overwrite_total'} > 0) {
                   11624:                 my $total = $env{'form.archive_overwrite_total'};
                   11625:                 for (my $i=0; $i<$total; $i++) {
                   11626:                     if ($env{'form.archive_overwrite_'.$i} == 1) {
                   11627:                         push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
                   11628:                     } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
                   11629:                         push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
                   11630:                     }
                   11631:                 }
                   11632:             }
                   11633:             my $numskip = scalar(@to_skip);
                   11634:             if (($numskip > 0) && 
                   11635:                 ($numskip == $env{'form.archive_itemcount'})) {
                   11636:                 $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');         
                   11637:             } elsif ($dir eq '') {
1.1055    raeburn  11638:                 $error = &mt('Directory containing archive file unavailable.');
                   11639:             } elsif (!$error) {
1.1065    raeburn  11640:                 my ($decompressed,$display);
                   11641:                 if ($numskip > 0) {
                   11642:                     my $tempdir = time.'_'.$$.int(rand(10000));
                   11643:                     mkdir("$dir/$tempdir",0755);
                   11644:                     system("mv $dir/$file $dir/$tempdir/$file");
                   11645:                     ($decompressed,$display) = 
                   11646:                         &decompress_uploaded_file($file,"$dir/$tempdir");
                   11647:                     foreach my $item (@to_skip) {
                   11648:                         if (($item ne '') && ($item !~ /\.\./)) {
                   11649:                             if (-f "$dir/$tempdir/$item") { 
                   11650:                                 unlink("$dir/$tempdir/$item");
                   11651:                             } elsif (-d "$dir/$tempdir/$item") {
                   11652:                                 system("rm -rf $dir/$tempdir/$item");
                   11653:                             }
                   11654:                         }
                   11655:                     }
                   11656:                     system("mv $dir/$tempdir/* $dir");
                   11657:                     rmdir("$dir/$tempdir");   
                   11658:                 } else {
                   11659:                     ($decompressed,$display) = 
                   11660:                         &decompress_uploaded_file($file,$dir);
                   11661:                 }
1.1055    raeburn  11662:                 if ($decompressed eq 'ok') {
1.1065    raeburn  11663:                     $output = '<p class="LC_info">'.
                   11664:                               &mt('Files extracted successfully from archive.').
                   11665:                               '</p>'."\n";
1.1055    raeburn  11666:                     my ($warning,$result,@contents);
                   11667:                     my ($newdirlistref,$newlisterror) =
                   11668:                         &Apache::lonnet::dirlist($currdir,$docudom,
                   11669:                                                  $docuname,1);
                   11670:                     my (%is_dir,%changes,@newitems);
                   11671:                     my $dirptr = 16384;
1.1065    raeburn  11672:                     if (ref($newdirlistref) eq 'ARRAY') {
1.1055    raeburn  11673:                         foreach my $dir_line (@{$newdirlistref}) {
                   11674:                             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1065    raeburn  11675:                             unless (($item =~ /^\.+$/) || ($item eq $file) || 
                   11676:                                     ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) {
1.1055    raeburn  11677:                                 push(@newitems,$item);
                   11678:                                 if ($dirptr&$testdir) {
                   11679:                                     $is_dir{$item} = 1;
                   11680:                                 }
                   11681:                                 $changes{$item} = 1;
                   11682:                             }
                   11683:                         }
                   11684:                     }
                   11685:                     if (keys(%changes) > 0) {
                   11686:                         foreach my $item (sort(@newitems)) {
                   11687:                             if ($changes{$item}) {
                   11688:                                 push(@contents,$item);
                   11689:                             }
                   11690:                         }
                   11691:                     }
                   11692:                     if (@contents > 0) {
1.1067    raeburn  11693:                         my $wantform;
                   11694:                         unless ($env{'form.autoextract_camtasia'}) {
                   11695:                             $wantform = 1;
                   11696:                         }
1.1056    raeburn  11697:                         my (%children,%parent,%dirorder,%titles);
1.1055    raeburn  11698:                         my ($count,$datatable) = &get_extracted($docudom,$docuname,
                   11699:                                                                 $currdir,\%is_dir,
                   11700:                                                                 \%children,\%parent,
1.1056    raeburn  11701:                                                                 \@contents,\%dirorder,
                   11702:                                                                 \%titles,$wantform);
1.1055    raeburn  11703:                         if ($datatable ne '') {
                   11704:                             $output .= &archive_options_form('decompressed',$datatable,
                   11705:                                                              $count,$hiddenelem);
1.1065    raeburn  11706:                             my $startcount = 6;
1.1055    raeburn  11707:                             $output .= &archive_javascript($startcount,$count,
1.1056    raeburn  11708:                                                            \%titles,\%children);
1.1055    raeburn  11709:                         }
1.1067    raeburn  11710:                         if ($env{'form.autoextract_camtasia'}) {
1.1075.2.59  raeburn  11711:                             my $version = $env{'form.autoextract_camtasia'};
1.1067    raeburn  11712:                             my %displayed;
                   11713:                             my $total = 1;
                   11714:                             $env{'form.archive_directory'} = [];
                   11715:                             foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
                   11716:                                 my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
                   11717:                                 $path =~ s{/$}{};
                   11718:                                 my $item;
                   11719:                                 if ($path ne '') {
                   11720:                                     $item = "$path/$titles{$i}";
                   11721:                                 } else {
                   11722:                                     $item = $titles{$i};
                   11723:                                 }
                   11724:                                 $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
                   11725:                                 if ($item eq $contents[0]) {
                   11726:                                     push(@{$env{'form.archive_directory'}},$i);
                   11727:                                     $env{'form.archive_'.$i} = 'display';
                   11728:                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
                   11729:                                     $displayed{'folder'} = $i;
1.1075.2.59  raeburn  11730:                                 } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) ||
                   11731:                                          (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) {
1.1067    raeburn  11732:                                     $env{'form.archive_'.$i} = 'display';
                   11733:                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
                   11734:                                     $displayed{'web'} = $i;
                   11735:                                 } else {
1.1075.2.59  raeburn  11736:                                     if ((($item eq "$contents[0]/media") && ($version == 6)) ||
                   11737:                                         ((($item eq "$contents[0]/scripts") || ($item eq "$contents[0]/skins") ||
                   11738:                                              ($item eq "$contents[0]/skins/express_show")) && ($version == 8))) {
1.1067    raeburn  11739:                                         push(@{$env{'form.archive_directory'}},$i);
                   11740:                                     }
                   11741:                                     $env{'form.archive_'.$i} = 'dependency';
                   11742:                                 }
                   11743:                                 $total ++;
                   11744:                             }
                   11745:                             for (my $i=1; $i<$total; $i++) {
                   11746:                                 next if ($i == $displayed{'web'});
                   11747:                                 next if ($i == $displayed{'folder'});
                   11748:                                 $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
                   11749:                             }
                   11750:                             $env{'form.phase'} = 'decompress_cleanup';
                   11751:                             $env{'form.archivedelete'} = 1;
                   11752:                             $env{'form.archive_count'} = $total-1;
                   11753:                             $output .=
                   11754:                                 &process_extracted_files('coursedocs',$docudom,
                   11755:                                                          $docuname,$destination,
                   11756:                                                          $dir_root,$hiddenelem);
                   11757:                         }
1.1055    raeburn  11758:                     } else {
                   11759:                         $warning = &mt('No new items extracted from archive file.');
                   11760:                     }
                   11761:                 } else {
                   11762:                     $output = $display;
                   11763:                     $error = &mt('An error occurred during extraction from the archive file.');
                   11764:                 }
                   11765:             }
                   11766:         }
                   11767:     }
                   11768:     if ($error) {
                   11769:         $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   11770:                    $error.'</p>'."\n";
                   11771:     }
                   11772:     if ($warning) {
                   11773:         $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
                   11774:     }
                   11775:     return $output;
                   11776: }
                   11777: 
                   11778: sub get_extracted {
1.1056    raeburn  11779:     my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
                   11780:         $titles,$wantform) = @_;
1.1055    raeburn  11781:     my $count = 0;
                   11782:     my $depth = 0;
                   11783:     my $datatable;
1.1056    raeburn  11784:     my @hierarchy;
1.1055    raeburn  11785:     return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056    raeburn  11786:                    (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
                   11787:                    (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055    raeburn  11788:     foreach my $item (@{$contents}) {
                   11789:         $count ++;
1.1056    raeburn  11790:         @{$dirorder->{$count}} = @hierarchy;
                   11791:         $titles->{$count} = $item;
1.1055    raeburn  11792:         &archive_hierarchy($depth,$count,$parent,$children);
                   11793:         if ($wantform) {
                   11794:             $datatable .= &archive_row($is_dir->{$item},$item,
                   11795:                                        $currdir,$depth,$count);
                   11796:         }
                   11797:         if ($is_dir->{$item}) {
                   11798:             $depth ++;
1.1056    raeburn  11799:             push(@hierarchy,$count);
                   11800:             $parent->{$depth} = $count;
1.1055    raeburn  11801:             $datatable .=
                   11802:                 &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056    raeburn  11803:                                            \$depth,\$count,\@hierarchy,$dirorder,
                   11804:                                            $children,$parent,$titles,$wantform);
1.1055    raeburn  11805:             $depth --;
1.1056    raeburn  11806:             pop(@hierarchy);
1.1055    raeburn  11807:         }
                   11808:     }
                   11809:     return ($count,$datatable);
                   11810: }
                   11811: 
                   11812: sub recurse_extracted_archive {
1.1056    raeburn  11813:     my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
                   11814:         $children,$parent,$titles,$wantform) = @_;
1.1055    raeburn  11815:     my $result='';
1.1056    raeburn  11816:     unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
                   11817:             (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
                   11818:             (ref($dirorder) eq 'HASH')) {
1.1055    raeburn  11819:         return $result;
                   11820:     }
                   11821:     my $dirptr = 16384;
                   11822:     my ($newdirlistref,$newlisterror) =
                   11823:         &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
                   11824:     if (ref($newdirlistref) eq 'ARRAY') {
                   11825:         foreach my $dir_line (@{$newdirlistref}) {
                   11826:             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
                   11827:             unless ($item =~ /^\.+$/) {
                   11828:                 $$count ++;
1.1056    raeburn  11829:                 @{$dirorder->{$$count}} = @{$hierarchy};
                   11830:                 $titles->{$$count} = $item;
1.1055    raeburn  11831:                 &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056    raeburn  11832: 
1.1055    raeburn  11833:                 my $is_dir;
                   11834:                 if ($dirptr&$testdir) {
                   11835:                     $is_dir = 1;
                   11836:                 }
                   11837:                 if ($wantform) {
                   11838:                     $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
                   11839:                 }
                   11840:                 if ($is_dir) {
                   11841:                     $$depth ++;
1.1056    raeburn  11842:                     push(@{$hierarchy},$$count);
                   11843:                     $parent->{$$depth} = $$count;
1.1055    raeburn  11844:                     $result .=
                   11845:                         &recurse_extracted_archive("$currdir/$item",$docudom,
                   11846:                                                    $docuname,$depth,$count,
1.1056    raeburn  11847:                                                    $hierarchy,$dirorder,$children,
                   11848:                                                    $parent,$titles,$wantform);
1.1055    raeburn  11849:                     $$depth --;
1.1056    raeburn  11850:                     pop(@{$hierarchy});
1.1055    raeburn  11851:                 }
                   11852:             }
                   11853:         }
                   11854:     }
                   11855:     return $result;
                   11856: }
                   11857: 
                   11858: sub archive_hierarchy {
                   11859:     my ($depth,$count,$parent,$children) =@_;
                   11860:     if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
                   11861:         if (exists($parent->{$depth})) {
                   11862:              $children->{$parent->{$depth}} .= $count.':';
                   11863:         }
                   11864:     }
                   11865:     return;
                   11866: }
                   11867: 
                   11868: sub archive_row {
                   11869:     my ($is_dir,$item,$currdir,$depth,$count) = @_;
                   11870:     my ($name) = ($item =~ m{([^/]+)$});
                   11871:     my %choices = &Apache::lonlocal::texthash (
1.1059    raeburn  11872:                                        'display'    => 'Add as file',
1.1055    raeburn  11873:                                        'dependency' => 'Include as dependency',
                   11874:                                        'discard'    => 'Discard',
                   11875:                                       );
                   11876:     if ($is_dir) {
1.1059    raeburn  11877:         $choices{'display'} = &mt('Add as folder'); 
1.1055    raeburn  11878:     }
1.1056    raeburn  11879:     my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
                   11880:     my $offset = 0;
1.1055    raeburn  11881:     foreach my $action ('display','dependency','discard') {
1.1056    raeburn  11882:         $offset ++;
1.1065    raeburn  11883:         if ($action ne 'display') {
                   11884:             $offset ++;
                   11885:         }  
1.1055    raeburn  11886:         $output .= '<td><span class="LC_nobreak">'.
                   11887:                    '<label><input type="radio" name="archive_'.$count.
                   11888:                    '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
                   11889:         my $text = $choices{$action};
                   11890:         if ($is_dir) {
                   11891:             $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
                   11892:             if ($action eq 'display') {
1.1059    raeburn  11893:                 $text = &mt('Add as folder');
1.1055    raeburn  11894:             }
1.1056    raeburn  11895:         } else {
                   11896:             $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
                   11897: 
                   11898:         }
                   11899:         $output .= ' />&nbsp;'.$choices{$action}.'</label></span>';
                   11900:         if ($action eq 'dependency') {
                   11901:             $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
                   11902:                        &mt('Used by:').'&nbsp;<select name="archive_dependent_on_'.$count.'" '.
                   11903:                        'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
                   11904:                        '<option value=""></option>'."\n".
                   11905:                        '</select>'."\n".
                   11906:                        '</div>';
1.1059    raeburn  11907:         } elsif ($action eq 'display') {
                   11908:             $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
                   11909:                        &mt('Title:').'&nbsp;<input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
                   11910:                        '</div>';
1.1055    raeburn  11911:         }
1.1056    raeburn  11912:         $output .= '</td>';
1.1055    raeburn  11913:     }
                   11914:     $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
                   11915:                &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.('&nbsp;' x 2);
                   11916:     for (my $i=0; $i<$depth; $i++) {
                   11917:         $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
                   11918:     }
                   11919:     if ($is_dir) {
                   11920:         $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" />&nbsp;'."\n".
                   11921:                    '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
                   11922:     } else {
                   11923:         $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
                   11924:     }
                   11925:     $output .= '&nbsp;'.$name.'</td>'."\n".
                   11926:                &end_data_table_row();
                   11927:     return $output;
                   11928: }
                   11929: 
                   11930: sub archive_options_form {
1.1065    raeburn  11931:     my ($form,$display,$count,$hiddenelem) = @_;
                   11932:     my %lt = &Apache::lonlocal::texthash(
                   11933:                perm => 'Permanently remove archive file?',
                   11934:                hows => 'How should each extracted item be incorporated in the course?',
                   11935:                cont => 'Content actions for all',
                   11936:                addf => 'Add as folder/file',
                   11937:                incd => 'Include as dependency for a displayed file',
                   11938:                disc => 'Discard',
                   11939:                no   => 'No',
                   11940:                yes  => 'Yes',
                   11941:                save => 'Save',
                   11942:     );
                   11943:     my $output = <<"END";
                   11944: <form name="$form" method="post" action="">
                   11945: <p><span class="LC_nobreak">$lt{'perm'}&nbsp;
                   11946: <label>
                   11947:   <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
                   11948: </label>
                   11949: &nbsp;
                   11950: <label>
                   11951:   <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
                   11952: </span>
                   11953: </p>
                   11954: <input type="hidden" name="phase" value="decompress_cleanup" />
                   11955: <br />$lt{'hows'}
                   11956: <div class="LC_columnSection">
                   11957:   <fieldset>
                   11958:     <legend>$lt{'cont'}</legend>
                   11959:     <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" /> 
                   11960:     &nbsp;&nbsp;<input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
                   11961:     &nbsp;&nbsp;<input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
                   11962:   </fieldset>
                   11963: </div>
                   11964: END
                   11965:     return $output.
1.1055    raeburn  11966:            &start_data_table()."\n".
1.1065    raeburn  11967:            $display."\n".
1.1055    raeburn  11968:            &end_data_table()."\n".
                   11969:            '<input type="hidden" name="archive_count" value="'.$count.'" />'.
                   11970:            $hiddenelem.
1.1065    raeburn  11971:            '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055    raeburn  11972:            '</form>';
                   11973: }
                   11974: 
                   11975: sub archive_javascript {
1.1056    raeburn  11976:     my ($startcount,$numitems,$titles,$children) = @_;
                   11977:     return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059    raeburn  11978:     my $maintitle = $env{'form.comment'};
1.1055    raeburn  11979:     my $scripttag = <<START;
                   11980: <script type="text/javascript">
                   11981: // <![CDATA[
                   11982: 
                   11983: function checkAll(form,prefix) {
                   11984:     var idstr =  new RegExp("^archive_"+prefix+"_\\\\d+\$");
                   11985:     for (var i=0; i < form.elements.length; i++) {
                   11986:         var id = form.elements[i].id;
                   11987:         if ((id != '') && (id != undefined)) {
                   11988:             if (idstr.test(id)) {
                   11989:                 if (form.elements[i].type == 'radio') {
                   11990:                     form.elements[i].checked = true;
1.1056    raeburn  11991:                     var nostart = i-$startcount;
1.1059    raeburn  11992:                     var offset = nostart%7;
                   11993:                     var count = (nostart-offset)/7;    
1.1056    raeburn  11994:                     dependencyCheck(form,count,offset);
1.1055    raeburn  11995:                 }
                   11996:             }
                   11997:         }
                   11998:     }
                   11999: }
                   12000: 
                   12001: function propagateCheck(form,count) {
                   12002:     if (count > 0) {
1.1059    raeburn  12003:         var startelement = $startcount + ((count-1) * 7);
                   12004:         for (var j=1; j<6; j++) {
                   12005:             if ((j != 2) && (j != 4)) {
1.1056    raeburn  12006:                 var item = startelement + j; 
                   12007:                 if (form.elements[item].type == 'radio') {
                   12008:                     if (form.elements[item].checked) {
                   12009:                         containerCheck(form,count,j);
                   12010:                         break;
                   12011:                     }
1.1055    raeburn  12012:                 }
                   12013:             }
                   12014:         }
                   12015:     }
                   12016: }
                   12017: 
                   12018: numitems = $numitems
1.1056    raeburn  12019: var titles = new Array(numitems);
                   12020: var parents = new Array(numitems);
1.1055    raeburn  12021: for (var i=0; i<numitems; i++) {
1.1056    raeburn  12022:     parents[i] = new Array;
1.1055    raeburn  12023: }
1.1059    raeburn  12024: var maintitle = '$maintitle';
1.1055    raeburn  12025: 
                   12026: START
                   12027: 
1.1056    raeburn  12028:     foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
                   12029:         my @contents = split(/:/,$children->{$container});
1.1055    raeburn  12030:         for (my $i=0; $i<@contents; $i ++) {
                   12031:             $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
                   12032:         }
                   12033:     }
                   12034: 
1.1056    raeburn  12035:     foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
                   12036:         $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
                   12037:     }
                   12038: 
1.1055    raeburn  12039:     $scripttag .= <<END;
                   12040: 
                   12041: function containerCheck(form,count,offset) {
                   12042:     if (count > 0) {
1.1056    raeburn  12043:         dependencyCheck(form,count,offset);
1.1059    raeburn  12044:         var item = (offset+$startcount)+7*(count-1);
1.1055    raeburn  12045:         form.elements[item].checked = true;
                   12046:         if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   12047:             if (parents[count].length > 0) {
                   12048:                 for (var j=0; j<parents[count].length; j++) {
1.1056    raeburn  12049:                     containerCheck(form,parents[count][j],offset);
                   12050:                 }
                   12051:             }
                   12052:         }
                   12053:     }
                   12054: }
                   12055: 
                   12056: function dependencyCheck(form,count,offset) {
                   12057:     if (count > 0) {
1.1059    raeburn  12058:         var chosen = (offset+$startcount)+7*(count-1);
                   12059:         var depitem = $startcount + ((count-1) * 7) + 4;
1.1056    raeburn  12060:         var currtype = form.elements[depitem].type;
                   12061:         if (form.elements[chosen].value == 'dependency') {
                   12062:             document.getElementById('arc_depon_'+count).style.display='block'; 
                   12063:             form.elements[depitem].options.length = 0;
                   12064:             form.elements[depitem].options[0] = new Option('Select','',true,true);
1.1075.2.11  raeburn  12065:             for (var i=1; i<=numitems; i++) {
                   12066:                 if (i == count) {
                   12067:                     continue;
                   12068:                 }
1.1059    raeburn  12069:                 var startelement = $startcount + (i-1) * 7;
                   12070:                 for (var j=1; j<6; j++) {
                   12071:                     if ((j != 2) && (j!= 4)) {
1.1056    raeburn  12072:                         var item = startelement + j;
                   12073:                         if (form.elements[item].type == 'radio') {
                   12074:                             if (form.elements[item].checked) {
                   12075:                                 if (form.elements[item].value == 'display') {
                   12076:                                     var n = form.elements[depitem].options.length;
                   12077:                                     form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
                   12078:                                 }
                   12079:                             }
                   12080:                         }
                   12081:                     }
                   12082:                 }
                   12083:             }
                   12084:         } else {
                   12085:             document.getElementById('arc_depon_'+count).style.display='none';
                   12086:             form.elements[depitem].options.length = 0;
                   12087:             form.elements[depitem].options[0] = new Option('Select','',true,true);
                   12088:         }
1.1059    raeburn  12089:         titleCheck(form,count,offset);
1.1056    raeburn  12090:     }
                   12091: }
                   12092: 
                   12093: function propagateSelect(form,count,offset) {
                   12094:     if (count > 0) {
1.1065    raeburn  12095:         var item = (1+offset+$startcount)+7*(count-1);
1.1056    raeburn  12096:         var picked = form.elements[item].options[form.elements[item].selectedIndex].value; 
                   12097:         if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   12098:             if (parents[count].length > 0) {
                   12099:                 for (var j=0; j<parents[count].length; j++) {
                   12100:                     containerSelect(form,parents[count][j],offset,picked);
1.1055    raeburn  12101:                 }
                   12102:             }
                   12103:         }
                   12104:     }
                   12105: }
1.1056    raeburn  12106: 
                   12107: function containerSelect(form,count,offset,picked) {
                   12108:     if (count > 0) {
1.1065    raeburn  12109:         var item = (offset+$startcount)+7*(count-1);
1.1056    raeburn  12110:         if (form.elements[item].type == 'radio') {
                   12111:             if (form.elements[item].value == 'dependency') {
                   12112:                 if (form.elements[item+1].type == 'select-one') {
                   12113:                     for (var i=0; i<form.elements[item+1].options.length; i++) {
                   12114:                         if (form.elements[item+1].options[i].value == picked) {
                   12115:                             form.elements[item+1].selectedIndex = i;
                   12116:                             break;
                   12117:                         }
                   12118:                     }
                   12119:                 }
                   12120:                 if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   12121:                     if (parents[count].length > 0) {
                   12122:                         for (var j=0; j<parents[count].length; j++) {
                   12123:                             containerSelect(form,parents[count][j],offset,picked);
                   12124:                         }
                   12125:                     }
                   12126:                 }
                   12127:             }
                   12128:         }
                   12129:     }
                   12130: }
                   12131: 
1.1059    raeburn  12132: function titleCheck(form,count,offset) {
                   12133:     if (count > 0) {
                   12134:         var chosen = (offset+$startcount)+7*(count-1);
                   12135:         var depitem = $startcount + ((count-1) * 7) + 2;
                   12136:         var currtype = form.elements[depitem].type;
                   12137:         if (form.elements[chosen].value == 'display') {
                   12138:             document.getElementById('arc_title_'+count).style.display='block';
                   12139:             if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
                   12140:                 document.getElementById('archive_title_'+count).value=maintitle;
                   12141:             }
                   12142:         } else {
                   12143:             document.getElementById('arc_title_'+count).style.display='none';
                   12144:             if (currtype == 'text') { 
                   12145:                 document.getElementById('archive_title_'+count).value='';
                   12146:             }
                   12147:         }
                   12148:     }
                   12149:     return;
                   12150: }
                   12151: 
1.1055    raeburn  12152: // ]]>
                   12153: </script>
                   12154: END
                   12155:     return $scripttag;
                   12156: }
                   12157: 
                   12158: sub process_extracted_files {
1.1067    raeburn  12159:     my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055    raeburn  12160:     my $numitems = $env{'form.archive_count'};
                   12161:     return unless ($numitems);
                   12162:     my @ids=&Apache::lonnet::current_machine_ids();
                   12163:     my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067    raeburn  12164:         %folders,%containers,%mapinner,%prompttofetch);
1.1055    raeburn  12165:     my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
                   12166:     if (grep(/^\Q$docuhome\E$/,@ids)) {
                   12167:         $prefix = &LONCAPA::propath($docudom,$docuname);
                   12168:         $pathtocheck = "$dir_root/$destination";
                   12169:         $dir = $dir_root;
                   12170:         $ishome = 1;
                   12171:     } else {
                   12172:         $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
                   12173:         $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
                   12174:         $dir = "$dir_root/$docudom/$docuname";    
                   12175:     }
                   12176:     my $currdir = "$dir_root/$destination";
                   12177:     (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
                   12178:     if ($env{'form.folderpath'}) {
                   12179:         my @items = split('&',$env{'form.folderpath'});
                   12180:         $folders{'0'} = $items[-2];
1.1075.2.17  raeburn  12181:         if ($env{'form.folderpath'} =~ /\:1$/) {
                   12182:             $containers{'0'}='page';
                   12183:         } else {
                   12184:             $containers{'0'}='sequence';
                   12185:         }
1.1055    raeburn  12186:     }
                   12187:     my @archdirs = &get_env_multiple('form.archive_directory');
                   12188:     if ($numitems) {
                   12189:         for (my $i=1; $i<=$numitems; $i++) {
                   12190:             my $path = $env{'form.archive_content_'.$i};
                   12191:             if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
                   12192:                 my $item = $1;
                   12193:                 $toplevelitems{$item} = $i;
                   12194:                 if (grep(/^\Q$i\E$/,@archdirs)) {
                   12195:                     $is_dir{$item} = 1;
                   12196:                 }
                   12197:             }
                   12198:         }
                   12199:     }
1.1067    raeburn  12200:     my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055    raeburn  12201:     if (keys(%toplevelitems) > 0) {
                   12202:         my @contents = sort(keys(%toplevelitems));
1.1056    raeburn  12203:         (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
                   12204:                                            \%parent,\@contents,\%dirorder,\%titles);
1.1055    raeburn  12205:     }
1.1066    raeburn  12206:     my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055    raeburn  12207:     if ($numitems) {
                   12208:         for (my $i=1; $i<=$numitems; $i++) {
1.1075.2.11  raeburn  12209:             next if ($env{'form.archive_'.$i} eq 'dependency');
1.1055    raeburn  12210:             my $path = $env{'form.archive_content_'.$i};
                   12211:             if ($path =~ /^\Q$pathtocheck\E/) {
                   12212:                 if ($env{'form.archive_'.$i} eq 'discard') {
                   12213:                     if ($prefix ne '' && $path ne '') {
                   12214:                         if (-e $prefix.$path) {
1.1066    raeburn  12215:                             if ((@archdirs > 0) && 
                   12216:                                 (grep(/^\Q$i\E$/,@archdirs))) {
                   12217:                                 $todeletedir{$prefix.$path} = 1;
                   12218:                             } else {
                   12219:                                 $todelete{$prefix.$path} = 1;
                   12220:                             }
1.1055    raeburn  12221:                         }
                   12222:                     }
                   12223:                 } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059    raeburn  12224:                     my ($docstitle,$title,$url,$outer);
1.1055    raeburn  12225:                     ($title) = ($path =~ m{/([^/]+)$});
1.1059    raeburn  12226:                     $docstitle = $env{'form.archive_title_'.$i};
                   12227:                     if ($docstitle eq '') {
                   12228:                         $docstitle = $title;
                   12229:                     }
1.1055    raeburn  12230:                     $outer = 0;
1.1056    raeburn  12231:                     if (ref($dirorder{$i}) eq 'ARRAY') {
                   12232:                         if (@{$dirorder{$i}} > 0) {
                   12233:                             foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055    raeburn  12234:                                 if ($env{'form.archive_'.$item} eq 'display') {
                   12235:                                     $outer = $item;
                   12236:                                     last;
                   12237:                                 }
                   12238:                             }
                   12239:                         }
                   12240:                     }
                   12241:                     my ($errtext,$fatal) = 
                   12242:                         &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
                   12243:                                                '/'.$folders{$outer}.'.'.
                   12244:                                                $containers{$outer});
                   12245:                     next if ($fatal);
                   12246:                     if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
                   12247:                         if ($context eq 'coursedocs') {
1.1056    raeburn  12248:                             $mapinner{$i} = time;
1.1055    raeburn  12249:                             $folders{$i} = 'default_'.$mapinner{$i};
                   12250:                             $containers{$i} = 'sequence';
                   12251:                             my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
                   12252:                                       $folders{$i}.'.'.$containers{$i};
                   12253:                             my $newidx = &LONCAPA::map::getresidx();
                   12254:                             $LONCAPA::map::resources[$newidx]=
1.1059    raeburn  12255:                                 $docstitle.':'.$url.':false:normal:res';
1.1055    raeburn  12256:                             push(@LONCAPA::map::order,$newidx);
                   12257:                             my ($outtext,$errtext) =
                   12258:                                 &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
                   12259:                                                         $docuname.'/'.$folders{$outer}.
1.1075.2.11  raeburn  12260:                                                         '.'.$containers{$outer},1,1);
1.1056    raeburn  12261:                             $newseqid{$i} = $newidx;
1.1067    raeburn  12262:                             unless ($errtext) {
                   12263:                                 $result .=  '<li>'.&mt('Folder: [_1] added to course',$docstitle).'</li>'."\n";
                   12264:                             }
1.1055    raeburn  12265:                         }
                   12266:                     } else {
                   12267:                         if ($context eq 'coursedocs') {
                   12268:                             my $newidx=&LONCAPA::map::getresidx();
                   12269:                             my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
                   12270:                                       $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
                   12271:                                       $title;
                   12272:                             if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
                   12273:                                 mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
                   12274:                             }
                   12275:                             if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                   12276:                                 mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
                   12277:                             }
                   12278:                             if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                   12279:                                 system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title");
1.1056    raeburn  12280:                                 $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
1.1067    raeburn  12281:                                 unless ($ishome) {
                   12282:                                     my $fetch = "$newdest{$i}/$title";
                   12283:                                     $fetch =~ s/^\Q$prefix$dir\E//;
                   12284:                                     $prompttofetch{$fetch} = 1;
                   12285:                                 }
1.1055    raeburn  12286:                             }
                   12287:                             $LONCAPA::map::resources[$newidx]=
1.1059    raeburn  12288:                                 $docstitle.':'.$url.':false:normal:res';
1.1055    raeburn  12289:                             push(@LONCAPA::map::order, $newidx);
                   12290:                             my ($outtext,$errtext)=
                   12291:                                 &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
                   12292:                                                         $docuname.'/'.$folders{$outer}.
1.1075.2.11  raeburn  12293:                                                         '.'.$containers{$outer},1,1);
1.1067    raeburn  12294:                             unless ($errtext) {
                   12295:                                 if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
                   12296:                                     $result .= '<li>'.&mt('File: [_1] added to course',$docstitle).'</li>'."\n";
                   12297:                                 }
                   12298:                             }
1.1055    raeburn  12299:                         }
                   12300:                     }
1.1075.2.11  raeburn  12301:                 }
                   12302:             } else {
                   12303:                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
                   12304:             }
                   12305:         }
                   12306:         for (my $i=1; $i<=$numitems; $i++) {
                   12307:             next unless ($env{'form.archive_'.$i} eq 'dependency');
                   12308:             my $path = $env{'form.archive_content_'.$i};
                   12309:             if ($path =~ /^\Q$pathtocheck\E/) {
                   12310:                 my ($title) = ($path =~ m{/([^/]+)$});
                   12311:                 $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
                   12312:                 if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
                   12313:                     if (ref($dirorder{$i}) eq 'ARRAY') {
                   12314:                         my ($itemidx,$fullpath,$relpath);
                   12315:                         if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
                   12316:                             my $container = $dirorder{$referrer{$i}}->[-1];
1.1056    raeburn  12317:                             for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
1.1075.2.11  raeburn  12318:                                 if ($dirorder{$i}->[$j] eq $container) {
                   12319:                                     $itemidx = $j;
1.1056    raeburn  12320:                                 }
                   12321:                             }
1.1075.2.11  raeburn  12322:                         }
                   12323:                         if ($itemidx eq '') {
                   12324:                             $itemidx =  0;
                   12325:                         }
                   12326:                         if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
                   12327:                             if ($mapinner{$referrer{$i}}) {
                   12328:                                 $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
                   12329:                                 for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
                   12330:                                     if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
                   12331:                                         unless (defined($newseqid{$dirorder{$i}->[$j]})) {
                   12332:                                             $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   12333:                                             $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   12334:                                             if (!-e $fullpath) {
                   12335:                                                 mkdir($fullpath,0755);
1.1056    raeburn  12336:                                             }
                   12337:                                         }
1.1075.2.11  raeburn  12338:                                     } else {
                   12339:                                         last;
1.1056    raeburn  12340:                                     }
1.1075.2.11  raeburn  12341:                                 }
                   12342:                             }
                   12343:                         } elsif ($newdest{$referrer{$i}}) {
                   12344:                             $fullpath = $newdest{$referrer{$i}};
                   12345:                             for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
                   12346:                                 if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
                   12347:                                     $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
                   12348:                                     last;
                   12349:                                 } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
                   12350:                                     unless (defined($newseqid{$dirorder{$i}->[$j]})) {
                   12351:                                         $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   12352:                                         $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   12353:                                         if (!-e $fullpath) {
                   12354:                                             mkdir($fullpath,0755);
1.1056    raeburn  12355:                                         }
                   12356:                                     }
1.1075.2.11  raeburn  12357:                                 } else {
                   12358:                                     last;
1.1056    raeburn  12359:                                 }
1.1075.2.11  raeburn  12360:                             }
                   12361:                         }
                   12362:                         if ($fullpath ne '') {
                   12363:                             if (-e "$prefix$path") {
                   12364:                                 system("mv $prefix$path $fullpath/$title");
                   12365:                             }
                   12366:                             if (-e "$fullpath/$title") {
                   12367:                                 my $showpath;
                   12368:                                 if ($relpath ne '') {
                   12369:                                     $showpath = "$relpath/$title";
                   12370:                                 } else {
                   12371:                                     $showpath = "/$title";
1.1056    raeburn  12372:                                 }
1.1075.2.11  raeburn  12373:                                 $result .= '<li>'.&mt('[_1] included as a dependency',$showpath).'</li>'."\n";
                   12374:                             }
                   12375:                             unless ($ishome) {
                   12376:                                 my $fetch = "$fullpath/$title";
                   12377:                                 $fetch =~ s/^\Q$prefix$dir\E//;
                   12378:                                 $prompttofetch{$fetch} = 1;
1.1055    raeburn  12379:                             }
                   12380:                         }
                   12381:                     }
1.1075.2.11  raeburn  12382:                 } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
                   12383:                     $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
                   12384:                                     $path,$env{'form.archive_content_'.$referrer{$i}}).'<br />';
1.1055    raeburn  12385:                 }
                   12386:             } else {
1.1075.2.11  raeburn  12387:                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
1.1055    raeburn  12388:             }
                   12389:         }
                   12390:         if (keys(%todelete)) {
                   12391:             foreach my $key (keys(%todelete)) {
                   12392:                 unlink($key);
1.1066    raeburn  12393:             }
                   12394:         }
                   12395:         if (keys(%todeletedir)) {
                   12396:             foreach my $key (keys(%todeletedir)) {
                   12397:                 rmdir($key);
                   12398:             }
                   12399:         }
                   12400:         foreach my $dir (sort(keys(%is_dir))) {
                   12401:             if (($pathtocheck ne '') && ($dir ne ''))  {
                   12402:                 &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055    raeburn  12403:             }
                   12404:         }
1.1067    raeburn  12405:         if ($result ne '') {
                   12406:             $output .= '<ul>'."\n".
                   12407:                        $result."\n".
                   12408:                        '</ul>';
                   12409:         }
                   12410:         unless ($ishome) {
                   12411:             my $replicationfail;
                   12412:             foreach my $item (keys(%prompttofetch)) {
                   12413:                 my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
                   12414:                 unless ($fetchresult eq 'ok') {
                   12415:                     $replicationfail .= '<li>'.$item.'</li>'."\n";
                   12416:                 }
                   12417:             }
                   12418:             if ($replicationfail) {
                   12419:                 $output .= '<p class="LC_error">'.
                   12420:                            &mt('Course home server failed to retrieve:').'<ul>'.
                   12421:                            $replicationfail.
                   12422:                            '</ul></p>';
                   12423:             }
                   12424:         }
1.1055    raeburn  12425:     } else {
                   12426:         $warning = &mt('No items found in archive.');
                   12427:     }
                   12428:     if ($error) {
                   12429:         $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   12430:                    $error.'</p>'."\n";
                   12431:     }
                   12432:     if ($warning) {
                   12433:         $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
                   12434:     }
                   12435:     return $output;
                   12436: }
                   12437: 
1.1066    raeburn  12438: sub cleanup_empty_dirs {
                   12439:     my ($path) = @_;
                   12440:     if (($path ne '') && (-d $path)) {
                   12441:         if (opendir(my $dirh,$path)) {
                   12442:             my @dircontents = grep(!/^\./,readdir($dirh));
                   12443:             my $numitems = 0;
                   12444:             foreach my $item (@dircontents) {
                   12445:                 if (-d "$path/$item") {
1.1075.2.28  raeburn  12446:                     &cleanup_empty_dirs("$path/$item");
1.1066    raeburn  12447:                     if (-e "$path/$item") {
                   12448:                         $numitems ++;
                   12449:                     }
                   12450:                 } else {
                   12451:                     $numitems ++;
                   12452:                 }
                   12453:             }
                   12454:             if ($numitems == 0) {
                   12455:                 rmdir($path);
                   12456:             }
                   12457:             closedir($dirh);
                   12458:         }
                   12459:     }
                   12460:     return;
                   12461: }
                   12462: 
1.41      ng       12463: =pod
1.45      matthew  12464: 
1.1075.2.56  raeburn  12465: =item * &get_folder_hierarchy()
1.1068    raeburn  12466: 
                   12467: Provides hierarchy of names of folders/sub-folders containing the current
                   12468: item,
                   12469: 
                   12470: Inputs: 3
                   12471:      - $navmap - navmaps object
                   12472: 
                   12473:      - $map - url for map (either the trigger itself, or map containing
                   12474:                            the resource, which is the trigger).
                   12475: 
                   12476:      - $showitem - 1 => show title for map itself; 0 => do not show.
                   12477: 
                   12478: Outputs: 1 @pathitems - array of folder/subfolder names.
                   12479: 
                   12480: =cut
                   12481: 
                   12482: sub get_folder_hierarchy {
                   12483:     my ($navmap,$map,$showitem) = @_;
                   12484:     my @pathitems;
                   12485:     if (ref($navmap)) {
                   12486:         my $mapres = $navmap->getResourceByUrl($map);
                   12487:         if (ref($mapres)) {
                   12488:             my $pcslist = $mapres->map_hierarchy();
                   12489:             if ($pcslist ne '') {
                   12490:                 my @pcs = split(/,/,$pcslist);
                   12491:                 foreach my $pc (@pcs) {
                   12492:                     if ($pc == 1) {
1.1075.2.38  raeburn  12493:                         push(@pathitems,&mt('Main Content'));
1.1068    raeburn  12494:                     } else {
                   12495:                         my $res = $navmap->getByMapPc($pc);
                   12496:                         if (ref($res)) {
                   12497:                             my $title = $res->compTitle();
                   12498:                             $title =~ s/\W+/_/g;
                   12499:                             if ($title ne '') {
                   12500:                                 push(@pathitems,$title);
                   12501:                             }
                   12502:                         }
                   12503:                     }
                   12504:                 }
                   12505:             }
1.1071    raeburn  12506:             if ($showitem) {
                   12507:                 if ($mapres->{ID} eq '0.0') {
1.1075.2.38  raeburn  12508:                     push(@pathitems,&mt('Main Content'));
1.1071    raeburn  12509:                 } else {
                   12510:                     my $maptitle = $mapres->compTitle();
                   12511:                     $maptitle =~ s/\W+/_/g;
                   12512:                     if ($maptitle ne '') {
                   12513:                         push(@pathitems,$maptitle);
                   12514:                     }
1.1068    raeburn  12515:                 }
                   12516:             }
                   12517:         }
                   12518:     }
                   12519:     return @pathitems;
                   12520: }
                   12521: 
                   12522: =pod
                   12523: 
1.1015    raeburn  12524: =item * &get_turnedin_filepath()
                   12525: 
                   12526: Determines path in a user's portfolio file for storage of files uploaded
                   12527: to a specific essayresponse or dropbox item.
                   12528: 
                   12529: Inputs: 3 required + 1 optional.
                   12530: $symb is symb for resource, $uname and $udom are for current user (required).
                   12531: $caller is optional (can be "submission", if routine is called when storing
                   12532: an upoaded file when "Submit Answer" button was pressed).
                   12533: 
                   12534: Returns array containing $path and $multiresp. 
                   12535: $path is path in portfolio.  $multiresp is 1 if this resource contains more
                   12536: than one file upload item.  Callers of routine should append partid as a 
                   12537: subdirectory to $path in cases where $multiresp is 1.
                   12538: 
                   12539: Called by: homework/essayresponse.pm and homework/structuretags.pm
                   12540: 
                   12541: =cut
                   12542: 
                   12543: sub get_turnedin_filepath {
                   12544:     my ($symb,$uname,$udom,$caller) = @_;
                   12545:     my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
                   12546:     my $turnindir;
                   12547:     my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
                   12548:     $turnindir = $userhash{'turnindir'};
                   12549:     my ($path,$multiresp);
                   12550:     if ($turnindir eq '') {
                   12551:         if ($caller eq 'submission') {
                   12552:             $turnindir = &mt('turned in');
                   12553:             $turnindir =~ s/\W+/_/g;
                   12554:             my %newhash = (
                   12555:                             'turnindir' => $turnindir,
                   12556:                           );
                   12557:             &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
                   12558:         }
                   12559:     }
                   12560:     if ($turnindir ne '') {
                   12561:         $path = '/'.$turnindir.'/';
                   12562:         my ($multipart,$turnin,@pathitems);
                   12563:         my $navmap = Apache::lonnavmaps::navmap->new();
                   12564:         if (defined($navmap)) {
                   12565:             my $mapres = $navmap->getResourceByUrl($map);
                   12566:             if (ref($mapres)) {
                   12567:                 my $pcslist = $mapres->map_hierarchy();
                   12568:                 if ($pcslist ne '') {
                   12569:                     foreach my $pc (split(/,/,$pcslist)) {
                   12570:                         my $res = $navmap->getByMapPc($pc);
                   12571:                         if (ref($res)) {
                   12572:                             my $title = $res->compTitle();
                   12573:                             $title =~ s/\W+/_/g;
                   12574:                             if ($title ne '') {
1.1075.2.48  raeburn  12575:                                 if (($pc > 1) && (length($title) > 12)) {
                   12576:                                     $title = substr($title,0,12);
                   12577:                                 }
1.1015    raeburn  12578:                                 push(@pathitems,$title);
                   12579:                             }
                   12580:                         }
                   12581:                     }
                   12582:                 }
                   12583:                 my $maptitle = $mapres->compTitle();
                   12584:                 $maptitle =~ s/\W+/_/g;
                   12585:                 if ($maptitle ne '') {
1.1075.2.48  raeburn  12586:                     if (length($maptitle) > 12) {
                   12587:                         $maptitle = substr($maptitle,0,12);
                   12588:                     }
1.1015    raeburn  12589:                     push(@pathitems,$maptitle);
                   12590:                 }
                   12591:                 unless ($env{'request.state'} eq 'construct') {
                   12592:                     my $res = $navmap->getBySymb($symb);
                   12593:                     if (ref($res)) {
                   12594:                         my $partlist = $res->parts();
                   12595:                         my $totaluploads = 0;
                   12596:                         if (ref($partlist) eq 'ARRAY') {
                   12597:                             foreach my $part (@{$partlist}) {
                   12598:                                 my @types = $res->responseType($part);
                   12599:                                 my @ids = $res->responseIds($part);
                   12600:                                 for (my $i=0; $i < scalar(@ids); $i++) {
                   12601:                                     if ($types[$i] eq 'essay') {
                   12602:                                         my $partid = $part.'_'.$ids[$i];
                   12603:                                         if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
                   12604:                                             $totaluploads ++;
                   12605:                                         }
                   12606:                                     }
                   12607:                                 }
                   12608:                             }
                   12609:                             if ($totaluploads > 1) {
                   12610:                                 $multiresp = 1;
                   12611:                             }
                   12612:                         }
                   12613:                     }
                   12614:                 }
                   12615:             } else {
                   12616:                 return;
                   12617:             }
                   12618:         } else {
                   12619:             return;
                   12620:         }
                   12621:         my $restitle=&Apache::lonnet::gettitle($symb);
                   12622:         $restitle =~ s/\W+/_/g;
                   12623:         if ($restitle eq '') {
                   12624:             $restitle = ($resurl =~ m{/[^/]+$});
                   12625:             if ($restitle eq '') {
                   12626:                 $restitle = time;
                   12627:             }
                   12628:         }
1.1075.2.48  raeburn  12629:         if (length($restitle) > 12) {
                   12630:             $restitle = substr($restitle,0,12);
                   12631:         }
1.1015    raeburn  12632:         push(@pathitems,$restitle);
                   12633:         $path .= join('/',@pathitems);
                   12634:     }
                   12635:     return ($path,$multiresp);
                   12636: }
                   12637: 
                   12638: =pod
                   12639: 
1.464     albertel 12640: =back
1.41      ng       12641: 
1.112     bowersj2 12642: =head1 CSV Upload/Handling functions
1.38      albertel 12643: 
1.41      ng       12644: =over 4
                   12645: 
1.648     raeburn  12646: =item * &upfile_store($r)
1.41      ng       12647: 
                   12648: Store uploaded file, $r should be the HTTP Request object,
1.258     albertel 12649: needs $env{'form.upfile'}
1.41      ng       12650: returns $datatoken to be put into hidden field
                   12651: 
                   12652: =cut
1.31      albertel 12653: 
                   12654: sub upfile_store {
                   12655:     my $r=shift;
1.258     albertel 12656:     $env{'form.upfile'}=~s/\r/\n/gs;
                   12657:     $env{'form.upfile'}=~s/\f/\n/gs;
                   12658:     $env{'form.upfile'}=~s/\n+/\n/gs;
                   12659:     $env{'form.upfile'}=~s/\n+$//gs;
1.31      albertel 12660: 
1.258     albertel 12661:     my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
                   12662: 	'_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
1.31      albertel 12663:     {
1.158     raeburn  12664:         my $datafile = $r->dir_config('lonDaemons').
                   12665:                            '/tmp/'.$datatoken.'.tmp';
                   12666:         if ( open(my $fh,">$datafile") ) {
1.258     albertel 12667:             print $fh $env{'form.upfile'};
1.158     raeburn  12668:             close($fh);
                   12669:         }
1.31      albertel 12670:     }
                   12671:     return $datatoken;
                   12672: }
                   12673: 
1.56      matthew  12674: =pod
                   12675: 
1.648     raeburn  12676: =item * &load_tmp_file($r)
1.41      ng       12677: 
                   12678: Load uploaded file from tmp, $r should be the HTTP Request object,
1.258     albertel 12679: needs $env{'form.datatoken'},
                   12680: sets $env{'form.upfile'} to the contents of the file
1.41      ng       12681: 
                   12682: =cut
1.31      albertel 12683: 
                   12684: sub load_tmp_file {
                   12685:     my $r=shift;
                   12686:     my @studentdata=();
                   12687:     {
1.158     raeburn  12688:         my $studentfile = $r->dir_config('lonDaemons').
1.258     albertel 12689:                               '/tmp/'.$env{'form.datatoken'}.'.tmp';
1.158     raeburn  12690:         if ( open(my $fh,"<$studentfile") ) {
                   12691:             @studentdata=<$fh>;
                   12692:             close($fh);
                   12693:         }
1.31      albertel 12694:     }
1.258     albertel 12695:     $env{'form.upfile'}=join('',@studentdata);
1.31      albertel 12696: }
                   12697: 
1.56      matthew  12698: =pod
                   12699: 
1.648     raeburn  12700: =item * &upfile_record_sep()
1.41      ng       12701: 
                   12702: Separate uploaded file into records
                   12703: returns array of records,
1.258     albertel 12704: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41      ng       12705: 
                   12706: =cut
1.31      albertel 12707: 
                   12708: sub upfile_record_sep {
1.258     albertel 12709:     if ($env{'form.upfiletype'} eq 'xml') {
1.31      albertel 12710:     } else {
1.248     albertel 12711: 	my @records;
1.258     albertel 12712: 	foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248     albertel 12713: 	    if ($line=~/^\s*$/) { next; }
                   12714: 	    push(@records,$line);
                   12715: 	}
                   12716: 	return @records;
1.31      albertel 12717:     }
                   12718: }
                   12719: 
1.56      matthew  12720: =pod
                   12721: 
1.648     raeburn  12722: =item * &record_sep($record)
1.41      ng       12723: 
1.258     albertel 12724: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41      ng       12725: 
                   12726: =cut
                   12727: 
1.263     www      12728: sub takeleft {
                   12729:     my $index=shift;
                   12730:     return substr('0000'.$index,-4,4);
                   12731: }
                   12732: 
1.31      albertel 12733: sub record_sep {
                   12734:     my $record=shift;
                   12735:     my %components=();
1.258     albertel 12736:     if ($env{'form.upfiletype'} eq 'xml') {
                   12737:     } elsif ($env{'form.upfiletype'} eq 'space') {
1.31      albertel 12738:         my $i=0;
1.356     albertel 12739:         foreach my $field (split(/\s+/,$record)) {
1.31      albertel 12740:             $field=~s/^(\"|\')//;
                   12741:             $field=~s/(\"|\')$//;
1.263     www      12742:             $components{&takeleft($i)}=$field;
1.31      albertel 12743:             $i++;
                   12744:         }
1.258     albertel 12745:     } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31      albertel 12746:         my $i=0;
1.356     albertel 12747:         foreach my $field (split(/\t/,$record)) {
1.31      albertel 12748:             $field=~s/^(\"|\')//;
                   12749:             $field=~s/(\"|\')$//;
1.263     www      12750:             $components{&takeleft($i)}=$field;
1.31      albertel 12751:             $i++;
                   12752:         }
                   12753:     } else {
1.561     www      12754:         my $separator=',';
1.480     banghart 12755:         if ($env{'form.upfiletype'} eq 'semisv') {
1.561     www      12756:             $separator=';';
1.480     banghart 12757:         }
1.31      albertel 12758:         my $i=0;
1.561     www      12759: # the character we are looking for to indicate the end of a quote or a record 
                   12760:         my $looking_for=$separator;
                   12761: # do not add the characters to the fields
                   12762:         my $ignore=0;
                   12763: # we just encountered a separator (or the beginning of the record)
                   12764:         my $just_found_separator=1;
                   12765: # store the field we are working on here
                   12766:         my $field='';
                   12767: # work our way through all characters in record
                   12768:         foreach my $character ($record=~/(.)/g) {
                   12769:             if ($character eq $looking_for) {
                   12770:                if ($character ne $separator) {
                   12771: # Found the end of a quote, again looking for separator
                   12772:                   $looking_for=$separator;
                   12773:                   $ignore=1;
                   12774:                } else {
                   12775: # Found a separator, store away what we got
                   12776:                   $components{&takeleft($i)}=$field;
                   12777: 	          $i++;
                   12778:                   $just_found_separator=1;
                   12779:                   $ignore=0;
                   12780:                   $field='';
                   12781:                }
                   12782:                next;
                   12783:             }
                   12784: # single or double quotation marks after a separator indicate beginning of a quote
                   12785: # we are now looking for the end of the quote and need to ignore separators
                   12786:             if ((($character eq '"') || ($character eq "'")) && ($just_found_separator))  {
                   12787:                $looking_for=$character;
                   12788:                next;
                   12789:             }
                   12790: # ignore would be true after we reached the end of a quote
                   12791:             if ($ignore) { next; }
                   12792:             if (($just_found_separator) && ($character=~/\s/)) { next; }
                   12793:             $field.=$character;
                   12794:             $just_found_separator=0; 
1.31      albertel 12795:         }
1.561     www      12796: # catch the very last entry, since we never encountered the separator
                   12797:         $components{&takeleft($i)}=$field;
1.31      albertel 12798:     }
                   12799:     return %components;
                   12800: }
                   12801: 
1.144     matthew  12802: ######################################################
                   12803: ######################################################
                   12804: 
1.56      matthew  12805: =pod
                   12806: 
1.648     raeburn  12807: =item * &upfile_select_html()
1.41      ng       12808: 
1.144     matthew  12809: Return HTML code to select a file from the users machine and specify 
                   12810: the file type.
1.41      ng       12811: 
                   12812: =cut
                   12813: 
1.144     matthew  12814: ######################################################
                   12815: ######################################################
1.31      albertel 12816: sub upfile_select_html {
1.144     matthew  12817:     my %Types = (
                   12818:                  csv   => &mt('CSV (comma separated values, spreadsheet)'),
1.480     banghart 12819:                  semisv => &mt('Semicolon separated values'),
1.144     matthew  12820:                  space => &mt('Space separated'),
                   12821:                  tab   => &mt('Tabulator separated'),
                   12822: #                 xml   => &mt('HTML/XML'),
                   12823:                  );
                   12824:     my $Str = '<input type="file" name="upfile" size="50" />'.
1.727     riegler  12825:         '<br />'.&mt('Type').': <select name="upfiletype">';
1.144     matthew  12826:     foreach my $type (sort(keys(%Types))) {
                   12827:         $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
                   12828:     }
                   12829:     $Str .= "</select>\n";
                   12830:     return $Str;
1.31      albertel 12831: }
                   12832: 
1.301     albertel 12833: sub get_samples {
                   12834:     my ($records,$toget) = @_;
                   12835:     my @samples=({});
                   12836:     my $got=0;
                   12837:     foreach my $rec (@$records) {
                   12838: 	my %temp = &record_sep($rec);
                   12839: 	if (! grep(/\S/, values(%temp))) { next; }
                   12840: 	if (%temp) {
                   12841: 	    $samples[$got]=\%temp;
                   12842: 	    $got++;
                   12843: 	    if ($got == $toget) { last; }
                   12844: 	}
                   12845:     }
                   12846:     return \@samples;
                   12847: }
                   12848: 
1.144     matthew  12849: ######################################################
                   12850: ######################################################
                   12851: 
1.56      matthew  12852: =pod
                   12853: 
1.648     raeburn  12854: =item * &csv_print_samples($r,$records)
1.41      ng       12855: 
                   12856: Prints a table of sample values from each column uploaded $r is an
                   12857: Apache Request ref, $records is an arrayref from
                   12858: &Apache::loncommon::upfile_record_sep
                   12859: 
                   12860: =cut
                   12861: 
1.144     matthew  12862: ######################################################
                   12863: ######################################################
1.31      albertel 12864: sub csv_print_samples {
                   12865:     my ($r,$records) = @_;
1.662     bisitz   12866:     my $samples = &get_samples($records,5);
1.301     albertel 12867: 
1.594     raeburn  12868:     $r->print(&mt('Samples').'<br />'.&start_data_table().
                   12869:               &start_data_table_header_row());
1.356     albertel 12870:     foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) { 
1.845     bisitz   12871:         $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594     raeburn  12872:     $r->print(&end_data_table_header_row());
1.301     albertel 12873:     foreach my $hash (@$samples) {
1.594     raeburn  12874: 	$r->print(&start_data_table_row());
1.356     albertel 12875: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31      albertel 12876: 	    $r->print('<td>');
1.356     albertel 12877: 	    if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31      albertel 12878: 	    $r->print('</td>');
                   12879: 	}
1.594     raeburn  12880: 	$r->print(&end_data_table_row());
1.31      albertel 12881:     }
1.594     raeburn  12882:     $r->print(&end_data_table().'<br />'."\n");
1.31      albertel 12883: }
                   12884: 
1.144     matthew  12885: ######################################################
                   12886: ######################################################
                   12887: 
1.56      matthew  12888: =pod
                   12889: 
1.648     raeburn  12890: =item * &csv_print_select_table($r,$records,$d)
1.41      ng       12891: 
                   12892: Prints a table to create associations between values and table columns.
1.144     matthew  12893: 
1.41      ng       12894: $r is an Apache Request ref,
                   12895: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174     matthew  12896: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41      ng       12897: 
                   12898: =cut
                   12899: 
1.144     matthew  12900: ######################################################
                   12901: ######################################################
1.31      albertel 12902: sub csv_print_select_table {
                   12903:     my ($r,$records,$d) = @_;
1.301     albertel 12904:     my $i=0;
                   12905:     my $samples = &get_samples($records,1);
1.144     matthew  12906:     $r->print(&mt('Associate columns with student attributes.')."\n".
1.594     raeburn  12907: 	      &start_data_table().&start_data_table_header_row().
1.144     matthew  12908:               '<th>'.&mt('Attribute').'</th>'.
1.594     raeburn  12909:               '<th>'.&mt('Column').'</th>'.
                   12910:               &end_data_table_header_row()."\n");
1.356     albertel 12911:     foreach my $array_ref (@$d) {
                   12912: 	my ($value,$display,$defaultcol)=@{ $array_ref };
1.729     raeburn  12913: 	$r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31      albertel 12914: 
1.875     bisitz   12915: 	$r->print('<td><select name="f'.$i.'"'.
1.32      matthew  12916: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.31      albertel 12917: 	$r->print('<option value="none"></option>');
1.356     albertel 12918: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
                   12919: 	    $r->print('<option value="'.$sample.'"'.
                   12920:                       ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662     bisitz   12921:                       '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31      albertel 12922: 	}
1.594     raeburn  12923: 	$r->print('</select></td>'.&end_data_table_row()."\n");
1.31      albertel 12924: 	$i++;
                   12925:     }
1.594     raeburn  12926:     $r->print(&end_data_table());
1.31      albertel 12927:     $i--;
                   12928:     return $i;
                   12929: }
1.56      matthew  12930: 
1.144     matthew  12931: ######################################################
                   12932: ######################################################
                   12933: 
1.56      matthew  12934: =pod
1.31      albertel 12935: 
1.648     raeburn  12936: =item * &csv_samples_select_table($r,$records,$d)
1.41      ng       12937: 
                   12938: Prints a table of sample values from the upload and can make associate samples to internal names.
                   12939: 
                   12940: $r is an Apache Request ref,
                   12941: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
                   12942: $d is an array of 2 element arrays (internal name, displayed name)
                   12943: 
                   12944: =cut
                   12945: 
1.144     matthew  12946: ######################################################
                   12947: ######################################################
1.31      albertel 12948: sub csv_samples_select_table {
                   12949:     my ($r,$records,$d) = @_;
                   12950:     my $i=0;
1.144     matthew  12951:     #
1.662     bisitz   12952:     my $max_samples = 5;
                   12953:     my $samples = &get_samples($records,$max_samples);
1.594     raeburn  12954:     $r->print(&start_data_table().
                   12955:               &start_data_table_header_row().'<th>'.
                   12956:               &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
                   12957:               &end_data_table_header_row());
1.301     albertel 12958: 
                   12959:     foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594     raeburn  12960: 	$r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32      matthew  12961: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.301     albertel 12962: 	foreach my $option (@$d) {
                   12963: 	    my ($value,$display,$defaultcol)=@{ $option };
1.174     matthew  12964: 	    $r->print('<option value="'.$value.'"'.
1.253     albertel 12965:                       ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174     matthew  12966:                       $display.'</option>');
1.31      albertel 12967: 	}
                   12968: 	$r->print('</select></td><td>');
1.662     bisitz   12969: 	foreach my $line (0..($max_samples-1)) {
1.301     albertel 12970: 	    if (defined($samples->[$line]{$key})) { 
                   12971: 		$r->print($samples->[$line]{$key}."<br />\n"); 
                   12972: 	    }
                   12973: 	}
1.594     raeburn  12974: 	$r->print('</td>'.&end_data_table_row());
1.31      albertel 12975: 	$i++;
                   12976:     }
1.594     raeburn  12977:     $r->print(&end_data_table());
1.31      albertel 12978:     $i--;
                   12979:     return($i);
1.115     matthew  12980: }
                   12981: 
1.144     matthew  12982: ######################################################
                   12983: ######################################################
                   12984: 
1.115     matthew  12985: =pod
                   12986: 
1.648     raeburn  12987: =item * &clean_excel_name($name)
1.115     matthew  12988: 
                   12989: Returns a replacement for $name which does not contain any illegal characters.
                   12990: 
                   12991: =cut
                   12992: 
1.144     matthew  12993: ######################################################
                   12994: ######################################################
1.115     matthew  12995: sub clean_excel_name {
                   12996:     my ($name) = @_;
                   12997:     $name =~ s/[:\*\?\/\\]//g;
                   12998:     if (length($name) > 31) {
                   12999:         $name = substr($name,0,31);
                   13000:     }
                   13001:     return $name;
1.25      albertel 13002: }
1.84      albertel 13003: 
1.85      albertel 13004: =pod
                   13005: 
1.648     raeburn  13006: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85      albertel 13007: 
                   13008: Returns either 1 or undef
                   13009: 
                   13010: 1 if the part is to be hidden, undef if it is to be shown
                   13011: 
                   13012: Arguments are:
                   13013: 
                   13014: $id the id of the part to be checked
                   13015: $symb, optional the symb of the resource to check
                   13016: $udom, optional the domain of the user to check for
                   13017: $uname, optional the username of the user to check for
                   13018: 
                   13019: =cut
1.84      albertel 13020: 
                   13021: sub check_if_partid_hidden {
                   13022:     my ($id,$symb,$udom,$uname) = @_;
1.133     albertel 13023:     my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84      albertel 13024: 					 $symb,$udom,$uname);
1.141     albertel 13025:     my $truth=1;
                   13026:     #if the string starts with !, then the list is the list to show not hide
                   13027:     if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84      albertel 13028:     my @hiddenlist=split(/,/,$hiddenparts);
                   13029:     foreach my $checkid (@hiddenlist) {
1.141     albertel 13030: 	if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84      albertel 13031:     }
1.141     albertel 13032:     return !$truth;
1.84      albertel 13033: }
1.127     matthew  13034: 
1.138     matthew  13035: 
                   13036: ############################################################
                   13037: ############################################################
                   13038: 
                   13039: =pod
                   13040: 
1.157     matthew  13041: =back 
                   13042: 
1.138     matthew  13043: =head1 cgi-bin script and graphing routines
                   13044: 
1.157     matthew  13045: =over 4
                   13046: 
1.648     raeburn  13047: =item * &get_cgi_id()
1.138     matthew  13048: 
                   13049: Inputs: none
                   13050: 
                   13051: Returns an id which can be used to pass environment variables
                   13052: to various cgi-bin scripts.  These environment variables will
                   13053: be removed from the users environment after a given time by
                   13054: the routine &Apache::lonnet::transfer_profile_to_env.
                   13055: 
                   13056: =cut
                   13057: 
                   13058: ############################################################
                   13059: ############################################################
1.152     albertel 13060: my $uniq=0;
1.136     matthew  13061: sub get_cgi_id {
1.154     albertel 13062:     $uniq=($uniq+1)%100000;
1.280     albertel 13063:     return (time.'_'.$$.'_'.$uniq);
1.136     matthew  13064: }
                   13065: 
1.127     matthew  13066: ############################################################
                   13067: ############################################################
                   13068: 
                   13069: =pod
                   13070: 
1.648     raeburn  13071: =item * &DrawBarGraph()
1.127     matthew  13072: 
1.138     matthew  13073: Facilitates the plotting of data in a (stacked) bar graph.
                   13074: Puts plot definition data into the users environment in order for 
                   13075: graph.png to plot it.  Returns an <img> tag for the plot.
                   13076: The bars on the plot are labeled '1','2',...,'n'.
                   13077: 
                   13078: Inputs:
                   13079: 
                   13080: =over 4
                   13081: 
                   13082: =item $Title: string, the title of the plot
                   13083: 
                   13084: =item $xlabel: string, text describing the X-axis of the plot
                   13085: 
                   13086: =item $ylabel: string, text describing the Y-axis of the plot
                   13087: 
                   13088: =item $Max: scalar, the maximum Y value to use in the plot
                   13089: If $Max is < any data point, the graph will not be rendered.
                   13090: 
1.140     matthew  13091: =item $colors: array ref holding the colors to be used for the data sets when
1.138     matthew  13092: they are plotted.  If undefined, default values will be used.
                   13093: 
1.178     matthew  13094: =item $labels: array ref holding the labels to use on the x-axis for the bars.
                   13095: 
1.138     matthew  13096: =item @Values: An array of array references.  Each array reference holds data
                   13097: to be plotted in a stacked bar chart.
                   13098: 
1.239     matthew  13099: =item If the final element of @Values is a hash reference the key/value
                   13100: pairs will be added to the graph definition.
                   13101: 
1.138     matthew  13102: =back
                   13103: 
                   13104: Returns:
                   13105: 
                   13106: An <img> tag which references graph.png and the appropriate identifying
                   13107: information for the plot.
                   13108: 
1.127     matthew  13109: =cut
                   13110: 
                   13111: ############################################################
                   13112: ############################################################
1.134     matthew  13113: sub DrawBarGraph {
1.178     matthew  13114:     my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134     matthew  13115:     #
                   13116:     if (! defined($colors)) {
                   13117:         $colors = ['#33ff00', 
                   13118:                   '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
                   13119:                   '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
                   13120:                   ]; 
                   13121:     }
1.228     matthew  13122:     my $extra_settings = {};
                   13123:     if (ref($Values[-1]) eq 'HASH') {
                   13124:         $extra_settings = pop(@Values);
                   13125:     }
1.127     matthew  13126:     #
1.136     matthew  13127:     my $identifier = &get_cgi_id();
                   13128:     my $id = 'cgi.'.$identifier;        
1.129     matthew  13129:     if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127     matthew  13130:         return '';
                   13131:     }
1.225     matthew  13132:     #
                   13133:     my @Labels;
                   13134:     if (defined($labels)) {
                   13135:         @Labels = @$labels;
                   13136:     } else {
                   13137:         for (my $i=0;$i<@{$Values[0]};$i++) {
                   13138:             push (@Labels,$i+1);
                   13139:         }
                   13140:     }
                   13141:     #
1.129     matthew  13142:     my $NumBars = scalar(@{$Values[0]});
1.225     matthew  13143:     if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129     matthew  13144:     my %ValuesHash;
                   13145:     my $NumSets=1;
                   13146:     foreach my $array (@Values) {
                   13147:         next if (! ref($array));
1.136     matthew  13148:         $ValuesHash{$id.'.data.'.$NumSets++} = 
1.132     matthew  13149:             join(',',@$array);
1.129     matthew  13150:     }
1.127     matthew  13151:     #
1.136     matthew  13152:     my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225     matthew  13153:     if ($NumBars < 3) {
                   13154:         $width = 120+$NumBars*32;
1.220     matthew  13155:         $xskip = 1;
1.225     matthew  13156:         $bar_width = 30;
                   13157:     } elsif ($NumBars < 5) {
                   13158:         $width = 120+$NumBars*20;
                   13159:         $xskip = 1;
                   13160:         $bar_width = 20;
1.220     matthew  13161:     } elsif ($NumBars < 10) {
1.136     matthew  13162:         $width = 120+$NumBars*15;
                   13163:         $xskip = 1;
                   13164:         $bar_width = 15;
                   13165:     } elsif ($NumBars <= 25) {
                   13166:         $width = 120+$NumBars*11;
                   13167:         $xskip = 5;
                   13168:         $bar_width = 8;
                   13169:     } elsif ($NumBars <= 50) {
                   13170:         $width = 120+$NumBars*8;
                   13171:         $xskip = 5;
                   13172:         $bar_width = 4;
                   13173:     } else {
                   13174:         $width = 120+$NumBars*8;
                   13175:         $xskip = 5;
                   13176:         $bar_width = 4;
                   13177:     }
                   13178:     #
1.137     matthew  13179:     $Max = 1 if ($Max < 1);
                   13180:     if ( int($Max) < $Max ) {
                   13181:         $Max++;
                   13182:         $Max = int($Max);
                   13183:     }
1.127     matthew  13184:     $Title  = '' if (! defined($Title));
                   13185:     $xlabel = '' if (! defined($xlabel));
                   13186:     $ylabel = '' if (! defined($ylabel));
1.369     www      13187:     $ValuesHash{$id.'.title'}    = &escape($Title);
                   13188:     $ValuesHash{$id.'.xlabel'}   = &escape($xlabel);
                   13189:     $ValuesHash{$id.'.ylabel'}   = &escape($ylabel);
1.137     matthew  13190:     $ValuesHash{$id.'.y_max_value'} = $Max;
1.136     matthew  13191:     $ValuesHash{$id.'.NumBars'}  = $NumBars;
                   13192:     $ValuesHash{$id.'.NumSets'}  = $NumSets;
                   13193:     $ValuesHash{$id.'.PlotType'} = 'bar';
                   13194:     $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   13195:     $ValuesHash{$id.'.height'}   = $height;
                   13196:     $ValuesHash{$id.'.width'}    = $width;
                   13197:     $ValuesHash{$id.'.xskip'}    = $xskip;
                   13198:     $ValuesHash{$id.'.bar_width'} = $bar_width;
                   13199:     $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127     matthew  13200:     #
1.228     matthew  13201:     # Deal with other parameters
                   13202:     while (my ($key,$value) = each(%$extra_settings)) {
                   13203:         $ValuesHash{$id.'.'.$key} = $value;
                   13204:     }
                   13205:     #
1.646     raeburn  13206:     &Apache::lonnet::appenv(\%ValuesHash);
1.137     matthew  13207:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   13208: }
                   13209: 
                   13210: ############################################################
                   13211: ############################################################
                   13212: 
                   13213: =pod
                   13214: 
1.648     raeburn  13215: =item * &DrawXYGraph()
1.137     matthew  13216: 
1.138     matthew  13217: Facilitates the plotting of data in an XY graph.
                   13218: Puts plot definition data into the users environment in order for 
                   13219: graph.png to plot it.  Returns an <img> tag for the plot.
                   13220: 
                   13221: Inputs:
                   13222: 
                   13223: =over 4
                   13224: 
                   13225: =item $Title: string, the title of the plot
                   13226: 
                   13227: =item $xlabel: string, text describing the X-axis of the plot
                   13228: 
                   13229: =item $ylabel: string, text describing the Y-axis of the plot
                   13230: 
                   13231: =item $Max: scalar, the maximum Y value to use in the plot
                   13232: If $Max is < any data point, the graph will not be rendered.
                   13233: 
                   13234: =item $colors: Array ref containing the hex color codes for the data to be 
                   13235: plotted in.  If undefined, default values will be used.
                   13236: 
                   13237: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   13238: 
                   13239: =item $Ydata: Array ref containing Array refs.  
1.185     www      13240: Each of the contained arrays will be plotted as a separate curve.
1.138     matthew  13241: 
                   13242: =item %Values: hash indicating or overriding any default values which are 
                   13243: passed to graph.png.  
                   13244: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   13245: 
                   13246: =back
                   13247: 
                   13248: Returns:
                   13249: 
                   13250: An <img> tag which references graph.png and the appropriate identifying
                   13251: information for the plot.
                   13252: 
1.137     matthew  13253: =cut
                   13254: 
                   13255: ############################################################
                   13256: ############################################################
                   13257: sub DrawXYGraph {
                   13258:     my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
                   13259:     #
                   13260:     # Create the identifier for the graph
                   13261:     my $identifier = &get_cgi_id();
                   13262:     my $id = 'cgi.'.$identifier;
                   13263:     #
                   13264:     $Title  = '' if (! defined($Title));
                   13265:     $xlabel = '' if (! defined($xlabel));
                   13266:     $ylabel = '' if (! defined($ylabel));
                   13267:     my %ValuesHash = 
                   13268:         (
1.369     www      13269:          $id.'.title'  => &escape($Title),
                   13270:          $id.'.xlabel' => &escape($xlabel),
                   13271:          $id.'.ylabel' => &escape($ylabel),
1.137     matthew  13272:          $id.'.y_max_value'=> $Max,
                   13273:          $id.'.labels'     => join(',',@$Xlabels),
                   13274:          $id.'.PlotType'   => 'XY',
                   13275:          );
                   13276:     #
                   13277:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   13278:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   13279:     }
                   13280:     #
                   13281:     if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
                   13282:         return '';
                   13283:     }
                   13284:     my $NumSets=1;
1.138     matthew  13285:     foreach my $array (@{$Ydata}){
1.137     matthew  13286:         next if (! ref($array));
                   13287:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
                   13288:     }
1.138     matthew  13289:     $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137     matthew  13290:     #
                   13291:     # Deal with other parameters
                   13292:     while (my ($key,$value) = each(%Values)) {
                   13293:         $ValuesHash{$id.'.'.$key} = $value;
1.127     matthew  13294:     }
                   13295:     #
1.646     raeburn  13296:     &Apache::lonnet::appenv(\%ValuesHash);
1.136     matthew  13297:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   13298: }
                   13299: 
                   13300: ############################################################
                   13301: ############################################################
                   13302: 
                   13303: =pod
                   13304: 
1.648     raeburn  13305: =item * &DrawXYYGraph()
1.138     matthew  13306: 
                   13307: Facilitates the plotting of data in an XY graph with two Y axes.
                   13308: Puts plot definition data into the users environment in order for 
                   13309: graph.png to plot it.  Returns an <img> tag for the plot.
                   13310: 
                   13311: Inputs:
                   13312: 
                   13313: =over 4
                   13314: 
                   13315: =item $Title: string, the title of the plot
                   13316: 
                   13317: =item $xlabel: string, text describing the X-axis of the plot
                   13318: 
                   13319: =item $ylabel: string, text describing the Y-axis of the plot
                   13320: 
                   13321: =item $colors: Array ref containing the hex color codes for the data to be 
                   13322: plotted in.  If undefined, default values will be used.
                   13323: 
                   13324: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   13325: 
                   13326: =item $Ydata1: The first data set
                   13327: 
                   13328: =item $Min1: The minimum value of the left Y-axis
                   13329: 
                   13330: =item $Max1: The maximum value of the left Y-axis
                   13331: 
                   13332: =item $Ydata2: The second data set
                   13333: 
                   13334: =item $Min2: The minimum value of the right Y-axis
                   13335: 
                   13336: =item $Max2: The maximum value of the left Y-axis
                   13337: 
                   13338: =item %Values: hash indicating or overriding any default values which are 
                   13339: passed to graph.png.  
                   13340: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   13341: 
                   13342: =back
                   13343: 
                   13344: Returns:
                   13345: 
                   13346: An <img> tag which references graph.png and the appropriate identifying
                   13347: information for the plot.
1.136     matthew  13348: 
                   13349: =cut
                   13350: 
                   13351: ############################################################
                   13352: ############################################################
1.137     matthew  13353: sub DrawXYYGraph {
                   13354:     my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
                   13355:                                         $Ydata2,$Min2,$Max2,%Values)=@_;
1.136     matthew  13356:     #
                   13357:     # Create the identifier for the graph
                   13358:     my $identifier = &get_cgi_id();
                   13359:     my $id = 'cgi.'.$identifier;
                   13360:     #
                   13361:     $Title  = '' if (! defined($Title));
                   13362:     $xlabel = '' if (! defined($xlabel));
                   13363:     $ylabel = '' if (! defined($ylabel));
                   13364:     my %ValuesHash = 
                   13365:         (
1.369     www      13366:          $id.'.title'  => &escape($Title),
                   13367:          $id.'.xlabel' => &escape($xlabel),
                   13368:          $id.'.ylabel' => &escape($ylabel),
1.136     matthew  13369:          $id.'.labels' => join(',',@$Xlabels),
                   13370:          $id.'.PlotType' => 'XY',
                   13371:          $id.'.NumSets' => 2,
1.137     matthew  13372:          $id.'.two_axes' => 1,
                   13373:          $id.'.y1_max_value' => $Max1,
                   13374:          $id.'.y1_min_value' => $Min1,
                   13375:          $id.'.y2_max_value' => $Max2,
                   13376:          $id.'.y2_min_value' => $Min2,
1.136     matthew  13377:          );
                   13378:     #
1.137     matthew  13379:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   13380:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   13381:     }
                   13382:     #
                   13383:     if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
                   13384:         ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136     matthew  13385:         return '';
                   13386:     }
                   13387:     my $NumSets=1;
1.137     matthew  13388:     foreach my $array ($Ydata1,$Ydata2){
1.136     matthew  13389:         next if (! ref($array));
                   13390:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137     matthew  13391:     }
                   13392:     #
                   13393:     # Deal with other parameters
                   13394:     while (my ($key,$value) = each(%Values)) {
                   13395:         $ValuesHash{$id.'.'.$key} = $value;
1.136     matthew  13396:     }
                   13397:     #
1.646     raeburn  13398:     &Apache::lonnet::appenv(\%ValuesHash);
1.130     albertel 13399:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139     matthew  13400: }
                   13401: 
                   13402: ############################################################
                   13403: ############################################################
                   13404: 
                   13405: =pod
                   13406: 
1.157     matthew  13407: =back 
                   13408: 
1.139     matthew  13409: =head1 Statistics helper routines?  
                   13410: 
                   13411: Bad place for them but what the hell.
                   13412: 
1.157     matthew  13413: =over 4
                   13414: 
1.648     raeburn  13415: =item * &chartlink()
1.139     matthew  13416: 
                   13417: Returns a link to the chart for a specific student.  
                   13418: 
                   13419: Inputs:
                   13420: 
                   13421: =over 4
                   13422: 
                   13423: =item $linktext: The text of the link
                   13424: 
                   13425: =item $sname: The students username
                   13426: 
                   13427: =item $sdomain: The students domain
                   13428: 
                   13429: =back
                   13430: 
1.157     matthew  13431: =back
                   13432: 
1.139     matthew  13433: =cut
                   13434: 
                   13435: ############################################################
                   13436: ############################################################
                   13437: sub chartlink {
                   13438:     my ($linktext, $sname, $sdomain) = @_;
                   13439:     my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369     www      13440:         '&amp;SelectedStudent='.&escape($sname.':'.$sdomain).
1.219     albertel 13441:         '&amp;chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139     matthew  13442:        '">'.$linktext.'</a>';
1.153     matthew  13443: }
                   13444: 
                   13445: #######################################################
                   13446: #######################################################
                   13447: 
                   13448: =pod
                   13449: 
                   13450: =head1 Course Environment Routines
1.157     matthew  13451: 
                   13452: =over 4
1.153     matthew  13453: 
1.648     raeburn  13454: =item * &restore_course_settings()
1.153     matthew  13455: 
1.648     raeburn  13456: =item * &store_course_settings()
1.153     matthew  13457: 
                   13458: Restores/Store indicated form parameters from the course environment.
                   13459: Will not overwrite existing values of the form parameters.
                   13460: 
                   13461: Inputs: 
                   13462: a scalar describing the data (e.g. 'chart', 'problem_analysis')
                   13463: 
                   13464: a hash ref describing the data to be stored.  For example:
                   13465:    
                   13466: %Save_Parameters = ('Status' => 'scalar',
                   13467:     'chartoutputmode' => 'scalar',
                   13468:     'chartoutputdata' => 'scalar',
                   13469:     'Section' => 'array',
1.373     raeburn  13470:     'Group' => 'array',
1.153     matthew  13471:     'StudentData' => 'array',
                   13472:     'Maps' => 'array');
                   13473: 
                   13474: Returns: both routines return nothing
                   13475: 
1.631     raeburn  13476: =back
                   13477: 
1.153     matthew  13478: =cut
                   13479: 
                   13480: #######################################################
                   13481: #######################################################
                   13482: sub store_course_settings {
1.496     albertel 13483:     return &store_settings($env{'request.course.id'},@_);
                   13484: }
                   13485: 
                   13486: sub store_settings {
1.153     matthew  13487:     # save to the environment
                   13488:     # appenv the same items, just to be safe
1.300     albertel 13489:     my $udom  = $env{'user.domain'};
                   13490:     my $uname = $env{'user.name'};
1.496     albertel 13491:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  13492:     my %SaveHash;
                   13493:     my %AppHash;
                   13494:     while (my ($setting,$type) = each(%$Settings)) {
1.496     albertel 13495:         my $basename = join('.','internal',$context,$prefix,$setting);
1.300     albertel 13496:         my $envname = 'environment.'.$basename;
1.258     albertel 13497:         if (exists($env{'form.'.$setting})) {
1.153     matthew  13498:             # Save this value away
                   13499:             if ($type eq 'scalar' &&
1.258     albertel 13500:                 (! exists($env{$envname}) || 
                   13501:                  $env{$envname} ne $env{'form.'.$setting})) {
                   13502:                 $SaveHash{$basename} = $env{'form.'.$setting};
                   13503:                 $AppHash{$envname}   = $env{'form.'.$setting};
1.153     matthew  13504:             } elsif ($type eq 'array') {
                   13505:                 my $stored_form;
1.258     albertel 13506:                 if (ref($env{'form.'.$setting})) {
1.153     matthew  13507:                     $stored_form = join(',',
                   13508:                                         map {
1.369     www      13509:                                             &escape($_);
1.258     albertel 13510:                                         } sort(@{$env{'form.'.$setting}}));
1.153     matthew  13511:                 } else {
                   13512:                     $stored_form = 
1.369     www      13513:                         &escape($env{'form.'.$setting});
1.153     matthew  13514:                 }
                   13515:                 # Determine if the array contents are the same.
1.258     albertel 13516:                 if ($stored_form ne $env{$envname}) {
1.153     matthew  13517:                     $SaveHash{$basename} = $stored_form;
                   13518:                     $AppHash{$envname}   = $stored_form;
                   13519:                 }
                   13520:             }
                   13521:         }
                   13522:     }
                   13523:     my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300     albertel 13524:                                           $udom,$uname);
1.153     matthew  13525:     if ($put_result !~ /^(ok|delayed)/) {
                   13526:         &Apache::lonnet::logthis('unable to save form parameters, '.
                   13527:                                  'got error:'.$put_result);
                   13528:     }
                   13529:     # Make sure these settings stick around in this session, too
1.646     raeburn  13530:     &Apache::lonnet::appenv(\%AppHash);
1.153     matthew  13531:     return;
                   13532: }
                   13533: 
                   13534: sub restore_course_settings {
1.499     albertel 13535:     return &restore_settings($env{'request.course.id'},@_);
1.496     albertel 13536: }
                   13537: 
                   13538: sub restore_settings {
                   13539:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  13540:     while (my ($setting,$type) = each(%$Settings)) {
1.258     albertel 13541:         next if (exists($env{'form.'.$setting}));
1.496     albertel 13542:         my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153     matthew  13543:             '.'.$setting;
1.258     albertel 13544:         if (exists($env{$envname})) {
1.153     matthew  13545:             if ($type eq 'scalar') {
1.258     albertel 13546:                 $env{'form.'.$setting} = $env{$envname};
1.153     matthew  13547:             } elsif ($type eq 'array') {
1.258     albertel 13548:                 $env{'form.'.$setting} = [ 
1.153     matthew  13549:                                            map { 
1.369     www      13550:                                                &unescape($_); 
1.258     albertel 13551:                                            } split(',',$env{$envname})
1.153     matthew  13552:                                            ];
                   13553:             }
                   13554:         }
                   13555:     }
1.127     matthew  13556: }
                   13557: 
1.618     raeburn  13558: #######################################################
                   13559: #######################################################
                   13560: 
                   13561: =pod
                   13562: 
                   13563: =head1 Domain E-mail Routines  
                   13564: 
                   13565: =over 4
                   13566: 
1.648     raeburn  13567: =item * &build_recipient_list()
1.618     raeburn  13568: 
1.1075.2.44  raeburn  13569: Build recipient lists for following types of e-mail:
1.766     raeburn  13570: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.1075.2.44  raeburn  13571: (d) Help requests, (e) Course requests needing approval, (f) loncapa
                   13572: module change checking, student/employee ID conflict checks, as
                   13573: generated by lonerrorhandler.pm, CHECKRPMS, loncron,
                   13574: lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.
1.618     raeburn  13575: 
                   13576: Inputs:
1.1075.2.44  raeburn  13577: defmail (scalar - email address of default recipient),
                   13578: mailing type (scalar: errormail, packagesmail, helpdeskmail,
                   13579: requestsmail, updatesmail, or idconflictsmail).
                   13580: 
1.619     raeburn  13581: defdom (domain for which to retrieve configuration settings),
1.1075.2.44  raeburn  13582: 
                   13583: origmail (scalar - email address of recipient from loncapa.conf,
                   13584: i.e., predates configuration by DC via domainprefs.pm
1.618     raeburn  13585: 
1.655     raeburn  13586: Returns: comma separated list of addresses to which to send e-mail.
                   13587: 
                   13588: =back
1.618     raeburn  13589: 
                   13590: =cut
                   13591: 
                   13592: ############################################################
                   13593: ############################################################
                   13594: sub build_recipient_list {
1.619     raeburn  13595:     my ($defmail,$mailing,$defdom,$origmail) = @_;
1.618     raeburn  13596:     my @recipients;
                   13597:     my $otheremails;
                   13598:     my %domconfig =
                   13599:          &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
                   13600:     if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766     raeburn  13601:         if (exists($domconfig{'contacts'}{$mailing})) {
                   13602:             if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
                   13603:                 my @contacts = ('adminemail','supportemail');
                   13604:                 foreach my $item (@contacts) {
                   13605:                     if ($domconfig{'contacts'}{$mailing}{$item}) {
                   13606:                         my $addr = $domconfig{'contacts'}{$item}; 
                   13607:                         if (!grep(/^\Q$addr\E$/,@recipients)) {
                   13608:                             push(@recipients,$addr);
                   13609:                         }
1.619     raeburn  13610:                     }
1.766     raeburn  13611:                     $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
1.618     raeburn  13612:                 }
                   13613:             }
1.766     raeburn  13614:         } elsif ($origmail ne '') {
                   13615:             push(@recipients,$origmail);
1.618     raeburn  13616:         }
1.619     raeburn  13617:     } elsif ($origmail ne '') {
                   13618:         push(@recipients,$origmail);
1.618     raeburn  13619:     }
1.688     raeburn  13620:     if (defined($defmail)) {
                   13621:         if ($defmail ne '') {
                   13622:             push(@recipients,$defmail);
                   13623:         }
1.618     raeburn  13624:     }
                   13625:     if ($otheremails) {
1.619     raeburn  13626:         my @others;
                   13627:         if ($otheremails =~ /,/) {
                   13628:             @others = split(/,/,$otheremails);
1.618     raeburn  13629:         } else {
1.619     raeburn  13630:             push(@others,$otheremails);
                   13631:         }
                   13632:         foreach my $addr (@others) {
                   13633:             if (!grep(/^\Q$addr\E$/,@recipients)) {
                   13634:                 push(@recipients,$addr);
                   13635:             }
1.618     raeburn  13636:         }
                   13637:     }
1.619     raeburn  13638:     my $recipientlist = join(',',@recipients); 
1.618     raeburn  13639:     return $recipientlist;
                   13640: }
                   13641: 
1.127     matthew  13642: ############################################################
                   13643: ############################################################
1.154     albertel 13644: 
1.655     raeburn  13645: =pod
                   13646: 
                   13647: =head1 Course Catalog Routines
                   13648: 
                   13649: =over 4
                   13650: 
                   13651: =item * &gather_categories()
                   13652: 
                   13653: Converts category definitions - keys of categories hash stored in  
                   13654: coursecategories in configuration.db on the primary library server in a 
                   13655: domain - to an array.  Also generates javascript and idx hash used to 
                   13656: generate Domain Coordinator interface for editing Course Categories.
                   13657: 
                   13658: Inputs:
1.663     raeburn  13659: 
1.655     raeburn  13660: categories (reference to hash of category definitions).
1.663     raeburn  13661: 
1.655     raeburn  13662: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   13663:       categories and subcategories).
1.663     raeburn  13664: 
1.655     raeburn  13665: idx (reference to hash of counters used in Domain Coordinator interface for 
                   13666:       editing Course Categories).
1.663     raeburn  13667: 
1.655     raeburn  13668: jsarray (reference to array of categories used to create Javascript arrays for
                   13669:          Domain Coordinator interface for editing Course Categories).
                   13670: 
                   13671: Returns: nothing
                   13672: 
                   13673: Side effects: populates cats, idx and jsarray. 
                   13674: 
                   13675: =cut
                   13676: 
                   13677: sub gather_categories {
                   13678:     my ($categories,$cats,$idx,$jsarray) = @_;
                   13679:     my %counters;
                   13680:     my $num = 0;
                   13681:     foreach my $item (keys(%{$categories})) {
                   13682:         my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
                   13683:         if ($container eq '' && $depth == 0) {
                   13684:             $cats->[$depth][$categories->{$item}] = $cat;
                   13685:         } else {
                   13686:             $cats->[$depth]{$container}[$categories->{$item}] = $cat;
                   13687:         }
                   13688:         my ($escitem,$tail) = split(/:/,$item,2);
                   13689:         if ($counters{$tail} eq '') {
                   13690:             $counters{$tail} = $num;
                   13691:             $num ++;
                   13692:         }
                   13693:         if (ref($idx) eq 'HASH') {
                   13694:             $idx->{$item} = $counters{$tail};
                   13695:         }
                   13696:         if (ref($jsarray) eq 'ARRAY') {
                   13697:             push(@{$jsarray->[$counters{$tail}]},$item);
                   13698:         }
                   13699:     }
                   13700:     return;
                   13701: }
                   13702: 
                   13703: =pod
                   13704: 
                   13705: =item * &extract_categories()
                   13706: 
                   13707: Used to generate breadcrumb trails for course categories.
                   13708: 
                   13709: Inputs:
1.663     raeburn  13710: 
1.655     raeburn  13711: categories (reference to hash of category definitions).
1.663     raeburn  13712: 
1.655     raeburn  13713: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   13714:       categories and subcategories).
1.663     raeburn  13715: 
1.655     raeburn  13716: trails (reference to array of breacrumb trails for each category).
1.663     raeburn  13717: 
1.655     raeburn  13718: allitems (reference to hash - key is category key 
                   13719:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  13720: 
1.655     raeburn  13721: idx (reference to hash of counters used in Domain Coordinator interface for
                   13722:       editing Course Categories).
1.663     raeburn  13723: 
1.655     raeburn  13724: jsarray (reference to array of categories used to create Javascript arrays for
                   13725:          Domain Coordinator interface for editing Course Categories).
                   13726: 
1.665     raeburn  13727: subcats (reference to hash of arrays containing all subcategories within each 
                   13728:          category, -recursive)
                   13729: 
1.655     raeburn  13730: Returns: nothing
                   13731: 
                   13732: Side effects: populates trails and allitems hash references.
                   13733: 
                   13734: =cut
                   13735: 
                   13736: sub extract_categories {
1.665     raeburn  13737:     my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
1.655     raeburn  13738:     if (ref($categories) eq 'HASH') {
                   13739:         &gather_categories($categories,$cats,$idx,$jsarray);
                   13740:         if (ref($cats->[0]) eq 'ARRAY') {
                   13741:             for (my $i=0; $i<@{$cats->[0]}; $i++) {
                   13742:                 my $name = $cats->[0][$i];
                   13743:                 my $item = &escape($name).'::0';
                   13744:                 my $trailstr;
                   13745:                 if ($name eq 'instcode') {
                   13746:                     $trailstr = &mt('Official courses (with institutional codes)');
1.919     raeburn  13747:                 } elsif ($name eq 'communities') {
                   13748:                     $trailstr = &mt('Communities');
1.655     raeburn  13749:                 } else {
                   13750:                     $trailstr = $name;
                   13751:                 }
                   13752:                 if ($allitems->{$item} eq '') {
                   13753:                     push(@{$trails},$trailstr);
                   13754:                     $allitems->{$item} = scalar(@{$trails})-1;
                   13755:                 }
                   13756:                 my @parents = ($name);
                   13757:                 if (ref($cats->[1]{$name}) eq 'ARRAY') {
                   13758:                     for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
                   13759:                         my $category = $cats->[1]{$name}[$j];
1.665     raeburn  13760:                         if (ref($subcats) eq 'HASH') {
                   13761:                             push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
                   13762:                         }
                   13763:                         &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
                   13764:                     }
                   13765:                 } else {
                   13766:                     if (ref($subcats) eq 'HASH') {
                   13767:                         $subcats->{$item} = [];
1.655     raeburn  13768:                     }
                   13769:                 }
                   13770:             }
                   13771:         }
                   13772:     }
                   13773:     return;
                   13774: }
                   13775: 
                   13776: =pod
                   13777: 
1.1075.2.56  raeburn  13778: =item * &recurse_categories()
1.655     raeburn  13779: 
                   13780: Recursively used to generate breadcrumb trails for course categories.
                   13781: 
                   13782: Inputs:
1.663     raeburn  13783: 
1.655     raeburn  13784: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   13785:       categories and subcategories).
1.663     raeburn  13786: 
1.655     raeburn  13787: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663     raeburn  13788: 
                   13789: category (current course category, for which breadcrumb trail is being generated).
                   13790: 
                   13791: trails (reference to array of breadcrumb trails for each category).
                   13792: 
1.655     raeburn  13793: allitems (reference to hash - key is category key
                   13794:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  13795: 
1.655     raeburn  13796: parents (array containing containers directories for current category, 
                   13797:          back to top level). 
                   13798: 
                   13799: Returns: nothing
                   13800: 
                   13801: Side effects: populates trails and allitems hash references
                   13802: 
                   13803: =cut
                   13804: 
                   13805: sub recurse_categories {
1.665     raeburn  13806:     my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
1.655     raeburn  13807:     my $shallower = $depth - 1;
                   13808:     if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
                   13809:         for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
                   13810:             my $name = $cats->[$depth]{$category}[$k];
                   13811:             my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   13812:             my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   13813:             if ($allitems->{$item} eq '') {
                   13814:                 push(@{$trails},$trailstr);
                   13815:                 $allitems->{$item} = scalar(@{$trails})-1;
                   13816:             }
                   13817:             my $deeper = $depth+1;
                   13818:             push(@{$parents},$category);
1.665     raeburn  13819:             if (ref($subcats) eq 'HASH') {
                   13820:                 my $subcat = &escape($name).':'.$category.':'.$depth;
                   13821:                 for (my $j=@{$parents}; $j>=0; $j--) {
                   13822:                     my $higher;
                   13823:                     if ($j > 0) {
                   13824:                         $higher = &escape($parents->[$j]).':'.
                   13825:                                   &escape($parents->[$j-1]).':'.$j;
                   13826:                     } else {
                   13827:                         $higher = &escape($parents->[$j]).'::'.$j;
                   13828:                     }
                   13829:                     push(@{$subcats->{$higher}},$subcat);
                   13830:                 }
                   13831:             }
                   13832:             &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
                   13833:                                 $subcats);
1.655     raeburn  13834:             pop(@{$parents});
                   13835:         }
                   13836:     } else {
                   13837:         my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   13838:         my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   13839:         if ($allitems->{$item} eq '') {
                   13840:             push(@{$trails},$trailstr);
                   13841:             $allitems->{$item} = scalar(@{$trails})-1;
                   13842:         }
                   13843:     }
                   13844:     return;
                   13845: }
                   13846: 
1.663     raeburn  13847: =pod
                   13848: 
1.1075.2.56  raeburn  13849: =item * &assign_categories_table()
1.663     raeburn  13850: 
                   13851: Create a datatable for display of hierarchical categories in a domain,
                   13852: with checkboxes to allow a course to be categorized. 
                   13853: 
                   13854: Inputs:
                   13855: 
                   13856: cathash - reference to hash of categories defined for the domain (from
                   13857:           configuration.db)
                   13858: 
                   13859: currcat - scalar with an & separated list of categories assigned to a course. 
                   13860: 
1.919     raeburn  13861: type    - scalar contains course type (Course or Community).
                   13862: 
1.663     raeburn  13863: Returns: $output (markup to be displayed) 
                   13864: 
                   13865: =cut
                   13866: 
                   13867: sub assign_categories_table {
1.919     raeburn  13868:     my ($cathash,$currcat,$type) = @_;
1.663     raeburn  13869:     my $output;
                   13870:     if (ref($cathash) eq 'HASH') {
                   13871:         my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
                   13872:         &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
                   13873:         $maxdepth = scalar(@cats);
                   13874:         if (@cats > 0) {
                   13875:             my $itemcount = 0;
                   13876:             if (ref($cats[0]) eq 'ARRAY') {
                   13877:                 my @currcategories;
                   13878:                 if ($currcat ne '') {
                   13879:                     @currcategories = split('&',$currcat);
                   13880:                 }
1.919     raeburn  13881:                 my $table;
1.663     raeburn  13882:                 for (my $i=0; $i<@{$cats[0]}; $i++) {
                   13883:                     my $parent = $cats[0][$i];
1.919     raeburn  13884:                     next if ($parent eq 'instcode');
                   13885:                     if ($type eq 'Community') {
                   13886:                         next unless ($parent eq 'communities');
                   13887:                     } else {
                   13888:                         next if ($parent eq 'communities');
                   13889:                     }
1.663     raeburn  13890:                     my $css_class = $itemcount%2?' class="LC_odd_row"':'';
                   13891:                     my $item = &escape($parent).'::0';
                   13892:                     my $checked = '';
                   13893:                     if (@currcategories > 0) {
                   13894:                         if (grep(/^\Q$item\E$/,@currcategories)) {
1.772     bisitz   13895:                             $checked = ' checked="checked"';
1.663     raeburn  13896:                         }
                   13897:                     }
1.919     raeburn  13898:                     my $parent_title = $parent;
                   13899:                     if ($parent eq 'communities') {
                   13900:                         $parent_title = &mt('Communities');
                   13901:                     }
                   13902:                     $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
                   13903:                               '<input type="checkbox" name="usecategory" value="'.
                   13904:                               $item.'"'.$checked.' />'.$parent_title.'</span>'.
                   13905:                               '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663     raeburn  13906:                     my $depth = 1;
                   13907:                     push(@path,$parent);
1.919     raeburn  13908:                     $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);
1.663     raeburn  13909:                     pop(@path);
1.919     raeburn  13910:                     $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663     raeburn  13911:                     $itemcount ++;
                   13912:                 }
1.919     raeburn  13913:                 if ($itemcount) {
                   13914:                     $output = &Apache::loncommon::start_data_table().
                   13915:                               $table.
                   13916:                               &Apache::loncommon::end_data_table();
                   13917:                 }
1.663     raeburn  13918:             }
                   13919:         }
                   13920:     }
                   13921:     return $output;
                   13922: }
                   13923: 
                   13924: =pod
                   13925: 
1.1075.2.56  raeburn  13926: =item * &assign_category_rows()
1.663     raeburn  13927: 
                   13928: Create a datatable row for display of nested categories in a domain,
                   13929: with checkboxes to allow a course to be categorized,called recursively.
                   13930: 
                   13931: Inputs:
                   13932: 
                   13933: itemcount - track row number for alternating colors
                   13934: 
                   13935: cats - reference to array of arrays/hashes which encapsulates hierarchy of
                   13936:       categories and subcategories.
                   13937: 
                   13938: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
                   13939: 
                   13940: parent - parent of current category item
                   13941: 
                   13942: path - Array containing all categories back up through the hierarchy from the
                   13943:        current category to the top level.
                   13944: 
                   13945: currcategories - reference to array of current categories assigned to the course
                   13946: 
                   13947: Returns: $output (markup to be displayed).
                   13948: 
                   13949: =cut
                   13950: 
                   13951: sub assign_category_rows {
                   13952:     my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_;
                   13953:     my ($text,$name,$item,$chgstr);
                   13954:     if (ref($cats) eq 'ARRAY') {
                   13955:         my $maxdepth = scalar(@{$cats});
                   13956:         if (ref($cats->[$depth]) eq 'HASH') {
                   13957:             if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
                   13958:                 my $numchildren = @{$cats->[$depth]{$parent}};
                   13959:                 my $css_class = $itemcount%2?' class="LC_odd_row"':'';
1.1075.2.45  raeburn  13960:                 $text .= '<td><table class="LC_data_table">';
1.663     raeburn  13961:                 for (my $j=0; $j<$numchildren; $j++) {
                   13962:                     $name = $cats->[$depth]{$parent}[$j];
                   13963:                     $item = &escape($name).':'.&escape($parent).':'.$depth;
                   13964:                     my $deeper = $depth+1;
                   13965:                     my $checked = '';
                   13966:                     if (ref($currcategories) eq 'ARRAY') {
                   13967:                         if (@{$currcategories} > 0) {
                   13968:                             if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772     bisitz   13969:                                 $checked = ' checked="checked"';
1.663     raeburn  13970:                             }
                   13971:                         }
                   13972:                     }
1.664     raeburn  13973:                     $text .= '<tr><td><span class="LC_nobreak"><label>'.
                   13974:                              '<input type="checkbox" name="usecategory" value="'.
1.675     raeburn  13975:                              $item.'"'.$checked.' />'.$name.'</label></span>'.
                   13976:                              '<input type="hidden" name="catname" value="'.$name.'" />'.
                   13977:                              '</td><td>';
1.663     raeburn  13978:                     if (ref($path) eq 'ARRAY') {
                   13979:                         push(@{$path},$name);
                   13980:                         $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);
                   13981:                         pop(@{$path});
                   13982:                     }
                   13983:                     $text .= '</td></tr>';
                   13984:                 }
                   13985:                 $text .= '</table></td>';
                   13986:             }
                   13987:         }
                   13988:     }
                   13989:     return $text;
                   13990: }
                   13991: 
1.1075.2.69  raeburn  13992: =pod
                   13993: 
                   13994: =back
                   13995: 
                   13996: =cut
                   13997: 
1.655     raeburn  13998: ############################################################
                   13999: ############################################################
                   14000: 
                   14001: 
1.443     albertel 14002: sub commit_customrole {
1.664     raeburn  14003:     my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630     raeburn  14004:     my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443     albertel 14005:                          ($start?', '.&mt('starting').' '.localtime($start):'').
                   14006:                          ($end?', ending '.localtime($end):'').': <b>'.
                   14007:               &Apache::lonnet::assigncustomrole(
1.664     raeburn  14008:                  $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443     albertel 14009:                  '</b><br />';
                   14010:     return $output;
                   14011: }
                   14012: 
                   14013: sub commit_standardrole {
1.1075.2.31  raeburn  14014:     my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits) = @_;
1.541     raeburn  14015:     my ($output,$logmsg,$linefeed);
                   14016:     if ($context eq 'auto') {
                   14017:         $linefeed = "\n";
                   14018:     } else {
                   14019:         $linefeed = "<br />\n";
                   14020:     }  
1.443     albertel 14021:     if ($three eq 'st') {
1.541     raeburn  14022:         my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
1.1075.2.31  raeburn  14023:                                          $one,$two,$sec,$context,$credits);
1.541     raeburn  14024:         if (($result =~ /^error/) || ($result eq 'not_in_class') || 
1.626     raeburn  14025:             ($result eq 'unknown_course') || ($result eq 'refused')) {
                   14026:             $output = $logmsg.' '.&mt('Error: ').$result."\n"; 
1.443     albertel 14027:         } else {
1.541     raeburn  14028:             $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443     albertel 14029:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  14030:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
                   14031:             if ($context eq 'auto') {
                   14032:                 $output .= $result.$linefeed.&mt('Add to classlist').': ok';
                   14033:             } else {
                   14034:                $output .= '<b>'.$result.'</b>'.$linefeed.
                   14035:                &mt('Add to classlist').': <b>ok</b>';
                   14036:             }
                   14037:             $output .= $linefeed;
1.443     albertel 14038:         }
                   14039:     } else {
                   14040:         $output = &mt('Assigning').' '.$three.' in '.$url.
                   14041:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  14042:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652     raeburn  14043:         my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541     raeburn  14044:         if ($context eq 'auto') {
                   14045:             $output .= $result.$linefeed;
                   14046:         } else {
                   14047:             $output .= '<b>'.$result.'</b>'.$linefeed;
                   14048:         }
1.443     albertel 14049:     }
                   14050:     return $output;
                   14051: }
                   14052: 
                   14053: sub commit_studentrole {
1.1075.2.31  raeburn  14054:     my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,
                   14055:         $credits) = @_;
1.626     raeburn  14056:     my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541     raeburn  14057:     if ($context eq 'auto') {
                   14058:         $linefeed = "\n";
                   14059:     } else {
                   14060:         $linefeed = '<br />'."\n";
                   14061:     }
1.443     albertel 14062:     if (defined($one) && defined($two)) {
                   14063:         my $cid=$one.'_'.$two;
                   14064:         my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
                   14065:         my $secchange = 0;
                   14066:         my $expire_role_result;
                   14067:         my $modify_section_result;
1.628     raeburn  14068:         if ($oldsec ne '-1') { 
                   14069:             if ($oldsec ne $sec) {
1.443     albertel 14070:                 $secchange = 1;
1.628     raeburn  14071:                 my $now = time;
1.443     albertel 14072:                 my $uurl='/'.$cid;
                   14073:                 $uurl=~s/\_/\//g;
                   14074:                 if ($oldsec) {
                   14075:                     $uurl.='/'.$oldsec;
                   14076:                 }
1.626     raeburn  14077:                 $oldsecurl = $uurl;
1.628     raeburn  14078:                 $expire_role_result = 
1.652     raeburn  14079:                     &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628     raeburn  14080:                 if ($env{'request.course.sec'} ne '') { 
                   14081:                     if ($expire_role_result eq 'refused') {
                   14082:                         my @roles = ('st');
                   14083:                         my @statuses = ('previous');
                   14084:                         my @roledoms = ($one);
                   14085:                         my $withsec = 1;
                   14086:                         my %roleshash = 
                   14087:                             &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
                   14088:                                               \@statuses,\@roles,\@roledoms,$withsec);
                   14089:                         if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
                   14090:                             my ($oldstart,$oldend) = 
                   14091:                                 split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
                   14092:                             if ($oldend > 0 && $oldend <= $now) {
                   14093:                                 $expire_role_result = 'ok';
                   14094:                             }
                   14095:                         }
                   14096:                     }
                   14097:                 }
1.443     albertel 14098:                 $result = $expire_role_result;
                   14099:             }
                   14100:         }
                   14101:         if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.1075.2.31  raeburn  14102:             $modify_section_result = 
                   14103:                 &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
                   14104:                                                            undef,undef,undef,$sec,
                   14105:                                                            $end,$start,'','',$cid,
                   14106:                                                            '',$context,$credits);
1.443     albertel 14107:             if ($modify_section_result =~ /^ok/) {
                   14108:                 if ($secchange == 1) {
1.628     raeburn  14109:                     if ($sec eq '') {
                   14110:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
                   14111:                     } else {
                   14112:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
                   14113:                     }
1.443     albertel 14114:                 } elsif ($oldsec eq '-1') {
1.628     raeburn  14115:                     if ($sec eq '') {
                   14116:                         $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
                   14117:                     } else {
                   14118:                         $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   14119:                     }
1.443     albertel 14120:                 } else {
1.628     raeburn  14121:                     if ($sec eq '') {
                   14122:                         $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
                   14123:                     } else {
                   14124:                         $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   14125:                     }
1.443     albertel 14126:                 }
                   14127:             } else {
1.628     raeburn  14128:                 if ($secchange) {       
                   14129:                     $$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;
                   14130:                 } else {
                   14131:                     $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
                   14132:                 }
1.443     albertel 14133:             }
                   14134:             $result = $modify_section_result;
                   14135:         } elsif ($secchange == 1) {
1.628     raeburn  14136:             if ($oldsec eq '') {
1.1075.2.20  raeburn  14137:                 $$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  14138:             } else {
                   14139:                 $$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;
                   14140:             }
1.626     raeburn  14141:             if ($expire_role_result eq 'refused') {
                   14142:                 my $newsecurl = '/'.$cid;
                   14143:                 $newsecurl =~ s/\_/\//g;
                   14144:                 if ($sec ne '') {
                   14145:                     $newsecurl.='/'.$sec;
                   14146:                 }
                   14147:                 if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
                   14148:                     if ($sec eq '') {
                   14149:                         $$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;
                   14150:                     } else {
                   14151:                         $$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;
                   14152:                     }
                   14153:                 }
                   14154:             }
1.443     albertel 14155:         }
                   14156:     } else {
1.626     raeburn  14157:         $$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 14158:         $result = "error: incomplete course id\n";
                   14159:     }
                   14160:     return $result;
                   14161: }
                   14162: 
1.1075.2.25  raeburn  14163: sub show_role_extent {
                   14164:     my ($scope,$context,$role) = @_;
                   14165:     $scope =~ s{^/}{};
                   14166:     my @courseroles = &Apache::lonuserutils::roles_by_context('course',1);
                   14167:     push(@courseroles,'co');
                   14168:     my @authorroles = &Apache::lonuserutils::roles_by_context('author');
                   14169:     if (($context eq 'course') || (grep(/^\Q$role\E/,@courseroles))) {
                   14170:         $scope =~ s{/}{_};
                   14171:         return '<span class="LC_cusr_emph">'.$env{'course.'.$scope.'.description'}.'</span>';
                   14172:     } elsif (($context eq 'author') || (grep(/^\Q$role\E/,@authorroles))) {
                   14173:         my ($audom,$auname) = split(/\//,$scope);
                   14174:         return &mt('[_1] Author Space','<span class="LC_cusr_emph">'.
                   14175:                    &Apache::loncommon::plainname($auname,$audom).'</span>');
                   14176:     } else {
                   14177:         $scope =~ s{/$}{};
                   14178:         return &mt('Domain: [_1]','<span class="LC_cusr_emph">'.
                   14179:                    &Apache::lonnet::domain($scope,'description').'</span>');
                   14180:     }
                   14181: }
                   14182: 
1.443     albertel 14183: ############################################################
                   14184: ############################################################
                   14185: 
1.566     albertel 14186: sub check_clone {
1.578     raeburn  14187:     my ($args,$linefeed) = @_;
1.566     albertel 14188:     my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
                   14189:     my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
                   14190:     my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
                   14191:     my $clonemsg;
                   14192:     my $can_clone = 0;
1.944     raeburn  14193:     my $lctype = lc($args->{'crstype'});
1.908     raeburn  14194:     if ($lctype ne 'community') {
                   14195:         $lctype = 'course';
                   14196:     }
1.566     albertel 14197:     if ($clonehome eq 'no_host') {
1.944     raeburn  14198:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  14199:             $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'});
                   14200:         } else {
                   14201:             $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'});
                   14202:         }     
1.566     albertel 14203:     } else {
                   14204: 	my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.944     raeburn  14205:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  14206:             if ($clonedesc{'type'} ne 'Community') {
                   14207:                  $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'});
                   14208:                 return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   14209:             }
                   14210:         }
1.882     raeburn  14211: 	if (($env{'request.role.domain'} eq $args->{'clonedomain'}) && 
                   14212:             (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566     albertel 14213: 	    $can_clone = 1;
                   14214: 	} else {
1.1075.2.95  raeburn  14215: 	    my %clonehash = &Apache::lonnet::get('environment',['cloners','internal.coursecode'],
1.566     albertel 14216: 						 $args->{'clonedomain'},$args->{'clonecourse'});
1.1075.2.95  raeburn  14217:             if ($clonehash{'cloners'} eq '') {
                   14218:                 my %domdefs = &Apache::lonnet::get_domain_defaults($args->{'course_domain'});
                   14219:                 if ($domdefs{'canclone'}) {
                   14220:                     unless ($domdefs{'canclone'} eq 'none') {
                   14221:                         if ($domdefs{'canclone'} eq 'domain') {
                   14222:                             if ($args->{'ccdomain'} eq $args->{'clonedomain'}) {
                   14223:                                 $can_clone = 1;
                   14224:                             }
                   14225:                         } elsif (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
                   14226:                                  ($args->{'clonedomain'} eq  $args->{'course_domain'})) {
                   14227:                             if (&Apache::lonnet::default_instcode_cloning($args->{'clonedomain'},$domdefs{'canclone'},
                   14228:                                                                           $clonehash{'internal.coursecode'},$args->{'crscode'})) {
                   14229:                                 $can_clone = 1;
                   14230:                             }
                   14231:                         }
                   14232:                     }
1.908     raeburn  14233:                 }
1.1075.2.95  raeburn  14234:             } else {
                   14235: 	        my @cloners = split(/,/,$clonehash{'cloners'});
                   14236:                 if (grep(/^\*$/,@cloners)) {
1.942     raeburn  14237:                     $can_clone = 1;
1.1075.2.95  raeburn  14238:                 } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
1.942     raeburn  14239:                     $can_clone = 1;
1.1075.2.96  raeburn  14240:                 } elsif (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners)) {
                   14241:                     $can_clone = 1;
1.1075.2.95  raeburn  14242:                 }
                   14243:                 unless ($can_clone) {
1.1075.2.96  raeburn  14244:                     if (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
                   14245:                         ($args->{'clonedomain'} eq  $args->{'course_domain'})) {
1.1075.2.95  raeburn  14246:                         my (%gotdomdefaults,%gotcodedefaults);
                   14247:                         foreach my $cloner (@cloners) {
                   14248:                             if (($cloner ne '*') && ($cloner !~ /^\*\:$match_domain$/) &&
                   14249:                                 ($cloner !~ /^$match_username\:$match_domain$/) && ($cloner ne '')) {
                   14250:                                 my (%codedefaults,@code_order);
                   14251:                                 if (ref($gotcodedefaults{$args->{'clonedomain'}}) eq 'HASH') {
                   14252:                                     if (ref($gotcodedefaults{$args->{'clonedomain'}}{'defaults'}) eq 'HASH') {
                   14253:                                         %codedefaults = %{$gotcodedefaults{$args->{'clonedomain'}}{'defaults'}};
                   14254:                                     }
                   14255:                                     if (ref($gotcodedefaults{$args->{'clonedomain'}}{'order'}) eq 'ARRAY') {
                   14256:                                         @code_order = @{$gotcodedefaults{$args->{'clonedomain'}}{'order'}};
                   14257:                                     }
                   14258:                                 } else {
                   14259:                                     &Apache::lonnet::auto_instcode_defaults($args->{'clonedomain'},
                   14260:                                                                             \%codedefaults,
                   14261:                                                                             \@code_order);
                   14262:                                     $gotcodedefaults{$args->{'clonedomain'}}{'defaults'} = \%codedefaults;
                   14263:                                     $gotcodedefaults{$args->{'clonedomain'}}{'order'} = \@code_order;
                   14264:                                 }
                   14265:                                 if (@code_order > 0) {
                   14266:                                     if (&Apache::lonnet::check_instcode_cloning(\%codedefaults,\@code_order,
                   14267:                                                                                 $cloner,$clonehash{'internal.coursecode'},
                   14268:                                                                                 $args->{'crscode'})) {
                   14269:                                         $can_clone = 1;
                   14270:                                         last;
                   14271:                                     }
                   14272:                                 }
                   14273:                             }
                   14274:                         }
                   14275:                     }
1.1075.2.96  raeburn  14276:                 }
                   14277:             }
                   14278:             unless ($can_clone) {
                   14279:                 my $ccrole = 'cc';
                   14280:                 if ($args->{'crstype'} eq 'Community') {
                   14281:                     $ccrole = 'co';
                   14282:                 }
                   14283:                 my %roleshash =
                   14284:                     &Apache::lonnet::get_my_roles($args->{'ccuname'},
                   14285:                                                   $args->{'ccdomain'},
                   14286:                                                   'userroles',['active'],[$ccrole],
                   14287:                                                   [$args->{'clonedomain'}]);
                   14288:                 if ($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) {
                   14289:                     $can_clone = 1;
                   14290:                 } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},
                   14291:                                                           $args->{'ccuname'},$args->{'ccdomain'})) {
                   14292:                     $can_clone = 1;
1.1075.2.95  raeburn  14293:                 }
                   14294:             }
                   14295:             unless ($can_clone) {
                   14296:                 if ($args->{'crstype'} eq 'Community') {
                   14297:                     $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'});
                   14298:                 } else {
                   14299:                     $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'});
1.578     raeburn  14300: 	        }
1.566     albertel 14301: 	    }
1.578     raeburn  14302:         }
1.566     albertel 14303:     }
                   14304:     return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   14305: }
                   14306: 
1.444     albertel 14307: sub construct_course {
1.1075.2.59  raeburn  14308:     my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category,$coderef) = @_;
1.444     albertel 14309:     my $outcome;
1.541     raeburn  14310:     my $linefeed =  '<br />'."\n";
                   14311:     if ($context eq 'auto') {
                   14312:         $linefeed = "\n";
                   14313:     }
1.566     albertel 14314: 
                   14315: #
                   14316: # Are we cloning?
                   14317: #
                   14318:     my ($can_clone, $clonemsg, $cloneid, $clonehome);
                   14319:     if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578     raeburn  14320: 	($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566     albertel 14321: 	if ($context ne 'auto') {
1.578     raeburn  14322:             if ($clonemsg ne '') {
                   14323: 	        $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
                   14324:             }
1.566     albertel 14325: 	}
                   14326: 	$outcome .= $clonemsg.$linefeed;
                   14327: 
                   14328:         if (!$can_clone) {
                   14329: 	    return (0,$outcome);
                   14330: 	}
                   14331:     }
                   14332: 
1.444     albertel 14333: #
                   14334: # Open course
                   14335: #
                   14336:     my $crstype = lc($args->{'crstype'});
                   14337:     my %cenv=();
                   14338:     $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
                   14339:                                              $args->{'cdescr'},
                   14340:                                              $args->{'curl'},
                   14341:                                              $args->{'course_home'},
                   14342:                                              $args->{'nonstandard'},
                   14343:                                              $args->{'crscode'},
                   14344:                                              $args->{'ccuname'}.':'.
                   14345:                                              $args->{'ccdomain'},
1.882     raeburn  14346:                                              $args->{'crstype'},
1.885     raeburn  14347:                                              $cnum,$context,$category);
1.444     albertel 14348: 
                   14349:     # Note: The testing routines depend on this being output; see 
                   14350:     # Utils::Course. This needs to at least be output as a comment
                   14351:     # if anyone ever decides to not show this, and Utils::Course::new
                   14352:     # will need to be suitably modified.
1.541     raeburn  14353:     $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
1.943     raeburn  14354:     if ($$courseid =~ /^error:/) {
                   14355:         return (0,$outcome);
                   14356:     }
                   14357: 
1.444     albertel 14358: #
                   14359: # Check if created correctly
                   14360: #
1.479     albertel 14361:     ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444     albertel 14362:     my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943     raeburn  14363:     if ($crsuhome eq 'no_host') {
                   14364:         $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
                   14365:         return (0,$outcome);
                   14366:     }
1.541     raeburn  14367:     $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566     albertel 14368: 
1.444     albertel 14369: #
1.566     albertel 14370: # Do the cloning
                   14371: #   
                   14372:     if ($can_clone && $cloneid) {
                   14373: 	$clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
                   14374: 	if ($context ne 'auto') {
                   14375: 	    $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
                   14376: 	}
                   14377: 	$outcome .= $clonemsg.$linefeed;
                   14378: 	my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444     albertel 14379: # Copy all files
1.637     www      14380: 	&Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444     albertel 14381: # Restore URL
1.566     albertel 14382: 	$cenv{'url'}=$oldcenv{'url'};
1.444     albertel 14383: # Restore title
1.566     albertel 14384: 	$cenv{'description'}=$oldcenv{'description'};
1.955     raeburn  14385: # Restore creation date, creator and creation context.
                   14386:         $cenv{'internal.created'}=$oldcenv{'internal.created'};
                   14387:         $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
                   14388:         $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444     albertel 14389: # Mark as cloned
1.566     albertel 14390: 	$cenv{'clonedfrom'}=$cloneid;
1.638     www      14391: # Need to clone grading mode
                   14392:         my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
                   14393:         $cenv{'grading'}=$newenv{'grading'};
                   14394: # Do not clone these environment entries
                   14395:         &Apache::lonnet::del('environment',
                   14396:                   ['default_enrollment_start_date',
                   14397:                    'default_enrollment_end_date',
                   14398:                    'question.email',
                   14399:                    'policy.email',
                   14400:                    'comment.email',
                   14401:                    'pch.users.denied',
1.725     raeburn  14402:                    'plc.users.denied',
                   14403:                    'hidefromcat',
1.1075.2.36  raeburn  14404:                    'checkforpriv',
1.1075.2.59  raeburn  14405:                    'categories',
                   14406:                    'internal.uniquecode'],
1.638     www      14407:                    $$crsudom,$$crsunum);
1.1075.2.63  raeburn  14408:         if ($args->{'textbook'}) {
                   14409:             $cenv{'internal.textbook'} = $args->{'textbook'};
                   14410:         }
1.444     albertel 14411:     }
1.566     albertel 14412: 
1.444     albertel 14413: #
                   14414: # Set environment (will override cloned, if existing)
                   14415: #
                   14416:     my @sections = ();
                   14417:     my @xlists = ();
                   14418:     if ($args->{'crstype'}) {
                   14419:         $cenv{'type'}=$args->{'crstype'};
                   14420:     }
                   14421:     if ($args->{'crsid'}) {
                   14422:         $cenv{'courseid'}=$args->{'crsid'};
                   14423:     }
                   14424:     if ($args->{'crscode'}) {
                   14425:         $cenv{'internal.coursecode'}=$args->{'crscode'};
                   14426:     }
                   14427:     if ($args->{'crsquota'} ne '') {
                   14428:         $cenv{'internal.coursequota'}=$args->{'crsquota'};
                   14429:     } else {
                   14430:         $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
                   14431:     }
                   14432:     if ($args->{'ccuname'}) {
                   14433:         $cenv{'internal.courseowner'} = $args->{'ccuname'}.
                   14434:                                         ':'.$args->{'ccdomain'};
                   14435:     } else {
                   14436:         $cenv{'internal.courseowner'} = $args->{'curruser'};
                   14437:     }
1.1075.2.31  raeburn  14438:     if ($args->{'defaultcredits'}) {
                   14439:         $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};
                   14440:     }
1.444     albertel 14441:     my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
                   14442:     if ($args->{'crssections'}) {
                   14443:         $cenv{'internal.sectionnums'} = '';
                   14444:         if ($args->{'crssections'} =~ m/,/) {
                   14445:             @sections = split/,/,$args->{'crssections'};
                   14446:         } else {
                   14447:             $sections[0] = $args->{'crssections'};
                   14448:         }
                   14449:         if (@sections > 0) {
                   14450:             foreach my $item (@sections) {
                   14451:                 my ($sec,$gp) = split/:/,$item;
                   14452:                 my $class = $args->{'crscode'}.$sec;
                   14453:                 my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
                   14454:                 $cenv{'internal.sectionnums'} .= $item.',';
                   14455:                 unless ($addcheck eq 'ok') {
                   14456:                     push @badclasses, $class;
                   14457:                 }
                   14458:             }
                   14459:             $cenv{'internal.sectionnums'} =~ s/,$//;
                   14460:         }
                   14461:     }
                   14462: # do not hide course coordinator from staff listing, 
                   14463: # even if privileged
                   14464:     $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
1.1075.2.36  raeburn  14465: # add course coordinator's domain to domains to check for privileged users
                   14466: # if different to course domain
                   14467:     if ($$crsudom ne $args->{'ccdomain'}) {
                   14468:         $cenv{'checkforpriv'} = $args->{'ccdomain'};
                   14469:     }
1.444     albertel 14470: # add crosslistings
                   14471:     if ($args->{'crsxlist'}) {
                   14472:         $cenv{'internal.crosslistings'}='';
                   14473:         if ($args->{'crsxlist'} =~ m/,/) {
                   14474:             @xlists = split/,/,$args->{'crsxlist'};
                   14475:         } else {
                   14476:             $xlists[0] = $args->{'crsxlist'};
                   14477:         }
                   14478:         if (@xlists > 0) {
                   14479:             foreach my $item (@xlists) {
                   14480:                 my ($xl,$gp) = split/:/,$item;
                   14481:                 my $addcheck =  &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
                   14482:                 $cenv{'internal.crosslistings'} .= $item.',';
                   14483:                 unless ($addcheck eq 'ok') {
                   14484:                     push @badclasses, $xl;
                   14485:                 }
                   14486:             }
                   14487:             $cenv{'internal.crosslistings'} =~ s/,$//;
                   14488:         }
                   14489:     }
                   14490:     if ($args->{'autoadds'}) {
                   14491:         $cenv{'internal.autoadds'}=$args->{'autoadds'};
                   14492:     }
                   14493:     if ($args->{'autodrops'}) {
                   14494:         $cenv{'internal.autodrops'}=$args->{'autodrops'};
                   14495:     }
                   14496: # check for notification of enrollment changes
                   14497:     my @notified = ();
                   14498:     if ($args->{'notify_owner'}) {
                   14499:         if ($args->{'ccuname'} ne '') {
                   14500:             push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
                   14501:         }
                   14502:     }
                   14503:     if ($args->{'notify_dc'}) {
                   14504:         if ($uname ne '') { 
1.630     raeburn  14505:             push(@notified,$uname.':'.$udom);
1.444     albertel 14506:         }
                   14507:     }
                   14508:     if (@notified > 0) {
                   14509:         my $notifylist;
                   14510:         if (@notified > 1) {
                   14511:             $notifylist = join(',',@notified);
                   14512:         } else {
                   14513:             $notifylist = $notified[0];
                   14514:         }
                   14515:         $cenv{'internal.notifylist'} = $notifylist;
                   14516:     }
                   14517:     if (@badclasses > 0) {
                   14518:         my %lt=&Apache::lonlocal::texthash(
                   14519:                 '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',
                   14520:                 'dnhr' => 'does not have rights to access enrollment in these classes',
                   14521:                 'adby' => 'as determined by the policies of your institution on access to official classlists'
                   14522:         );
1.541     raeburn  14523:         my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
                   14524:                            ' ('.$lt{'adby'}.')';
                   14525:         if ($context eq 'auto') {
                   14526:             $outcome .= $badclass_msg.$linefeed;
1.566     albertel 14527:             $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.541     raeburn  14528:             foreach my $item (@badclasses) {
                   14529:                 if ($context eq 'auto') {
                   14530:                     $outcome .= " - $item\n";
                   14531:                 } else {
                   14532:                     $outcome .= "<li>$item</li>\n";
                   14533:                 }
                   14534:             }
                   14535:             if ($context eq 'auto') {
                   14536:                 $outcome .= $linefeed;
                   14537:             } else {
1.566     albertel 14538:                 $outcome .= "</ul><br /><br /></div>\n";
1.541     raeburn  14539:             }
                   14540:         } 
1.444     albertel 14541:     }
                   14542:     if ($args->{'no_end_date'}) {
                   14543:         $args->{'endaccess'} = 0;
                   14544:     }
                   14545:     $cenv{'internal.autostart'}=$args->{'enrollstart'};
                   14546:     $cenv{'internal.autoend'}=$args->{'enrollend'};
                   14547:     $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
                   14548:     $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
                   14549:     if ($args->{'showphotos'}) {
                   14550:       $cenv{'internal.showphotos'}=$args->{'showphotos'};
                   14551:     }
                   14552:     $cenv{'internal.authtype'} = $args->{'authtype'};
                   14553:     $cenv{'internal.autharg'} = $args->{'autharg'}; 
                   14554:     if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
                   14555:         if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'}  eq '') {
1.541     raeburn  14556:             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'); 
                   14557:             if ($context eq 'auto') {
                   14558:                 $outcome .= $krb_msg;
                   14559:             } else {
1.566     albertel 14560:                 $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541     raeburn  14561:             }
                   14562:             $outcome .= $linefeed;
1.444     albertel 14563:         }
                   14564:     }
                   14565:     if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
                   14566:        if ($args->{'setpolicy'}) {
                   14567:            $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   14568:        }
                   14569:        if ($args->{'setcontent'}) {
                   14570:            $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   14571:        }
                   14572:     }
                   14573:     if ($args->{'reshome'}) {
                   14574: 	$cenv{'reshome'}=$args->{'reshome'}.'/';
                   14575: 	$cenv{'reshome'}=~s/\/+$/\//;
                   14576:     }
                   14577: #
                   14578: # course has keyed access
                   14579: #
                   14580:     if ($args->{'setkeys'}) {
                   14581:        $cenv{'keyaccess'}='yes';
                   14582:     }
                   14583: # if specified, key authority is not course, but user
                   14584: # only active if keyaccess is yes
                   14585:     if ($args->{'keyauth'}) {
1.487     albertel 14586: 	my ($user,$domain) = split(':',$args->{'keyauth'});
                   14587: 	$user = &LONCAPA::clean_username($user);
                   14588: 	$domain = &LONCAPA::clean_username($domain);
1.488     foxr     14589: 	if ($user ne '' && $domain ne '') {
1.487     albertel 14590: 	    $cenv{'keyauth'}=$user.':'.$domain;
1.444     albertel 14591: 	}
                   14592:     }
                   14593: 
1.1075.2.59  raeburn  14594: #
                   14595: #  generate and store uniquecode (available to course requester), if course should have one.
                   14596: #
                   14597:     if ($args->{'uniquecode'}) {
                   14598:         my ($code,$error) = &make_unique_code($$crsudom,$$crsunum);
                   14599:         if ($code) {
                   14600:             $cenv{'internal.uniquecode'} = $code;
                   14601:             my %crsinfo =
                   14602:                 &Apache::lonnet::courseiddump($$crsudom,'.',1,'.','.',$$crsunum,undef,undef,'.');
                   14603:             if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') {
                   14604:                 $crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code;
                   14605:                 my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime');
                   14606:             }
                   14607:             if (ref($coderef)) {
                   14608:                 $$coderef = $code;
                   14609:             }
                   14610:         }
                   14611:     }
                   14612: 
1.444     albertel 14613:     if ($args->{'disresdis'}) {
                   14614:         $cenv{'pch.roles.denied'}='st';
                   14615:     }
                   14616:     if ($args->{'disablechat'}) {
                   14617:         $cenv{'plc.roles.denied'}='st';
                   14618:     }
                   14619: 
                   14620:     # Record we've not yet viewed the Course Initialization Helper for this 
                   14621:     # course
                   14622:     $cenv{'course.helper.not.run'} = 1;
                   14623:     #
                   14624:     # Use new Randomseed
                   14625:     #
                   14626:     $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
                   14627:     $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
                   14628:     #
                   14629:     # The encryption code and receipt prefix for this course
                   14630:     #
                   14631:     $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
                   14632:     $cenv{'internal.encpref'}=100+int(9*rand(99));
                   14633:     #
                   14634:     # By default, use standard grading
                   14635:     if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
                   14636: 
1.541     raeburn  14637:     $outcome .= $linefeed.&mt('Setting environment').': '.                 
                   14638:           &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 14639: #
                   14640: # Open all assignments
                   14641: #
                   14642:     if ($args->{'openall'}) {
                   14643:        my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
                   14644:        my %storecontent = ($storeunder         => time,
                   14645:                            $storeunder.'.type' => 'date_start');
                   14646:        
                   14647:        $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541     raeburn  14648:                  ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 14649:    }
                   14650: #
                   14651: # Set first page
                   14652: #
                   14653:     unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
                   14654: 	    || ($cloneid)) {
1.445     albertel 14655: 	use LONCAPA::map;
1.444     albertel 14656: 	$outcome .= &mt('Setting first resource').': ';
1.445     albertel 14657: 
                   14658: 	my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
                   14659:         my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
                   14660: 
1.444     albertel 14661:         $outcome .= ($fatal?$errtext:'read ok').' - ';
                   14662:         my $title; my $url;
                   14663:         if ($args->{'firstres'} eq 'syl') {
1.690     bisitz   14664: 	    $title=&mt('Syllabus');
1.444     albertel 14665:             $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
                   14666:         } else {
1.963     raeburn  14667:             $title=&mt('Table of Contents');
1.444     albertel 14668:             $url='/adm/navmaps';
                   14669:         }
1.445     albertel 14670: 
                   14671:         $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
                   14672: 	(my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
                   14673: 
                   14674: 	if ($errtext) { $fatal=2; }
1.541     raeburn  14675:         $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444     albertel 14676:     }
1.566     albertel 14677: 
                   14678:     return (1,$outcome);
1.444     albertel 14679: }
                   14680: 
1.1075.2.59  raeburn  14681: sub make_unique_code {
                   14682:     my ($cdom,$cnum) = @_;
                   14683:     # get lock on uniquecodes db
                   14684:     my $lockhash = {
                   14685:                       $cnum."\0".'uniquecodes' => $env{'user.name'}.
                   14686:                                                   ':'.$env{'user.domain'},
                   14687:                    };
                   14688:     my $tries = 0;
                   14689:     my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
                   14690:     my ($code,$error);
                   14691: 
                   14692:     while (($gotlock ne 'ok') && ($tries<3)) {
                   14693:         $tries ++;
                   14694:         sleep 1;
                   14695:         $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
                   14696:     }
                   14697:     if ($gotlock eq 'ok') {
                   14698:         my %currcodes = &Apache::lonnet::dump_dom('uniquecodes',$cdom);
                   14699:         my $gotcode;
                   14700:         my $attempts = 0;
                   14701:         while ((!$gotcode) && ($attempts < 100)) {
                   14702:             $code = &generate_code();
                   14703:             if (!exists($currcodes{$code})) {
                   14704:                 $gotcode = 1;
                   14705:                 unless (&Apache::lonnet::newput_dom('uniquecodes',{ $code => $cnum },$cdom) eq 'ok') {
                   14706:                     $error = 'nostore';
                   14707:                 }
                   14708:             }
                   14709:             $attempts ++;
                   14710:         }
                   14711:         my @del_lock = ($cnum."\0".'uniquecodes');
                   14712:         my $dellockoutcome = &Apache::lonnet::del_dom('uniquecodes',\@del_lock,$cdom);
                   14713:     } else {
                   14714:         $error = 'nolock';
                   14715:     }
                   14716:     return ($code,$error);
                   14717: }
                   14718: 
                   14719: sub generate_code {
                   14720:     my $code;
                   14721:     my @letts = qw(B C D G H J K M N P Q R S T V W X Z);
                   14722:     for (my $i=0; $i<6; $i++) {
                   14723:         my $lettnum = int (rand 2);
                   14724:         my $item = '';
                   14725:         if ($lettnum) {
                   14726:             $item = $letts[int( rand(18) )];
                   14727:         } else {
                   14728:             $item = 1+int( rand(8) );
                   14729:         }
                   14730:         $code .= $item;
                   14731:     }
                   14732:     return $code;
                   14733: }
                   14734: 
1.444     albertel 14735: ############################################################
                   14736: ############################################################
                   14737: 
1.953     droeschl 14738: #SD
                   14739: # only Community and Course, or anything else?
1.378     raeburn  14740: sub course_type {
                   14741:     my ($cid) = @_;
                   14742:     if (!defined($cid)) {
                   14743:         $cid = $env{'request.course.id'};
                   14744:     }
1.404     albertel 14745:     if (defined($env{'course.'.$cid.'.type'})) {
                   14746:         return $env{'course.'.$cid.'.type'};
1.378     raeburn  14747:     } else {
                   14748:         return 'Course';
1.377     raeburn  14749:     }
                   14750: }
1.156     albertel 14751: 
1.406     raeburn  14752: sub group_term {
                   14753:     my $crstype = &course_type();
                   14754:     my %names = (
                   14755:                   'Course' => 'group',
1.865     raeburn  14756:                   'Community' => 'group',
1.406     raeburn  14757:                 );
                   14758:     return $names{$crstype};
                   14759: }
                   14760: 
1.902     raeburn  14761: sub course_types {
1.1075.2.59  raeburn  14762:     my @types = ('official','unofficial','community','textbook');
1.902     raeburn  14763:     my %typename = (
                   14764:                          official   => 'Official course',
                   14765:                          unofficial => 'Unofficial course',
                   14766:                          community  => 'Community',
1.1075.2.59  raeburn  14767:                          textbook   => 'Textbook course',
1.902     raeburn  14768:                    );
                   14769:     return (\@types,\%typename);
                   14770: }
                   14771: 
1.156     albertel 14772: sub icon {
                   14773:     my ($file)=@_;
1.505     albertel 14774:     my $curfext = lc((split(/\./,$file))[-1]);
1.168     albertel 14775:     my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156     albertel 14776:     my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168     albertel 14777:     if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
                   14778: 	if (-e  $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
                   14779: 	          $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   14780: 	            $curfext.".gif") {
                   14781: 	    $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   14782: 		$curfext.".gif";
                   14783: 	}
                   14784:     }
1.249     albertel 14785:     return &lonhttpdurl($iconname);
1.154     albertel 14786: } 
1.84      albertel 14787: 
1.575     albertel 14788: sub lonhttpdurl {
1.692     www      14789: #
                   14790: # Had been used for "small fry" static images on separate port 8080.
                   14791: # Modify here if lightweight http functionality desired again.
                   14792: # Currently eliminated due to increasing firewall issues.
                   14793: #
1.575     albertel 14794:     my ($url)=@_;
1.692     www      14795:     return $url;
1.215     albertel 14796: }
                   14797: 
1.213     albertel 14798: sub connection_aborted {
                   14799:     my ($r)=@_;
                   14800:     $r->print(" ");$r->rflush();
                   14801:     my $c = $r->connection;
                   14802:     return $c->aborted();
                   14803: }
                   14804: 
1.221     foxr     14805: #    Escapes strings that may have embedded 's that will be put into
1.222     foxr     14806: #    strings as 'strings'.
                   14807: sub escape_single {
1.221     foxr     14808:     my ($input) = @_;
1.223     albertel 14809:     $input =~ s/\\/\\\\/g;	# Escape the \'s..(must be first)>
1.221     foxr     14810:     $input =~ s/\'/\\\'/g;	# Esacpe the 's....
                   14811:     return $input;
                   14812: }
1.223     albertel 14813: 
1.222     foxr     14814: #  Same as escape_single, but escape's "'s  This 
                   14815: #  can be used for  "strings"
                   14816: sub escape_double {
                   14817:     my ($input) = @_;
                   14818:     $input =~ s/\\/\\\\/g;	# Escape the /'s..(must be first)>
                   14819:     $input =~ s/\"/\\\"/g;	# Esacpe the "s....
                   14820:     return $input;
                   14821: }
1.223     albertel 14822:  
1.222     foxr     14823: #   Escapes the last element of a full URL.
                   14824: sub escape_url {
                   14825:     my ($url)   = @_;
1.238     raeburn  14826:     my @urlslices = split(/\//, $url,-1);
1.369     www      14827:     my $lastitem = &escape(pop(@urlslices));
1.1075.2.83  raeburn  14828:     return &HTML::Entities::encode(join('/',@urlslices),"'").'/'.$lastitem;
1.222     foxr     14829: }
1.462     albertel 14830: 
1.820     raeburn  14831: sub compare_arrays {
                   14832:     my ($arrayref1,$arrayref2) = @_;
                   14833:     my (@difference,%count);
                   14834:     @difference = ();
                   14835:     %count = ();
                   14836:     if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
                   14837:         foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
                   14838:         foreach my $element (keys(%count)) {
                   14839:             if ($count{$element} == 1) {
                   14840:                 push(@difference,$element);
                   14841:             }
                   14842:         }
                   14843:     }
                   14844:     return @difference;
                   14845: }
                   14846: 
1.817     bisitz   14847: # -------------------------------------------------------- Initialize user login
1.462     albertel 14848: sub init_user_environment {
1.463     albertel 14849:     my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462     albertel 14850:     my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
                   14851: 
                   14852:     my $public=($username eq 'public' && $domain eq 'public');
                   14853: 
                   14854: # See if old ID present, if so, remove
                   14855: 
1.1062    raeburn  14856:     my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
1.462     albertel 14857:     my $now=time;
                   14858: 
                   14859:     if ($public) {
                   14860: 	my $max_public=100;
                   14861: 	my $oldest;
                   14862: 	my $oldest_time=0;
                   14863: 	for(my $next=1;$next<=$max_public;$next++) {
                   14864: 	    if (-e $lonids."/publicuser_$next.id") {
                   14865: 		my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
                   14866: 		if ($mtime<$oldest_time || !$oldest_time) {
                   14867: 		    $oldest_time=$mtime;
                   14868: 		    $oldest=$next;
                   14869: 		}
                   14870: 	    } else {
                   14871: 		$cookie="publicuser_$next";
                   14872: 		last;
                   14873: 	    }
                   14874: 	}
                   14875: 	if (!$cookie) { $cookie="publicuser_$oldest"; }
                   14876:     } else {
1.463     albertel 14877: 	# if this isn't a robot, kill any existing non-robot sessions
                   14878: 	if (!$args->{'robot'}) {
                   14879: 	    opendir(DIR,$lonids);
                   14880: 	    while ($filename=readdir(DIR)) {
                   14881: 		if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
                   14882: 		    unlink($lonids.'/'.$filename);
                   14883: 		}
1.462     albertel 14884: 	    }
1.463     albertel 14885: 	    closedir(DIR);
1.1075.2.84  raeburn  14886: # If there is a undeleted lockfile for the user's paste buffer remove it.
                   14887:             my $namespace = 'nohist_courseeditor';
                   14888:             my $lockingkey = 'paste'."\0".'locked_num';
                   14889:             my %lockhash = &Apache::lonnet::get($namespace,[$lockingkey],
                   14890:                                                 $domain,$username);
                   14891:             if (exists($lockhash{$lockingkey})) {
                   14892:                 my $delresult = &Apache::lonnet::del($namespace,[$lockingkey],$domain,$username);
                   14893:                 unless ($delresult eq 'ok') {
                   14894:                     &Apache::lonnet::logthis("Failed to delete paste buffer locking key in $namespace for ".$username.":".$domain." Result was: $delresult");
                   14895:                 }
                   14896:             }
1.462     albertel 14897: 	}
                   14898: # Give them a new cookie
1.463     albertel 14899: 	my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684     www      14900: 		                   : $now.$$.int(rand(10000)));
1.463     albertel 14901: 	$cookie="$username\_$id\_$domain\_$authhost";
1.462     albertel 14902:     
                   14903: # Initialize roles
                   14904: 
1.1062    raeburn  14905: 	($userroles,$firstaccenv,$timerintenv) = 
                   14906:             &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462     albertel 14907:     }
                   14908: # ------------------------------------ Check browser type and MathML capability
                   14909: 
1.1075.2.77  raeburn  14910:     my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,$clientunicode,
                   14911:         $clientos,$clientmobile,$clientinfo,$clientosversion) = &decode_user_agent($r);
1.462     albertel 14912: 
                   14913: # ------------------------------------------------------------- Get environment
                   14914: 
                   14915:     my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
                   14916:     my ($tmp) = keys(%userenv);
                   14917:     if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   14918:     } else {
                   14919: 	undef(%userenv);
                   14920:     }
                   14921:     if (($userenv{'interface'}) && (!$form->{'interface'})) {
                   14922: 	$form->{'interface'}=$userenv{'interface'};
                   14923:     }
                   14924:     if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
                   14925: 
                   14926: # --------------- Do not trust query string to be put directly into environment
1.817     bisitz   14927:     foreach my $option ('interface','localpath','localres') {
                   14928:         $form->{$option}=~s/[\n\r\=]//gs;
1.462     albertel 14929:     }
                   14930: # --------------------------------------------------------- Write first profile
                   14931: 
                   14932:     {
                   14933: 	my %initial_env = 
                   14934: 	    ("user.name"          => $username,
                   14935: 	     "user.domain"        => $domain,
                   14936: 	     "user.home"          => $authhost,
                   14937: 	     "browser.type"       => $clientbrowser,
                   14938: 	     "browser.version"    => $clientversion,
                   14939: 	     "browser.mathml"     => $clientmathml,
                   14940: 	     "browser.unicode"    => $clientunicode,
                   14941: 	     "browser.os"         => $clientos,
1.1075.2.42  raeburn  14942:              "browser.mobile"     => $clientmobile,
                   14943:              "browser.info"       => $clientinfo,
1.1075.2.77  raeburn  14944:              "browser.osversion"  => $clientosversion,
1.462     albertel 14945: 	     "server.domain"      => $Apache::lonnet::perlvar{'lonDefDomain'},
                   14946: 	     "request.course.fn"  => '',
                   14947: 	     "request.course.uri" => '',
                   14948: 	     "request.course.sec" => '',
                   14949: 	     "request.role"       => 'cm',
                   14950: 	     "request.role.adv"   => $env{'user.adv'},
                   14951: 	     "request.host"       => $ENV{'REMOTE_ADDR'},);
                   14952: 
                   14953:         if ($form->{'localpath'}) {
                   14954: 	    $initial_env{"browser.localpath"}  = $form->{'localpath'};
                   14955: 	    $initial_env{"browser.localres"}   = $form->{'localres'};
                   14956:         }
                   14957: 	
                   14958: 	if ($form->{'interface'}) {
                   14959: 	    $form->{'interface'}=~s/\W//gs;
                   14960: 	    $initial_env{"browser.interface"} = $form->{'interface'};
                   14961: 	    $env{'browser.interface'}=$form->{'interface'};
                   14962: 	}
                   14963: 
1.1075.2.54  raeburn  14964:         if ($form->{'iptoken'}) {
                   14965:             my $lonhost = $r->dir_config('lonHostID');
                   14966:             $initial_env{"user.noloadbalance"} = $lonhost;
                   14967:             $env{'user.noloadbalance'} = $lonhost;
                   14968:         }
                   14969: 
1.981     raeburn  14970:         my %is_adv = ( is_adv => $env{'user.adv'} );
1.1016    raeburn  14971:         my %domdef;
                   14972:         unless ($domain eq 'public') {
                   14973:             %domdef = &Apache::lonnet::get_domain_defaults($domain);
                   14974:         }
1.980     raeburn  14975: 
1.1075.2.7  raeburn  14976:         foreach my $tool ('aboutme','blog','webdav','portfolio') {
1.724     raeburn  14977:             $userenv{'availabletools.'.$tool} = 
1.980     raeburn  14978:                 &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
                   14979:                                                   undef,\%userenv,\%domdef,\%is_adv);
1.724     raeburn  14980:         }
                   14981: 
1.1075.2.59  raeburn  14982:         foreach my $crstype ('official','unofficial','community','textbook') {
1.765     raeburn  14983:             $userenv{'canrequest.'.$crstype} =
                   14984:                 &Apache::lonnet::usertools_access($username,$domain,$crstype,
1.980     raeburn  14985:                                                   'reload','requestcourses',
                   14986:                                                   \%userenv,\%domdef,\%is_adv);
1.765     raeburn  14987:         }
                   14988: 
1.1075.2.14  raeburn  14989:         $userenv{'canrequest.author'} =
                   14990:             &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
                   14991:                                         'reload','requestauthor',
                   14992:                                         \%userenv,\%domdef,\%is_adv);
                   14993:         my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
                   14994:                                              $domain,$username);
                   14995:         my $reqstatus = $reqauthor{'author_status'};
                   14996:         if ($reqstatus eq 'approval' || $reqstatus eq 'approved') {
                   14997:             if (ref($reqauthor{'author'}) eq 'HASH') {
                   14998:                 $userenv{'requestauthorqueued'} = $reqstatus.':'.
                   14999:                                                   $reqauthor{'author'}{'timestamp'};
                   15000:             }
                   15001:         }
                   15002: 
1.462     albertel 15003: 	$env{'user.environment'} = "$lonids/$cookie.id";
1.1062    raeburn  15004: 
1.462     albertel 15005: 	if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
                   15006: 		 &GDBM_WRCREAT(),0640)) {
                   15007: 	    &_add_to_env(\%disk_env,\%initial_env);
                   15008: 	    &_add_to_env(\%disk_env,\%userenv,'environment.');
                   15009: 	    &_add_to_env(\%disk_env,$userroles);
1.1062    raeburn  15010:             if (ref($firstaccenv) eq 'HASH') {
                   15011:                 &_add_to_env(\%disk_env,$firstaccenv);
                   15012:             }
                   15013:             if (ref($timerintenv) eq 'HASH') {
                   15014:                 &_add_to_env(\%disk_env,$timerintenv);
                   15015:             }
1.463     albertel 15016: 	    if (ref($args->{'extra_env'})) {
                   15017: 		&_add_to_env(\%disk_env,$args->{'extra_env'});
                   15018: 	    }
1.462     albertel 15019: 	    untie(%disk_env);
                   15020: 	} else {
1.705     tempelho 15021: 	    &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
                   15022: 			   'Could not create environment storage in lonauth: '.$!.'</span>');
1.462     albertel 15023: 	    return 'error: '.$!;
                   15024: 	}
                   15025:     }
                   15026:     $env{'request.role'}='cm';
                   15027:     $env{'request.role.adv'}=$env{'user.adv'};
                   15028:     $env{'browser.type'}=$clientbrowser;
                   15029: 
                   15030:     return $cookie;
                   15031: 
                   15032: }
                   15033: 
                   15034: sub _add_to_env {
                   15035:     my ($idf,$env_data,$prefix) = @_;
1.676     raeburn  15036:     if (ref($env_data) eq 'HASH') {
                   15037:         while (my ($key,$value) = each(%$env_data)) {
                   15038: 	    $idf->{$prefix.$key} = $value;
                   15039: 	    $env{$prefix.$key}   = $value;
                   15040:         }
1.462     albertel 15041:     }
                   15042: }
                   15043: 
1.685     tempelho 15044: # --- Get the symbolic name of a problem and the url
                   15045: sub get_symb {
                   15046:     my ($request,$silent) = @_;
1.726     raeburn  15047:     (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685     tempelho 15048:     my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
                   15049:     if ($symb eq '') {
                   15050:         if (!$silent) {
1.1071    raeburn  15051:             if (ref($request)) { 
                   15052:                 $request->print("Unable to handle ambiguous references:$url:.");
                   15053:             }
1.685     tempelho 15054:             return ();
                   15055:         }
                   15056:     }
                   15057:     &Apache::lonenc::check_decrypt(\$symb);
                   15058:     return ($symb);
                   15059: }
                   15060: 
                   15061: # --------------------------------------------------------------Get annotation
                   15062: 
                   15063: sub get_annotation {
                   15064:     my ($symb,$enc) = @_;
                   15065: 
                   15066:     my $key = $symb;
                   15067:     if (!$enc) {
                   15068:         $key =
                   15069:             &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
                   15070:     }
                   15071:     my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
                   15072:     return $annotation{$key};
                   15073: }
                   15074: 
                   15075: sub clean_symb {
1.731     raeburn  15076:     my ($symb,$delete_enc) = @_;
1.685     tempelho 15077: 
                   15078:     &Apache::lonenc::check_decrypt(\$symb);
                   15079:     my $enc = $env{'request.enc'};
1.731     raeburn  15080:     if ($delete_enc) {
1.730     raeburn  15081:         delete($env{'request.enc'});
                   15082:     }
1.685     tempelho 15083: 
                   15084:     return ($symb,$enc);
                   15085: }
1.462     albertel 15086: 
1.1075.2.69  raeburn  15087: ############################################################
                   15088: ############################################################
                   15089: 
                   15090: =pod
                   15091: 
                   15092: =head1 Routines for building display used to search for courses
                   15093: 
                   15094: 
                   15095: =over 4
                   15096: 
                   15097: =item * &build_filters()
                   15098: 
                   15099: Create markup for a table used to set filters to use when selecting
                   15100: courses in a domain.  Used by lonpickcourse.pm, lonmodifycourse.pm
                   15101: and quotacheck.pl
                   15102: 
                   15103: 
                   15104: Inputs:
                   15105: 
                   15106: filterlist - anonymous array of fields to include as potential filters
                   15107: 
                   15108: crstype - course type
                   15109: 
                   15110: roleelement - fifth arg in selectcourse_link() populates fifth arg in javascript: opencrsbrowser() function, used
                   15111:               to pop-open a course selector (will contain "extra element").
                   15112: 
                   15113: multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1
                   15114: 
                   15115: filter - anonymous hash of criteria and their values
                   15116: 
                   15117: action - form action
                   15118: 
                   15119: numfiltersref - ref to scalar (count of number of elements in institutional codes -- e.g., 4 for year, semester, department, and number)
                   15120: 
                   15121: caller - caller context (e.g., set to 'modifycourse' when routine is called from lonmodifycourse.pm)
                   15122: 
                   15123: cloneruname - username of owner of new course who wants to clone
                   15124: 
                   15125: clonerudom - domain of owner of new course who wants to clone
                   15126: 
                   15127: typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community)
                   15128: 
                   15129: codetitlesref - reference to array of titles of components in institutional codes (official courses)
                   15130: 
                   15131: codedom - domain
                   15132: 
                   15133: formname - value of form element named "form".
                   15134: 
                   15135: fixeddom - domain, if fixed.
                   15136: 
                   15137: prevphase - value to assign to form element named "phase" when going back to the previous screen
                   15138: 
                   15139: cnameelement - name of form element in form on opener page which will receive title of selected course
                   15140: 
                   15141: cnumelement - name of form element in form on opener page which will receive courseID  of selected course
                   15142: 
                   15143: cdomelement - name of form element in form on opener page which will receive domain of selected course
                   15144: 
                   15145: setroles - includes access constraint identifier when setting a roles-based condition for acces to a portfolio file
                   15146: 
                   15147: clonetext - hidden form elements containing list of courses cloneable by intended course owner when DC creates a course
                   15148: 
                   15149: clonewarning - warning message about missing information for intended course owner when DC creates a course
                   15150: 
                   15151: 
                   15152: Returns: $output - HTML for display of search criteria, and hidden form elements.
                   15153: 
                   15154: 
                   15155: Side Effects: None
                   15156: 
                   15157: =cut
                   15158: 
                   15159: # ---------------------------------------------- search for courses based on last activity etc.
                   15160: 
                   15161: sub build_filters {
                   15162:     my ($filterlist,$crstype,$roleelement,$multelement,$filter,$action,
                   15163:         $numtitlesref,$caller,$cloneruname,$clonerudom,$typeelement,
                   15164:         $codetitlesref,$codedom,$formname,$fixeddom,$prevphase,
                   15165:         $cnameelement,$cnumelement,$cdomelement,$setroles,
                   15166:         $clonetext,$clonewarning) = @_;
                   15167:     my ($list,$jscript);
                   15168:     my $onchange = 'javascript:updateFilters(this)';
                   15169:     my ($domainselectform,$sincefilterform,$createdfilterform,
                   15170:         $ownerdomselectform,$persondomselectform,$instcodeform,
                   15171:         $typeselectform,$instcodetitle);
                   15172:     if ($formname eq '') {
                   15173:         $formname = $caller;
                   15174:     }
                   15175:     foreach my $item (@{$filterlist}) {
                   15176:         unless (($item eq 'descriptfilter') || ($item eq 'instcodefilter') ||
                   15177:                 ($item eq 'sincefilter') || ($item eq 'createdfilter')) {
                   15178:             if ($item eq 'domainfilter') {
                   15179:                 $filter->{$item} = &LONCAPA::clean_domain($filter->{$item});
                   15180:             } elsif ($item eq 'coursefilter') {
                   15181:                 $filter->{$item} = &LONCAPA::clean_courseid($filter->{$item});
                   15182:             } elsif ($item eq 'ownerfilter') {
                   15183:                 $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
                   15184:             } elsif ($item eq 'ownerdomfilter') {
                   15185:                 $filter->{'ownerdomfilter'} =
                   15186:                     &LONCAPA::clean_domain($filter->{$item});
                   15187:                 $ownerdomselectform = &select_dom_form($filter->{'ownerdomfilter'},
                   15188:                                                        'ownerdomfilter',1);
                   15189:             } elsif ($item eq 'personfilter') {
                   15190:                 $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
                   15191:             } elsif ($item eq 'persondomfilter') {
                   15192:                 $persondomselectform = &select_dom_form($filter->{'persondomfilter'},
                   15193:                                                         'persondomfilter',1);
                   15194:             } else {
                   15195:                 $filter->{$item} =~ s/\W//g;
                   15196:             }
                   15197:             if (!$filter->{$item}) {
                   15198:                 $filter->{$item} = '';
                   15199:             }
                   15200:         }
                   15201:         if ($item eq 'domainfilter') {
                   15202:             my $allow_blank = 1;
                   15203:             if ($formname eq 'portform') {
                   15204:                 $allow_blank=0;
                   15205:             } elsif ($formname eq 'studentform') {
                   15206:                 $allow_blank=0;
                   15207:             }
                   15208:             if ($fixeddom) {
                   15209:                 $domainselectform = '<input type="hidden" name="domainfilter"'.
                   15210:                                     ' value="'.$codedom.'" />'.
                   15211:                                     &Apache::lonnet::domain($codedom,'description');
                   15212:             } else {
                   15213:                 $domainselectform = &select_dom_form($filter->{$item},
                   15214:                                                      'domainfilter',
                   15215:                                                       $allow_blank,'',$onchange);
                   15216:             }
                   15217:         } else {
                   15218:             $list->{$item} = &HTML::Entities::encode($filter->{$item},'<>&"');
                   15219:         }
                   15220:     }
                   15221: 
                   15222:     # last course activity filter and selection
                   15223:     $sincefilterform = &timebased_select_form('sincefilter',$filter);
                   15224: 
                   15225:     # course created filter and selection
                   15226:     if (exists($filter->{'createdfilter'})) {
                   15227:         $createdfilterform = &timebased_select_form('createdfilter',$filter);
                   15228:     }
                   15229: 
                   15230:     my %lt = &Apache::lonlocal::texthash(
                   15231:                 'cac' => "$crstype Activity",
                   15232:                 'ccr' => "$crstype Created",
                   15233:                 'cde' => "$crstype Title",
                   15234:                 'cdo' => "$crstype Domain",
                   15235:                 'ins' => 'Institutional Code',
                   15236:                 'inc' => 'Institutional Categorization',
                   15237:                 'cow' => "$crstype Owner/Co-owner",
                   15238:                 'cop' => "$crstype Personnel Includes",
                   15239:                 'cog' => 'Type',
                   15240:              );
                   15241: 
                   15242:     if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
                   15243:         my $typeval = 'Course';
                   15244:         if ($crstype eq 'Community') {
                   15245:             $typeval = 'Community';
                   15246:         }
                   15247:         $typeselectform = '<input type="hidden" name="type" value="'.$typeval.'" />';
                   15248:     } else {
                   15249:         $typeselectform =  '<select name="type" size="1"';
                   15250:         if ($onchange) {
                   15251:             $typeselectform .= ' onchange="'.$onchange.'"';
                   15252:         }
                   15253:         $typeselectform .= '>'."\n";
                   15254:         foreach my $posstype ('Course','Community') {
                   15255:             $typeselectform.='<option value="'.$posstype.'"'.
                   15256:                 ($posstype eq $crstype ? ' selected="selected" ' : ''). ">".&mt($posstype)."</option>\n";
                   15257:         }
                   15258:         $typeselectform.="</select>";
                   15259:     }
                   15260: 
                   15261:     my ($cloneableonlyform,$cloneabletitle);
                   15262:     if (exists($filter->{'cloneableonly'})) {
                   15263:         my $cloneableon = '';
                   15264:         my $cloneableoff = ' checked="checked"';
                   15265:         if ($filter->{'cloneableonly'}) {
                   15266:             $cloneableon = $cloneableoff;
                   15267:             $cloneableoff = '';
                   15268:         }
                   15269:         $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>';
                   15270:         if ($formname eq 'ccrs') {
1.1075.2.71  raeburn  15271:             $cloneabletitle = &mt('Cloneable for [_1]',$cloneruname.':'.$clonerudom);
1.1075.2.69  raeburn  15272:         } else {
                   15273:             $cloneabletitle = &mt('Cloneable by you');
                   15274:         }
                   15275:     }
                   15276:     my $officialjs;
                   15277:     if ($crstype eq 'Course') {
                   15278:         if (exists($filter->{'instcodefilter'})) {
                   15279: #            if (($fixeddom) || ($formname eq 'requestcrs') ||
                   15280: #                ($formname eq 'modifycourse') || ($formname eq 'filterpicker')) {
                   15281:             if ($codedom) {
                   15282:                 $officialjs = 1;
                   15283:                 ($instcodeform,$jscript,$$numtitlesref) =
                   15284:                     &Apache::courseclassifier::instcode_selectors($codedom,'filterpicker',
                   15285:                                                                   $officialjs,$codetitlesref);
                   15286:                 if ($jscript) {
                   15287:                     $jscript = '<script type="text/javascript">'."\n".
                   15288:                                '// <![CDATA['."\n".
                   15289:                                $jscript."\n".
                   15290:                                '// ]]>'."\n".
                   15291:                                '</script>'."\n";
                   15292:                 }
                   15293:             }
                   15294:             if ($instcodeform eq '') {
                   15295:                 $instcodeform =
                   15296:                     '<input type="text" name="instcodefilter" size="10" value="'.
                   15297:                     $list->{'instcodefilter'}.'" />';
                   15298:                 $instcodetitle = $lt{'ins'};
                   15299:             } else {
                   15300:                 $instcodetitle = $lt{'inc'};
                   15301:             }
                   15302:             if ($fixeddom) {
                   15303:                 $instcodetitle .= '<br />('.$codedom.')';
                   15304:             }
                   15305:         }
                   15306:     }
                   15307:     my $output = qq|
                   15308: <form method="post" name="filterpicker" action="$action">
                   15309: <input type="hidden" name="form" value="$formname" />
                   15310: |;
                   15311:     if ($formname eq 'modifycourse') {
                   15312:         $output .= '<input type="hidden" name="phase" value="courselist" />'."\n".
                   15313:                    '<input type="hidden" name="prevphase" value="'.
                   15314:                    $prevphase.'" />'."\n";
1.1075.2.82  raeburn  15315:     } elsif ($formname eq 'quotacheck') {
                   15316:         $output .= qq|
                   15317: <input type="hidden" name="sortby" value="" />
                   15318: <input type="hidden" name="sortorder" value="" />
                   15319: |;
                   15320:     } else {
1.1075.2.69  raeburn  15321:         my $name_input;
                   15322:         if ($cnameelement ne '') {
                   15323:             $name_input = '<input type="hidden" name="cnameelement" value="'.
                   15324:                           $cnameelement.'" />';
                   15325:         }
                   15326:         $output .= qq|
                   15327: <input type="hidden" name="cnumelement" value="$cnumelement" />
                   15328: <input type="hidden" name="cdomelement" value="$cdomelement" />
                   15329: $name_input
                   15330: $roleelement
                   15331: $multelement
                   15332: $typeelement
                   15333: |;
                   15334:         if ($formname eq 'portform') {
                   15335:             $output .= '<input type="hidden" name="setroles" value="'.$setroles.'" />'."\n";
                   15336:         }
                   15337:     }
                   15338:     if ($fixeddom) {
                   15339:         $output .= '<input type="hidden" name="fixeddom" value="'.$fixeddom.'" />'."\n";
                   15340:     }
                   15341:     $output .= "<br />\n".&Apache::lonhtmlcommon::start_pick_box();
                   15342:     if ($sincefilterform) {
                   15343:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cac'})
                   15344:                   .$sincefilterform
                   15345:                   .&Apache::lonhtmlcommon::row_closure();
                   15346:     }
                   15347:     if ($createdfilterform) {
                   15348:         $output .= &Apache::lonhtmlcommon::row_title($lt{'ccr'})
                   15349:                   .$createdfilterform
                   15350:                   .&Apache::lonhtmlcommon::row_closure();
                   15351:     }
                   15352:     if ($domainselectform) {
                   15353:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cdo'})
                   15354:                   .$domainselectform
                   15355:                   .&Apache::lonhtmlcommon::row_closure();
                   15356:     }
                   15357:     if ($typeselectform) {
                   15358:         if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
                   15359:             $output .= $typeselectform;
                   15360:         } else {
                   15361:             $output .= &Apache::lonhtmlcommon::row_title($lt{'cog'})
                   15362:                       .$typeselectform
                   15363:                       .&Apache::lonhtmlcommon::row_closure();
                   15364:         }
                   15365:     }
                   15366:     if ($instcodeform) {
                   15367:         $output .= &Apache::lonhtmlcommon::row_title($instcodetitle)
                   15368:                   .$instcodeform
                   15369:                   .&Apache::lonhtmlcommon::row_closure();
                   15370:     }
                   15371:     if (exists($filter->{'ownerfilter'})) {
                   15372:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cow'}).
                   15373:                    '<table><tr><td>'.&mt('Username').'<br />'.
                   15374:                    '<input type="text" name="ownerfilter" size="20" value="'.
                   15375:                    $list->{'ownerfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
                   15376:                    $ownerdomselectform.'</td></tr></table>'.
                   15377:                    &Apache::lonhtmlcommon::row_closure();
                   15378:     }
                   15379:     if (exists($filter->{'personfilter'})) {
                   15380:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cop'}).
                   15381:                    '<table><tr><td>'.&mt('Username').'<br />'.
                   15382:                    '<input type="text" name="personfilter" size="20" value="'.
                   15383:                    $list->{'personfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
                   15384:                    $persondomselectform.'</td></tr></table>'.
                   15385:                    &Apache::lonhtmlcommon::row_closure();
                   15386:     }
                   15387:     if (exists($filter->{'coursefilter'})) {
                   15388:         $output .= &Apache::lonhtmlcommon::row_title(&mt('LON-CAPA course ID'))
                   15389:                   .'<input type="text" name="coursefilter" size="25" value="'
                   15390:                   .$list->{'coursefilter'}.'" />'
                   15391:                   .&Apache::lonhtmlcommon::row_closure();
                   15392:     }
                   15393:     if ($cloneableonlyform) {
                   15394:         $output .= &Apache::lonhtmlcommon::row_title($cloneabletitle).
                   15395:                    $cloneableonlyform.&Apache::lonhtmlcommon::row_closure();
                   15396:     }
                   15397:     if (exists($filter->{'descriptfilter'})) {
                   15398:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cde'})
                   15399:                   .'<input type="text" name="descriptfilter" size="40" value="'
                   15400:                   .$list->{'descriptfilter'}.'" />'
                   15401:                   .&Apache::lonhtmlcommon::row_closure(1);
                   15402:     }
                   15403:     $output .= &Apache::lonhtmlcommon::end_pick_box().'<p>'.$clonetext."\n".
                   15404:                '<input type="hidden" name="updater" value="" />'."\n".
                   15405:                '<input type="submit" name="gosearch" value="'.
                   15406:                &mt('Search').'" /></p>'."\n".'</form>'."\n".'<hr />'."\n";
                   15407:     return $jscript.$clonewarning.$output;
                   15408: }
                   15409: 
                   15410: =pod
                   15411: 
                   15412: =item * &timebased_select_form()
                   15413: 
                   15414: Create markup for a dropdown list used to select a time-based
                   15415: filter e.g., Course Activity, Course Created, when searching for courses
                   15416: or communities
                   15417: 
                   15418: Inputs:
                   15419: 
                   15420: item - name of form element (sincefilter or createdfilter)
                   15421: 
                   15422: filter - anonymous hash of criteria and their values
                   15423: 
                   15424: Returns: HTML for a select box contained a blank, then six time selections,
                   15425:          with value set in incoming form variables currently selected.
                   15426: 
                   15427: Side Effects: None
                   15428: 
                   15429: =cut
                   15430: 
                   15431: sub timebased_select_form {
                   15432:     my ($item,$filter) = @_;
                   15433:     if (ref($filter) eq 'HASH') {
                   15434:         $filter->{$item} =~ s/[^\d-]//g;
                   15435:         if (!$filter->{$item}) { $filter->{$item}=-1; }
                   15436:         return &select_form(
                   15437:                             $filter->{$item},
                   15438:                             $item,
                   15439:                             {      '-1' => '',
                   15440:                                 '86400' => &mt('today'),
                   15441:                                '604800' => &mt('last week'),
                   15442:                               '2592000' => &mt('last month'),
                   15443:                               '7776000' => &mt('last three months'),
                   15444:                              '15552000' => &mt('last six months'),
                   15445:                              '31104000' => &mt('last year'),
                   15446:                     'select_form_order' =>
                   15447:                            ['-1','86400','604800','2592000','7776000',
                   15448:                             '15552000','31104000']});
                   15449:     }
                   15450: }
                   15451: 
                   15452: =pod
                   15453: 
                   15454: =item * &js_changer()
                   15455: 
                   15456: Create script tag containing Javascript used to submit course search form
                   15457: when course type or domain is changed, and also to hide 'Searching ...' on
                   15458: page load completion for page showing search result.
                   15459: 
                   15460: Inputs: None
                   15461: 
                   15462: Returns: markup containing updateFilters() and hideSearching() javascript functions.
                   15463: 
                   15464: Side Effects: None
                   15465: 
                   15466: =cut
                   15467: 
                   15468: sub js_changer {
                   15469:     return <<ENDJS;
                   15470: <script type="text/javascript">
                   15471: // <![CDATA[
                   15472: function updateFilters(caller) {
                   15473:     if (typeof(caller) != "undefined") {
                   15474:         document.filterpicker.updater.value = caller.name;
                   15475:     }
                   15476:     document.filterpicker.submit();
                   15477: }
                   15478: 
                   15479: function hideSearching() {
                   15480:     if (document.getElementById('searching')) {
                   15481:         document.getElementById('searching').style.display = 'none';
                   15482:     }
                   15483:     return;
                   15484: }
                   15485: 
                   15486: // ]]>
                   15487: </script>
                   15488: 
                   15489: ENDJS
                   15490: }
                   15491: 
                   15492: =pod
                   15493: 
                   15494: =item * &search_courses()
                   15495: 
                   15496: Process selected filters form course search form and pass to lonnet::courseiddump
                   15497: to retrieve a hash for which keys are courseIDs which match the selected filters.
                   15498: 
                   15499: Inputs:
                   15500: 
                   15501: dom - domain being searched
                   15502: 
                   15503: type - course type ('Course' or 'Community' or '.' if any).
                   15504: 
                   15505: filter - anonymous hash of criteria and their values
                   15506: 
                   15507: numtitles - for institutional codes - number of categories
                   15508: 
                   15509: cloneruname - optional username of new course owner
                   15510: 
                   15511: clonerudom - optional domain of new course owner
                   15512: 
1.1075.2.95  raeburn  15513: domcloner - optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by,
1.1075.2.69  raeburn  15514:             (used when DC is using course creation form)
                   15515: 
                   15516: codetitles - reference to array of titles of components in institutional codes (official courses).
                   15517: 
1.1075.2.95  raeburn  15518: cc_clone - escaped comma separated list of courses for which course cloner has active CC role
                   15519:            (and so can clone automatically)
                   15520: 
                   15521: reqcrsdom - domain of new course, where search_courses is used to identify potential courses to clone
                   15522: 
                   15523: reqinstcode - institutional code of new course, where search_courses is used to identify potential
                   15524:               courses to clone
1.1075.2.69  raeburn  15525: 
                   15526: Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type.
                   15527: 
                   15528: 
                   15529: Side Effects: None
                   15530: 
                   15531: =cut
                   15532: 
                   15533: 
                   15534: sub search_courses {
1.1075.2.95  raeburn  15535:     my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles,
                   15536:         $cc_clone,$reqcrsdom,$reqinstcode) = @_;
1.1075.2.69  raeburn  15537:     my (%courses,%showcourses,$cloner);
                   15538:     if (($filter->{'ownerfilter'} ne '') ||
                   15539:         ($filter->{'ownerdomfilter'} ne '')) {
                   15540:         $filter->{'combownerfilter'} = $filter->{'ownerfilter'}.':'.
                   15541:                                        $filter->{'ownerdomfilter'};
                   15542:     }
                   15543:     foreach my $item ('descriptfilter','coursefilter','combownerfilter') {
                   15544:         if (!$filter->{$item}) {
                   15545:             $filter->{$item}='.';
                   15546:         }
                   15547:     }
                   15548:     my $now = time;
                   15549:     my $timefilter =
                   15550:        ($filter->{'sincefilter'}==-1?1:$now-$filter->{'sincefilter'});
                   15551:     my ($createdbefore,$createdafter);
                   15552:     if (($filter->{'createdfilter'} ne '') && ($filter->{'createdfilter'} !=-1)) {
                   15553:         $createdbefore = $now;
                   15554:         $createdafter = $now-$filter->{'createdfilter'};
                   15555:     }
                   15556:     my ($instcodefilter,$regexpok);
                   15557:     if ($numtitles) {
                   15558:         if ($env{'form.official'} eq 'on') {
                   15559:             $instcodefilter =
                   15560:                 &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
                   15561:             $regexpok = 1;
                   15562:         } elsif ($env{'form.official'} eq 'off') {
                   15563:             $instcodefilter = &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
                   15564:             unless ($instcodefilter eq '') {
                   15565:                 $regexpok = -1;
                   15566:             }
                   15567:         }
                   15568:     } else {
                   15569:         $instcodefilter = $filter->{'instcodefilter'};
                   15570:     }
                   15571:     if ($instcodefilter eq '') { $instcodefilter = '.'; }
                   15572:     if ($type eq '') { $type = '.'; }
                   15573: 
                   15574:     if (($clonerudom ne '') && ($cloneruname ne '')) {
                   15575:         $cloner = $cloneruname.':'.$clonerudom;
                   15576:     }
                   15577:     %courses = &Apache::lonnet::courseiddump($dom,
                   15578:                                              $filter->{'descriptfilter'},
                   15579:                                              $timefilter,
                   15580:                                              $instcodefilter,
                   15581:                                              $filter->{'combownerfilter'},
                   15582:                                              $filter->{'coursefilter'},
                   15583:                                              undef,undef,$type,$regexpok,undef,undef,
1.1075.2.95  raeburn  15584:                                              undef,undef,$cloner,$cc_clone,
1.1075.2.69  raeburn  15585:                                              $filter->{'cloneableonly'},
                   15586:                                              $createdbefore,$createdafter,undef,
1.1075.2.95  raeburn  15587:                                              $domcloner,undef,$reqcrsdom,$reqinstcode);
1.1075.2.69  raeburn  15588:     if (($filter->{'personfilter'} ne '') && ($filter->{'persondomfilter'} ne '')) {
                   15589:         my $ccrole;
                   15590:         if ($type eq 'Community') {
                   15591:             $ccrole = 'co';
                   15592:         } else {
                   15593:             $ccrole = 'cc';
                   15594:         }
                   15595:         my %rolehash = &Apache::lonnet::get_my_roles($filter->{'personfilter'},
                   15596:                                                      $filter->{'persondomfilter'},
                   15597:                                                      'userroles',undef,
                   15598:                                                      [$ccrole,'in','ad','ep','ta','cr'],
                   15599:                                                      $dom);
                   15600:         foreach my $role (keys(%rolehash)) {
                   15601:             my ($cnum,$cdom,$courserole) = split(':',$role);
                   15602:             my $cid = $cdom.'_'.$cnum;
                   15603:             if (exists($courses{$cid})) {
                   15604:                 if (ref($courses{$cid}) eq 'HASH') {
                   15605:                     if (ref($courses{$cid}{roles}) eq 'ARRAY') {
                   15606:                         if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) {
                   15607:                             push (@{$courses{$cid}{roles}},$courserole);
                   15608:                         }
                   15609:                     } else {
                   15610:                         $courses{$cid}{roles} = [$courserole];
                   15611:                     }
                   15612:                     $showcourses{$cid} = $courses{$cid};
                   15613:                 }
                   15614:             }
                   15615:         }
                   15616:         %courses = %showcourses;
                   15617:     }
                   15618:     return %courses;
                   15619: }
                   15620: 
                   15621: =pod
                   15622: 
                   15623: =back
                   15624: 
1.1075.2.88  raeburn  15625: =head1 Routines for version requirements for current course.
                   15626: 
                   15627: =over 4
                   15628: 
                   15629: =item * &check_release_required()
                   15630: 
                   15631: Compares required LON-CAPA version with version on server, and
                   15632: if required version is newer looks for a server with the required version.
                   15633: 
                   15634: Looks first at servers in user's owen domain; if none suitable, looks at
                   15635: servers in course's domain are permitted to host sessions for user's domain.
                   15636: 
                   15637: Inputs:
                   15638: 
                   15639: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
                   15640: 
                   15641: $courseid - Course ID of current course
                   15642: 
                   15643: $rolecode - User's current role in course (for switchserver query string).
                   15644: 
                   15645: $required - LON-CAPA version needed by course (format: Major.Minor).
                   15646: 
                   15647: 
                   15648: Returns:
                   15649: 
                   15650: $switchserver - query string tp append to /adm/switchserver call (if
                   15651:                 current server's LON-CAPA version is too old.
                   15652: 
                   15653: $warning - Message is displayed if no suitable server could be found.
                   15654: 
                   15655: =cut
                   15656: 
                   15657: sub check_release_required {
                   15658:     my ($loncaparev,$courseid,$rolecode,$required) = @_;
                   15659:     my ($switchserver,$warning);
                   15660:     if ($required ne '') {
                   15661:         my ($reqdmajor,$reqdminor) = ($required =~ /^(\d+)\.(\d+)$/);
                   15662:         my ($major,$minor) = ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
                   15663:         if ($reqdmajor ne '' && $reqdminor ne '') {
                   15664:             my $otherserver;
                   15665:             if (($major eq '' && $minor eq '') ||
                   15666:                 (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)))) {
                   15667:                 my ($userdomserver) = &Apache::lonnet::choose_server($env{'user.domain'},undef,$required,1);
                   15668:                 my $switchlcrev =
                   15669:                     &Apache::lonnet::get_server_loncaparev($env{'user.domain'},
                   15670:                                                            $userdomserver);
                   15671:                 my ($swmajor,$swminor) = ($switchlcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
                   15672:                 if (($swmajor eq '' && $swminor eq '') || ($reqdmajor > $swmajor) ||
                   15673:                     (($reqdmajor == $swmajor) && ($reqdminor > $swminor))) {
                   15674:                     my $cdom = $env{'course.'.$courseid.'.domain'};
                   15675:                     if ($cdom ne $env{'user.domain'}) {
                   15676:                         my ($coursedomserver,$coursehostname) = &Apache::lonnet::choose_server($cdom,undef,$required,1);
                   15677:                         my $serverhomeID = &Apache::lonnet::get_server_homeID($coursehostname);
                   15678:                         my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
                   15679:                         my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);
                   15680:                         my %udomdefaults = &Apache::lonnet::get_domain_defaults($env{'user.domain'});
                   15681:                         my $remoterev = &Apache::lonnet::get_server_loncaparev($serverhomedom,$coursedomserver);
                   15682:                         my $canhost =
                   15683:                             &Apache::lonnet::can_host_session($env{'user.domain'},
                   15684:                                                               $coursedomserver,
                   15685:                                                               $remoterev,
                   15686:                                                               $udomdefaults{'remotesessions'},
                   15687:                                                               $defdomdefaults{'hostedsessions'});
                   15688: 
                   15689:                         if ($canhost) {
                   15690:                             $otherserver = $coursedomserver;
                   15691:                         } else {
                   15692:                             $warning = &mt('Requires LON-CAPA version [_1].',$env{'course.'.$courseid.'.internal.releaserequired'}).'<br />'. &mt("No suitable server could be found amongst servers in either your own domain or in the course's domain.");
                   15693:                         }
                   15694:                     } else {
                   15695:                         $warning = &mt('Requires LON-CAPA version [_1].',$env{'course.'.$courseid.'.internal.releaserequired'}).'<br />'.&mt("No suitable server could be found amongst servers in your own domain (which is also the course's domain).");
                   15696:                     }
                   15697:                 } else {
                   15698:                     $otherserver = $userdomserver;
                   15699:                 }
                   15700:             }
                   15701:             if ($otherserver ne '') {
                   15702:                 $switchserver = 'otherserver='.$otherserver.'&amp;role='.$rolecode;
                   15703:             }
                   15704:         }
                   15705:     }
                   15706:     return ($switchserver,$warning);
                   15707: }
                   15708: 
                   15709: =pod
                   15710: 
                   15711: =item * &check_release_result()
                   15712: 
                   15713: Inputs:
                   15714: 
                   15715: $switchwarning - Warning message if no suitable server found to host session.
                   15716: 
                   15717: $switchserver - query string to append to /adm/switchserver containing lonHostID
                   15718:                 and current role.
                   15719: 
                   15720: Returns: HTML to display with information about requirement to switch server.
                   15721:          Either displaying warning with link to Roles/Courses screen or
                   15722:          display link to switchserver.
                   15723: 
1.1075.2.69  raeburn  15724: =cut
                   15725: 
1.1075.2.88  raeburn  15726: sub check_release_result {
                   15727:     my ($switchwarning,$switchserver) = @_;
                   15728:     my $output = &start_page('Selected course unavailable on this server').
                   15729:                  '<p class="LC_warning">';
                   15730:     if ($switchwarning) {
                   15731:         $output .= $switchwarning.'<br /><a href="/adm/roles">';
                   15732:         if (&show_course()) {
                   15733:             $output .= &mt('Display courses');
                   15734:         } else {
                   15735:             $output .= &mt('Display roles');
                   15736:         }
                   15737:         $output .= '</a>';
                   15738:     } elsif ($switchserver) {
                   15739:         $output .= &mt('This course requires a newer version of LON-CAPA than is installed on this server.').
                   15740:                    '<br />'.
                   15741:                    '<a href="/adm/switchserver?'.$switchserver.'">'.
                   15742:                    &mt('Switch Server').
                   15743:                    '</a>';
                   15744:     }
                   15745:     $output .= '</p>'.&end_page();
                   15746:     return $output;
                   15747: }
                   15748: 
                   15749: =pod
                   15750: 
                   15751: =item * &needs_coursereinit()
                   15752: 
                   15753: Determine if course contents stored for user's session needs to be
                   15754: refreshed, because content has changed since "Big Hash" last tied.
                   15755: 
                   15756: Check for change is made if time last checked is more than 10 minutes ago
                   15757: (by default).
                   15758: 
                   15759: Inputs:
                   15760: 
                   15761: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
                   15762: 
                   15763: $interval (optional) - Time which may elapse (in s) between last check for content
                   15764:                        change in current course. (default: 600 s).
                   15765: 
                   15766: Returns: an array; first element is:
                   15767: 
                   15768: =over 4
                   15769: 
                   15770: 'switch' - if content updates mean user's session
                   15771:            needs to be switched to a server running a newer LON-CAPA version
                   15772: 
                   15773: 'update' - if course session needs to be refreshed (i.e., Big Hash needs to be reloaded)
                   15774:            on current server hosting user's session
                   15775: 
                   15776: ''       - if no action required.
                   15777: 
                   15778: =back
                   15779: 
                   15780: If first item element is 'switch':
                   15781: 
                   15782: second item is $switchwarning - Warning message if no suitable server found to host session.
                   15783: 
                   15784: third item is $switchserver - query string to append to /adm/switchserver containing lonHostID
                   15785:                               and current role.
                   15786: 
                   15787: otherwise: no other elements returned.
                   15788: 
                   15789: =back
                   15790: 
                   15791: =cut
                   15792: 
                   15793: sub needs_coursereinit {
                   15794:     my ($loncaparev,$interval) = @_;
                   15795:     return() unless ($env{'request.course.id'} && $env{'request.course.tied'});
                   15796:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   15797:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   15798:     my $now = time;
                   15799:     if ($interval eq '') {
                   15800:         $interval = 600;
                   15801:     }
                   15802:     if (($now-$env{'request.course.timechecked'})>$interval) {
                   15803:         my $lastchange = &Apache::lonnet::get_coursechange($cdom,$cnum);
                   15804:         &Apache::lonnet::appenv({'request.course.timechecked'=>$now});
                   15805:         if ($lastchange > $env{'request.course.tied'}) {
                   15806:             my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
                   15807:             if ($curr_reqd_hash{'internal.releaserequired'} ne '') {
                   15808:                 my $required = $env{'course.'.$cdom.'_'.$cnum.'.internal.releaserequired'};
                   15809:                 if ($curr_reqd_hash{'internal.releaserequired'} ne $required) {
                   15810:                     &Apache::lonnet::appenv({'course.'.$cdom.'_'.$cnum.'.internal.releaserequired' =>
                   15811:                                              $curr_reqd_hash{'internal.releaserequired'}});
                   15812:                     my ($switchserver,$switchwarning) =
                   15813:                         &check_release_required($loncaparev,$cdom.'_'.$cnum,$env{'request.role'},
                   15814:                                                 $curr_reqd_hash{'internal.releaserequired'});
                   15815:                     if ($switchwarning ne '' || $switchserver ne '') {
                   15816:                         return ('switch',$switchwarning,$switchserver);
                   15817:                     }
                   15818:                 }
                   15819:             }
                   15820:             return ('update');
                   15821:         }
                   15822:     }
                   15823:     return ();
                   15824: }
1.1075.2.69  raeburn  15825: 
1.1075.2.11  raeburn  15826: sub update_content_constraints {
                   15827:     my ($cdom,$cnum,$chome,$cid) = @_;
                   15828:     my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
                   15829:     my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
                   15830:     my %checkresponsetypes;
                   15831:     foreach my $key (keys(%Apache::lonnet::needsrelease)) {
                   15832:         my ($item,$name,$value) = split(/:/,$key);
                   15833:         if ($item eq 'resourcetag') {
                   15834:             if ($name eq 'responsetype') {
                   15835:                 $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
                   15836:             }
                   15837:         }
                   15838:     }
                   15839:     my $navmap = Apache::lonnavmaps::navmap->new();
                   15840:     if (defined($navmap)) {
                   15841:         my %allresponses;
                   15842:         foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
                   15843:             my %responses = $res->responseTypes();
                   15844:             foreach my $key (keys(%responses)) {
                   15845:                 next unless(exists($checkresponsetypes{$key}));
                   15846:                 $allresponses{$key} += $responses{$key};
                   15847:             }
                   15848:         }
                   15849:         foreach my $key (keys(%allresponses)) {
                   15850:             my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
                   15851:             if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
                   15852:                 ($reqdmajor,$reqdminor) = ($major,$minor);
                   15853:             }
                   15854:         }
                   15855:         undef($navmap);
                   15856:     }
                   15857:     unless (($reqdmajor eq '') && ($reqdminor eq '')) {
                   15858:         &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
                   15859:     }
                   15860:     return;
                   15861: }
                   15862: 
1.1075.2.27  raeburn  15863: sub allmaps_incourse {
                   15864:     my ($cdom,$cnum,$chome,$cid) = @_;
                   15865:     if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') {
                   15866:         $cid = $env{'request.course.id'};
                   15867:         $cdom = $env{'course.'.$cid.'.domain'};
                   15868:         $cnum = $env{'course.'.$cid.'.num'};
                   15869:         $chome = $env{'course.'.$cid.'.home'};
                   15870:     }
                   15871:     my %allmaps = ();
                   15872:     my $lastchange =
                   15873:         &Apache::lonnet::get_coursechange($cdom,$cnum);
                   15874:     if ($lastchange > $env{'request.course.tied'}) {
                   15875:         my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
                   15876:         unless ($ferr) {
                   15877:             &update_content_constraints($cdom,$cnum,$chome,$cid);
                   15878:         }
                   15879:     }
                   15880:     my $navmap = Apache::lonnavmaps::navmap->new();
                   15881:     if (defined($navmap)) {
                   15882:         foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) {
                   15883:             $allmaps{$res->src()} = 1;
                   15884:         }
                   15885:     }
                   15886:     return \%allmaps;
                   15887: }
                   15888: 
1.1075.2.11  raeburn  15889: sub parse_supplemental_title {
                   15890:     my ($title) = @_;
                   15891: 
                   15892:     my ($foldertitle,$renametitle);
                   15893:     if ($title =~ /&amp;&amp;&amp;/) {
                   15894:         $title = &HTML::Entites::decode($title);
                   15895:     }
                   15896:     if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
                   15897:         $renametitle=$4;
                   15898:         my ($time,$uname,$udom) = ($1,$2,$3);
                   15899:         $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
                   15900:         my $name =  &plainname($uname,$udom);
                   15901:         $name = &HTML::Entities::encode($name,'"<>&\'');
                   15902:         $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
                   15903:         $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.
                   15904:             $name.': <br />'.$foldertitle;
                   15905:     }
                   15906:     if (wantarray) {
                   15907:         return ($title,$foldertitle,$renametitle);
                   15908:     }
                   15909:     return $title;
                   15910: }
                   15911: 
1.1075.2.43  raeburn  15912: sub recurse_supplemental {
                   15913:     my ($cnum,$cdom,$suppmap,$numfiles,$errors) = @_;
                   15914:     if ($suppmap) {
                   15915:         my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
                   15916:         if ($fatal) {
                   15917:             $errors ++;
                   15918:         } else {
                   15919:             if ($#LONCAPA::map::resources > 0) {
                   15920:                 foreach my $res (@LONCAPA::map::resources) {
                   15921:                     my ($title,$src,$ext,$type,$status)=split(/\:/,$res);
                   15922:                     if (($src ne '') && ($status eq 'res')) {
1.1075.2.46  raeburn  15923:                         if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
                   15924:                             ($numfiles,$errors) = &recurse_supplemental($cnum,$cdom,$1,$numfiles,$errors);
1.1075.2.43  raeburn  15925:                         } else {
                   15926:                             $numfiles ++;
                   15927:                         }
                   15928:                     }
                   15929:                 }
                   15930:             }
                   15931:         }
                   15932:     }
                   15933:     return ($numfiles,$errors);
                   15934: }
                   15935: 
1.1075.2.18  raeburn  15936: sub symb_to_docspath {
                   15937:     my ($symb) = @_;
                   15938:     return unless ($symb);
                   15939:     my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
                   15940:     if ($resurl=~/\.(sequence|page)$/) {
                   15941:         $mapurl=$resurl;
                   15942:     } elsif ($resurl eq 'adm/navmaps') {
                   15943:         $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
                   15944:     }
                   15945:     my $mapresobj;
                   15946:     my $navmap = Apache::lonnavmaps::navmap->new();
                   15947:     if (ref($navmap)) {
                   15948:         $mapresobj = $navmap->getResourceByUrl($mapurl);
                   15949:     }
                   15950:     $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
                   15951:     my $type=$2;
                   15952:     my $path;
                   15953:     if (ref($mapresobj)) {
                   15954:         my $pcslist = $mapresobj->map_hierarchy();
                   15955:         if ($pcslist ne '') {
                   15956:             foreach my $pc (split(/,/,$pcslist)) {
                   15957:                 next if ($pc <= 1);
                   15958:                 my $res = $navmap->getByMapPc($pc);
                   15959:                 if (ref($res)) {
                   15960:                     my $thisurl = $res->src();
                   15961:                     $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
                   15962:                     my $thistitle = $res->title();
                   15963:                     $path .= '&'.
                   15964:                              &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
1.1075.2.46  raeburn  15965:                              &escape($thistitle).
1.1075.2.18  raeburn  15966:                              ':'.$res->randompick().
                   15967:                              ':'.$res->randomout().
                   15968:                              ':'.$res->encrypted().
                   15969:                              ':'.$res->randomorder().
                   15970:                              ':'.$res->is_page();
                   15971:                 }
                   15972:             }
                   15973:         }
                   15974:         $path =~ s/^\&//;
                   15975:         my $maptitle = $mapresobj->title();
                   15976:         if ($mapurl eq 'default') {
1.1075.2.38  raeburn  15977:             $maptitle = 'Main Content';
1.1075.2.18  raeburn  15978:         }
                   15979:         $path .= (($path ne '')? '&' : '').
                   15980:                  &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1075.2.46  raeburn  15981:                  &escape($maptitle).
1.1075.2.18  raeburn  15982:                  ':'.$mapresobj->randompick().
                   15983:                  ':'.$mapresobj->randomout().
                   15984:                  ':'.$mapresobj->encrypted().
                   15985:                  ':'.$mapresobj->randomorder().
                   15986:                  ':'.$mapresobj->is_page();
                   15987:     } else {
                   15988:         my $maptitle = &Apache::lonnet::gettitle($mapurl);
                   15989:         my $ispage = (($type eq 'page')? 1 : '');
                   15990:         if ($mapurl eq 'default') {
1.1075.2.38  raeburn  15991:             $maptitle = 'Main Content';
1.1075.2.18  raeburn  15992:         }
                   15993:         $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1075.2.46  raeburn  15994:                 &escape($maptitle).':::::'.$ispage;
1.1075.2.18  raeburn  15995:     }
                   15996:     unless ($mapurl eq 'default') {
                   15997:         $path = 'default&'.
1.1075.2.46  raeburn  15998:                 &escape('Main Content').
1.1075.2.18  raeburn  15999:                 ':::::&'.$path;
                   16000:     }
                   16001:     return $path;
                   16002: }
                   16003: 
1.1075.2.14  raeburn  16004: sub captcha_display {
                   16005:     my ($context,$lonhost) = @_;
                   16006:     my ($output,$error);
                   16007:     my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
                   16008:     if ($captcha eq 'original') {
                   16009:         $output = &create_captcha();
                   16010:         unless ($output) {
                   16011:             $error = 'captcha';
                   16012:         }
                   16013:     } elsif ($captcha eq 'recaptcha') {
                   16014:         $output = &create_recaptcha($pubkey);
                   16015:         unless ($output) {
                   16016:             $error = 'recaptcha';
                   16017:         }
                   16018:     }
1.1075.2.66  raeburn  16019:     return ($output,$error,$captcha);
1.1075.2.14  raeburn  16020: }
                   16021: 
                   16022: sub captcha_response {
                   16023:     my ($context,$lonhost) = @_;
                   16024:     my ($captcha_chk,$captcha_error);
                   16025:     my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
                   16026:     if ($captcha eq 'original') {
                   16027:         ($captcha_chk,$captcha_error) = &check_captcha();
                   16028:     } elsif ($captcha eq 'recaptcha') {
                   16029:         $captcha_chk = &check_recaptcha($privkey);
                   16030:     } else {
                   16031:         $captcha_chk = 1;
                   16032:     }
                   16033:     return ($captcha_chk,$captcha_error);
                   16034: }
                   16035: 
                   16036: sub get_captcha_config {
                   16037:     my ($context,$lonhost) = @_;
                   16038:     my ($captcha,$pubkey,$privkey,$hashtocheck);
                   16039:     my $hostname = &Apache::lonnet::hostname($lonhost);
                   16040:     my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
                   16041:     my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
                   16042:     if ($context eq 'usercreation') {
                   16043:         my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
                   16044:         if (ref($domconfig{$context}) eq 'HASH') {
                   16045:             $hashtocheck = $domconfig{$context}{'cancreate'};
                   16046:             if (ref($hashtocheck) eq 'HASH') {
                   16047:                 if ($hashtocheck->{'captcha'} eq 'recaptcha') {
                   16048:                     if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
                   16049:                         $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
                   16050:                         $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
                   16051:                     }
                   16052:                     if ($privkey && $pubkey) {
                   16053:                         $captcha = 'recaptcha';
                   16054:                     } else {
                   16055:                         $captcha = 'original';
                   16056:                     }
                   16057:                 } elsif ($hashtocheck->{'captcha'} ne 'notused') {
                   16058:                     $captcha = 'original';
                   16059:                 }
                   16060:             }
                   16061:         } else {
                   16062:             $captcha = 'captcha';
                   16063:         }
                   16064:     } elsif ($context eq 'login') {
                   16065:         my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
                   16066:         if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
                   16067:             $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
                   16068:             $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
                   16069:             if ($privkey && $pubkey) {
                   16070:                 $captcha = 'recaptcha';
                   16071:             } else {
                   16072:                 $captcha = 'original';
                   16073:             }
                   16074:         } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
                   16075:             $captcha = 'original';
                   16076:         }
                   16077:     }
                   16078:     return ($captcha,$pubkey,$privkey);
                   16079: }
                   16080: 
                   16081: sub create_captcha {
                   16082:     my %captcha_params = &captcha_settings();
                   16083:     my ($output,$maxtries,$tries) = ('',10,0);
                   16084:     while ($tries < $maxtries) {
                   16085:         $tries ++;
                   16086:         my $captcha = Authen::Captcha->new (
                   16087:                                            output_folder => $captcha_params{'output_dir'},
                   16088:                                            data_folder   => $captcha_params{'db_dir'},
                   16089:                                           );
                   16090:         my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
                   16091: 
                   16092:         if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
                   16093:             $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
                   16094:                       &mt('Type in the letters/numbers shown below').'&nbsp;'.
1.1075.2.66  raeburn  16095:                       '<input type="text" size="5" name="code" value="" autocomplete="off" />'.
                   16096:                       '<br />'.
                   16097:                       '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />';
1.1075.2.14  raeburn  16098:             last;
                   16099:         }
                   16100:     }
                   16101:     return $output;
                   16102: }
                   16103: 
                   16104: sub captcha_settings {
                   16105:     my %captcha_params = (
                   16106:                            output_dir     => $Apache::lonnet::perlvar{'lonCaptchaDir'},
                   16107:                            www_output_dir => "/captchaspool",
                   16108:                            db_dir         => $Apache::lonnet::perlvar{'lonCaptchaDb'},
                   16109:                            numchars       => '5',
                   16110:                          );
                   16111:     return %captcha_params;
                   16112: }
                   16113: 
                   16114: sub check_captcha {
                   16115:     my ($captcha_chk,$captcha_error);
                   16116:     my $code = $env{'form.code'};
                   16117:     my $md5sum = $env{'form.crypt'};
                   16118:     my %captcha_params = &captcha_settings();
                   16119:     my $captcha = Authen::Captcha->new(
                   16120:                       output_folder => $captcha_params{'output_dir'},
                   16121:                       data_folder   => $captcha_params{'db_dir'},
                   16122:                   );
1.1075.2.26  raeburn  16123:     $captcha_chk = $captcha->check_code($code,$md5sum);
1.1075.2.14  raeburn  16124:     my %captcha_hash = (
                   16125:                         0       => 'Code not checked (file error)',
                   16126:                        -1      => 'Failed: code expired',
                   16127:                        -2      => 'Failed: invalid code (not in database)',
                   16128:                        -3      => 'Failed: invalid code (code does not match crypt)',
                   16129:     );
                   16130:     if ($captcha_chk != 1) {
                   16131:         $captcha_error = $captcha_hash{$captcha_chk}
                   16132:     }
                   16133:     return ($captcha_chk,$captcha_error);
                   16134: }
                   16135: 
                   16136: sub create_recaptcha {
                   16137:     my ($pubkey) = @_;
1.1075.2.51  raeburn  16138:     my $use_ssl;
                   16139:     if ($ENV{'SERVER_PORT'} == 443) {
                   16140:         $use_ssl = 1;
                   16141:     }
1.1075.2.14  raeburn  16142:     my $captcha = Captcha::reCAPTCHA->new;
                   16143:     return $captcha->get_options_setter({theme => 'white'})."\n".
1.1075.2.51  raeburn  16144:            $captcha->get_html($pubkey,undef,$use_ssl).
1.1075.2.92  raeburn  16145:            &mt('If the text is hard to read, [_1] will replace them.',
1.1075.2.39  raeburn  16146:                '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
1.1075.2.14  raeburn  16147:            '<br /><br />';
                   16148: }
                   16149: 
                   16150: sub check_recaptcha {
                   16151:     my ($privkey) = @_;
                   16152:     my $captcha_chk;
                   16153:     my $captcha = Captcha::reCAPTCHA->new;
                   16154:     my $captcha_result =
                   16155:         $captcha->check_answer(
                   16156:                                 $privkey,
                   16157:                                 $ENV{'REMOTE_ADDR'},
                   16158:                                 $env{'form.recaptcha_challenge_field'},
                   16159:                                 $env{'form.recaptcha_response_field'},
                   16160:                               );
                   16161:     if ($captcha_result->{is_valid}) {
                   16162:         $captcha_chk = 1;
                   16163:     }
                   16164:     return $captcha_chk;
                   16165: }
                   16166: 
1.1075.2.64  raeburn  16167: sub emailusername_info {
1.1075.2.67  raeburn  16168:     my @fields = ('firstname','lastname','institution','web','location','officialemail');
1.1075.2.64  raeburn  16169:     my %titles = &Apache::lonlocal::texthash (
                   16170:                      lastname      => 'Last Name',
                   16171:                      firstname     => 'First Name',
                   16172:                      institution   => 'School/college/university',
                   16173:                      location      => "School's city, state/province, country",
                   16174:                      web           => "School's web address",
                   16175:                      officialemail => 'E-mail address at institution (if different)',
                   16176:                  );
                   16177:     return (\@fields,\%titles);
                   16178: }
                   16179: 
1.1075.2.56  raeburn  16180: sub cleanup_html {
                   16181:     my ($incoming) = @_;
                   16182:     my $outgoing;
                   16183:     if ($incoming ne '') {
                   16184:         $outgoing = $incoming;
                   16185:         $outgoing =~ s/;/&#059;/g;
                   16186:         $outgoing =~ s/\#/&#035;/g;
                   16187:         $outgoing =~ s/\&/&#038;/g;
                   16188:         $outgoing =~ s/</&#060;/g;
                   16189:         $outgoing =~ s/>/&#062;/g;
                   16190:         $outgoing =~ s/\(/&#040/g;
                   16191:         $outgoing =~ s/\)/&#041;/g;
                   16192:         $outgoing =~ s/"/&#034;/g;
                   16193:         $outgoing =~ s/'/&#039;/g;
                   16194:         $outgoing =~ s/\$/&#036;/g;
                   16195:         $outgoing =~ s{/}{&#047;}g;
                   16196:         $outgoing =~ s/=/&#061;/g;
                   16197:         $outgoing =~ s/\\/&#092;/g
                   16198:     }
                   16199:     return $outgoing;
                   16200: }
                   16201: 
1.1075.2.74  raeburn  16202: # Checks for critical messages and returns a redirect url if one exists.
                   16203: # $interval indicates how often to check for messages.
                   16204: sub critical_redirect {
                   16205:     my ($interval) = @_;
                   16206:     if ((time-$env{'user.criticalcheck.time'})>$interval) {
                   16207:         my @what=&Apache::lonnet::dump('critical', $env{'user.domain'},
                   16208:                                         $env{'user.name'});
                   16209:         &Apache::lonnet::appenv({'user.criticalcheck.time'=>time});
                   16210:         my $redirecturl;
                   16211:         if ($what[0]) {
                   16212:             if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) {
                   16213:                 $redirecturl='/adm/email?critical=display';
                   16214:                 my $url=&Apache::lonnet::absolute_url().$redirecturl;
                   16215:                 return (1, $url);
                   16216:             }
                   16217:         }
                   16218:     }
                   16219:     return ();
                   16220: }
                   16221: 
1.1075.2.64  raeburn  16222: # Use:
                   16223: #   my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
                   16224: #
                   16225: ##################################################
                   16226: #          password associated functions         #
                   16227: ##################################################
                   16228: sub des_keys {
                   16229:     # Make a new key for DES encryption.
                   16230:     # Each key has two parts which are returned separately.
                   16231:     # Please note:  Each key must be passed through the &hex function
                   16232:     # before it is output to the web browser.  The hex versions cannot
                   16233:     # be used to decrypt.
                   16234:     my @hexstr=('0','1','2','3','4','5','6','7',
                   16235:                 '8','9','a','b','c','d','e','f');
                   16236:     my $lkey='';
                   16237:     for (0..7) {
                   16238:         $lkey.=$hexstr[rand(15)];
                   16239:     }
                   16240:     my $ukey='';
                   16241:     for (0..7) {
                   16242:         $ukey.=$hexstr[rand(15)];
                   16243:     }
                   16244:     return ($lkey,$ukey);
                   16245: }
                   16246: 
                   16247: sub des_decrypt {
                   16248:     my ($key,$cyphertext) = @_;
                   16249:     my $keybin=pack("H16",$key);
                   16250:     my $cypher;
                   16251:     if ($Crypt::DES::VERSION>=2.03) {
                   16252:         $cypher=new Crypt::DES $keybin;
                   16253:     } else {
                   16254:         $cypher=new DES $keybin;
                   16255:     }
                   16256:     my $plaintext=
                   16257:         $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,0,16))));
                   16258:     $plaintext.=
                   16259:         $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,16,16))));
                   16260:     $plaintext=substr($plaintext,1,ord(substr($plaintext,0,1)) );
                   16261:     return $plaintext;
                   16262: }
                   16263: 
1.112     bowersj2 16264: 1;
                   16265: __END__;
1.41      ng       16266: 

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