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

1.10      albertel    1: # The LearningOnline Network with CAPA
1.1       albertel    2: # a pile of common routines
1.10      albertel    3: #
1.102   ! www         4: # $Id: loncommon.pm,v 1.101 2003/05/23 21:18:56 www 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.12      harris41   28: # YEAR=2001
                     29: # 2/13-12/7 Guy Albertelli
1.18      www        30: # 12/21 Gerd Kortemeyer
1.22      www        31: # 12/25,12/28 Gerd Kortemeyer
1.23      www        32: # YEAR=2002
                     33: # 1/4 Gerd Kortemeyer
1.43      ng         34: # 6/24,7/2 H. K. Ng
1.1       albertel   35: 
                     36: # Makes a table out of the previous attempts
1.2       albertel   37: # Inputs result_from_symbread, user, domain, course_id
1.16      harris41   38: # Reads in non-network-related .tab files
1.1       albertel   39: 
1.35      matthew    40: # POD header:
                     41: 
1.45      matthew    42: =pod
                     43: 
1.35      matthew    44: =head1 NAME
                     45: 
                     46: Apache::loncommon - pile of common routines
                     47: 
                     48: =head1 SYNOPSIS
                     49: 
                     50: Referenced by other mod_perl Apache modules.
                     51: 
                     52: Invocation:
                     53:  &Apache::loncommon::SUBROUTINENAME(ARGUMENTS);
                     54: 
                     55: =head1 INTRODUCTION
                     56: 
                     57: Common collection of used subroutines.  This collection helps remove
                     58: redundancy from other modules and increase efficiency of memory usage.
                     59: 
                     60: Current things done:
                     61: 
                     62:  Makes a table out of the previous homework attempts
                     63:  Inputs result_from_symbread, user, domain, course_id
                     64:  Reads in non-network-related .tab files
                     65: 
                     66: This is part of the LearningOnline Network with CAPA project
                     67: described at http://www.lon-capa.org.
                     68: 
1.41      ng         69: =head2 General Subroutines
1.35      matthew    70: 
                     71: =over 4
                     72: 
                     73: =cut 
                     74: 
                     75: # End of POD header
1.1       albertel   76: package Apache::loncommon;
                     77: 
                     78: use strict;
1.22      www        79: use Apache::lonnet();
1.46      matthew    80: use GDBM_File;
1.51      www        81: use POSIX qw(strftime mktime);
1.99      www        82: use Apache::Constants qw(:common :http :methods);
1.1       albertel   83: use Apache::lonmsg();
1.82      www        84: use Apache::lonmenu();
1.22      www        85: my $readit;
                     86: 
1.46      matthew    87: =pod 
                     88: 
                     89: =item Global Variables
                     90: 
                     91: =over 4
                     92: 
                     93: =cut
1.20      www        94: # ----------------------------------------------- Filetypes/Languages/Copyright
1.12      harris41   95: my %language;
                     96: my %cprtag;
                     97: my %fe; my %fd;
1.41      ng         98: my %category_extensions;
1.12      harris41   99: 
1.63      www       100: # ---------------------------------------------- Designs
                    101: 
                    102: my %designhash;
                    103: 
1.46      matthew   104: # ---------------------------------------------- Thesaurus variables
                    105: 
                    106: =pod
                    107: 
                    108: =item %Keywords  
                    109: 
                    110: A hash used by &keyword to determine if a word is considered a keyword.
                    111: 
                    112: =item $thesaurus_db_file
                    113: 
                    114: Scalar containing the full path to the thesaurus database.                 
                    115: 
                    116: =cut
                    117: 
                    118: my %Keywords;
                    119: my $thesaurus_db_file;
                    120: 
                    121: 
                    122: =pod
                    123: 
                    124: =back
                    125: 
                    126: =cut
1.20      www       127: 
1.12      harris41  128: # ----------------------------------------------------------------------- BEGIN
1.41      ng        129: 
                    130: =pod
                    131: 
1.35      matthew   132: =item BEGIN() 
                    133: 
                    134: Initialize values from language.tab, copyright.tab, filetypes.tab,
1.45      matthew   135: thesaurus.tab, and filecategories.tab.
1.35      matthew   136: 
                    137: =cut
1.45      matthew   138: 
1.35      matthew   139: # ----------------------------------------------------------------------- BEGIN
                    140: 
1.18      www       141: BEGIN {
1.46      matthew   142:     # Variable initialization
                    143:     $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
                    144:     #
1.22      www       145:     unless ($readit) {
1.12      harris41  146: # ------------------------------------------------------------------- languages
                    147:     {
                    148: 	my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
                    149: 				 '/language.tab');
1.16      harris41  150: 	if ($fh) {
                    151: 	    while (<$fh>) {
                    152: 		next if /^\#/;
                    153: 		chomp;
1.98      www       154: 		my ($key,$two,$country,$three,$enc,$val)=(split(/\t/,$_));
                    155: 		$language{$key}=$val.' - '.$enc;
1.16      harris41  156: 	    }
1.12      harris41  157: 	}
                    158:     }
                    159: # ------------------------------------------------------------------ copyrights
                    160:     {
1.16      harris41  161: 	my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonIncludes'}.
                    162: 				  '/copyright.tab');
                    163: 	if ($fh) {
                    164: 	    while (<$fh>) {
                    165: 		next if /^\#/;
                    166: 		chomp;
                    167: 		my ($key,$val)=(split(/\s+/,$_,2));
                    168: 		$cprtag{$key}=$val;
                    169: 	    }
1.12      harris41  170: 	}
                    171:     }
1.63      www       172: 
                    173: # -------------------------------------------------------------- domain designs
                    174: 
                    175:     my $filename;
                    176:     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
                    177:     opendir(DIR,$designdir);
                    178:     while ($filename=readdir(DIR)) {
                    179: 	my ($domain)=($filename=~/^(\w+)\./);
                    180:     {
                    181: 	my $fh=Apache::File->new($designdir.'/'.$filename);
                    182: 	if ($fh) {
                    183: 	    while (<$fh>) {
                    184: 		next if /^\#/;
                    185: 		chomp;
                    186: 		my ($key,$val)=(split(/\=/,$_));
                    187: 		if ($val) { $designhash{$domain.'.'.$key}=$val; }
                    188: 	    }
                    189: 	}
                    190:     }
                    191: 
                    192:     }
                    193:     closedir(DIR);
                    194: 
                    195: 
1.15      harris41  196: # ------------------------------------------------------------- file categories
                    197:     {
                    198: 	my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
1.16      harris41  199: 				  '/filecategories.tab');
                    200: 	if ($fh) {
                    201: 	    while (<$fh>) {
                    202: 		next if /^\#/;
                    203: 		chomp;
1.41      ng        204: 		my ($extension,$category)=(split(/\s+/,$_,2));
                    205: 		push @{$category_extensions{lc($category)}},$extension;
1.16      harris41  206: 	    }
1.15      harris41  207: 	}
                    208:     }
1.12      harris41  209: # ------------------------------------------------------------------ file types
                    210:     {
1.16      harris41  211: 	my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
                    212: 	       '/filetypes.tab');
                    213: 	if ($fh) {
                    214:             while (<$fh>) {
                    215: 		next if (/^\#/);
                    216: 		chomp;
                    217: 		my ($ending,$emb,$descr)=split(/\s+/,$_,3);
                    218: 		if ($descr ne '') { 
                    219: 		    $fe{$ending}=lc($emb);
                    220: 		    $fd{$ending}=$descr;
                    221: 		}
1.12      harris41  222: 	    }
                    223: 	}
                    224:     }
1.22      www       225:     &Apache::lonnet::logthis(
1.46      matthew   226:               "<font color=yellow>INFO: Read file types</font>");
1.22      www       227:     $readit=1;
1.46      matthew   228:     }  # end of unless($readit) 
1.32      matthew   229:     
                    230: }
                    231: # ============================================================= END BEGIN BLOCK
1.42      matthew   232: ###############################################################
                    233: ##           HTML and Javascript Helper Functions            ##
                    234: ###############################################################
                    235: 
                    236: =pod 
                    237: 
                    238: =item browser_and_searcher_javascript 
                    239: 
                    240: Returns scalar containing javascript to open a browser window
                    241: or a searcher window.  Also creates 
                    242: 
                    243: =over 4
                    244: 
                    245: =item openbrowser(formname,elementname,only,omit) [javascript]
                    246: 
                    247: inputs: formname, elementname, only, omit
                    248: 
                    249: formname and elementname indicate the name of the html form and name of
                    250: the element that the results of the browsing selection are to be placed in. 
                    251: 
                    252: Specifying 'only' will restrict the browser to displaying only files
                    253: with the given extension.  Can be a comma seperated list.
                    254: 
                    255: Specifying 'omit' will restrict the browser to NOT displaying files
                    256: with the given extension.  Can be a comma seperated list.
                    257: 
                    258: =item opensearcher(formname, elementname) [javascript]
                    259: 
                    260: Inputs: formname, elementname
                    261: 
                    262: formname and elementname specify the name of the html form and the name
                    263: of the element the selection from the search results will be placed in.
                    264: 
                    265: =back
                    266: 
                    267: =cut
                    268: 
                    269: ###############################################################
                    270: sub browser_and_searcher_javascript {
                    271:     return <<END;
1.50      matthew   272:     var editbrowser = null;
1.42      matthew   273:     function openbrowser(formname,elementname,only,omit) {
                    274:         var url = '/res/?';
                    275:         if (editbrowser == null) {
                    276:             url += 'launch=1&';
                    277:         }
                    278:         url += 'catalogmode=interactive&';
                    279:         url += 'mode=edit&';
                    280:         url += 'form=' + formname + '&';
                    281:         if (only != null) {
                    282:             url += 'only=' + only + '&';
                    283:         } 
                    284:         if (omit != null) {
                    285:             url += 'omit=' + omit + '&';
                    286:         }
                    287:         url += 'element=' + elementname + '';
                    288:         var title = 'Browser';
                    289:         var options = 'scrollbars=1,resizable=1,menubar=0';
                    290:         options += ',width=700,height=600';
                    291:         editbrowser = open(url,title,options,'1');
                    292:         editbrowser.focus();
                    293:     }
                    294:     var editsearcher;
                    295:     function opensearcher(formname,elementname) {
                    296:         var url = '/adm/searchcat?';
                    297:         if (editsearcher == null) {
                    298:             url += 'launch=1&';
                    299:         }
                    300:         url += 'catalogmode=interactive&';
                    301:         url += 'mode=edit&';
                    302:         url += 'form=' + formname + '&';
                    303:         url += 'element=' + elementname + '';
                    304:         var title = 'Search';
                    305:         var options = 'scrollbars=1,resizable=1,menubar=0';
                    306:         options += ',width=700,height=600';
                    307:         editsearcher = open(url,title,options,'1');
                    308:         editsearcher.focus();
                    309:     }
                    310: END
                    311: }
                    312: 
1.74      www       313: sub studentbrowser_javascript {
                    314:    unless ($ENV{'request.course.id'}) { return ''; }  
                    315:    unless (&Apache::lonnet::allowed('srm',$ENV{'request.course.id'})) {
                    316:         return '';
                    317:    }
                    318:    return (<<'ENDSTDBRW');
                    319: <script type="text/javascript" language="Javascript" >
                    320:     var stdeditbrowser;
                    321:     function openstdbrowser(formname,uname,udom) {
                    322:         var url = '/adm/pickstudent?';
                    323:         var filter;
                    324:         eval('filter=document.'+formname+'.'+uname+'.value;');
                    325:         if (filter != null) {
                    326:            if (filter != '') {
                    327:                url += 'filter='+filter+'&';
                    328: 	   }
                    329:         }
                    330:         url += 'form=' + formname + '&unameelement='+uname+
                    331:                                     '&udomelement='+udom;
1.102   ! www       332:         var title = 'Student_Browser';
1.74      www       333:         var options = 'scrollbars=1,resizable=1,menubar=0';
                    334:         options += ',width=700,height=600';
                    335:         stdeditbrowser = open(url,title,options,'1');
                    336:         stdeditbrowser.focus();
                    337:     }
                    338: </script>
                    339: ENDSTDBRW
                    340: }
1.42      matthew   341: 
1.74      www       342: sub selectstudent_link {
                    343:     my ($form,$unameele,$udomele)=@_;
                    344:    unless ($ENV{'request.course.id'}) { return ''; }  
                    345:    unless (&Apache::lonnet::allowed('srm',$ENV{'request.course.id'})) {
                    346:         return '';
                    347:    }
                    348:     return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele.
1.92      www       349:         '","'.$udomele.'");'."'>Select User</a>";
1.91      www       350: }
                    351: 
                    352: sub coursebrowser_javascript {
                    353:    return (<<'ENDSTDBRW');
                    354: <script type="text/javascript" language="Javascript" >
                    355:     var stdeditbrowser;
                    356:     function opencrsbrowser(formname,uname,udom) {
                    357:         var url = '/adm/pickcourse?';
                    358:         var filter;
                    359:         if (filter != null) {
                    360:            if (filter != '') {
                    361:                url += 'filter='+filter+'&';
                    362: 	   }
                    363:         }
                    364:         url += 'form=' + formname + '&cnumelement='+uname+
                    365:                                     '&cdomelement='+udom;
1.102   ! www       366:         var title = 'Course_Browser';
1.91      www       367:         var options = 'scrollbars=1,resizable=1,menubar=0';
                    368:         options += ',width=700,height=600';
                    369:         stdeditbrowser = open(url,title,options,'1');
                    370:         stdeditbrowser.focus();
                    371:     }
                    372: </script>
                    373: ENDSTDBRW
                    374: }
                    375: 
                    376: sub selectcourse_link {
                    377:    my ($form,$unameele,$udomele)=@_;
                    378:     return "<a href='".'javascript:opencrsbrowser("'.$form.'","'.$unameele.
                    379:         '","'.$udomele.'");'."'>Select Course</a>";
1.74      www       380: }
1.42      matthew   381: 
                    382: ###############################################################
                    383: 
                    384: =pod
1.36      matthew   385: 
                    386: =item linked_select_forms(...)
                    387: 
                    388: linked_select_forms returns a string containing a <script></script> block
                    389: and html for two <select> menus.  The select menus will be linked in that
                    390: changing the value of the first menu will result in new values being placed
                    391: in the second menu.  The values in the select menu will appear in alphabetical
                    392: order.
                    393: 
                    394: linked_select_forms takes the following ordered inputs:
                    395: 
                    396: =over 4
                    397: 
                    398: =item $formname, the name of the <form> tag
                    399: 
                    400: =item $middletext, the text which appears between the <select> tags
                    401: 
                    402: =item $firstdefault, the default value for the first menu
                    403: 
                    404: =item $firstselectname, the name of the first <select> tag
                    405: 
                    406: =item $secondselectname, the name of the second <select> tag
                    407: 
                    408: =item $hashref, a reference to a hash containing the data for the menus.
                    409: 
1.41      ng        410: =back 
                    411: 
1.36      matthew   412: Below is an example of such a hash.  Only the 'text', 'default', and 
                    413: 'select2' keys must appear as stated.  keys(%menu) are the possible 
                    414: values for the first select menu.  The text that coincides with the 
1.41      ng        415: first menu value is given in $menu{$choice1}->{'text'}.  The values 
1.36      matthew   416: and text for the second menu are given in the hash pointed to by 
                    417: $menu{$choice1}->{'select2'}.  
                    418: 
1.41      ng        419: my %menu = ( A1 => { text =>"Choice A1" ,
1.36      matthew   420:                       default => "B3",
                    421:                       select2 => { 
                    422:                           B1 => "Choice B1",
                    423:                           B2 => "Choice B2",
                    424:                           B3 => "Choice B3",
                    425:                           B4 => "Choice B4"
                    426:                           }
                    427:                   },
                    428:               A2 => { text =>"Choice A2" ,
                    429:                       default => "C2",
                    430:                       select2 => { 
                    431:                           C1 => "Choice C1",
                    432:                           C2 => "Choice C2",
                    433:                           C3 => "Choice C3"
                    434:                           }
                    435:                   },
                    436:               A3 => { text =>"Choice A3" ,
                    437:                       default => "D6",
                    438:                       select2 => { 
                    439:                           D1 => "Choice D1",
                    440:                           D2 => "Choice D2",
                    441:                           D3 => "Choice D3",
                    442:                           D4 => "Choice D4",
                    443:                           D5 => "Choice D5",
                    444:                           D6 => "Choice D6",
                    445:                           D7 => "Choice D7"
                    446:                           }
                    447:                   }
                    448:               );
                    449: 
                    450: =cut
                    451: 
                    452: # ------------------------------------------------
                    453: 
                    454: sub linked_select_forms {
                    455:     my ($formname,
                    456:         $middletext,
                    457:         $firstdefault,
                    458:         $firstselectname,
                    459:         $secondselectname, 
                    460:         $hashref
                    461:         ) = @_;
                    462:     my $second = "document.$formname.$secondselectname";
                    463:     my $first = "document.$formname.$firstselectname";
                    464:     # output the javascript to do the changing
                    465:     my $result = '';
                    466:     $result.="<script>\n";
                    467:     $result.="var select2data = new Object();\n";
                    468:     $" = '","';
                    469:     my $debug = '';
                    470:     foreach my $s1 (sort(keys(%$hashref))) {
                    471:         $result.="select2data.d_$s1 = new Object();\n";        
                    472:         $result.="select2data.d_$s1.def = new String('".
                    473:             $hashref->{$s1}->{'default'}."');\n";
                    474:         $result.="select2data.d_$s1.values = new Array(";        
                    475:         my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
                    476:         $result.="\"@s2values\");\n";
                    477:         $result.="select2data.d_$s1.texts = new Array(";        
                    478:         my @s2texts;
                    479:         foreach my $value (@s2values) {
                    480:             push @s2texts, $hashref->{$s1}->{'select2'}->{$value};
                    481:         }
                    482:         $result.="\"@s2texts\");\n";
                    483:     }
                    484:     $"=' ';
                    485:     $result.= <<"END";
                    486: 
                    487: function select1_changed() {
                    488:     // Determine new choice
                    489:     var newvalue = "d_" + $first.value;
                    490:     // update select2
                    491:     var values     = select2data[newvalue].values;
                    492:     var texts      = select2data[newvalue].texts;
                    493:     var select2def = select2data[newvalue].def;
                    494:     var i;
                    495:     // out with the old
                    496:     for (i = 0; i < $second.options.length; i++) {
                    497:         $second.options[i] = null;
                    498:     }
                    499:     // in with the nuclear
                    500:     for (i=0;i<values.length; i++) {
                    501:         $second.options[i] = new Option(values[i]);
                    502:         $second.options[i].text = texts[i];
                    503:         if (values[i] == select2def) {
                    504:             $second.options[i].selected = true;
                    505:         }
                    506:     }
                    507: }
                    508: </script>
                    509: END
                    510:     # output the initial values for the selection lists
                    511:     $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed()\">\n";
                    512:     foreach my $value (sort(keys(%$hashref))) {
                    513:         $result.="    <option value=\"$value\" ";
                    514:         $result.=" selected=\"true\" " if ($value eq $firstdefault);
                    515:         $result.=">$hashref->{$value}->{'text'}</option>\n";
                    516:     }
                    517:     $result .= "</select>\n";
                    518:     my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
                    519:     $result .= $middletext;
                    520:     $result .= "<select size=\"1\" name=\"$secondselectname\">\n";
                    521:     my $seconddefault = $hashref->{$firstdefault}->{'default'};
                    522:     foreach my $value (sort(keys(%select2))) {
                    523:         $result.="    <option value=\"$value\" ";        
                    524:         $result.=" selected=\"true\" " if ($value eq $seconddefault);
                    525:         $result.=">$select2{$value}</option>\n";
                    526:     }
                    527:     $result .= "</select>\n";
                    528:     #    return $debug;
                    529:     return $result;
                    530: }   #  end of sub linked_select_forms {
                    531: 
1.33      matthew   532: ###############################################################
1.44      bowersj2  533: 
1.45      matthew   534: =pod
1.44      bowersj2  535: 
1.48      bowersj2  536: =item help_open_topic($topic, $text, $stayOnPage, $width, $height)
1.44      bowersj2  537: 
                    538: Returns a string corresponding to an HTML link to the given help $topic, where $topic corresponds to the name of a .tex file in /home/httpd/html/adm/help/tex, with underscores replaced by spaces.
                    539: 
1.48      bowersj2  540: $text will optionally be linked to the same topic, allowing you to link text in addition to the graphic. If you do not want to link text, but wish to specify one of the later parameters, pass an empty string.
                    541: 
1.44      bowersj2  542: $stayOnPage is a value that will be interpreted as a boolean. If true, the link will not open a new window. If false, the link will open a new window using Javascript. (Default is false.)
                    543: 
                    544: $width and $height are optional numerical parameters that will override the width and height of the popped up window, which may be useful for certain help topics with big pictures included.
                    545: 
                    546: =cut
                    547: 
                    548: sub help_open_topic {
1.48      bowersj2  549:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
                    550:     $text = "" if (not defined $text);
1.44      bowersj2  551:     $stayOnPage = 0 if (not defined $stayOnPage);
1.79      www       552:     if ($ENV{'browser.interface'} eq 'textual') {
                    553: 	$stayOnPage=1;
                    554:     }
1.44      bowersj2  555:     $width = 350 if (not defined $width);
                    556:     $height = 400 if (not defined $height);
                    557:     my $filename = $topic;
                    558:     $filename =~ s/ /_/g;
                    559: 
1.48      bowersj2  560:     my $template = "";
                    561:     my $link;
1.44      bowersj2  562: 
                    563:     if (!$stayOnPage)
                    564:     {
1.72      bowersj2  565: 	$link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1.44      bowersj2  566:     }
                    567:     else
                    568:     {
1.48      bowersj2  569: 	$link = "/adm/help/${filename}.hlp";
                    570:     }
                    571: 
                    572:     # Add the text
                    573:     if ($text ne "")
                    574:     {
1.77      www       575: 	$template .= 
                    576:   "<table bgcolor='#3333AA' cellspacing='1' cellpadding='1' border='0'><tr>".
1.78      www       577:   "<td bgcolor='#5555FF'><a href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>";
1.48      bowersj2  578:     }
                    579: 
                    580:     # Add the graphic
                    581:     $template .= <<"ENDTEMPLATE";
1.77      www       582:  <a href="$link"><image src="/adm/help/gif/smallHelp.gif" border="0" alt="(Help: $topic)" /></a>
1.44      bowersj2  583: ENDTEMPLATE
1.78      www       584:     if ($text ne '') { $template.='</td></tr></table>' };
1.44      bowersj2  585:     return $template;
                    586: 
                    587: }
1.37      matthew   588: 
1.45      matthew   589: =pod
                    590: 
1.37      matthew   591: =item csv_translate($text) 
                    592: 
                    593: Translate $text to allow it to be output as a 'comma seperated values' 
                    594: format.
                    595: 
                    596: =cut
                    597: 
                    598: sub csv_translate {
                    599:     my $text = shift;
                    600:     $text =~ s/\"/\"\"/g;
                    601:     $text =~ s/\n//g;
                    602:     return $text;
                    603: }
                    604: 
                    605: ###############################################################
1.33      matthew   606: ##        Home server <option> list generating code          ##
                    607: ###############################################################
1.35      matthew   608: #-------------------------------------------
                    609: 
1.45      matthew   610: =pod
                    611: 
1.35      matthew   612: =item get_domains()
                    613: 
                    614: Returns an array containing each of the domains listed in the hosts.tab
                    615: file.
                    616: 
                    617: =cut
                    618: 
                    619: #-------------------------------------------
1.34      matthew   620: sub get_domains {
                    621:     # The code below was stolen from "The Perl Cookbook", p 102, 1st ed.
                    622:     my @domains;
                    623:     my %seen;
                    624:     foreach (sort values(%Apache::lonnet::hostdom)) {
                    625:         push (@domains,$_) unless $seen{$_}++;
                    626:     }
                    627:     return @domains;
                    628: }
1.88      www       629: 
                    630: #-------------------------------------------
                    631: 
                    632: =pod
                    633: 
                    634: =item select_form($defdom,$name,%hash)
                    635: 
                    636: Returns a string containing a <select name='$name' size='1'> form to 
                    637: allow a user to select options from a hash option_name => displayed text.  
                    638: See lonrights.pm for an example invocation and use.
                    639: 
                    640: =cut
                    641: 
                    642: #-------------------------------------------
                    643: sub select_form {
                    644:     my ($def,$name,%hash) = @_;
                    645:     my $selectform = "<select name=\"$name\" size=\"1\">\n";
1.89      www       646:     foreach (sort keys %hash) {
1.88      www       647:         $selectform.="<option value=\"$_\" ".
                    648:             ($_ eq $def ? 'selected' : '').
                    649:                 ">".$hash{$_}."</option>\n";
                    650:     }
                    651:     $selectform.="</select>";
                    652:     return $selectform;
                    653: }
                    654: 
1.34      matthew   655: 
1.35      matthew   656: #-------------------------------------------
                    657: 
1.45      matthew   658: =pod
                    659: 
1.90      www       660: =item select_dom_form($defdom,$name,$includeempty)
1.35      matthew   661: 
                    662: Returns a string containing a <select name='$name' size='1'> form to 
                    663: allow a user to select the domain to preform an operation in.  
                    664: See loncreateuser.pm for an example invocation and use.
                    665: 
1.90      www       666: If the $includeempty flag is set, it also includes an empty choice ("no domain
                    667: selected");
                    668: 
1.35      matthew   669: =cut
                    670: 
                    671: #-------------------------------------------
1.34      matthew   672: sub select_dom_form {
1.90      www       673:     my ($defdom,$name,$includeempty) = @_;
1.34      matthew   674:     my @domains = get_domains();
1.90      www       675:     if ($includeempty) { @domains=('',@domains); }
1.34      matthew   676:     my $selectdomain = "<select name=\"$name\" size=\"1\">\n";
                    677:     foreach (@domains) {
                    678:         $selectdomain.="<option value=\"$_\" ".
                    679:             ($_ eq $defdom ? 'selected' : '').
                    680:                 ">$_</option>\n";
                    681:     }
                    682:     $selectdomain.="</select>";
                    683:     return $selectdomain;
                    684: }
                    685: 
1.35      matthew   686: #-------------------------------------------
                    687: 
1.45      matthew   688: =pod
                    689: 
1.52      matthew   690: =item get_library_servers($domain)
1.35      matthew   691: 
                    692: Returns a hash which contains keys like '103l3' and values like 
                    693: 'kirk.lite.msu.edu'.  All of the keys will be for machines in the
                    694: given $domain.
                    695: 
                    696: =cut
                    697: 
                    698: #-------------------------------------------
1.52      matthew   699: sub get_library_servers {
1.33      matthew   700:     my $domain = shift;
1.52      matthew   701:     my %library_servers;
1.33      matthew   702:     foreach (keys(%Apache::lonnet::libserv)) {
                    703:         if ($Apache::lonnet::hostdom{$_} eq $domain) {
1.52      matthew   704:             $library_servers{$_} = $Apache::lonnet::hostname{$_};
1.33      matthew   705:         }
                    706:     }
1.52      matthew   707:     return %library_servers;
1.33      matthew   708: }
                    709: 
1.35      matthew   710: #-------------------------------------------
                    711: 
1.45      matthew   712: =pod
                    713: 
1.35      matthew   714: =item home_server_option_list($domain)
                    715: 
                    716: returns a string which contains an <option> list to be used in a 
                    717: <select> form input.  See loncreateuser.pm for an example.
                    718: 
                    719: =cut
                    720: 
                    721: #-------------------------------------------
1.33      matthew   722: sub home_server_option_list {
                    723:     my $domain = shift;
1.52      matthew   724:     my %servers = &get_library_servers($domain);
1.33      matthew   725:     my $result = '';
                    726:     foreach (sort keys(%servers)) {
                    727:         $result.=
                    728:             '<option value="'.$_.'">'.$_.' '.$servers{$_}."</option>\n";
                    729:     }
                    730:     return $result;
                    731: }
                    732: ###############################################################
                    733: ##    End of home server <option> list generating code       ##
                    734: ###############################################################
1.87      matthew   735: 
                    736: ###############################################################
                    737: ###############################################################
                    738: 
                    739: =pod
                    740: 
                    741: =item &decode_user_agent()
                    742: 
                    743: Inputs: $r
                    744: 
                    745: Outputs:
                    746: 
                    747: =over 4
                    748: 
                    749: =item $httpbrowser
                    750: 
                    751: =item $clientbrowser
                    752: 
                    753: =item $clientversion
                    754: 
                    755: =item $clientmathml
                    756: 
                    757: =item $clientunicode
                    758: 
                    759: =item $clientos
                    760: 
                    761: =back
                    762: 
                    763: =cut
                    764: 
                    765: ###############################################################
                    766: ###############################################################
                    767: sub decode_user_agent {
                    768:     my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
                    769:     my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
                    770:     my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
                    771:     my $clientbrowser='unknown';
                    772:     my $clientversion='0';
                    773:     my $clientmathml='';
                    774:     my $clientunicode='0';
                    775:     for (my $i=0;$i<=$#browsertype;$i++) {
                    776:         my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\:/,$browsertype[$i]);
                    777: 	if (($httpbrowser=~/$match/i)  && ($httpbrowser!~/$notmatch/i)) {
                    778: 	    $clientbrowser=$bname;
                    779:             $httpbrowser=~/$vreg/i;
                    780: 	    $clientversion=$1;
                    781:             $clientmathml=($clientversion>=$minv);
                    782:             $clientunicode=($clientversion>=$univ);
                    783: 	}
                    784:     }
                    785:     my $clientos='unknown';
                    786:     if (($httpbrowser=~/linux/i) ||
                    787:         ($httpbrowser=~/unix/i) ||
                    788:         ($httpbrowser=~/ux/i) ||
                    789:         ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
                    790:     if (($httpbrowser=~/vax/i) ||
                    791:         ($httpbrowser=~/vms/i)) { $clientos='vms'; }
                    792:     if ($httpbrowser=~/next/i) { $clientos='next'; }
                    793:     if (($httpbrowser=~/mac/i) ||
                    794:         ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
                    795:     if ($httpbrowser=~/win/i) { $clientos='win'; }
                    796:     if ($httpbrowser=~/embed/i) { $clientos='pda'; }
                    797:     return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
                    798:             $clientunicode,$clientos,);
                    799: }
                    800: 
                    801: ###############################################################
                    802: ###############################################################
                    803: 
1.32      matthew   804: 
                    805: ###############################################################
                    806: ##    Authentication changing form generation subroutines    ##
                    807: ###############################################################
                    808: ##
                    809: ## All of the authform_xxxxxxx subroutines take their inputs in a
                    810: ## hash, and have reasonable default values.
                    811: ##
                    812: ##    formname = the name given in the <form> tag.
1.35      matthew   813: #-------------------------------------------
                    814: 
1.45      matthew   815: =pod
                    816: 
1.35      matthew   817: =item authform_xxxxxx
                    818: 
                    819: The authform_xxxxxx subroutines provide javascript and html forms which 
                    820: handle some of the conveniences required for authentication forms.  
                    821: This is not an optimal method, but it works.  
                    822: 
                    823: See loncreateuser.pm for invocation and use examples.
                    824: 
                    825: =over 4
                    826: 
                    827: =item authform_header
                    828: 
                    829: =item authform_authorwarning
                    830: 
                    831: =item authform_nochange
                    832: 
                    833: =item authform_kerberos
                    834: 
                    835: =item authform_internal
                    836: 
                    837: =item authform_filesystem
                    838: 
                    839: =back
                    840: 
                    841: =cut
                    842: 
                    843: #-------------------------------------------
1.32      matthew   844: sub authform_header{  
                    845:     my %in = (
                    846:         formname => 'cu',
1.80      albertel  847:         kerb_def_dom => '',
1.32      matthew   848:         @_,
                    849:     );
                    850:     $in{'formname'} = 'document.' . $in{'formname'};
                    851:     my $result='';
1.80      albertel  852: 
                    853: #---------------------------------------------- Code for upper case translation
                    854:     my $Javascript_toUpperCase;
                    855:     unless ($in{kerb_def_dom}) {
                    856:         $Javascript_toUpperCase =<<"END";
                    857:         switch (choice) {
                    858:            case 'krb': currentform.elements[choicearg].value =
                    859:                currentform.elements[choicearg].value.toUpperCase();
                    860:                break;
                    861:            default:
                    862:         }
                    863: END
                    864:     } else {
                    865:         $Javascript_toUpperCase = "";
                    866:     }
                    867: 
1.32      matthew   868:     $result.=<<"END";
                    869: var current = new Object();
                    870: current.radiovalue = 'nochange';
                    871: current.argfield = null;
                    872: 
                    873: function changed_radio(choice,currentform) {
                    874:     var choicearg = choice + 'arg';
                    875:     // If a radio button in changed, we need to change the argfield
                    876:     if (current.radiovalue != choice) {
                    877:         current.radiovalue = choice;
                    878:         if (current.argfield != null) {
                    879:             currentform.elements[current.argfield].value = '';
                    880:         }
                    881:         if (choice == 'nochange') {
                    882:             current.argfield = null;
                    883:         } else {
                    884:             current.argfield = choicearg;
                    885:             switch(choice) {
                    886:                 case 'krb': 
                    887:                     currentform.elements[current.argfield].value = 
                    888:                         "$in{'kerb_def_dom'}";
                    889:                 break;
                    890:               default:
                    891:                 break;
                    892:             }
                    893:         }
                    894:     }
                    895:     return;
                    896: }
1.22      www       897: 
1.32      matthew   898: function changed_text(choice,currentform) {
                    899:     var choicearg = choice + 'arg';
                    900:     if (currentform.elements[choicearg].value !='') {
1.80      albertel  901:         $Javascript_toUpperCase
1.32      matthew   902:         // clear old field
                    903:         if ((current.argfield != choicearg) && (current.argfield != null)) {
                    904:             currentform.elements[current.argfield].value = '';
                    905:         }
                    906:         current.argfield = choicearg;
                    907:     }
                    908:     set_auth_radio_buttons(choice,currentform);
                    909:     return;
1.20      www       910: }
1.32      matthew   911: 
                    912: function set_auth_radio_buttons(newvalue,currentform) {
                    913:     var i=0;
                    914:     while (i < currentform.login.length) {
                    915:         if (currentform.login[i].value == newvalue) { break; }
                    916:         i++;
                    917:     }
                    918:     if (i == currentform.login.length) {
                    919:         return;
                    920:     }
                    921:     current.radiovalue = newvalue;
                    922:     currentform.login[i].checked = true;
                    923:     return;
                    924: }
                    925: END
                    926:     return $result;
                    927: }
                    928: 
                    929: sub authform_authorwarning{
                    930:     my $result='';
                    931:     $result=<<"END";
                    932: <i>As a general rule, only authors or co-authors should be filesystem
                    933: authenticated (which allows access to the server filesystem).</i>
                    934: END
                    935:     return $result;
                    936: }
                    937: 
                    938: sub authform_nochange{  
                    939:     my %in = (
                    940:               formname => 'document.cu',
                    941:               kerb_def_dom => 'MSU.EDU',
                    942:               @_,
                    943:           );
                    944:     my $result='';
                    945:     $result.=<<"END";
                    946: <input type="radio" name="login" value="nochange" checked="checked"
1.57      albertel  947:        onclick="javascript:changed_radio('nochange',$in{'formname'});" />
1.32      matthew   948: Do not change login data
                    949: END
                    950:     return $result;
                    951: }
                    952: 
                    953: sub authform_kerberos{  
                    954:     my %in = (
                    955:               formname => 'document.cu',
                    956:               kerb_def_dom => 'MSU.EDU',
1.80      albertel  957:               kerb_def_auth => 'krb4',
1.32      matthew   958:               @_,
                    959:               );
                    960:     my $result='';
1.80      albertel  961:     my $check4;
                    962:     my $check5;
                    963:     if ($in{'kerb_def_auth'} eq 'krb5') {
                    964:        $check5 = " checked=\"on\"";
                    965:     } else {
                    966:        $check4 = " checked=\"on\"";
                    967:     }
1.32      matthew   968:     $result.=<<"END";
                    969: <input type="radio" name="login" value="krb" 
                    970:        onclick="javascript:changed_radio('krb',$in{'formname'});"
1.57      albertel  971:        onchange="javascript:changed_radio('krb',$in{'formname'});" />
1.32      matthew   972: Kerberos authenticated with domain
1.80      albertel  973: <input type="text" size="10" name="krbarg" value="$in{'kerb_def_dom'}"
1.57      albertel  974:        onchange="javascript:changed_text('krb',$in{'formname'});" />
1.80      albertel  975: <input type="radio" name="krbver" value="4" $check4 />Version 4
                    976: <input type="radio" name="krbver" value="5" $check5 />Version 5
1.32      matthew   977: END
                    978:     return $result;
                    979: }
                    980: 
                    981: sub authform_internal{  
                    982:     my %args = (
                    983:                 formname => 'document.cu',
                    984:                 kerb_def_dom => 'MSU.EDU',
                    985:                 @_,
                    986:                 );
                    987:     my $result='';
                    988:     $result.=<<"END";
                    989: <input type="radio" name="login" value="int"
                    990:        onchange="javascript:changed_radio('int',$args{'formname'});"
1.57      albertel  991:        onclick="javascript:changed_radio('int',$args{'formname'});" />
1.32      matthew   992: Internally authenticated (with initial password 
                    993: <input type="text" size="10" name="intarg" value=""
1.75      www       994:        onchange="javascript:changed_text('int',$args{'formname'});" />)
1.32      matthew   995: END
                    996:     return $result;
                    997: }
                    998: 
                    999: sub authform_local{  
                   1000:     my %in = (
                   1001:               formname => 'document.cu',
                   1002:               kerb_def_dom => 'MSU.EDU',
                   1003:               @_,
                   1004:               );
                   1005:     my $result='';
                   1006:     $result.=<<"END";
                   1007: <input type="radio" name="login" value="loc"
                   1008:        onchange="javascript:changed_radio('loc',$in{'formname'});"
1.57      albertel 1009:        onclick="javascript:changed_radio('loc',$in{'formname'});" />
1.32      matthew  1010: Local Authentication with argument
                   1011: <input type="text" size="10" name="locarg" value=""
1.57      albertel 1012:        onchange="javascript:changed_text('loc',$in{'formname'});" />
1.32      matthew  1013: END
                   1014:     return $result;
                   1015: }
                   1016: 
                   1017: sub authform_filesystem{  
                   1018:     my %in = (
                   1019:               formname => 'document.cu',
                   1020:               kerb_def_dom => 'MSU.EDU',
                   1021:               @_,
                   1022:               );
                   1023:     my $result='';
                   1024:     $result.=<<"END";
                   1025: <input type="radio" name="login" value="fsys" 
                   1026:        onchange="javascript:changed_radio('fsys',$in{'formname'});"
1.57      albertel 1027:        onclick="javascript:changed_radio('fsys',$in{'formname'});" />
1.32      matthew  1028: Filesystem authenticated (with initial password 
                   1029: <input type="text" size="10" name="fsysarg" value=""
1.75      www      1030:        onchange="javascript:changed_text('fsys',$in{'formname'});">)
1.32      matthew  1031: END
                   1032:     return $result;
                   1033: }
                   1034: 
                   1035: ###############################################################
                   1036: ##   End Authentication changing form generation functions   ##
1.80      albertel 1037: ###############################################################
                   1038: 
                   1039: ###############################################################
                   1040: ##    Get Authentication Defaults for Domain                 ##
                   1041: ###############################################################
                   1042: ##
                   1043: ## Returns default authentication type and an associated argument
                   1044: ## as listed in file domain.tab
                   1045: ##
                   1046: #-------------------------------------------
                   1047: 
                   1048: =pod
                   1049: 
                   1050: =item get_auth_defaults
                   1051: 
                   1052: get_auth_defaults($target_domain) returns the default authentication
                   1053: type and an associated argument (initial password or a kerberos domain).
                   1054: These values are stored in lonTabs/domain.tab
                   1055: 
                   1056: ($def_auth, $def_arg) = &get_auth_defaults($target_domain);
                   1057: 
                   1058: If target_domain is not found in domain.tab, returns nothing ('').
                   1059: 
                   1060: =over 4
                   1061: 
                   1062: =item get_auth_defaults
                   1063: 
                   1064: =back
                   1065: 
                   1066: =cut
                   1067: 
                   1068: #-------------------------------------------
                   1069: sub get_auth_defaults {
                   1070:     my $domain=shift;
                   1071:     return ($Apache::lonnet::domain_auth_def{$domain},$Apache::lonnet::domain_auth_arg_def{$domain});
                   1072: }
                   1073: ###############################################################
                   1074: ##   End Get Authentication Defaults for Domain              ##
                   1075: ###############################################################
                   1076: 
                   1077: ###############################################################
                   1078: ##    Get Kerberos Defaults for Domain                 ##
                   1079: ###############################################################
                   1080: ##
                   1081: ## Returns default kerberos version and an associated argument
                   1082: ## as listed in file domain.tab. If not listed, provides
                   1083: ## appropriate default domain and kerberos version.
                   1084: ##
                   1085: #-------------------------------------------
                   1086: 
                   1087: =pod
                   1088: 
                   1089: =item get_kerberos_defaults
                   1090: 
                   1091: get_kerberos_defaults($target_domain) returns the default kerberos
                   1092: version and domain. If not found in domain.tabs, it defaults to
                   1093: version 4 and the domain of the server.
                   1094: 
                   1095: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
                   1096: 
                   1097: =over 4
                   1098: 
                   1099: =item get_kerberos_defaults
                   1100: 
                   1101: =back
                   1102: 
                   1103: =cut
                   1104: 
                   1105: #-------------------------------------------
                   1106: sub get_kerberos_defaults {
                   1107:     my $domain=shift;
                   1108:     my ($krbdef,$krbdefdom) =
                   1109:         &Apache::loncommon::get_auth_defaults($domain);
                   1110:     unless ($krbdef =~/^krb/ && $krbdefdom) {
                   1111:         $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
                   1112:         my $krbdefdom=$1;
                   1113:         $krbdefdom=~tr/a-z/A-Z/;
                   1114:         $krbdef = "krb4";
                   1115:     }
                   1116:     return ($krbdef,$krbdefdom);
                   1117: }
                   1118: ###############################################################
                   1119: ##   End Get Kerberos Defaults for Domain              ##
1.32      matthew  1120: ###############################################################
                   1121: 
1.46      matthew  1122: ###############################################################
                   1123: ##                Thesaurus Functions                        ##
                   1124: ###############################################################
1.20      www      1125: 
1.46      matthew  1126: =pod
1.20      www      1127: 
1.46      matthew  1128: =item initialize_keywords
                   1129: 
                   1130: Initializes the package variable %Keywords if it is empty.  Uses the
                   1131: package variable $thesaurus_db_file.
                   1132: 
                   1133: =cut
                   1134: 
                   1135: ###################################################
                   1136: 
                   1137: sub initialize_keywords {
                   1138:     return 1 if (scalar keys(%Keywords));
                   1139:     # If we are here, %Keywords is empty, so fill it up
                   1140:     #   Make sure the file we need exists...
                   1141:     if (! -e $thesaurus_db_file) {
                   1142:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
                   1143:                                  " failed because it does not exist");
                   1144:         return 0;
                   1145:     }
                   1146:     #   Set up the hash as a database
                   1147:     my %thesaurus_db;
                   1148:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 1149:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  1150:         &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
                   1151:                                  $thesaurus_db_file);
                   1152:         return 0;
                   1153:     } 
                   1154:     #  Get the average number of appearances of a word.
                   1155:     my $avecount = $thesaurus_db{'average.count'};
                   1156:     #  Put keywords (those that appear > average) into %Keywords
                   1157:     while (my ($word,$data)=each (%thesaurus_db)) {
                   1158:         my ($count,undef) = split /:/,$data;
                   1159:         $Keywords{$word}++ if ($count > $avecount);
                   1160:     }
                   1161:     untie %thesaurus_db;
                   1162:     # Remove special values from %Keywords.
                   1163:     foreach ('total.count','average.count') {
                   1164:         delete($Keywords{$_}) if (exists($Keywords{$_}));
                   1165:     }
                   1166:     return 1;
                   1167: }
                   1168: 
                   1169: ###################################################
                   1170: 
                   1171: =pod
                   1172: 
                   1173: =item keyword($word)
                   1174: 
                   1175: Returns true if $word is a keyword.  A keyword is a word that appears more 
                   1176: than the average number of times in the thesaurus database.  Calls 
                   1177: &initialize_keywords
                   1178: 
                   1179: =cut
                   1180: 
                   1181: ###################################################
1.20      www      1182: 
                   1183: sub keyword {
1.46      matthew  1184:     return if (!&initialize_keywords());
                   1185:     my $word=lc(shift());
                   1186:     $word=~s/\W//g;
                   1187:     return exists($Keywords{$word});
1.20      www      1188: }
1.46      matthew  1189: 
                   1190: ###############################################################
                   1191: 
                   1192: =pod 
1.20      www      1193: 
1.46      matthew  1194: =item get_related_words
                   1195: 
                   1196: Look up a word in the thesaurus.  Takes a scalar arguement and returns
                   1197: an array of words.  If the keyword is not in the thesaurus, an empty array
                   1198: will be returned.  The order of the words returned is determined by the
                   1199: database which holds them.
                   1200: 
                   1201: Uses global $thesaurus_db_file.
                   1202: 
                   1203: =cut
                   1204: 
                   1205: ###############################################################
                   1206: sub get_related_words {
                   1207:     my $keyword = shift;
                   1208:     my %thesaurus_db;
                   1209:     if (! -e $thesaurus_db_file) {
                   1210:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
                   1211:                                  "failed because the file does not exist");
                   1212:         return ();
                   1213:     }
                   1214:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 1215:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  1216:         return ();
                   1217:     } 
                   1218:     my @Words=();
                   1219:     if (exists($thesaurus_db{$keyword})) {
                   1220:         $_ = $thesaurus_db{$keyword};
                   1221:         (undef,@Words) = split/:/;  # The first element is the number of times
                   1222:                                     # the word appears.  We do not need it now.
                   1223:         for (my $i=0;$i<=$#Words;$i++) {
                   1224:             ($Words[$i],undef)= split/\,/,$Words[$i];
1.20      www      1225:         }
                   1226:     }
1.46      matthew  1227:     untie %thesaurus_db;
                   1228:     return @Words;
1.14      harris41 1229: }
1.46      matthew  1230: 
                   1231: ###############################################################
                   1232: ##              End Thesaurus Functions                      ##
                   1233: ###############################################################
1.61      www      1234: 
                   1235: # -------------------------------------------------------------- Plaintext name
1.81      albertel 1236: =pod
                   1237: 
                   1238: =item plainname($uname,$udom)
                   1239: 
                   1240: Gets a users name and returns it as a string in
                   1241: "first middle last generation"
                   1242: form
                   1243: 
                   1244: =cut
1.61      www      1245: 
1.81      albertel 1246: ###############################################################
1.61      www      1247: sub plainname {
                   1248:     my ($uname,$udom)=@_;
                   1249:     my %names=&Apache::lonnet::get('environment',
                   1250:                     ['firstname','middlename','lastname','generation'],
                   1251: 					 $udom,$uname);
1.62      www      1252:     my $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
1.61      www      1253: 	$names{'lastname'}.' '.$names{'generation'};
1.62      www      1254:     $name=~s/\s+$//;
                   1255:     $name=~s/\s+/ /g;
                   1256:     return $name;
1.61      www      1257: }
1.66      www      1258: 
                   1259: # -------------------------------------------------------------------- Nickname
1.81      albertel 1260: =pod
                   1261: 
                   1262: =item nickname($uname,$udom)
                   1263: 
                   1264: Gets a users name and returns it as a string as
                   1265: 
                   1266: "&quot;nickname&quot;"
1.66      www      1267: 
1.81      albertel 1268: if the user has a nickname or
                   1269: 
                   1270: "first middle last generation"
                   1271: 
                   1272: if the user does not
                   1273: 
                   1274: =cut
1.66      www      1275: 
                   1276: sub nickname {
                   1277:     my ($uname,$udom)=@_;
                   1278:     my %names=&Apache::lonnet::get('environment',
                   1279:   ['nickname','firstname','middlename','lastname','generation'],$udom,$uname);
1.68      albertel 1280:     my $name=$names{'nickname'};
1.66      www      1281:     if ($name) {
                   1282:        $name='&quot;'.$name.'&quot;'; 
                   1283:     } else {
                   1284:        $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
                   1285: 	     $names{'lastname'}.' '.$names{'generation'};
                   1286:        $name=~s/\s+$//;
                   1287:        $name=~s/\s+/ /g;
                   1288:     }
                   1289:     return $name;
                   1290: }
                   1291: 
1.61      www      1292: 
                   1293: # ------------------------------------------------------------------ Screenname
1.81      albertel 1294: 
                   1295: =pod
                   1296: 
                   1297: =item screenname($uname,$udom)
                   1298: 
                   1299: Gets a users screenname and returns it as a string
                   1300: 
                   1301: =cut
1.61      www      1302: 
                   1303: sub screenname {
                   1304:     my ($uname,$udom)=@_;
                   1305:     my %names=
                   1306:  &Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68      albertel 1307:     return $names{'screenname'};
1.62      www      1308: }
                   1309: 
                   1310: # ------------------------------------------------------------- Message Wrapper
                   1311: 
                   1312: sub messagewrapper {
                   1313:     my ($link,$un,$do)=@_;
                   1314:     return 
                   1315: "<a href='/adm/email?compose=individual&recname=$un&recdom=$do'>$link</a>";
1.74      www      1316: }
                   1317: # --------------------------------------------------------------- Notes Wrapper
                   1318: 
                   1319: sub noteswrapper {
                   1320:     my ($link,$un,$do)=@_;
                   1321:     return 
                   1322: "<a href='/adm/email?recordftf=retrieve&recname=$un&recdom=$do'>$link</a>";
1.62      www      1323: }
                   1324: # ------------------------------------------------------------- Aboutme Wrapper
                   1325: 
                   1326: sub aboutmewrapper {
1.69      matthew  1327:     my ($link,$username,$domain)=@_;
                   1328:     return "<a href='/adm/$domain/$username/aboutme'>$link</a>";
1.62      www      1329: }
                   1330: 
                   1331: # ------------------------------------------------------------ Syllabus Wrapper
                   1332: 
                   1333: 
                   1334: sub syllabuswrapper {
1.73      www      1335:     my ($link,$un,$do,$tf)=@_;
                   1336:     if ($tf) { $link='<font color="'.$tf.'">'.$link.'</font>'; }
1.62      www      1337:     return "<a href='/public/$do/$un/syllabus'>$link</a>";
1.61      www      1338: }
1.14      harris41 1339: 
                   1340: # ---------------------------------------------------------------- Language IDs
                   1341: sub languageids {
1.16      harris41 1342:     return sort(keys(%language));
1.14      harris41 1343: }
                   1344: 
                   1345: # -------------------------------------------------------- Language Description
                   1346: sub languagedescription {
1.16      harris41 1347:     return $language{shift(@_)};
1.97      www      1348: }
                   1349: 
                   1350: # ----------------------------------------------------------- Display Languages
                   1351: # returns a hash with all desired display languages
                   1352: #
                   1353: 
                   1354: sub display_languages {
                   1355:     my %languages=();
                   1356:     if ($ENV{'environment.languages'}) {
                   1357: 	foreach (split(/\s*(\,|\;|\:)\s*/,$ENV{'environment.languages'})) {
                   1358: 	    $languages{$_}=1;
                   1359:         }
                   1360:     }
                   1361:     &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
                   1362:     if ($ENV{'form.displaylanguage'}) {
                   1363: 	foreach (split(/\s*(\,|\;|\:)\s*/,$ENV{'form.displaylanguage'})) {
                   1364: 	    $languages{$_}=1;
                   1365:         }
                   1366:     }
                   1367:     return %languages;
1.14      harris41 1368: }
                   1369: 
                   1370: # --------------------------------------------------------------- Copyright IDs
                   1371: sub copyrightids {
1.16      harris41 1372:     return sort(keys(%cprtag));
1.14      harris41 1373: }
                   1374: 
                   1375: # ------------------------------------------------------- Copyright Description
                   1376: sub copyrightdescription {
1.16      harris41 1377:     return $cprtag{shift(@_)};
1.14      harris41 1378: }
                   1379: 
                   1380: # ------------------------------------------------------------- File Categories
                   1381: sub filecategories {
1.41      ng       1382:     return sort(keys(%category_extensions));
1.15      harris41 1383: }
1.14      harris41 1384: 
1.17      harris41 1385: # -------------------------------------- File Types within a specified category
1.15      harris41 1386: sub filecategorytypes {
1.41      ng       1387:     return @{$category_extensions{lc($_[0])}};
1.14      harris41 1388: }
                   1389: 
                   1390: # ------------------------------------------------------------------ File Types
                   1391: sub fileextensions {
1.16      harris41 1392:     return sort(keys(%fe));
1.14      harris41 1393: }
                   1394: 
                   1395: # ------------------------------------------------------------- Embedding Style
                   1396: sub fileembstyle {
1.16      harris41 1397:     return $fe{lc(shift(@_))};
1.14      harris41 1398: }
                   1399: 
                   1400: # ------------------------------------------------------------ Description Text
                   1401: sub filedescription {
1.16      harris41 1402:     return $fd{lc(shift(@_))};
                   1403: }
                   1404: 
                   1405: # ------------------------------------------------------------ Description Text
                   1406: sub filedescriptionex {
                   1407:     my $ex=shift;
                   1408:     return '.'.$ex.' '.$fd{lc($ex)};
1.12      harris41 1409: }
1.1       albertel 1410: 
1.40      ng       1411: # ---- Retrieve attempts by students
                   1412: # input
                   1413: # $symb             - problem including path
                   1414: # $username,$domain - that of the student
                   1415: # $course           - course name
                   1416: # $getattempt       - leave blank if want all attempts, else put something.
1.43      ng       1417: # $regexp           - regular expression. If string matches regexp send to
                   1418: # $gradesub         - routine that process the string if it matches regexp
1.40      ng       1419: # 
                   1420: # output
                   1421: # formatted as a table all the attempts, if any.
                   1422: #
1.1       albertel 1423: sub get_previous_attempt {
1.43      ng       1424:   my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub)=@_;
1.1       albertel 1425:   my $prevattempts='';
1.43      ng       1426:   no strict 'refs';
1.1       albertel 1427:   if ($symb) {
1.3       albertel 1428:     my (%returnhash)=
                   1429:       &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1       albertel 1430:     if ($returnhash{'version'}) {
                   1431:       my %lasthash=();
                   1432:       my $version;
                   1433:       for ($version=1;$version<=$returnhash{'version'};$version++) {
1.19      harris41 1434:         foreach (sort(split(/\:/,$returnhash{$version.':keys'}))) {
1.1       albertel 1435: 	  $lasthash{$_}=$returnhash{$version.':'.$_};
1.19      harris41 1436:         }
1.1       albertel 1437:       }
1.43      ng       1438:       $prevattempts='<table border="0" width="100%"><tr><td bgcolor="#777777">';
1.40      ng       1439:       $prevattempts.='<table border="0" width="100%"><tr bgcolor="#e6ffff"><td>History</td>';
1.16      harris41 1440:       foreach (sort(keys %lasthash)) {
1.31      albertel 1441: 	my ($ign,@parts) = split(/\./,$_);
1.41      ng       1442: 	if ($#parts > 0) {
1.31      albertel 1443: 	  my $data=$parts[-1];
                   1444: 	  pop(@parts);
1.40      ng       1445: 	  $prevattempts.='<td>Part '.join('.',@parts).'<br />'.$data.'&nbsp;</td>';
1.31      albertel 1446: 	} else {
1.41      ng       1447: 	  if ($#parts == 0) {
                   1448: 	    $prevattempts.='<th>'.$parts[0].'</th>';
                   1449: 	  } else {
                   1450: 	    $prevattempts.='<th>'.$ign.'</th>';
                   1451: 	  }
1.31      albertel 1452: 	}
1.16      harris41 1453:       }
1.40      ng       1454:       if ($getattempt eq '') {
                   1455: 	for ($version=1;$version<=$returnhash{'version'};$version++) {
                   1456: 	  $prevattempts.='</tr><tr bgcolor="#ffffe6"><td>Transaction '.$version.'</td>';
                   1457: 	    foreach (sort(keys %lasthash)) {
                   1458: 	       my $value;
                   1459: 	       if ($_ =~ /timestamp/) {
                   1460: 		  $value=scalar(localtime($returnhash{$version.':'.$_}));
                   1461: 	       } else {
                   1462: 		  $value=$returnhash{$version.':'.$_};
                   1463: 	       }
                   1464: 	       $prevattempts.='<td>'.$value.'&nbsp;</td>';   
                   1465: 	    }
                   1466: 	 }
1.1       albertel 1467:       }
1.40      ng       1468:       $prevattempts.='</tr><tr bgcolor="#ffffe6"><td>Current</td>';
1.16      harris41 1469:       foreach (sort(keys %lasthash)) {
1.5       albertel 1470: 	my $value;
                   1471: 	if ($_ =~ /timestamp/) {
                   1472: 	  $value=scalar(localtime($lasthash{$_}));
                   1473: 	} else {
                   1474: 	  $value=$lasthash{$_};
                   1475: 	}
1.49      ng       1476: 	if ($_ =~/$regexp$/ && (defined &$gradesub)) {$value = &$gradesub($value)}
1.40      ng       1477: 	$prevattempts.='<td>'.$value.'&nbsp;</td>';
1.16      harris41 1478:       }
1.40      ng       1479:       $prevattempts.='</tr></table></td></tr></table>';
1.1       albertel 1480:     } else {
                   1481:       $prevattempts='Nothing submitted - no attempts.';
                   1482:     }
                   1483:   } else {
                   1484:     $prevattempts='No data.';
                   1485:   }
1.10      albertel 1486: }
                   1487: 
                   1488: sub get_student_view {
1.64      sakharuk 1489:   my ($symb,$username,$domain,$courseid,$target) = @_;
1.10      albertel 1490:   my ($map,$id,$feedurl) = split(/___/,$symb);
                   1491:   my (%old,%moreenv);
                   1492:   my @elements=('symb','courseid','domain','username');
                   1493:   foreach my $element (@elements) {
                   1494:     $old{$element}=$ENV{'form.grade_'.$element};
                   1495:     $moreenv{'form.grade_'.$element}=eval '$'.$element #'
                   1496:   }
1.64      sakharuk 1497:   if ($target eq 'tex') {$moreenv{'form.grade_target'} = 'tex';}
1.11      albertel 1498:   &Apache::lonnet::appenv(%moreenv);
                   1499:   my $userview=&Apache::lonnet::ssi('/res/'.$feedurl);
                   1500:   &Apache::lonnet::delenv('form.grade_');
                   1501:   foreach my $element (@elements) {
                   1502:     $ENV{'form.grade_'.$element}=$old{$element};
                   1503:   }
                   1504:   $userview=~s/\<body[^\>]*\>//gi;
                   1505:   $userview=~s/\<\/body\>//gi;
                   1506:   $userview=~s/\<html\>//gi;
                   1507:   $userview=~s/\<\/html\>//gi;
                   1508:   $userview=~s/\<head\>//gi;
                   1509:   $userview=~s/\<\/head\>//gi;
                   1510:   $userview=~s/action\s*\=/would_be_action\=/gi;
                   1511:   return $userview;
                   1512: }
                   1513: 
                   1514: sub get_student_answers {
1.100     sakharuk 1515:   my ($symb,$username,$domain,$courseid,%form) = @_;
1.11      albertel 1516:   my ($map,$id,$feedurl) = split(/___/,$symb);
                   1517:   my (%old,%moreenv);
                   1518:   my @elements=('symb','courseid','domain','username');
                   1519:   foreach my $element (@elements) {
                   1520:     $old{$element}=$ENV{'form.grade_'.$element};
                   1521:     $moreenv{'form.grade_'.$element}=eval '$'.$element #'
                   1522:   }
                   1523:   $moreenv{'form.grade_target'}='answer';
1.10      albertel 1524:   &Apache::lonnet::appenv(%moreenv);
1.100     sakharuk 1525:   my $userview=&Apache::lonnet::ssi('/res/'.$feedurl,%form);
1.10      albertel 1526:   &Apache::lonnet::delenv('form.grade_');
                   1527:   foreach my $element (@elements) {
                   1528:     $ENV{'form.grade_'.$element}=$old{$element};
                   1529:   }
                   1530:   return $userview;
1.1       albertel 1531: }
1.37      matthew  1532: 
                   1533: ###############################################
1.51      www      1534: 
                   1535: 
                   1536: sub timehash {
                   1537:     my @ltime=localtime(shift);
                   1538:     return ( 'seconds' => $ltime[0],
                   1539:              'minutes' => $ltime[1],
                   1540:              'hours'   => $ltime[2],
                   1541:              'day'     => $ltime[3],
                   1542:              'month'   => $ltime[4]+1,
                   1543:              'year'    => $ltime[5]+1900,
                   1544:              'weekday' => $ltime[6],
                   1545:              'dayyear' => $ltime[7]+1,
                   1546:              'dlsav'   => $ltime[8] );
                   1547: }
                   1548: 
                   1549: sub maketime {
                   1550:     my %th=@_;
                   1551:     return POSIX::mktime(
                   1552:         ($th{'seconds'},$th{'minutes'},$th{'hours'},
                   1553:          $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,$th{'dlsav'}));
                   1554: }
                   1555: 
1.70      www      1556: 
                   1557: #########################################
                   1558: #
                   1559: # Retro-fixing of un-backward-compatible time format
                   1560: 
                   1561: sub unsqltime {
                   1562:     my $timestamp=shift;
                   1563:     if ($timestamp=~/^(\d+)\-(\d+)\-(\d+)\s+(\d+)\:(\d+)\:(\d+)$/) {
                   1564:        $timestamp=&maketime(
                   1565: 	   'year'=>$1,'month'=>$2,'day'=>$3,
                   1566:            'hours'=>$4,'minutes'=>$5,'seconds'=>$6);
                   1567:     }
                   1568:     return $timestamp;
                   1569: }
                   1570: 
                   1571: #########################################
1.51      www      1572: 
                   1573: sub findallcourses {
                   1574:     my %courses=();
                   1575:     my $now=time;
                   1576:     foreach (keys %ENV) {
                   1577: 	if ($_=~/^user\.role\.\w+\.\/(\w+)\/(\w+)/) {
                   1578: 	    my ($starttime,$endtime)=$ENV{$_};
                   1579:             my $active=1;
                   1580:             if ($starttime) {
                   1581: 		if ($now<$starttime) { $active=0; }
                   1582:             }
                   1583:             if ($endtime) {
                   1584:                 if ($now>$endtime) { $active=0; }
                   1585:             }
                   1586:             if ($active) { $courses{$1.'_'.$2}=1; }
                   1587:         }
                   1588:     }
                   1589:     return keys %courses;
                   1590: }
1.37      matthew  1591: 
1.54      www      1592: ###############################################
1.60      matthew  1593: ###############################################
                   1594: 
                   1595: =pod
                   1596: 
1.63      www      1597: =item &determinedomain()
1.60      matthew  1598: 
                   1599: Inputs: $domain (usually will be undef)
                   1600: 
1.63      www      1601: Returns: Determines which domain should be used for designs
1.60      matthew  1602: 
                   1603: =cut
1.54      www      1604: 
1.60      matthew  1605: ###############################################
1.63      www      1606: sub determinedomain {
                   1607:     my $domain=shift;
                   1608:    if (! $domain) {
1.60      matthew  1609:         # Determine domain if we have not been given one
                   1610:         $domain = $Apache::lonnet::perlvar{'lonDefDomain'};
                   1611:         if ($ENV{'user.domain'}) { $domain=$ENV{'user.domain'}; }
                   1612:         if ($ENV{'request.role.domain'}) { 
                   1613:             $domain=$ENV{'request.role.domain'}; 
                   1614:         }
                   1615:     }
1.63      www      1616:     return $domain;
                   1617: }
                   1618: ###############################################
                   1619: =pod
                   1620: 
                   1621: =item &domainlogo()
                   1622: 
                   1623: Inputs: $domain (usually will be undef)
                   1624: 
                   1625: Returns: A link to a domain logo, if the domain logo exists.
                   1626: If the domain logo does not exist, a description of the domain.
                   1627: 
                   1628: =cut
                   1629: ###############################################
                   1630: sub domainlogo {
                   1631:     my $domain = &determinedomain(shift);    
                   1632:      # See if there is a logo
1.59      www      1633:     if (-e '/home/httpd/html/adm/lonDomLogos/'.$domain.'.gif') {
1.83      albertel 1634: 	my $lonhttpdPort=$Apache::lonnet::perlvar{'lonhttpdPort'};
                   1635: 	if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; }
                   1636:         return '<img src="http://'.$ENV{'HTTP_HOST'}.':'.$lonhttpdPort.
                   1637: 	    '/adm/lonDomLogos/'.$domain.'.gif" />';
1.60      matthew  1638:     } elsif(exists($Apache::lonnet::domaindescription{$domain})) {
                   1639:         return $Apache::lonnet::domaindescription{$domain};
1.59      www      1640:     } else {
1.60      matthew  1641:         return '';
1.59      www      1642:     }
                   1643: }
1.63      www      1644: ##############################################
                   1645: 
                   1646: =pod
                   1647: 
                   1648: =item &designparm()
                   1649: 
                   1650: Inputs: $which parameter; $domain (usually will be undef)
                   1651: 
                   1652: Returns: value of designparamter $which
                   1653: 
                   1654: =cut
                   1655: ##############################################
                   1656: sub designparm {
                   1657:     my ($which,$domain)=@_;
1.96      www      1658:     if ($ENV{'environment.color.'.$which}) {
                   1659: 	return $ENV{'environment.color.'.$which};
                   1660:     }
1.63      www      1661:     $domain=&determinedomain($domain);
                   1662:     if ($designhash{$domain.'.'.$which}) {
                   1663: 	return $designhash{$domain.'.'.$which};
                   1664:     } else {
                   1665:         return $designhash{'default.'.$which};
                   1666:     }
                   1667: }
1.59      www      1668: 
1.60      matthew  1669: ###############################################
                   1670: ###############################################
                   1671: 
                   1672: =pod
                   1673: 
                   1674: =item &bodytag()
                   1675: 
                   1676: Returns a uniform header for LON-CAPA web pages.
                   1677: 
                   1678: Inputs: 
                   1679: 
                   1680:  $title, A title to be displayed on the page.
                   1681:  $function, the current role (can be undef).
                   1682:  $addentries, extra parameters for the <body> tag.
                   1683:  $bodyonly, if defined, only return the <body> tag.
                   1684:  $domain, if defined, force a given domain.
1.86      www      1685:  $forcereg, if page should register as content page (relevant for 
                   1686:             text interface only)
1.60      matthew  1687: 
                   1688: Returns: A uniform header for LON-CAPA web pages.  
                   1689: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
                   1690: If $bodyonly is undef or zero, an html string containing a <body> tag and 
                   1691: other decorations will be returned.
                   1692: 
                   1693: =cut
                   1694: 
                   1695: ###############################################
1.63      www      1696: 
                   1697: 
1.60      matthew  1698: ###############################################
1.54      www      1699: sub bodytag {
1.86      www      1700:     my ($title,$function,$addentries,$bodyonly,$domain,$forcereg)=@_;
1.55      www      1701:     unless ($function) {
                   1702: 	$function='student';
                   1703:         if ($ENV{'request.role'}=~/^(cc|in|ta|ep)/) {
                   1704: 	    $function='coordinator';
                   1705:         }
                   1706: 	if ($ENV{'request.role'}=~/^(su|dc|ad|li)/) {
                   1707:             $function='admin';
                   1708:         }
                   1709:         if (($ENV{'request.role'}=~/^(au|ca)/) ||
                   1710:             ($ENV{'REQUEST_URI'}=~/^(\/priv|\~)/)) {
                   1711:             $function='author';
                   1712:         }
                   1713:     }
1.63      www      1714:     my $img=&designparm($function.'.img',$domain);
                   1715:     my $pgbg=&designparm($function.'.pgbg',$domain);
                   1716:     my $tabbg=&designparm($function.'.tabbg',$domain);
                   1717:     my $font=&designparm($function.'.font',$domain);
                   1718:     my $link=&designparm($function.'.link',$domain);
                   1719:     my $alink=&designparm($function.'.alink',$domain);
                   1720:     my $vlink=&designparm($function.'.vlink',$domain);
                   1721:     my $sidebg=&designparm($function.'.sidebg',$domain);
                   1722: 
                   1723:  # role and realm
1.55      www      1724:     my ($role,$realm)
                   1725:        =&Apache::lonnet::plaintext((split(/\./,$ENV{'request.role'}))[0]);
                   1726: # realm
1.54      www      1727:     if ($ENV{'request.course.id'}) {
1.55      www      1728: 	$realm=
                   1729:          $ENV{'course.'.$ENV{'request.course.id'}.'.description'};
1.54      www      1730:     }
1.55      www      1731:     unless ($realm) { $realm='&nbsp;'; }
                   1732: # Set messages
1.60      matthew  1733:     my $messages=&domainlogo($domain);
1.101     www      1734: # Signal existance to Remote unless already done so
                   1735:     my $addscript='';
                   1736:     unless (($ENV{'browser.interface'} eq 'textual') || 
                   1737:             ($ENV{'environment.remote'} eq 'off') || ($addentries)) {
                   1738:         $addentries=' onLoad="'.&Apache::lonmenu::loadevents().
                   1739:                  '" onUnload="'.&Apache::lonmenu::unloadevents().'"';
                   1740: 	$addscript=&Apache::lonmenu::registerurl();
                   1741:     }
                   1742: # Port for miniserver
1.83      albertel 1743:     my $lonhttpdPort=$Apache::lonnet::perlvar{'lonhttpdPort'};
                   1744:     if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; }
1.101     www      1745: # construct main body tag
1.60      matthew  1746:     my $bodytag = <<END;
1.101     www      1747: $addscript
1.54      www      1748: <body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link"
                   1749: $addentries>
1.60      matthew  1750: END
1.94      www      1751:     my $upperleft='<img src="http://'.$ENV{'HTTP_HOST'}.':'.
                   1752:                    $lonhttpdPort.$img.'" />';
1.60      matthew  1753:     if ($bodyonly) {
                   1754:         return $bodytag;
1.79      www      1755:     } elsif ($ENV{'browser.interface'} eq 'textual') {
1.95      www      1756: # Accessibility
1.93      www      1757:         return $bodytag.&Apache::lonmenu::menubuttons($forcereg,'web',
                   1758:                                                       $forcereg).
                   1759:                '<h1>LON-CAPA: '.$title.'</h1>';
                   1760:     } elsif ($ENV{'environment.remote'} eq 'off') {
1.95      www      1761: # No Remote
                   1762:         return $bodytag.&Apache::lonmenu::menubuttons($forcereg,'web',
                   1763:                                                       $forcereg).
                   1764:                '<table bgcolor="'.$pgbg.'" width="100%" border="0" cellspacing="3" cellpadding="3"><tr><td bgcolor="'.$tabbg.'"><font size="+3" color="'.$font.'"><b>'.$title.
                   1765: '</b></font></td></tr></table>';
1.94      www      1766:     }
1.95      www      1767: 
1.93      www      1768: #
1.95      www      1769: # Top frame rendering, Remote is up
1.93      www      1770: #
1.94      www      1771:     return(<<ENDBODY);
1.60      matthew  1772: $bodytag
1.55      www      1773: <table width="100%" cellspacing="0" border="0" cellpadding="0">
1.95      www      1774: <tr><td bgcolor="$sidebg">
1.94      www      1775: $upperleft</td>
1.95      www      1776: <td bgcolor="$sidebg" align="right">$messages&nbsp;</td>
1.55      www      1777: </tr>
1.54      www      1778: <tr>
1.55      www      1779: <td rowspan="3" bgcolor="$tabbg">
                   1780: &nbsp;<font size="5"><b>$title</b></font>
1.54      www      1781: <td bgcolor="$tabbg"  align="right">
                   1782: <font size="2">
                   1783:     $ENV{'environment.firstname'}
                   1784:     $ENV{'environment.middlename'}
                   1785:     $ENV{'environment.lastname'}
                   1786:     $ENV{'environment.generation'}
1.55      www      1787:     </font>&nbsp;
1.54      www      1788: </td>
                   1789: </tr>
                   1790: <tr><td bgcolor="$tabbg" align="right">
1.55      www      1791: <font size="2">$role</font>&nbsp;
1.54      www      1792: </td></tr>
1.55      www      1793: <tr>
                   1794: <td bgcolor="$tabbg" align="right"><font size="2">$realm</font>&nbsp;</td></tr>
1.54      www      1795: </table><br>
                   1796: ENDBODY
                   1797: }
1.99      www      1798: 
                   1799: ###############################################
                   1800: 
                   1801: sub get_posted_cgi {
                   1802:     my $r=shift;
                   1803: 
                   1804:     my $buffer;
                   1805:     
                   1806:     $r->read($buffer,$r->header_in('Content-length'),0);
                   1807:     unless ($buffer=~/^(\-+\w+)\s+Content\-Disposition\:\s*form\-data/si) {
                   1808: 	my @pairs=split(/&/,$buffer);
                   1809: 	my $pair;
                   1810: 	foreach $pair (@pairs) {
                   1811: 	    my ($name,$value) = split(/=/,$pair);
                   1812: 	    $value =~ tr/+/ /;
                   1813: 	    $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
                   1814: 	    $name  =~ tr/+/ /;
                   1815: 	    $name  =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
                   1816: 	    &add_to_env("form.$name",$value);
                   1817: 	}
                   1818:     } else {
                   1819: 	my $contentsep=$1;
                   1820: 	my @lines = split (/\n/,$buffer);
                   1821: 	my $name='';
                   1822: 	my $value='';
                   1823: 	my $fname='';
                   1824: 	my $fmime='';
                   1825: 	my $i;
                   1826: 	for ($i=0;$i<=$#lines;$i++) {
                   1827: 	    if ($lines[$i]=~/^$contentsep/) {
                   1828: 		if ($name) {
                   1829: 		    chomp($value);
                   1830: 		    if ($fname) {
                   1831: 			$ENV{"form.$name.filename"}=$fname;
                   1832: 			$ENV{"form.$name.mimetype"}=$fmime;
                   1833: 		    } else {
                   1834: 			$value=~s/\s+$//s;
                   1835: 		    }
                   1836: 		    &add_to_env("form.$name",$value);
                   1837: 		}
                   1838: 		if ($i<$#lines) {
                   1839: 		    $i++;
                   1840: 		    $lines[$i]=~
                   1841: 		/Content\-Disposition\:\s*form\-data\;\s*name\=\"([^\"]+)\"/i;
                   1842: 		    $name=$1;
                   1843: 		    $value='';
                   1844: 		    if ($lines[$i]=~/filename\=\"([^\"]+)\"/i) {
                   1845: 			$fname=$1;
                   1846: 			if 
                   1847:                             ($lines[$i+1]=~/Content\-Type\:\s*([\w\-\/]+)/i) {
                   1848: 				$fmime=$1;
                   1849: 				$i++;
                   1850: 			    } else {
                   1851: 				$fmime='';
                   1852: 			    }
                   1853: 		    } else {
                   1854: 			$fname='';
                   1855: 			$fmime='';
                   1856: 		    }
                   1857: 		    $i++;
                   1858: 		}
                   1859: 	    } else {
                   1860: 		$value.=$lines[$i]."\n";
                   1861: 	    }
                   1862: 	}
                   1863:     }
                   1864:     $ENV{'request.method'}=$ENV{'REQUEST_METHOD'};
                   1865:     $r->method_number(M_GET);
                   1866:     $r->method('GET');
                   1867:     $r->headers_in->unset('Content-length');
                   1868: }
                   1869: 
1.37      matthew  1870: ###############################################
1.1       albertel 1871: 
1.6       albertel 1872: sub get_unprocessed_cgi {
1.25      albertel 1873:   my ($query,$possible_names)= @_;
1.26      matthew  1874:   # $Apache::lonxml::debug=1;
1.16      harris41 1875:   foreach (split(/&/,$query)) {
1.6       albertel 1876:     my ($name, $value) = split(/=/,$_);
1.25      albertel 1877:     $name = &Apache::lonnet::unescape($name);
                   1878:     if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
                   1879:       $value =~ tr/+/ /;
                   1880:       $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
                   1881:       &Apache::lonxml::debug("Seting :$name: to :$value:");
1.30      albertel 1882:       unless (defined($ENV{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25      albertel 1883:     }
1.16      harris41 1884:   }
1.6       albertel 1885: }
                   1886: 
1.7       albertel 1887: sub cacheheader {
1.23      www      1888:   unless ($ENV{'request.method'} eq 'GET') { return ''; }
1.8       albertel 1889:   my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
1.7       albertel 1890:   my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
                   1891:                 <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
                   1892:                 <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
                   1893:   return $output;
                   1894: }
                   1895: 
1.9       albertel 1896: sub no_cache {
                   1897:   my ($r) = @_;
1.23      www      1898:   unless ($ENV{'request.method'} eq 'GET') { return ''; }
1.24      albertel 1899:   #my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
1.9       albertel 1900:   $r->no_cache(1);
                   1901:   $r->header_out("Pragma" => "no-cache");
1.24      albertel 1902:   #$r->header_out("Expires" => $date);
1.9       albertel 1903: }
1.25      albertel 1904: 
                   1905: sub add_to_env {
                   1906:   my ($name,$value)=@_;
1.28      albertel 1907:   if (defined($ENV{$name})) {
1.27      albertel 1908:     if (ref($ENV{$name})) {
1.25      albertel 1909:       #already have multiple values
                   1910:       push(@{ $ENV{$name} },$value);
                   1911:     } else {
                   1912:       #first time seeing multiple values, convert hash entry to an arrayref
                   1913:       my $first=$ENV{$name};
                   1914:       undef($ENV{$name});
                   1915:       push(@{ $ENV{$name} },$first,$value);
                   1916:     }
                   1917:   } else {
                   1918:     $ENV{$name}=$value;
                   1919:   }
1.31      albertel 1920: }
                   1921: 
1.41      ng       1922: =pod
1.45      matthew  1923: 
                   1924: =back 
1.41      ng       1925: 
                   1926: =head2 CSV Upload/Handling functions
1.38      albertel 1927: 
1.41      ng       1928: =over 4
                   1929: 
                   1930: =item  upfile_store($r)
                   1931: 
                   1932: Store uploaded file, $r should be the HTTP Request object,
                   1933: needs $ENV{'form.upfile'}
                   1934: returns $datatoken to be put into hidden field
                   1935: 
                   1936: =cut
1.31      albertel 1937: 
                   1938: sub upfile_store {
                   1939:     my $r=shift;
                   1940:     $ENV{'form.upfile'}=~s/\r/\n/gs;
                   1941:     $ENV{'form.upfile'}=~s/\f/\n/gs;
                   1942:     $ENV{'form.upfile'}=~s/\n+/\n/gs;
                   1943:     $ENV{'form.upfile'}=~s/\n+$//gs;
                   1944: 
                   1945:     my $datatoken=$ENV{'user.name'}.'_'.$ENV{'user.domain'}.
                   1946: 	'_enroll_'.$ENV{'request.course.id'}.'_'.time.'_'.$$;
                   1947:     {
                   1948: 	my $fh=Apache::File->new('>'.$r->dir_config('lonDaemons').
                   1949: 				 '/tmp/'.$datatoken.'.tmp');
                   1950: 	print $fh $ENV{'form.upfile'};
                   1951:     }
                   1952:     return $datatoken;
                   1953: }
                   1954: 
1.56      matthew  1955: =pod
                   1956: 
1.41      ng       1957: =item load_tmp_file($r)
                   1958: 
                   1959: Load uploaded file from tmp, $r should be the HTTP Request object,
                   1960: needs $ENV{'form.datatoken'},
                   1961: sets $ENV{'form.upfile'} to the contents of the file
                   1962: 
                   1963: =cut
1.31      albertel 1964: 
                   1965: sub load_tmp_file {
                   1966:     my $r=shift;
                   1967:     my @studentdata=();
                   1968:     {
                   1969: 	my $fh;
                   1970: 	if ($fh=Apache::File->new($r->dir_config('lonDaemons').
                   1971: 				  '/tmp/'.$ENV{'form.datatoken'}.'.tmp')) {
                   1972: 	    @studentdata=<$fh>;
                   1973: 	}
                   1974:     }
                   1975:     $ENV{'form.upfile'}=join('',@studentdata);
                   1976: }
                   1977: 
1.56      matthew  1978: =pod
                   1979: 
1.41      ng       1980: =item upfile_record_sep()
                   1981: 
                   1982: Separate uploaded file into records
                   1983: returns array of records,
                   1984: needs $ENV{'form.upfile'} and $ENV{'form.upfiletype'}
                   1985: 
                   1986: =cut
1.31      albertel 1987: 
                   1988: sub upfile_record_sep {
                   1989:     if ($ENV{'form.upfiletype'} eq 'xml') {
                   1990:     } else {
                   1991: 	return split(/\n/,$ENV{'form.upfile'});
                   1992:     }
                   1993: }
                   1994: 
1.56      matthew  1995: =pod
                   1996: 
1.41      ng       1997: =item record_sep($record)
                   1998: 
                   1999: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $ENV{'form.upfiletype'}
                   2000: 
                   2001: =cut
                   2002: 
1.31      albertel 2003: sub record_sep {
                   2004:     my $record=shift;
                   2005:     my %components=();
                   2006:     if ($ENV{'form.upfiletype'} eq 'xml') {
                   2007:     } elsif ($ENV{'form.upfiletype'} eq 'space') {
                   2008:         my $i=0;
                   2009:         foreach (split(/\s+/,$record)) {
                   2010:             my $field=$_;
                   2011:             $field=~s/^(\"|\')//;
                   2012:             $field=~s/(\"|\')$//;
                   2013:             $components{$i}=$field;
                   2014:             $i++;
                   2015:         }
                   2016:     } elsif ($ENV{'form.upfiletype'} eq 'tab') {
                   2017:         my $i=0;
                   2018:         foreach (split(/\t+/,$record)) {
                   2019:             my $field=$_;
                   2020:             $field=~s/^(\"|\')//;
                   2021:             $field=~s/(\"|\')$//;
                   2022:             $components{$i}=$field;
                   2023:             $i++;
                   2024:         }
                   2025:     } else {
                   2026:         my @allfields=split(/\,/,$record);
                   2027:         my $i=0;
                   2028:         my $j;
                   2029:         for ($j=0;$j<=$#allfields;$j++) {
                   2030:             my $field=$allfields[$j];
                   2031:             if ($field=~/^\s*(\"|\')/) {
                   2032: 		my $delimiter=$1;
                   2033:                 while (($field!~/$delimiter$/) && ($j<$#allfields)) {
                   2034: 		    $j++;
                   2035: 		    $field.=','.$allfields[$j];
                   2036: 		}
                   2037:                 $field=~s/^\s*$delimiter//;
                   2038:                 $field=~s/$delimiter\s*$//;
                   2039:             }
                   2040:             $components{$i}=$field;
                   2041: 	    $i++;
                   2042:         }
                   2043:     }
                   2044:     return %components;
                   2045: }
                   2046: 
1.56      matthew  2047: =pod
                   2048: 
1.41      ng       2049: =item upfile_select_html()
                   2050: 
                   2051: return HTML code to select file and specify its type
                   2052: 
                   2053: =cut
                   2054: 
1.31      albertel 2055: sub upfile_select_html {
                   2056:     return (<<'ENDUPFORM');
1.57      albertel 2057: <input type="file" name="upfile" size="50" />
1.31      albertel 2058: <br />Type: <select name="upfiletype">
                   2059: <option value="csv">CSV (comma separated values, spreadsheet)</option>
                   2060: <option value="space">Space separated</option>
                   2061: <option value="tab">Tabulator separated</option>
                   2062: <option value="xml">HTML/XML</option>
                   2063: </select>
                   2064: ENDUPFORM
                   2065: }
                   2066: 
1.56      matthew  2067: =pod
                   2068: 
1.41      ng       2069: =item csv_print_samples($r,$records)
                   2070: 
                   2071: Prints a table of sample values from each column uploaded $r is an
                   2072: Apache Request ref, $records is an arrayref from
                   2073: &Apache::loncommon::upfile_record_sep
                   2074: 
                   2075: =cut
                   2076: 
1.31      albertel 2077: sub csv_print_samples {
                   2078:     my ($r,$records) = @_;
                   2079:     my (%sone,%stwo,%sthree);
                   2080:     %sone=&record_sep($$records[0]);
                   2081:     if (defined($$records[1])) {%stwo=&record_sep($$records[1]);}
                   2082:     if (defined($$records[2])) {%sthree=&record_sep($$records[2]);}
                   2083: 
                   2084:     $r->print('Samples<br /><table border="2"><tr>');
                   2085:     foreach (sort({$a <=> $b} keys(%sone))) { $r->print('<th>Column&nbsp;'.($_+1).'</th>'); }
                   2086:     $r->print('</tr>');
                   2087:     foreach my $hash (\%sone,\%stwo,\%sthree) {
                   2088: 	$r->print('<tr>');
                   2089: 	foreach (sort({$a <=> $b} keys(%sone))) {
                   2090: 	    $r->print('<td>');
                   2091: 	    if (defined($$hash{$_})) { $r->print($$hash{$_}); }
                   2092: 	    $r->print('</td>');
                   2093: 	}
                   2094: 	$r->print('</tr>');
                   2095:     }
                   2096:     $r->print('</tr></table><br />'."\n");
                   2097: }
                   2098: 
1.56      matthew  2099: =pod
                   2100: 
1.41      ng       2101: =item csv_print_select_table($r,$records,$d)
                   2102: 
                   2103: Prints a table to create associations between values and table columns.
                   2104: $r is an Apache Request ref,
                   2105: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
                   2106: $d is an array of 2 element arrays (internal name, displayed name)
                   2107: 
                   2108: =cut
                   2109: 
1.31      albertel 2110: sub csv_print_select_table {
                   2111:     my ($r,$records,$d) = @_;
                   2112:     my $i=0;my %sone;
                   2113:     %sone=&record_sep($$records[0]);
                   2114:     $r->print('Associate columns with student attributes.'."\n".
                   2115: 	     '<table border="2"><tr><th>Attribute</th><th>Column</th></tr>'."\n");
                   2116:     foreach (@$d) {
                   2117: 	my ($value,$display)=@{ $_ };
                   2118: 	$r->print('<tr><td>'.$display.'</td>');
                   2119: 
                   2120: 	$r->print('<td><select name=f'.$i.
1.32      matthew  2121: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.31      albertel 2122: 	$r->print('<option value="none"></option>');
                   2123: 	foreach (sort({$a <=> $b} keys(%sone))) {
                   2124: 	    $r->print('<option value="'.$_.'">Column '.($_+1).'</option>');
                   2125: 	}
                   2126: 	$r->print('</select></td></tr>'."\n");
                   2127: 	$i++;
                   2128:     }
                   2129:     $i--;
                   2130:     return $i;
                   2131: }
1.56      matthew  2132: 
                   2133: =pod
1.31      albertel 2134: 
1.41      ng       2135: =item csv_samples_select_table($r,$records,$d)
                   2136: 
                   2137: Prints a table of sample values from the upload and can make associate samples to internal names.
                   2138: 
                   2139: $r is an Apache Request ref,
                   2140: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
                   2141: $d is an array of 2 element arrays (internal name, displayed name)
                   2142: 
                   2143: =cut
                   2144: 
1.31      albertel 2145: sub csv_samples_select_table {
                   2146:     my ($r,$records,$d) = @_;
                   2147:     my %sone; my %stwo; my %sthree;
                   2148:     my $i=0;
                   2149: 
                   2150:     $r->print('<table border=2><tr><th>Field</th><th>Samples</th></tr>');
                   2151:     %sone=&record_sep($$records[0]);
                   2152:     if (defined($$records[1])) {%stwo=&record_sep($$records[1]);}
                   2153:     if (defined($$records[2])) {%sthree=&record_sep($$records[2]);}
                   2154: 
                   2155:     foreach (sort keys %sone) {
                   2156: 	$r->print('<tr><td><select name=f'.$i.
1.32      matthew  2157: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.31      albertel 2158: 	foreach (@$d) {
                   2159: 	    my ($value,$display)=@{ $_ };
                   2160: 	    $r->print('<option value='.$value.'>'.$display.'</option>');
                   2161: 	}
                   2162: 	$r->print('</select></td><td>');
                   2163: 	if (defined($sone{$_})) { $r->print($sone{$_}."</br>\n"); }
                   2164: 	if (defined($stwo{$_})) { $r->print($stwo{$_}."</br>\n"); }
                   2165: 	if (defined($sthree{$_})) { $r->print($sthree{$_}."</br>\n"); }
                   2166: 	$r->print('</td></tr>');
                   2167: 	$i++;
                   2168:     }
                   2169:     $i--;
                   2170:     return($i);
1.25      albertel 2171: }
1.84      albertel 2172: 
1.85      albertel 2173: =pod
                   2174: 
                   2175: =item check_if_partid_hidden($id,$symb,$udom,$uname)
                   2176: 
                   2177: Returns either 1 or undef
                   2178: 
                   2179: 1 if the part is to be hidden, undef if it is to be shown
                   2180: 
                   2181: Arguments are:
                   2182: 
                   2183: $id the id of the part to be checked
                   2184: $symb, optional the symb of the resource to check
                   2185: $udom, optional the domain of the user to check for
                   2186: $uname, optional the username of the user to check for
                   2187: 
                   2188: =cut
1.84      albertel 2189: 
                   2190: sub check_if_partid_hidden {
                   2191:     my ($id,$symb,$udom,$uname) = @_;
                   2192:     my $hiddenparts=&Apache::lonnet::EXT('resource.0.parameter_hiddenparts',
                   2193: 					 $symb,$udom,$uname);
                   2194:     my @hiddenlist=split(/,/,$hiddenparts);
                   2195:     foreach my $checkid (@hiddenlist) {
                   2196: 	if ($checkid =~ /^\s*\Q$id\E\s*$/) { return 1; }
                   2197:     }
                   2198:     return undef;
                   2199: }
                   2200: 
                   2201: 
                   2202: 
1.1       albertel 2203: 1;
                   2204: __END__;
1.17      harris41 2205: 
1.41      ng       2206: =pod
                   2207: 
                   2208: =back
                   2209: 
                   2210: =head2 Access .tab File Data
                   2211: 
                   2212: =over 4
                   2213: 
1.35      matthew  2214: =item languageids() 
1.17      harris41 2215: 
1.35      matthew  2216: returns list of all language ids
1.17      harris41 2217: 
1.35      matthew  2218: =item languagedescription() 
1.17      harris41 2219: 
1.35      matthew  2220: returns description of a specified language id
1.17      harris41 2221: 
1.35      matthew  2222: =item copyrightids() 
1.17      harris41 2223: 
1.35      matthew  2224: returns list of all copyrights
1.17      harris41 2225: 
1.35      matthew  2226: =item copyrightdescription() 
1.17      harris41 2227: 
1.35      matthew  2228: returns description of a specified copyright id
1.17      harris41 2229: 
1.35      matthew  2230: =item filecategories() 
1.17      harris41 2231: 
1.35      matthew  2232: returns list of all file categories
1.17      harris41 2233: 
1.35      matthew  2234: =item filecategorytypes() 
1.17      harris41 2235: 
1.35      matthew  2236: returns list of file types belonging to a given file
1.17      harris41 2237: category
                   2238: 
1.35      matthew  2239: =item fileembstyle() 
1.17      harris41 2240: 
1.35      matthew  2241: returns embedding style for a specified file type
1.17      harris41 2242: 
1.35      matthew  2243: =item filedescription() 
1.17      harris41 2244: 
1.35      matthew  2245: returns description for a specified file type
1.17      harris41 2246: 
1.35      matthew  2247: =item filedescriptionex() 
1.17      harris41 2248: 
1.35      matthew  2249: returns description for a specified file type with
1.17      harris41 2250: extra formatting
                   2251: 
1.41      ng       2252: =back
                   2253: 
                   2254: =head2 Alternate Problem Views
                   2255: 
                   2256: =over 4
                   2257: 
1.35      matthew  2258: =item get_previous_attempt() 
1.17      harris41 2259: 
1.35      matthew  2260: return string with previous attempt on problem
1.17      harris41 2261: 
1.35      matthew  2262: =item get_student_view() 
1.17      harris41 2263: 
1.35      matthew  2264: show a snapshot of what student was looking at
1.17      harris41 2265: 
1.35      matthew  2266: =item get_student_answers() 
1.17      harris41 2267: 
1.35      matthew  2268: show a snapshot of how student was answering problem
1.17      harris41 2269: 
1.41      ng       2270: =back
                   2271: 
                   2272: =head2 HTTP Helper
                   2273: 
                   2274: =over 4
                   2275: 
                   2276: =item get_unprocessed_cgi($query,$possible_names)
                   2277: 
                   2278: Modify the %ENV hash to contain unprocessed CGI form parameters held in
                   2279: $query.  The parameters listed in $possible_names (an array reference),
                   2280: will be set in $ENV{'form.name'} if they do not already exist.
1.17      harris41 2281: 
1.41      ng       2282: Typically called with $ENV{'QUERY_STRING'} as the first parameter.  
                   2283: $possible_names is an ref to an array of form element names.  As an example:
                   2284: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
                   2285: will result in $ENV{'form.uname'} and $ENV{'form.udom'} being set.
1.17      harris41 2286: 
1.35      matthew  2287: =item cacheheader() 
1.17      harris41 2288: 
1.35      matthew  2289: returns cache-controlling header code
1.17      harris41 2290: 
1.65      matthew  2291: =item no_cache($r) 
1.17      harris41 2292: 
1.35      matthew  2293: specifies header code to not have cache
1.25      albertel 2294: 
1.35      matthew  2295: =item add_to_env($name,$value) 
1.25      albertel 2296: 
1.35      matthew  2297: adds $name to the %ENV hash with value
1.25      albertel 2298: $value, if $name already exists, the entry is converted to an array
                   2299: reference and $value is added to the array.
1.17      harris41 2300: 
                   2301: =back
                   2302: 
                   2303: =cut

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