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

1.10      albertel    1: # The LearningOnline Network with CAPA
1.1       albertel    2: # a pile of common routines
1.10      albertel    3: #
1.52    ! matthew     4: # $Id: loncommon.pm,v 1.51 2002/08/08 13:43:04 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.17      harris41   30: # 12/11,12/12,12/17 Scott Harrison
1.18      www        31: # 12/21 Gerd Kortemeyer
1.20      www        32: # 12/21 Scott Harrison
1.22      www        33: # 12/25,12/28 Gerd Kortemeyer
1.23      www        34: # YEAR=2002
                     35: # 1/4 Gerd Kortemeyer
1.43      ng         36: # 6/24,7/2 H. K. Ng
1.1       albertel   37: 
                     38: # Makes a table out of the previous attempts
1.2       albertel   39: # Inputs result_from_symbread, user, domain, course_id
1.16      harris41   40: # Reads in non-network-related .tab files
1.1       albertel   41: 
1.35      matthew    42: # POD header:
                     43: 
1.45      matthew    44: =pod
                     45: 
1.35      matthew    46: =head1 NAME
                     47: 
                     48: Apache::loncommon - pile of common routines
                     49: 
                     50: =head1 SYNOPSIS
                     51: 
                     52: Referenced by other mod_perl Apache modules.
                     53: 
                     54: Invocation:
                     55:  &Apache::loncommon::SUBROUTINENAME(ARGUMENTS);
                     56: 
                     57: =head1 INTRODUCTION
                     58: 
                     59: Common collection of used subroutines.  This collection helps remove
                     60: redundancy from other modules and increase efficiency of memory usage.
                     61: 
                     62: Current things done:
                     63: 
                     64:  Makes a table out of the previous homework attempts
                     65:  Inputs result_from_symbread, user, domain, course_id
                     66:  Reads in non-network-related .tab files
                     67: 
                     68: This is part of the LearningOnline Network with CAPA project
                     69: described at http://www.lon-capa.org.
                     70: 
1.41      ng         71: =head2 General Subroutines
1.35      matthew    72: 
                     73: =over 4
                     74: 
                     75: =cut 
                     76: 
                     77: # End of POD header
1.1       albertel   78: package Apache::loncommon;
                     79: 
                     80: use strict;
1.22      www        81: use Apache::lonnet();
1.46      matthew    82: use GDBM_File;
1.51      www        83: use POSIX qw(strftime mktime);
1.1       albertel   84: use Apache::Constants qw(:common);
                     85: use Apache::lonmsg();
1.22      www        86: my $readit;
                     87: 
1.46      matthew    88: =pod 
                     89: 
                     90: =item Global Variables
                     91: 
                     92: =over 4
                     93: 
                     94: =cut
1.20      www        95: # ----------------------------------------------- Filetypes/Languages/Copyright
1.12      harris41   96: my %language;
                     97: my %cprtag;
                     98: my %fe; my %fd;
1.41      ng         99: my %category_extensions;
1.12      harris41  100: 
1.46      matthew   101: # ---------------------------------------------- Thesaurus variables
                    102: 
                    103: =pod
                    104: 
                    105: =item %Keywords  
                    106: 
                    107: A hash used by &keyword to determine if a word is considered a keyword.
                    108: 
                    109: =item $thesaurus_db_file
                    110: 
                    111: Scalar containing the full path to the thesaurus database.                 
                    112: 
                    113: =cut
                    114: 
                    115: my %Keywords;
                    116: my $thesaurus_db_file;
                    117: 
                    118: 
                    119: =pod
                    120: 
                    121: =back
                    122: 
                    123: =cut
1.20      www       124: 
1.12      harris41  125: # ----------------------------------------------------------------------- BEGIN
1.41      ng        126: 
                    127: =pod
                    128: 
1.35      matthew   129: =item BEGIN() 
                    130: 
                    131: Initialize values from language.tab, copyright.tab, filetypes.tab,
1.45      matthew   132: thesaurus.tab, and filecategories.tab.
1.35      matthew   133: 
                    134: =cut
1.45      matthew   135: 
1.35      matthew   136: # ----------------------------------------------------------------------- BEGIN
                    137: 
1.18      www       138: BEGIN {
1.46      matthew   139:     # Variable initialization
                    140:     $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
                    141:     #
1.22      www       142:     unless ($readit) {
1.12      harris41  143: # ------------------------------------------------------------------- languages
                    144:     {
                    145: 	my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
                    146: 				 '/language.tab');
1.16      harris41  147: 	if ($fh) {
                    148: 	    while (<$fh>) {
                    149: 		next if /^\#/;
                    150: 		chomp;
                    151: 		my ($key,$val)=(split(/\s+/,$_,2));
                    152: 		$language{$key}=$val;
                    153: 	    }
1.12      harris41  154: 	}
                    155:     }
                    156: # ------------------------------------------------------------------ copyrights
                    157:     {
1.16      harris41  158: 	my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonIncludes'}.
                    159: 				  '/copyright.tab');
                    160: 	if ($fh) {
                    161: 	    while (<$fh>) {
                    162: 		next if /^\#/;
                    163: 		chomp;
                    164: 		my ($key,$val)=(split(/\s+/,$_,2));
                    165: 		$cprtag{$key}=$val;
                    166: 	    }
1.12      harris41  167: 	}
                    168:     }
1.15      harris41  169: # ------------------------------------------------------------- file categories
                    170:     {
                    171: 	my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
1.16      harris41  172: 				  '/filecategories.tab');
                    173: 	if ($fh) {
                    174: 	    while (<$fh>) {
                    175: 		next if /^\#/;
                    176: 		chomp;
1.41      ng        177: 		my ($extension,$category)=(split(/\s+/,$_,2));
                    178: 		push @{$category_extensions{lc($category)}},$extension;
1.16      harris41  179: 	    }
1.15      harris41  180: 	}
                    181:     }
1.12      harris41  182: # ------------------------------------------------------------------ file types
                    183:     {
1.16      harris41  184: 	my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
                    185: 	       '/filetypes.tab');
                    186: 	if ($fh) {
                    187:             while (<$fh>) {
                    188: 		next if (/^\#/);
                    189: 		chomp;
                    190: 		my ($ending,$emb,$descr)=split(/\s+/,$_,3);
                    191: 		if ($descr ne '') { 
                    192: 		    $fe{$ending}=lc($emb);
                    193: 		    $fd{$ending}=$descr;
                    194: 		}
1.12      harris41  195: 	    }
                    196: 	}
                    197:     }
1.22      www       198:     &Apache::lonnet::logthis(
1.46      matthew   199:               "<font color=yellow>INFO: Read file types</font>");
1.22      www       200:     $readit=1;
1.46      matthew   201:     }  # end of unless($readit) 
1.32      matthew   202:     
                    203: }
                    204: # ============================================================= END BEGIN BLOCK
1.42      matthew   205: ###############################################################
                    206: ##           HTML and Javascript Helper Functions            ##
                    207: ###############################################################
                    208: 
                    209: =pod 
                    210: 
                    211: =item browser_and_searcher_javascript 
                    212: 
                    213: Returns scalar containing javascript to open a browser window
                    214: or a searcher window.  Also creates 
                    215: 
                    216: =over 4
                    217: 
                    218: =item openbrowser(formname,elementname,only,omit) [javascript]
                    219: 
                    220: inputs: formname, elementname, only, omit
                    221: 
                    222: formname and elementname indicate the name of the html form and name of
                    223: the element that the results of the browsing selection are to be placed in. 
                    224: 
                    225: Specifying 'only' will restrict the browser to displaying only files
                    226: with the given extension.  Can be a comma seperated list.
                    227: 
                    228: Specifying 'omit' will restrict the browser to NOT displaying files
                    229: with the given extension.  Can be a comma seperated list.
                    230: 
                    231: =item opensearcher(formname, elementname) [javascript]
                    232: 
                    233: Inputs: formname, elementname
                    234: 
                    235: formname and elementname specify the name of the html form and the name
                    236: of the element the selection from the search results will be placed in.
                    237: 
                    238: =back
                    239: 
                    240: =cut
                    241: 
                    242: ###############################################################
                    243: sub browser_and_searcher_javascript {
                    244:     return <<END;
1.50      matthew   245:     var editbrowser = null;
1.42      matthew   246:     function openbrowser(formname,elementname,only,omit) {
                    247:         var url = '/res/?';
                    248:         if (editbrowser == null) {
                    249:             url += 'launch=1&';
                    250:         }
                    251:         url += 'catalogmode=interactive&';
                    252:         url += 'mode=edit&';
                    253:         url += 'form=' + formname + '&';
                    254:         if (only != null) {
                    255:             url += 'only=' + only + '&';
                    256:         } 
                    257:         if (omit != null) {
                    258:             url += 'omit=' + omit + '&';
                    259:         }
                    260:         url += 'element=' + elementname + '';
                    261:         var title = 'Browser';
                    262:         var options = 'scrollbars=1,resizable=1,menubar=0';
                    263:         options += ',width=700,height=600';
                    264:         editbrowser = open(url,title,options,'1');
                    265:         editbrowser.focus();
                    266:     }
                    267:     var editsearcher;
                    268:     function opensearcher(formname,elementname) {
                    269:         var url = '/adm/searchcat?';
                    270:         if (editsearcher == null) {
                    271:             url += 'launch=1&';
                    272:         }
                    273:         url += 'catalogmode=interactive&';
                    274:         url += 'mode=edit&';
                    275:         url += 'form=' + formname + '&';
                    276:         url += 'element=' + elementname + '';
                    277:         var title = 'Search';
                    278:         var options = 'scrollbars=1,resizable=1,menubar=0';
                    279:         options += ',width=700,height=600';
                    280:         editsearcher = open(url,title,options,'1');
                    281:         editsearcher.focus();
                    282:     }
                    283: END
                    284: }
                    285: 
                    286: 
                    287: 
                    288: ###############################################################
                    289: 
                    290: =pod
1.36      matthew   291: 
                    292: =item linked_select_forms(...)
                    293: 
                    294: linked_select_forms returns a string containing a <script></script> block
                    295: and html for two <select> menus.  The select menus will be linked in that
                    296: changing the value of the first menu will result in new values being placed
                    297: in the second menu.  The values in the select menu will appear in alphabetical
                    298: order.
                    299: 
                    300: linked_select_forms takes the following ordered inputs:
                    301: 
                    302: =over 4
                    303: 
                    304: =item $formname, the name of the <form> tag
                    305: 
                    306: =item $middletext, the text which appears between the <select> tags
                    307: 
                    308: =item $firstdefault, the default value for the first menu
                    309: 
                    310: =item $firstselectname, the name of the first <select> tag
                    311: 
                    312: =item $secondselectname, the name of the second <select> tag
                    313: 
                    314: =item $hashref, a reference to a hash containing the data for the menus.
                    315: 
1.41      ng        316: =back 
                    317: 
1.36      matthew   318: Below is an example of such a hash.  Only the 'text', 'default', and 
                    319: 'select2' keys must appear as stated.  keys(%menu) are the possible 
                    320: values for the first select menu.  The text that coincides with the 
1.41      ng        321: first menu value is given in $menu{$choice1}->{'text'}.  The values 
1.36      matthew   322: and text for the second menu are given in the hash pointed to by 
                    323: $menu{$choice1}->{'select2'}.  
                    324: 
1.41      ng        325: my %menu = ( A1 => { text =>"Choice A1" ,
1.36      matthew   326:                       default => "B3",
                    327:                       select2 => { 
                    328:                           B1 => "Choice B1",
                    329:                           B2 => "Choice B2",
                    330:                           B3 => "Choice B3",
                    331:                           B4 => "Choice B4"
                    332:                           }
                    333:                   },
                    334:               A2 => { text =>"Choice A2" ,
                    335:                       default => "C2",
                    336:                       select2 => { 
                    337:                           C1 => "Choice C1",
                    338:                           C2 => "Choice C2",
                    339:                           C3 => "Choice C3"
                    340:                           }
                    341:                   },
                    342:               A3 => { text =>"Choice A3" ,
                    343:                       default => "D6",
                    344:                       select2 => { 
                    345:                           D1 => "Choice D1",
                    346:                           D2 => "Choice D2",
                    347:                           D3 => "Choice D3",
                    348:                           D4 => "Choice D4",
                    349:                           D5 => "Choice D5",
                    350:                           D6 => "Choice D6",
                    351:                           D7 => "Choice D7"
                    352:                           }
                    353:                   }
                    354:               );
                    355: 
                    356: =cut
                    357: 
                    358: # ------------------------------------------------
                    359: 
                    360: sub linked_select_forms {
                    361:     my ($formname,
                    362:         $middletext,
                    363:         $firstdefault,
                    364:         $firstselectname,
                    365:         $secondselectname, 
                    366:         $hashref
                    367:         ) = @_;
                    368:     my $second = "document.$formname.$secondselectname";
                    369:     my $first = "document.$formname.$firstselectname";
                    370:     # output the javascript to do the changing
                    371:     my $result = '';
                    372:     $result.="<script>\n";
                    373:     $result.="var select2data = new Object();\n";
                    374:     $" = '","';
                    375:     my $debug = '';
                    376:     foreach my $s1 (sort(keys(%$hashref))) {
                    377:         $result.="select2data.d_$s1 = new Object();\n";        
                    378:         $result.="select2data.d_$s1.def = new String('".
                    379:             $hashref->{$s1}->{'default'}."');\n";
                    380:         $result.="select2data.d_$s1.values = new Array(";        
                    381:         my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
                    382:         $result.="\"@s2values\");\n";
                    383:         $result.="select2data.d_$s1.texts = new Array(";        
                    384:         my @s2texts;
                    385:         foreach my $value (@s2values) {
                    386:             push @s2texts, $hashref->{$s1}->{'select2'}->{$value};
                    387:         }
                    388:         $result.="\"@s2texts\");\n";
                    389:     }
                    390:     $"=' ';
                    391:     $result.= <<"END";
                    392: 
                    393: function select1_changed() {
                    394:     // Determine new choice
                    395:     var newvalue = "d_" + $first.value;
                    396:     // update select2
                    397:     var values     = select2data[newvalue].values;
                    398:     var texts      = select2data[newvalue].texts;
                    399:     var select2def = select2data[newvalue].def;
                    400:     var i;
                    401:     // out with the old
                    402:     for (i = 0; i < $second.options.length; i++) {
                    403:         $second.options[i] = null;
                    404:     }
                    405:     // in with the nuclear
                    406:     for (i=0;i<values.length; i++) {
                    407:         $second.options[i] = new Option(values[i]);
                    408:         $second.options[i].text = texts[i];
                    409:         if (values[i] == select2def) {
                    410:             $second.options[i].selected = true;
                    411:         }
                    412:     }
                    413: }
                    414: </script>
                    415: END
                    416:     # output the initial values for the selection lists
                    417:     $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed()\">\n";
                    418:     foreach my $value (sort(keys(%$hashref))) {
                    419:         $result.="    <option value=\"$value\" ";
                    420:         $result.=" selected=\"true\" " if ($value eq $firstdefault);
                    421:         $result.=">$hashref->{$value}->{'text'}</option>\n";
                    422:     }
                    423:     $result .= "</select>\n";
                    424:     my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
                    425:     $result .= $middletext;
                    426:     $result .= "<select size=\"1\" name=\"$secondselectname\">\n";
                    427:     my $seconddefault = $hashref->{$firstdefault}->{'default'};
                    428:     foreach my $value (sort(keys(%select2))) {
                    429:         $result.="    <option value=\"$value\" ";        
                    430:         $result.=" selected=\"true\" " if ($value eq $seconddefault);
                    431:         $result.=">$select2{$value}</option>\n";
                    432:     }
                    433:     $result .= "</select>\n";
                    434:     #    return $debug;
                    435:     return $result;
                    436: }   #  end of sub linked_select_forms {
                    437: 
1.33      matthew   438: ###############################################################
1.44      bowersj2  439: 
1.45      matthew   440: =pod
1.44      bowersj2  441: 
1.48      bowersj2  442: =item help_open_topic($topic, $text, $stayOnPage, $width, $height)
1.44      bowersj2  443: 
                    444: 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.
                    445: 
1.48      bowersj2  446: $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.
                    447: 
1.44      bowersj2  448: $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.)
                    449: 
                    450: $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.
                    451: 
                    452: =cut
                    453: 
                    454: sub help_open_topic {
1.48      bowersj2  455:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
                    456:     $text = "" if (not defined $text);
1.44      bowersj2  457:     $stayOnPage = 0 if (not defined $stayOnPage);
                    458:     $width = 350 if (not defined $width);
                    459:     $height = 400 if (not defined $height);
                    460:     my $filename = $topic;
                    461:     $filename =~ s/ /_/g;
                    462: 
1.48      bowersj2  463:     my $template = "";
                    464:     my $link;
1.44      bowersj2  465: 
                    466:     if (!$stayOnPage)
                    467:     {
1.48      bowersj2  468: 	$link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height'))";
1.44      bowersj2  469:     }
                    470:     else
                    471:     {
1.48      bowersj2  472: 	$link = "/adm/help/${filename}.hlp";
                    473:     }
                    474: 
                    475:     # Add the text
                    476:     if ($text ne "")
                    477:     {
                    478: 	$template .= "<a href=\"$link\">$text</a> ";
                    479:     }
                    480: 
                    481:     # Add the graphic
                    482:     $template .= <<"ENDTEMPLATE";
                    483: <a href="$link"><image src="/adm/help/gif/smallHelp.gif" border="0" alt="(Help: $topic)"></a>
1.44      bowersj2  484: ENDTEMPLATE
                    485: 
                    486:     return $template;
                    487: 
                    488: }
1.37      matthew   489: 
1.45      matthew   490: =pod
                    491: 
1.37      matthew   492: =item csv_translate($text) 
                    493: 
                    494: Translate $text to allow it to be output as a 'comma seperated values' 
                    495: format.
                    496: 
                    497: =cut
                    498: 
                    499: sub csv_translate {
                    500:     my $text = shift;
                    501:     $text =~ s/\"/\"\"/g;
                    502:     $text =~ s/\n//g;
                    503:     return $text;
                    504: }
                    505: 
                    506: ###############################################################
1.33      matthew   507: ##        Home server <option> list generating code          ##
                    508: ###############################################################
1.35      matthew   509: #-------------------------------------------
                    510: 
1.45      matthew   511: =pod
                    512: 
1.35      matthew   513: =item get_domains()
                    514: 
                    515: Returns an array containing each of the domains listed in the hosts.tab
                    516: file.
                    517: 
                    518: =cut
                    519: 
                    520: #-------------------------------------------
1.34      matthew   521: sub get_domains {
                    522:     # The code below was stolen from "The Perl Cookbook", p 102, 1st ed.
                    523:     my @domains;
                    524:     my %seen;
                    525:     foreach (sort values(%Apache::lonnet::hostdom)) {
                    526:         push (@domains,$_) unless $seen{$_}++;
                    527:     }
                    528:     return @domains;
                    529: }
                    530: 
1.35      matthew   531: #-------------------------------------------
                    532: 
1.45      matthew   533: =pod
                    534: 
1.35      matthew   535: =item select_dom_form($defdom,$name)
                    536: 
                    537: Returns a string containing a <select name='$name' size='1'> form to 
                    538: allow a user to select the domain to preform an operation in.  
                    539: See loncreateuser.pm for an example invocation and use.
                    540: 
                    541: =cut
                    542: 
                    543: #-------------------------------------------
1.34      matthew   544: sub select_dom_form {
                    545:     my ($defdom,$name) = @_;
                    546:     my @domains = get_domains();
                    547:     my $selectdomain = "<select name=\"$name\" size=\"1\">\n";
                    548:     foreach (@domains) {
                    549:         $selectdomain.="<option value=\"$_\" ".
                    550:             ($_ eq $defdom ? 'selected' : '').
                    551:                 ">$_</option>\n";
                    552:     }
                    553:     $selectdomain.="</select>";
                    554:     return $selectdomain;
                    555: }
                    556: 
1.35      matthew   557: #-------------------------------------------
                    558: 
1.45      matthew   559: =pod
                    560: 
1.52    ! matthew   561: =item get_library_servers($domain)
1.35      matthew   562: 
                    563: Returns a hash which contains keys like '103l3' and values like 
                    564: 'kirk.lite.msu.edu'.  All of the keys will be for machines in the
                    565: given $domain.
                    566: 
                    567: =cut
                    568: 
                    569: #-------------------------------------------
1.52    ! matthew   570: sub get_library_servers {
1.33      matthew   571:     my $domain = shift;
1.52    ! matthew   572:     my %library_servers;
1.33      matthew   573:     foreach (keys(%Apache::lonnet::libserv)) {
                    574:         if ($Apache::lonnet::hostdom{$_} eq $domain) {
1.52    ! matthew   575:             $library_servers{$_} = $Apache::lonnet::hostname{$_};
1.33      matthew   576:         }
                    577:     }
1.52    ! matthew   578:     return %library_servers;
1.33      matthew   579: }
                    580: 
1.35      matthew   581: #-------------------------------------------
                    582: 
1.45      matthew   583: =pod
                    584: 
1.35      matthew   585: =item home_server_option_list($domain)
                    586: 
                    587: returns a string which contains an <option> list to be used in a 
                    588: <select> form input.  See loncreateuser.pm for an example.
                    589: 
                    590: =cut
                    591: 
                    592: #-------------------------------------------
1.33      matthew   593: sub home_server_option_list {
                    594:     my $domain = shift;
1.52    ! matthew   595:     my %servers = &get_library_servers($domain);
1.33      matthew   596:     my $result = '';
                    597:     foreach (sort keys(%servers)) {
                    598:         $result.=
                    599:             '<option value="'.$_.'">'.$_.' '.$servers{$_}."</option>\n";
                    600:     }
                    601:     return $result;
                    602: }
                    603: ###############################################################
                    604: ##    End of home server <option> list generating code       ##
                    605: ###############################################################
1.32      matthew   606: 
                    607: ###############################################################
                    608: ##    Authentication changing form generation subroutines    ##
                    609: ###############################################################
                    610: ##
                    611: ## All of the authform_xxxxxxx subroutines take their inputs in a
                    612: ## hash, and have reasonable default values.
                    613: ##
                    614: ##    formname = the name given in the <form> tag.
1.35      matthew   615: #-------------------------------------------
                    616: 
1.45      matthew   617: =pod
                    618: 
1.35      matthew   619: =item authform_xxxxxx
                    620: 
                    621: The authform_xxxxxx subroutines provide javascript and html forms which 
                    622: handle some of the conveniences required for authentication forms.  
                    623: This is not an optimal method, but it works.  
                    624: 
                    625: See loncreateuser.pm for invocation and use examples.
                    626: 
                    627: =over 4
                    628: 
                    629: =item authform_header
                    630: 
                    631: =item authform_authorwarning
                    632: 
                    633: =item authform_nochange
                    634: 
                    635: =item authform_kerberos
                    636: 
                    637: =item authform_internal
                    638: 
                    639: =item authform_filesystem
                    640: 
                    641: =back
                    642: 
                    643: =cut
                    644: 
                    645: #-------------------------------------------
1.32      matthew   646: sub authform_header{  
                    647:     my %in = (
                    648:         formname => 'cu',
                    649:         kerb_def_dom => 'MSU.EDU',
                    650:         @_,
                    651:     );
                    652:     $in{'formname'} = 'document.' . $in{'formname'};
                    653:     my $result='';
                    654:     $result.=<<"END";
                    655: var current = new Object();
                    656: current.radiovalue = 'nochange';
                    657: current.argfield = null;
                    658: 
                    659: function changed_radio(choice,currentform) {
                    660:     var choicearg = choice + 'arg';
                    661:     // If a radio button in changed, we need to change the argfield
                    662:     if (current.radiovalue != choice) {
                    663:         current.radiovalue = choice;
                    664:         if (current.argfield != null) {
                    665:             currentform.elements[current.argfield].value = '';
                    666:         }
                    667:         if (choice == 'nochange') {
                    668:             current.argfield = null;
                    669:         } else {
                    670:             current.argfield = choicearg;
                    671:             switch(choice) {
                    672:                 case 'krb': 
                    673:                     currentform.elements[current.argfield].value = 
                    674:                         "$in{'kerb_def_dom'}";
                    675:                 break;
                    676:               default:
                    677:                 break;
                    678:             }
                    679:         }
                    680:     }
                    681:     return;
                    682: }
1.22      www       683: 
1.32      matthew   684: function changed_text(choice,currentform) {
                    685:     var choicearg = choice + 'arg';
                    686:     if (currentform.elements[choicearg].value !='') {
                    687:         switch (choice) {
                    688:             case 'krb': currentform.elements[choicearg].value =
                    689:                 currentform.elements[choicearg].value.toUpperCase();
                    690:                 break;
                    691:             default:
                    692:         }
                    693:         // clear old field
                    694:         if ((current.argfield != choicearg) && (current.argfield != null)) {
                    695:             currentform.elements[current.argfield].value = '';
                    696:         }
                    697:         current.argfield = choicearg;
                    698:     }
                    699:     set_auth_radio_buttons(choice,currentform);
                    700:     return;
1.20      www       701: }
1.32      matthew   702: 
                    703: function set_auth_radio_buttons(newvalue,currentform) {
                    704:     var i=0;
                    705:     while (i < currentform.login.length) {
                    706:         if (currentform.login[i].value == newvalue) { break; }
                    707:         i++;
                    708:     }
                    709:     if (i == currentform.login.length) {
                    710:         return;
                    711:     }
                    712:     current.radiovalue = newvalue;
                    713:     currentform.login[i].checked = true;
                    714:     return;
                    715: }
                    716: END
                    717:     return $result;
                    718: }
                    719: 
                    720: sub authform_authorwarning{
                    721:     my $result='';
                    722:     $result=<<"END";
                    723: <i>As a general rule, only authors or co-authors should be filesystem
                    724: authenticated (which allows access to the server filesystem).</i>
                    725: END
                    726:     return $result;
                    727: }
                    728: 
                    729: sub authform_nochange{  
                    730:     my %in = (
                    731:               formname => 'document.cu',
                    732:               kerb_def_dom => 'MSU.EDU',
                    733:               @_,
                    734:           );
                    735:     my $result='';
                    736:     $result.=<<"END";
                    737: <input type="radio" name="login" value="nochange" checked="checked"
                    738:        onclick="javascript:changed_radio('nochange',$in{'formname'});">
                    739: Do not change login data
                    740: END
                    741:     return $result;
                    742: }
                    743: 
                    744: sub authform_kerberos{  
                    745:     my %in = (
                    746:               formname => 'document.cu',
                    747:               kerb_def_dom => 'MSU.EDU',
                    748:               @_,
                    749:               );
                    750:     my $result='';
                    751:     $result.=<<"END";
                    752: <input type="radio" name="login" value="krb" 
                    753:        onclick="javascript:changed_radio('krb',$in{'formname'});"
                    754:        onchange="javascript:changed_radio('krb',$in{'formname'});">
                    755: Kerberos authenticated with domain
                    756: <input type="text" size="10" name="krbarg" value=""
                    757:        onchange="javascript:changed_text('krb',$in{'formname'});">
                    758: END
                    759:     return $result;
                    760: }
                    761: 
                    762: sub authform_internal{  
                    763:     my %args = (
                    764:                 formname => 'document.cu',
                    765:                 kerb_def_dom => 'MSU.EDU',
                    766:                 @_,
                    767:                 );
                    768:     my $result='';
                    769:     $result.=<<"END";
                    770: <input type="radio" name="login" value="int"
                    771:        onchange="javascript:changed_radio('int',$args{'formname'});"
                    772:        onclick="javascript:changed_radio('int',$args{'formname'});">
                    773: Internally authenticated (with initial password 
                    774: <input type="text" size="10" name="intarg" value=""
                    775:        onchange="javascript:changed_text('int',$args{'formname'});">
                    776: END
                    777:     return $result;
                    778: }
                    779: 
                    780: sub authform_local{  
                    781:     my %in = (
                    782:               formname => 'document.cu',
                    783:               kerb_def_dom => 'MSU.EDU',
                    784:               @_,
                    785:               );
                    786:     my $result='';
                    787:     $result.=<<"END";
                    788: <input type="radio" name="login" value="loc"
                    789:        onchange="javascript:changed_radio('loc',$in{'formname'});"
                    790:        onclick="javascript:changed_radio('loc',$in{'formname'});"> 
                    791: Local Authentication with argument
                    792: <input type="text" size="10" name="locarg" value=""
                    793:        onchange="javascript:changed_text('loc',$in{'formname'});">
                    794: END
                    795:     return $result;
                    796: }
                    797: 
                    798: sub authform_filesystem{  
                    799:     my %in = (
                    800:               formname => 'document.cu',
                    801:               kerb_def_dom => 'MSU.EDU',
                    802:               @_,
                    803:               );
                    804:     my $result='';
                    805:     $result.=<<"END";
                    806: <input type="radio" name="login" value="fsys" 
                    807:        onchange="javascript:changed_radio('fsys',$in{'formname'});"
                    808:        onclick="javascript:changed_radio('fsys',$in{'formname'});"> 
                    809: Filesystem authenticated (with initial password 
                    810: <input type="text" size="10" name="fsysarg" value=""
                    811:        onchange="javascript:changed_text('fsys',$in{'formname'});">
                    812: END
                    813:     return $result;
                    814: }
                    815: 
                    816: ###############################################################
                    817: ##   End Authentication changing form generation functions   ##
                    818: ###############################################################
                    819: 
1.46      matthew   820: ###############################################################
                    821: ##                Thesaurus Functions                        ##
                    822: ###############################################################
1.20      www       823: 
1.46      matthew   824: =pod
1.20      www       825: 
1.46      matthew   826: =item initialize_keywords
                    827: 
                    828: Initializes the package variable %Keywords if it is empty.  Uses the
                    829: package variable $thesaurus_db_file.
                    830: 
                    831: =cut
                    832: 
                    833: ###################################################
                    834: 
                    835: sub initialize_keywords {
                    836:     return 1 if (scalar keys(%Keywords));
                    837:     # If we are here, %Keywords is empty, so fill it up
                    838:     #   Make sure the file we need exists...
                    839:     if (! -e $thesaurus_db_file) {
                    840:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
                    841:                                  " failed because it does not exist");
                    842:         return 0;
                    843:     }
                    844:     #   Set up the hash as a database
                    845:     my %thesaurus_db;
                    846:     if (! tie(%thesaurus_db,'GDBM_File',
                    847:               $thesaurus_db_file,&GDBM_READER,0640)){
                    848:         &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
                    849:                                  $thesaurus_db_file);
                    850:         return 0;
                    851:     } 
                    852:     #  Get the average number of appearances of a word.
                    853:     my $avecount = $thesaurus_db{'average.count'};
                    854:     #  Put keywords (those that appear > average) into %Keywords
                    855:     while (my ($word,$data)=each (%thesaurus_db)) {
                    856:         my ($count,undef) = split /:/,$data;
                    857:         $Keywords{$word}++ if ($count > $avecount);
                    858:     }
                    859:     untie %thesaurus_db;
                    860:     # Remove special values from %Keywords.
                    861:     foreach ('total.count','average.count') {
                    862:         delete($Keywords{$_}) if (exists($Keywords{$_}));
                    863:     }
                    864:     return 1;
                    865: }
                    866: 
                    867: ###################################################
                    868: 
                    869: =pod
                    870: 
                    871: =item keyword($word)
                    872: 
                    873: Returns true if $word is a keyword.  A keyword is a word that appears more 
                    874: than the average number of times in the thesaurus database.  Calls 
                    875: &initialize_keywords
                    876: 
                    877: =cut
                    878: 
                    879: ###################################################
1.20      www       880: 
                    881: sub keyword {
1.46      matthew   882:     return if (!&initialize_keywords());
                    883:     my $word=lc(shift());
                    884:     $word=~s/\W//g;
                    885:     return exists($Keywords{$word});
1.20      www       886: }
1.46      matthew   887: 
                    888: ###################################################
                    889: #         Old code, to be removed soon            #
                    890: ###################################################
1.20      www       891: # -------------------------------------------------------- Return related words
1.46      matthew   892: #sub related {
                    893: #    my $newword=shift;
                    894: #    $newword=~s/\W//g;
                    895: #    $newword=~tr/A-Z/a-z/;
                    896: #    my $tindex=$theindex{$newword};
                    897: #    if ($tindex) {
                    898: #        my %found=();
                    899: #        foreach (split(/\,/,$therelated[$tindex])) {
                    900: ## - Related word found
                    901: #            my ($ridx,$rcount)=split(/\:/,$_);
                    902: ## - Direct relation index
                    903: #            my $directrel=$rcount/$thecount[$tindex];
                    904: #            if ($directrel>$thethreshold) {
                    905: #               foreach (split(/\,/,$therelated[$ridx])) {
                    906: #                  my ($rridx,$rrcount)=split(/\:/,$_);
                    907: #                  if ($rridx==$tindex) {
                    908: ## - Determine reverse relation index
                    909: #                     my $revrel=$rrcount/$thecount[$ridx];
                    910: ## - Calculate full index
                    911: #                     $found{$ridx}=$directrel*$revrel;
                    912: #                     if ($found{$ridx}>$thethreshold) {
                    913: #                        foreach (split(/\,/,$therelated[$ridx])) {
                    914: #                            my ($rrridx,$rrrcount)=split(/\:/,$_);
                    915: #                            unless ($found{$rrridx}) {
                    916: #                               my $revrevrel=$rrrcount/$thecount[$ridx];
                    917: #                               if (
                    918: #                          $directrel*$revrel*$revrevrel>$thethreshold
                    919: #                               ) {
                    920: #                                  $found{$rrridx}=
                    921: #                                       $directrel*$revrel*$revrevrel;
                    922: #                               }
                    923: #                            }
                    924: #                        }
                    925: #                     }
                    926: #                  }
                    927: #               }
                    928: #            }
                    929: #        }
                    930: #    }
                    931: #    return ();
                    932: #}
                    933: 
                    934: ###############################################################
                    935: 
                    936: =pod 
1.20      www       937: 
1.46      matthew   938: =item get_related_words
                    939: 
                    940: Look up a word in the thesaurus.  Takes a scalar arguement and returns
                    941: an array of words.  If the keyword is not in the thesaurus, an empty array
                    942: will be returned.  The order of the words returned is determined by the
                    943: database which holds them.
                    944: 
                    945: Uses global $thesaurus_db_file.
                    946: 
                    947: =cut
                    948: 
                    949: ###############################################################
                    950: 
                    951: sub get_related_words {
                    952:     my $keyword = shift;
                    953:     my %thesaurus_db;
                    954:     if (! -e $thesaurus_db_file) {
                    955:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
                    956:                                  "failed because the file does not exist");
                    957:         return ();
                    958:     }
                    959:     if (! tie(%thesaurus_db,'GDBM_File',
                    960:               $thesaurus_db_file,&GDBM_READER,0640)){
                    961:         return ();
                    962:     } 
                    963:     my @Words=();
                    964:     if (exists($thesaurus_db{$keyword})) {
                    965:         $_ = $thesaurus_db{$keyword};
                    966:         (undef,@Words) = split/:/;  # The first element is the number of times
                    967:                                     # the word appears.  We do not need it now.
                    968:         for (my $i=0;$i<=$#Words;$i++) {
                    969:             ($Words[$i],undef)= split/\,/,$Words[$i];
1.20      www       970:         }
                    971:     }
1.46      matthew   972:     untie %thesaurus_db;
                    973:     return @Words;
1.14      harris41  974: }
1.46      matthew   975: 
                    976: ###############################################################
                    977: ##              End Thesaurus Functions                      ##
                    978: ###############################################################
1.14      harris41  979: 
                    980: # ---------------------------------------------------------------- Language IDs
                    981: sub languageids {
1.16      harris41  982:     return sort(keys(%language));
1.14      harris41  983: }
                    984: 
                    985: # -------------------------------------------------------- Language Description
                    986: sub languagedescription {
1.16      harris41  987:     return $language{shift(@_)};
1.14      harris41  988: }
                    989: 
                    990: # --------------------------------------------------------------- Copyright IDs
                    991: sub copyrightids {
1.16      harris41  992:     return sort(keys(%cprtag));
1.14      harris41  993: }
                    994: 
                    995: # ------------------------------------------------------- Copyright Description
                    996: sub copyrightdescription {
1.16      harris41  997:     return $cprtag{shift(@_)};
1.14      harris41  998: }
                    999: 
                   1000: # ------------------------------------------------------------- File Categories
                   1001: sub filecategories {
1.41      ng       1002:     return sort(keys(%category_extensions));
1.15      harris41 1003: }
1.14      harris41 1004: 
1.17      harris41 1005: # -------------------------------------- File Types within a specified category
1.15      harris41 1006: sub filecategorytypes {
1.41      ng       1007:     return @{$category_extensions{lc($_[0])}};
1.14      harris41 1008: }
                   1009: 
                   1010: # ------------------------------------------------------------------ File Types
                   1011: sub fileextensions {
1.16      harris41 1012:     return sort(keys(%fe));
1.14      harris41 1013: }
                   1014: 
                   1015: # ------------------------------------------------------------- Embedding Style
                   1016: sub fileembstyle {
1.16      harris41 1017:     return $fe{lc(shift(@_))};
1.14      harris41 1018: }
                   1019: 
                   1020: # ------------------------------------------------------------ Description Text
                   1021: sub filedescription {
1.16      harris41 1022:     return $fd{lc(shift(@_))};
                   1023: }
                   1024: 
                   1025: # ------------------------------------------------------------ Description Text
                   1026: sub filedescriptionex {
                   1027:     my $ex=shift;
                   1028:     return '.'.$ex.' '.$fd{lc($ex)};
1.12      harris41 1029: }
1.1       albertel 1030: 
1.40      ng       1031: # ---- Retrieve attempts by students
                   1032: # input
                   1033: # $symb             - problem including path
                   1034: # $username,$domain - that of the student
                   1035: # $course           - course name
                   1036: # $getattempt       - leave blank if want all attempts, else put something.
1.43      ng       1037: # $regexp           - regular expression. If string matches regexp send to
                   1038: # $gradesub         - routine that process the string if it matches regexp
1.40      ng       1039: # 
                   1040: # output
                   1041: # formatted as a table all the attempts, if any.
                   1042: #
1.1       albertel 1043: sub get_previous_attempt {
1.43      ng       1044:   my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub)=@_;
1.1       albertel 1045:   my $prevattempts='';
1.43      ng       1046:   no strict 'refs';
1.1       albertel 1047:   if ($symb) {
1.3       albertel 1048:     my (%returnhash)=
                   1049:       &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1       albertel 1050:     if ($returnhash{'version'}) {
                   1051:       my %lasthash=();
                   1052:       my $version;
                   1053:       for ($version=1;$version<=$returnhash{'version'};$version++) {
1.19      harris41 1054:         foreach (sort(split(/\:/,$returnhash{$version.':keys'}))) {
1.1       albertel 1055: 	  $lasthash{$_}=$returnhash{$version.':'.$_};
1.19      harris41 1056:         }
1.1       albertel 1057:       }
1.43      ng       1058:       $prevattempts='<table border="0" width="100%"><tr><td bgcolor="#777777">';
1.40      ng       1059:       $prevattempts.='<table border="0" width="100%"><tr bgcolor="#e6ffff"><td>History</td>';
1.16      harris41 1060:       foreach (sort(keys %lasthash)) {
1.31      albertel 1061: 	my ($ign,@parts) = split(/\./,$_);
1.41      ng       1062: 	if ($#parts > 0) {
1.31      albertel 1063: 	  my $data=$parts[-1];
                   1064: 	  pop(@parts);
1.40      ng       1065: 	  $prevattempts.='<td>Part '.join('.',@parts).'<br />'.$data.'&nbsp;</td>';
1.31      albertel 1066: 	} else {
1.41      ng       1067: 	  if ($#parts == 0) {
                   1068: 	    $prevattempts.='<th>'.$parts[0].'</th>';
                   1069: 	  } else {
                   1070: 	    $prevattempts.='<th>'.$ign.'</th>';
                   1071: 	  }
1.31      albertel 1072: 	}
1.16      harris41 1073:       }
1.40      ng       1074:       if ($getattempt eq '') {
                   1075: 	for ($version=1;$version<=$returnhash{'version'};$version++) {
                   1076: 	  $prevattempts.='</tr><tr bgcolor="#ffffe6"><td>Transaction '.$version.'</td>';
                   1077: 	    foreach (sort(keys %lasthash)) {
                   1078: 	       my $value;
                   1079: 	       if ($_ =~ /timestamp/) {
                   1080: 		  $value=scalar(localtime($returnhash{$version.':'.$_}));
                   1081: 	       } else {
                   1082: 		  $value=$returnhash{$version.':'.$_};
                   1083: 	       }
                   1084: 	       $prevattempts.='<td>'.$value.'&nbsp;</td>';   
                   1085: 	    }
                   1086: 	 }
1.1       albertel 1087:       }
1.40      ng       1088:       $prevattempts.='</tr><tr bgcolor="#ffffe6"><td>Current</td>';
1.16      harris41 1089:       foreach (sort(keys %lasthash)) {
1.5       albertel 1090: 	my $value;
                   1091: 	if ($_ =~ /timestamp/) {
                   1092: 	  $value=scalar(localtime($lasthash{$_}));
                   1093: 	} else {
                   1094: 	  $value=$lasthash{$_};
                   1095: 	}
1.49      ng       1096: 	if ($_ =~/$regexp$/ && (defined &$gradesub)) {$value = &$gradesub($value)}
1.40      ng       1097: 	$prevattempts.='<td>'.$value.'&nbsp;</td>';
1.16      harris41 1098:       }
1.40      ng       1099:       $prevattempts.='</tr></table></td></tr></table>';
1.1       albertel 1100:     } else {
                   1101:       $prevattempts='Nothing submitted - no attempts.';
                   1102:     }
                   1103:   } else {
                   1104:     $prevattempts='No data.';
                   1105:   }
1.10      albertel 1106: }
                   1107: 
                   1108: sub get_student_view {
                   1109:   my ($symb,$username,$domain,$courseid) = @_;
                   1110:   my ($map,$id,$feedurl) = split(/___/,$symb);
                   1111:   my (%old,%moreenv);
                   1112:   my @elements=('symb','courseid','domain','username');
                   1113:   foreach my $element (@elements) {
                   1114:     $old{$element}=$ENV{'form.grade_'.$element};
                   1115:     $moreenv{'form.grade_'.$element}=eval '$'.$element #'
                   1116:   }
1.11      albertel 1117:   &Apache::lonnet::appenv(%moreenv);
                   1118:   my $userview=&Apache::lonnet::ssi('/res/'.$feedurl);
                   1119:   &Apache::lonnet::delenv('form.grade_');
                   1120:   foreach my $element (@elements) {
                   1121:     $ENV{'form.grade_'.$element}=$old{$element};
                   1122:   }
                   1123:   $userview=~s/\<body[^\>]*\>//gi;
                   1124:   $userview=~s/\<\/body\>//gi;
                   1125:   $userview=~s/\<html\>//gi;
                   1126:   $userview=~s/\<\/html\>//gi;
                   1127:   $userview=~s/\<head\>//gi;
                   1128:   $userview=~s/\<\/head\>//gi;
                   1129:   $userview=~s/action\s*\=/would_be_action\=/gi;
                   1130:   return $userview;
                   1131: }
                   1132: 
                   1133: sub get_student_answers {
                   1134:   my ($symb,$username,$domain,$courseid) = @_;
                   1135:   my ($map,$id,$feedurl) = split(/___/,$symb);
                   1136:   my (%old,%moreenv);
                   1137:   my @elements=('symb','courseid','domain','username');
                   1138:   foreach my $element (@elements) {
                   1139:     $old{$element}=$ENV{'form.grade_'.$element};
                   1140:     $moreenv{'form.grade_'.$element}=eval '$'.$element #'
                   1141:   }
                   1142:   $moreenv{'form.grade_target'}='answer';
1.10      albertel 1143:   &Apache::lonnet::appenv(%moreenv);
                   1144:   my $userview=&Apache::lonnet::ssi('/res/'.$feedurl);
                   1145:   &Apache::lonnet::delenv('form.grade_');
                   1146:   foreach my $element (@elements) {
                   1147:     $ENV{'form.grade_'.$element}=$old{$element};
                   1148:   }
                   1149:   return $userview;
1.1       albertel 1150: }
1.37      matthew  1151: 
                   1152: ###############################################
1.51      www      1153: 
                   1154: 
                   1155: sub timehash {
                   1156:     my @ltime=localtime(shift);
                   1157:     return ( 'seconds' => $ltime[0],
                   1158:              'minutes' => $ltime[1],
                   1159:              'hours'   => $ltime[2],
                   1160:              'day'     => $ltime[3],
                   1161:              'month'   => $ltime[4]+1,
                   1162:              'year'    => $ltime[5]+1900,
                   1163:              'weekday' => $ltime[6],
                   1164:              'dayyear' => $ltime[7]+1,
                   1165:              'dlsav'   => $ltime[8] );
                   1166: }
                   1167: 
                   1168: sub maketime {
                   1169:     my %th=@_;
                   1170:     return POSIX::mktime(
                   1171:         ($th{'seconds'},$th{'minutes'},$th{'hours'},
                   1172:          $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,$th{'dlsav'}));
                   1173: }
                   1174: 
                   1175: 
                   1176: sub findallcourses {
                   1177:     my %courses=();
                   1178:     my $now=time;
                   1179:     foreach (keys %ENV) {
                   1180: 	if ($_=~/^user\.role\.\w+\.\/(\w+)\/(\w+)/) {
                   1181: 	    my ($starttime,$endtime)=$ENV{$_};
                   1182:             my $active=1;
                   1183:             if ($starttime) {
                   1184: 		if ($now<$starttime) { $active=0; }
                   1185:             }
                   1186:             if ($endtime) {
                   1187:                 if ($now>$endtime) { $active=0; }
                   1188:             }
                   1189:             if ($active) { $courses{$1.'_'.$2}=1; }
                   1190:         }
                   1191:     }
                   1192:     return keys %courses;
                   1193: }
1.37      matthew  1194: 
                   1195: ###############################################
1.1       albertel 1196: 
1.6       albertel 1197: sub get_unprocessed_cgi {
1.25      albertel 1198:   my ($query,$possible_names)= @_;
1.26      matthew  1199:   # $Apache::lonxml::debug=1;
1.16      harris41 1200:   foreach (split(/&/,$query)) {
1.6       albertel 1201:     my ($name, $value) = split(/=/,$_);
1.25      albertel 1202:     $name = &Apache::lonnet::unescape($name);
                   1203:     if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
                   1204:       $value =~ tr/+/ /;
                   1205:       $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
                   1206:       &Apache::lonxml::debug("Seting :$name: to :$value:");
1.30      albertel 1207:       unless (defined($ENV{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25      albertel 1208:     }
1.16      harris41 1209:   }
1.6       albertel 1210: }
                   1211: 
1.7       albertel 1212: sub cacheheader {
1.23      www      1213:   unless ($ENV{'request.method'} eq 'GET') { return ''; }
1.8       albertel 1214:   my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
1.7       albertel 1215:   my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
                   1216:                 <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
                   1217:                 <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
                   1218:   return $output;
                   1219: }
                   1220: 
1.9       albertel 1221: sub no_cache {
                   1222:   my ($r) = @_;
1.23      www      1223:   unless ($ENV{'request.method'} eq 'GET') { return ''; }
1.24      albertel 1224:   #my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
1.9       albertel 1225:   $r->no_cache(1);
                   1226:   $r->header_out("Pragma" => "no-cache");
1.24      albertel 1227:   #$r->header_out("Expires" => $date);
1.9       albertel 1228: }
1.25      albertel 1229: 
                   1230: sub add_to_env {
                   1231:   my ($name,$value)=@_;
1.28      albertel 1232:   if (defined($ENV{$name})) {
1.27      albertel 1233:     if (ref($ENV{$name})) {
1.25      albertel 1234:       #already have multiple values
                   1235:       push(@{ $ENV{$name} },$value);
                   1236:     } else {
                   1237:       #first time seeing multiple values, convert hash entry to an arrayref
                   1238:       my $first=$ENV{$name};
                   1239:       undef($ENV{$name});
                   1240:       push(@{ $ENV{$name} },$first,$value);
                   1241:     }
                   1242:   } else {
                   1243:     $ENV{$name}=$value;
                   1244:   }
1.31      albertel 1245: }
                   1246: 
1.41      ng       1247: =pod
1.45      matthew  1248: 
                   1249: =back 
1.41      ng       1250: 
                   1251: =head2 CSV Upload/Handling functions
1.38      albertel 1252: 
1.41      ng       1253: =over 4
                   1254: 
                   1255: =item  upfile_store($r)
                   1256: 
                   1257: Store uploaded file, $r should be the HTTP Request object,
                   1258: needs $ENV{'form.upfile'}
                   1259: returns $datatoken to be put into hidden field
                   1260: 
                   1261: =cut
1.31      albertel 1262: 
                   1263: sub upfile_store {
                   1264:     my $r=shift;
                   1265:     $ENV{'form.upfile'}=~s/\r/\n/gs;
                   1266:     $ENV{'form.upfile'}=~s/\f/\n/gs;
                   1267:     $ENV{'form.upfile'}=~s/\n+/\n/gs;
                   1268:     $ENV{'form.upfile'}=~s/\n+$//gs;
                   1269: 
                   1270:     my $datatoken=$ENV{'user.name'}.'_'.$ENV{'user.domain'}.
                   1271: 	'_enroll_'.$ENV{'request.course.id'}.'_'.time.'_'.$$;
                   1272:     {
                   1273: 	my $fh=Apache::File->new('>'.$r->dir_config('lonDaemons').
                   1274: 				 '/tmp/'.$datatoken.'.tmp');
                   1275: 	print $fh $ENV{'form.upfile'};
                   1276:     }
                   1277:     return $datatoken;
                   1278: }
                   1279: 
1.41      ng       1280: =item load_tmp_file($r)
                   1281: 
                   1282: Load uploaded file from tmp, $r should be the HTTP Request object,
                   1283: needs $ENV{'form.datatoken'},
                   1284: sets $ENV{'form.upfile'} to the contents of the file
                   1285: 
                   1286: =cut
1.31      albertel 1287: 
                   1288: sub load_tmp_file {
                   1289:     my $r=shift;
                   1290:     my @studentdata=();
                   1291:     {
                   1292: 	my $fh;
                   1293: 	if ($fh=Apache::File->new($r->dir_config('lonDaemons').
                   1294: 				  '/tmp/'.$ENV{'form.datatoken'}.'.tmp')) {
                   1295: 	    @studentdata=<$fh>;
                   1296: 	}
                   1297:     }
                   1298:     $ENV{'form.upfile'}=join('',@studentdata);
                   1299: }
                   1300: 
1.41      ng       1301: =item upfile_record_sep()
                   1302: 
                   1303: Separate uploaded file into records
                   1304: returns array of records,
                   1305: needs $ENV{'form.upfile'} and $ENV{'form.upfiletype'}
                   1306: 
                   1307: =cut
1.31      albertel 1308: 
                   1309: sub upfile_record_sep {
                   1310:     if ($ENV{'form.upfiletype'} eq 'xml') {
                   1311:     } else {
                   1312: 	return split(/\n/,$ENV{'form.upfile'});
                   1313:     }
                   1314: }
                   1315: 
1.41      ng       1316: =item record_sep($record)
                   1317: 
                   1318: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $ENV{'form.upfiletype'}
                   1319: 
                   1320: =cut
                   1321: 
1.31      albertel 1322: sub record_sep {
                   1323:     my $record=shift;
                   1324:     my %components=();
                   1325:     if ($ENV{'form.upfiletype'} eq 'xml') {
                   1326:     } elsif ($ENV{'form.upfiletype'} eq 'space') {
                   1327:         my $i=0;
                   1328:         foreach (split(/\s+/,$record)) {
                   1329:             my $field=$_;
                   1330:             $field=~s/^(\"|\')//;
                   1331:             $field=~s/(\"|\')$//;
                   1332:             $components{$i}=$field;
                   1333:             $i++;
                   1334:         }
                   1335:     } elsif ($ENV{'form.upfiletype'} eq 'tab') {
                   1336:         my $i=0;
                   1337:         foreach (split(/\t+/,$record)) {
                   1338:             my $field=$_;
                   1339:             $field=~s/^(\"|\')//;
                   1340:             $field=~s/(\"|\')$//;
                   1341:             $components{$i}=$field;
                   1342:             $i++;
                   1343:         }
                   1344:     } else {
                   1345:         my @allfields=split(/\,/,$record);
                   1346:         my $i=0;
                   1347:         my $j;
                   1348:         for ($j=0;$j<=$#allfields;$j++) {
                   1349:             my $field=$allfields[$j];
                   1350:             if ($field=~/^\s*(\"|\')/) {
                   1351: 		my $delimiter=$1;
                   1352:                 while (($field!~/$delimiter$/) && ($j<$#allfields)) {
                   1353: 		    $j++;
                   1354: 		    $field.=','.$allfields[$j];
                   1355: 		}
                   1356:                 $field=~s/^\s*$delimiter//;
                   1357:                 $field=~s/$delimiter\s*$//;
                   1358:             }
                   1359:             $components{$i}=$field;
                   1360: 	    $i++;
                   1361:         }
                   1362:     }
                   1363:     return %components;
                   1364: }
                   1365: 
1.41      ng       1366: =item upfile_select_html()
                   1367: 
                   1368: return HTML code to select file and specify its type
                   1369: 
                   1370: =cut
                   1371: 
1.31      albertel 1372: sub upfile_select_html {
                   1373:     return (<<'ENDUPFORM');
                   1374: <input type="file" name="upfile" size="50">
                   1375: <br />Type: <select name="upfiletype">
                   1376: <option value="csv">CSV (comma separated values, spreadsheet)</option>
                   1377: <option value="space">Space separated</option>
                   1378: <option value="tab">Tabulator separated</option>
                   1379: <option value="xml">HTML/XML</option>
                   1380: </select>
                   1381: ENDUPFORM
                   1382: }
                   1383: 
1.41      ng       1384: =item csv_print_samples($r,$records)
                   1385: 
                   1386: Prints a table of sample values from each column uploaded $r is an
                   1387: Apache Request ref, $records is an arrayref from
                   1388: &Apache::loncommon::upfile_record_sep
                   1389: 
                   1390: =cut
                   1391: 
1.31      albertel 1392: sub csv_print_samples {
                   1393:     my ($r,$records) = @_;
                   1394:     my (%sone,%stwo,%sthree);
                   1395:     %sone=&record_sep($$records[0]);
                   1396:     if (defined($$records[1])) {%stwo=&record_sep($$records[1]);}
                   1397:     if (defined($$records[2])) {%sthree=&record_sep($$records[2]);}
                   1398: 
                   1399:     $r->print('Samples<br /><table border="2"><tr>');
                   1400:     foreach (sort({$a <=> $b} keys(%sone))) { $r->print('<th>Column&nbsp;'.($_+1).'</th>'); }
                   1401:     $r->print('</tr>');
                   1402:     foreach my $hash (\%sone,\%stwo,\%sthree) {
                   1403: 	$r->print('<tr>');
                   1404: 	foreach (sort({$a <=> $b} keys(%sone))) {
                   1405: 	    $r->print('<td>');
                   1406: 	    if (defined($$hash{$_})) { $r->print($$hash{$_}); }
                   1407: 	    $r->print('</td>');
                   1408: 	}
                   1409: 	$r->print('</tr>');
                   1410:     }
                   1411:     $r->print('</tr></table><br />'."\n");
                   1412: }
                   1413: 
1.41      ng       1414: =item csv_print_select_table($r,$records,$d)
                   1415: 
                   1416: Prints a table to create associations between values and table columns.
                   1417: $r is an Apache Request ref,
                   1418: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
                   1419: $d is an array of 2 element arrays (internal name, displayed name)
                   1420: 
                   1421: =cut
                   1422: 
1.31      albertel 1423: sub csv_print_select_table {
                   1424:     my ($r,$records,$d) = @_;
                   1425:     my $i=0;my %sone;
                   1426:     %sone=&record_sep($$records[0]);
                   1427:     $r->print('Associate columns with student attributes.'."\n".
                   1428: 	     '<table border="2"><tr><th>Attribute</th><th>Column</th></tr>'."\n");
                   1429:     foreach (@$d) {
                   1430: 	my ($value,$display)=@{ $_ };
                   1431: 	$r->print('<tr><td>'.$display.'</td>');
                   1432: 
                   1433: 	$r->print('<td><select name=f'.$i.
1.32      matthew  1434: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.31      albertel 1435: 	$r->print('<option value="none"></option>');
                   1436: 	foreach (sort({$a <=> $b} keys(%sone))) {
                   1437: 	    $r->print('<option value="'.$_.'">Column '.($_+1).'</option>');
                   1438: 	}
                   1439: 	$r->print('</select></td></tr>'."\n");
                   1440: 	$i++;
                   1441:     }
                   1442:     $i--;
                   1443:     return $i;
                   1444: }
                   1445: 
1.41      ng       1446: =item csv_samples_select_table($r,$records,$d)
                   1447: 
                   1448: Prints a table of sample values from the upload and can make associate samples to internal names.
                   1449: 
                   1450: $r is an Apache Request ref,
                   1451: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
                   1452: $d is an array of 2 element arrays (internal name, displayed name)
                   1453: 
                   1454: =cut
                   1455: 
1.31      albertel 1456: sub csv_samples_select_table {
                   1457:     my ($r,$records,$d) = @_;
                   1458:     my %sone; my %stwo; my %sthree;
                   1459:     my $i=0;
                   1460: 
                   1461:     $r->print('<table border=2><tr><th>Field</th><th>Samples</th></tr>');
                   1462:     %sone=&record_sep($$records[0]);
                   1463:     if (defined($$records[1])) {%stwo=&record_sep($$records[1]);}
                   1464:     if (defined($$records[2])) {%sthree=&record_sep($$records[2]);}
                   1465: 
                   1466:     foreach (sort keys %sone) {
                   1467: 	$r->print('<tr><td><select name=f'.$i.
1.32      matthew  1468: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.31      albertel 1469: 	foreach (@$d) {
                   1470: 	    my ($value,$display)=@{ $_ };
                   1471: 	    $r->print('<option value='.$value.'>'.$display.'</option>');
                   1472: 	}
                   1473: 	$r->print('</select></td><td>');
                   1474: 	if (defined($sone{$_})) { $r->print($sone{$_}."</br>\n"); }
                   1475: 	if (defined($stwo{$_})) { $r->print($stwo{$_}."</br>\n"); }
                   1476: 	if (defined($sthree{$_})) { $r->print($sthree{$_}."</br>\n"); }
                   1477: 	$r->print('</td></tr>');
                   1478: 	$i++;
                   1479:     }
                   1480:     $i--;
                   1481:     return($i);
1.25      albertel 1482: }
1.1       albertel 1483: 1;
                   1484: __END__;
1.17      harris41 1485: 
1.41      ng       1486: =pod
                   1487: 
                   1488: =back
                   1489: 
                   1490: =head2 Access .tab File Data
                   1491: 
                   1492: =over 4
                   1493: 
1.35      matthew  1494: =item languageids() 
1.17      harris41 1495: 
1.35      matthew  1496: returns list of all language ids
1.17      harris41 1497: 
1.35      matthew  1498: =item languagedescription() 
1.17      harris41 1499: 
1.35      matthew  1500: returns description of a specified language id
1.17      harris41 1501: 
1.35      matthew  1502: =item copyrightids() 
1.17      harris41 1503: 
1.35      matthew  1504: returns list of all copyrights
1.17      harris41 1505: 
1.35      matthew  1506: =item copyrightdescription() 
1.17      harris41 1507: 
1.35      matthew  1508: returns description of a specified copyright id
1.17      harris41 1509: 
1.35      matthew  1510: =item filecategories() 
1.17      harris41 1511: 
1.35      matthew  1512: returns list of all file categories
1.17      harris41 1513: 
1.35      matthew  1514: =item filecategorytypes() 
1.17      harris41 1515: 
1.35      matthew  1516: returns list of file types belonging to a given file
1.17      harris41 1517: category
                   1518: 
1.35      matthew  1519: =item fileembstyle() 
1.17      harris41 1520: 
1.35      matthew  1521: returns embedding style for a specified file type
1.17      harris41 1522: 
1.35      matthew  1523: =item filedescription() 
1.17      harris41 1524: 
1.35      matthew  1525: returns description for a specified file type
1.17      harris41 1526: 
1.35      matthew  1527: =item filedescriptionex() 
1.17      harris41 1528: 
1.35      matthew  1529: returns description for a specified file type with
1.17      harris41 1530: extra formatting
                   1531: 
1.41      ng       1532: =back
                   1533: 
                   1534: =head2 Alternate Problem Views
                   1535: 
                   1536: =over 4
                   1537: 
1.35      matthew  1538: =item get_previous_attempt() 
1.17      harris41 1539: 
1.35      matthew  1540: return string with previous attempt on problem
1.17      harris41 1541: 
1.35      matthew  1542: =item get_student_view() 
1.17      harris41 1543: 
1.35      matthew  1544: show a snapshot of what student was looking at
1.17      harris41 1545: 
1.35      matthew  1546: =item get_student_answers() 
1.17      harris41 1547: 
1.35      matthew  1548: show a snapshot of how student was answering problem
1.17      harris41 1549: 
1.41      ng       1550: =back
                   1551: 
                   1552: =head2 HTTP Helper
                   1553: 
                   1554: =over 4
                   1555: 
                   1556: =item get_unprocessed_cgi($query,$possible_names)
                   1557: 
                   1558: Modify the %ENV hash to contain unprocessed CGI form parameters held in
                   1559: $query.  The parameters listed in $possible_names (an array reference),
                   1560: will be set in $ENV{'form.name'} if they do not already exist.
1.17      harris41 1561: 
1.41      ng       1562: Typically called with $ENV{'QUERY_STRING'} as the first parameter.  
                   1563: $possible_names is an ref to an array of form element names.  As an example:
                   1564: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
                   1565: will result in $ENV{'form.uname'} and $ENV{'form.udom'} being set.
1.17      harris41 1566: 
1.35      matthew  1567: =item cacheheader() 
1.17      harris41 1568: 
1.35      matthew  1569: returns cache-controlling header code
1.17      harris41 1570: 
1.35      matthew  1571: =item nocache() 
1.17      harris41 1572: 
1.35      matthew  1573: specifies header code to not have cache
1.25      albertel 1574: 
1.35      matthew  1575: =item add_to_env($name,$value) 
1.25      albertel 1576: 
1.35      matthew  1577: adds $name to the %ENV hash with value
1.25      albertel 1578: $value, if $name already exists, the entry is converted to an array
                   1579: reference and $value is added to the array.
1.17      harris41 1580: 
                   1581: =back
                   1582: 
                   1583: =cut

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