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

1.10      albertel    1: # The LearningOnline Network with CAPA
1.1       albertel    2: # a pile of common routines
1.10      albertel    3: #
1.47    ! bowersj2    4: # $Id: loncommon.pm,v 1.46 2002/07/12 14:36:16 matthew 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.8       albertel   83: use POSIX qw(strftime);
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;
                    245:     var editbrowser;
                    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: 
                    442: =item help_open_topic($topic, $stayOnPage, $width, $height)
                    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: 
                    446: $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.)
                    447: 
                    448: $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.
                    449: 
                    450: =cut
                    451: 
                    452: sub help_open_topic {
                    453:     my ($topic, $stayOnPage, $width, $height) = @_;
                    454:     $stayOnPage = 0 if (not defined $stayOnPage);
                    455:     $width = 350 if (not defined $width);
                    456:     $height = 400 if (not defined $height);
                    457:     my $filename = $topic;
                    458:     $filename =~ s/ /_/g;
                    459: 
                    460:     my $template;
                    461: 
                    462:     if (!$stayOnPage)
                    463:     {
                    464:         $template = <<"ENDTEMPLATE";
1.47    ! bowersj2  465: <a href="javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,s
1.44      bowersj2  466: crollbars=1,width=$width,height=$height'))"><image
                    467:   src="/adm/help/gif/smallHelp.gif"
                    468:   border="0" alt="(Help: $topic)"></a>
                    469: ENDTEMPLATE
                    470:     }
                    471:     else
                    472:     {
                    473:         $template = <<"ENDTEMPLATE";
                    474: <a href="/adm/help/${filename}.hlp"><image
                    475:   src="/adm/help/gif/smallHelp.gif"
                    476:   border="0" alt="(Help: $topic)"></a>
                    477: ENDTEMPLATE
                    478:     }
                    479: 
                    480:     return $template;
                    481: 
                    482: }
1.37      matthew   483: 
1.45      matthew   484: =pod
                    485: 
1.37      matthew   486: =item csv_translate($text) 
                    487: 
                    488: Translate $text to allow it to be output as a 'comma seperated values' 
                    489: format.
                    490: 
                    491: =cut
                    492: 
                    493: sub csv_translate {
                    494:     my $text = shift;
                    495:     $text =~ s/\"/\"\"/g;
                    496:     $text =~ s/\n//g;
                    497:     return $text;
                    498: }
                    499: 
                    500: ###############################################################
1.33      matthew   501: ##        Home server <option> list generating code          ##
                    502: ###############################################################
1.35      matthew   503: #-------------------------------------------
                    504: 
1.45      matthew   505: =pod
                    506: 
1.35      matthew   507: =item get_domains()
                    508: 
                    509: Returns an array containing each of the domains listed in the hosts.tab
                    510: file.
                    511: 
                    512: =cut
                    513: 
                    514: #-------------------------------------------
1.34      matthew   515: sub get_domains {
                    516:     # The code below was stolen from "The Perl Cookbook", p 102, 1st ed.
                    517:     my @domains;
                    518:     my %seen;
                    519:     foreach (sort values(%Apache::lonnet::hostdom)) {
                    520:         push (@domains,$_) unless $seen{$_}++;
                    521:     }
                    522:     return @domains;
                    523: }
                    524: 
1.35      matthew   525: #-------------------------------------------
                    526: 
1.45      matthew   527: =pod
                    528: 
1.35      matthew   529: =item select_dom_form($defdom,$name)
                    530: 
                    531: Returns a string containing a <select name='$name' size='1'> form to 
                    532: allow a user to select the domain to preform an operation in.  
                    533: See loncreateuser.pm for an example invocation and use.
                    534: 
                    535: =cut
                    536: 
                    537: #-------------------------------------------
1.34      matthew   538: sub select_dom_form {
                    539:     my ($defdom,$name) = @_;
                    540:     my @domains = get_domains();
                    541:     my $selectdomain = "<select name=\"$name\" size=\"1\">\n";
                    542:     foreach (@domains) {
                    543:         $selectdomain.="<option value=\"$_\" ".
                    544:             ($_ eq $defdom ? 'selected' : '').
                    545:                 ">$_</option>\n";
                    546:     }
                    547:     $selectdomain.="</select>";
                    548:     return $selectdomain;
                    549: }
                    550: 
1.35      matthew   551: #-------------------------------------------
                    552: 
1.45      matthew   553: =pod
                    554: 
1.35      matthew   555: =item get_home_servers($domain)
                    556: 
                    557: Returns a hash which contains keys like '103l3' and values like 
                    558: 'kirk.lite.msu.edu'.  All of the keys will be for machines in the
                    559: given $domain.
                    560: 
                    561: =cut
                    562: 
                    563: #-------------------------------------------
1.33      matthew   564: sub get_home_servers {
                    565:     my $domain = shift;
                    566:     my %home_servers;
                    567:     foreach (keys(%Apache::lonnet::libserv)) {
                    568:         if ($Apache::lonnet::hostdom{$_} eq $domain) {
                    569:             $home_servers{$_} = $Apache::lonnet::hostname{$_};
                    570:         }
                    571:     }
                    572:     return %home_servers;
                    573: }
                    574: 
1.35      matthew   575: #-------------------------------------------
                    576: 
1.45      matthew   577: =pod
                    578: 
1.35      matthew   579: =item home_server_option_list($domain)
                    580: 
                    581: returns a string which contains an <option> list to be used in a 
                    582: <select> form input.  See loncreateuser.pm for an example.
                    583: 
                    584: =cut
                    585: 
                    586: #-------------------------------------------
1.33      matthew   587: sub home_server_option_list {
                    588:     my $domain = shift;
                    589:     my %servers = &get_home_servers($domain);
                    590:     my $result = '';
                    591:     foreach (sort keys(%servers)) {
                    592:         $result.=
                    593:             '<option value="'.$_.'">'.$_.' '.$servers{$_}."</option>\n";
                    594:     }
                    595:     return $result;
                    596: }
                    597: ###############################################################
                    598: ##    End of home server <option> list generating code       ##
                    599: ###############################################################
1.32      matthew   600: 
                    601: ###############################################################
                    602: ##    Authentication changing form generation subroutines    ##
                    603: ###############################################################
                    604: ##
                    605: ## All of the authform_xxxxxxx subroutines take their inputs in a
                    606: ## hash, and have reasonable default values.
                    607: ##
                    608: ##    formname = the name given in the <form> tag.
1.35      matthew   609: #-------------------------------------------
                    610: 
1.45      matthew   611: =pod
                    612: 
1.35      matthew   613: =item authform_xxxxxx
                    614: 
                    615: The authform_xxxxxx subroutines provide javascript and html forms which 
                    616: handle some of the conveniences required for authentication forms.  
                    617: This is not an optimal method, but it works.  
                    618: 
                    619: See loncreateuser.pm for invocation and use examples.
                    620: 
                    621: =over 4
                    622: 
                    623: =item authform_header
                    624: 
                    625: =item authform_authorwarning
                    626: 
                    627: =item authform_nochange
                    628: 
                    629: =item authform_kerberos
                    630: 
                    631: =item authform_internal
                    632: 
                    633: =item authform_filesystem
                    634: 
                    635: =back
                    636: 
                    637: =cut
                    638: 
                    639: #-------------------------------------------
1.32      matthew   640: sub authform_header{  
                    641:     my %in = (
                    642:         formname => 'cu',
                    643:         kerb_def_dom => 'MSU.EDU',
                    644:         @_,
                    645:     );
                    646:     $in{'formname'} = 'document.' . $in{'formname'};
                    647:     my $result='';
                    648:     $result.=<<"END";
                    649: var current = new Object();
                    650: current.radiovalue = 'nochange';
                    651: current.argfield = null;
                    652: 
                    653: function changed_radio(choice,currentform) {
                    654:     var choicearg = choice + 'arg';
                    655:     // If a radio button in changed, we need to change the argfield
                    656:     if (current.radiovalue != choice) {
                    657:         current.radiovalue = choice;
                    658:         if (current.argfield != null) {
                    659:             currentform.elements[current.argfield].value = '';
                    660:         }
                    661:         if (choice == 'nochange') {
                    662:             current.argfield = null;
                    663:         } else {
                    664:             current.argfield = choicearg;
                    665:             switch(choice) {
                    666:                 case 'krb': 
                    667:                     currentform.elements[current.argfield].value = 
                    668:                         "$in{'kerb_def_dom'}";
                    669:                 break;
                    670:               default:
                    671:                 break;
                    672:             }
                    673:         }
                    674:     }
                    675:     return;
                    676: }
1.22      www       677: 
1.32      matthew   678: function changed_text(choice,currentform) {
                    679:     var choicearg = choice + 'arg';
                    680:     if (currentform.elements[choicearg].value !='') {
                    681:         switch (choice) {
                    682:             case 'krb': currentform.elements[choicearg].value =
                    683:                 currentform.elements[choicearg].value.toUpperCase();
                    684:                 break;
                    685:             default:
                    686:         }
                    687:         // clear old field
                    688:         if ((current.argfield != choicearg) && (current.argfield != null)) {
                    689:             currentform.elements[current.argfield].value = '';
                    690:         }
                    691:         current.argfield = choicearg;
                    692:     }
                    693:     set_auth_radio_buttons(choice,currentform);
                    694:     return;
1.20      www       695: }
1.32      matthew   696: 
                    697: function set_auth_radio_buttons(newvalue,currentform) {
                    698:     var i=0;
                    699:     while (i < currentform.login.length) {
                    700:         if (currentform.login[i].value == newvalue) { break; }
                    701:         i++;
                    702:     }
                    703:     if (i == currentform.login.length) {
                    704:         return;
                    705:     }
                    706:     current.radiovalue = newvalue;
                    707:     currentform.login[i].checked = true;
                    708:     return;
                    709: }
                    710: END
                    711:     return $result;
                    712: }
                    713: 
                    714: sub authform_authorwarning{
                    715:     my $result='';
                    716:     $result=<<"END";
                    717: <i>As a general rule, only authors or co-authors should be filesystem
                    718: authenticated (which allows access to the server filesystem).</i>
                    719: END
                    720:     return $result;
                    721: }
                    722: 
                    723: sub authform_nochange{  
                    724:     my %in = (
                    725:               formname => 'document.cu',
                    726:               kerb_def_dom => 'MSU.EDU',
                    727:               @_,
                    728:           );
                    729:     my $result='';
                    730:     $result.=<<"END";
                    731: <input type="radio" name="login" value="nochange" checked="checked"
                    732:        onclick="javascript:changed_radio('nochange',$in{'formname'});">
                    733: Do not change login data
                    734: END
                    735:     return $result;
                    736: }
                    737: 
                    738: sub authform_kerberos{  
                    739:     my %in = (
                    740:               formname => 'document.cu',
                    741:               kerb_def_dom => 'MSU.EDU',
                    742:               @_,
                    743:               );
                    744:     my $result='';
                    745:     $result.=<<"END";
                    746: <input type="radio" name="login" value="krb" 
                    747:        onclick="javascript:changed_radio('krb',$in{'formname'});"
                    748:        onchange="javascript:changed_radio('krb',$in{'formname'});">
                    749: Kerberos authenticated with domain
                    750: <input type="text" size="10" name="krbarg" value=""
                    751:        onchange="javascript:changed_text('krb',$in{'formname'});">
                    752: END
                    753:     return $result;
                    754: }
                    755: 
                    756: sub authform_internal{  
                    757:     my %args = (
                    758:                 formname => 'document.cu',
                    759:                 kerb_def_dom => 'MSU.EDU',
                    760:                 @_,
                    761:                 );
                    762:     my $result='';
                    763:     $result.=<<"END";
                    764: <input type="radio" name="login" value="int"
                    765:        onchange="javascript:changed_radio('int',$args{'formname'});"
                    766:        onclick="javascript:changed_radio('int',$args{'formname'});">
                    767: Internally authenticated (with initial password 
                    768: <input type="text" size="10" name="intarg" value=""
                    769:        onchange="javascript:changed_text('int',$args{'formname'});">
                    770: END
                    771:     return $result;
                    772: }
                    773: 
                    774: sub authform_local{  
                    775:     my %in = (
                    776:               formname => 'document.cu',
                    777:               kerb_def_dom => 'MSU.EDU',
                    778:               @_,
                    779:               );
                    780:     my $result='';
                    781:     $result.=<<"END";
                    782: <input type="radio" name="login" value="loc"
                    783:        onchange="javascript:changed_radio('loc',$in{'formname'});"
                    784:        onclick="javascript:changed_radio('loc',$in{'formname'});"> 
                    785: Local Authentication with argument
                    786: <input type="text" size="10" name="locarg" value=""
                    787:        onchange="javascript:changed_text('loc',$in{'formname'});">
                    788: END
                    789:     return $result;
                    790: }
                    791: 
                    792: sub authform_filesystem{  
                    793:     my %in = (
                    794:               formname => 'document.cu',
                    795:               kerb_def_dom => 'MSU.EDU',
                    796:               @_,
                    797:               );
                    798:     my $result='';
                    799:     $result.=<<"END";
                    800: <input type="radio" name="login" value="fsys" 
                    801:        onchange="javascript:changed_radio('fsys',$in{'formname'});"
                    802:        onclick="javascript:changed_radio('fsys',$in{'formname'});"> 
                    803: Filesystem authenticated (with initial password 
                    804: <input type="text" size="10" name="fsysarg" value=""
                    805:        onchange="javascript:changed_text('fsys',$in{'formname'});">
                    806: END
                    807:     return $result;
                    808: }
                    809: 
                    810: ###############################################################
                    811: ##   End Authentication changing form generation functions   ##
                    812: ###############################################################
                    813: 
1.46      matthew   814: ###############################################################
                    815: ##                Thesaurus Functions                        ##
                    816: ###############################################################
1.20      www       817: 
1.46      matthew   818: =pod
1.20      www       819: 
1.46      matthew   820: =item initialize_keywords
                    821: 
                    822: Initializes the package variable %Keywords if it is empty.  Uses the
                    823: package variable $thesaurus_db_file.
                    824: 
                    825: =cut
                    826: 
                    827: ###################################################
                    828: 
                    829: sub initialize_keywords {
                    830:     return 1 if (scalar keys(%Keywords));
                    831:     # If we are here, %Keywords is empty, so fill it up
                    832:     #   Make sure the file we need exists...
                    833:     if (! -e $thesaurus_db_file) {
                    834:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
                    835:                                  " failed because it does not exist");
                    836:         return 0;
                    837:     }
                    838:     #   Set up the hash as a database
                    839:     my %thesaurus_db;
                    840:     if (! tie(%thesaurus_db,'GDBM_File',
                    841:               $thesaurus_db_file,&GDBM_READER,0640)){
                    842:         &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
                    843:                                  $thesaurus_db_file);
                    844:         return 0;
                    845:     } 
                    846:     #  Get the average number of appearances of a word.
                    847:     my $avecount = $thesaurus_db{'average.count'};
                    848:     #  Put keywords (those that appear > average) into %Keywords
                    849:     while (my ($word,$data)=each (%thesaurus_db)) {
                    850:         my ($count,undef) = split /:/,$data;
                    851:         $Keywords{$word}++ if ($count > $avecount);
                    852:     }
                    853:     untie %thesaurus_db;
                    854:     # Remove special values from %Keywords.
                    855:     foreach ('total.count','average.count') {
                    856:         delete($Keywords{$_}) if (exists($Keywords{$_}));
                    857:     }
                    858:     return 1;
                    859: }
                    860: 
                    861: ###################################################
                    862: 
                    863: =pod
                    864: 
                    865: =item keyword($word)
                    866: 
                    867: Returns true if $word is a keyword.  A keyword is a word that appears more 
                    868: than the average number of times in the thesaurus database.  Calls 
                    869: &initialize_keywords
                    870: 
                    871: =cut
                    872: 
                    873: ###################################################
1.20      www       874: 
                    875: sub keyword {
1.46      matthew   876:     return if (!&initialize_keywords());
                    877:     my $word=lc(shift());
                    878:     $word=~s/\W//g;
                    879:     return exists($Keywords{$word});
1.20      www       880: }
1.46      matthew   881: 
                    882: ###################################################
                    883: #         Old code, to be removed soon            #
                    884: ###################################################
1.20      www       885: # -------------------------------------------------------- Return related words
1.46      matthew   886: #sub related {
                    887: #    my $newword=shift;
                    888: #    $newword=~s/\W//g;
                    889: #    $newword=~tr/A-Z/a-z/;
                    890: #    my $tindex=$theindex{$newword};
                    891: #    if ($tindex) {
                    892: #        my %found=();
                    893: #        foreach (split(/\,/,$therelated[$tindex])) {
                    894: ## - Related word found
                    895: #            my ($ridx,$rcount)=split(/\:/,$_);
                    896: ## - Direct relation index
                    897: #            my $directrel=$rcount/$thecount[$tindex];
                    898: #            if ($directrel>$thethreshold) {
                    899: #               foreach (split(/\,/,$therelated[$ridx])) {
                    900: #                  my ($rridx,$rrcount)=split(/\:/,$_);
                    901: #                  if ($rridx==$tindex) {
                    902: ## - Determine reverse relation index
                    903: #                     my $revrel=$rrcount/$thecount[$ridx];
                    904: ## - Calculate full index
                    905: #                     $found{$ridx}=$directrel*$revrel;
                    906: #                     if ($found{$ridx}>$thethreshold) {
                    907: #                        foreach (split(/\,/,$therelated[$ridx])) {
                    908: #                            my ($rrridx,$rrrcount)=split(/\:/,$_);
                    909: #                            unless ($found{$rrridx}) {
                    910: #                               my $revrevrel=$rrrcount/$thecount[$ridx];
                    911: #                               if (
                    912: #                          $directrel*$revrel*$revrevrel>$thethreshold
                    913: #                               ) {
                    914: #                                  $found{$rrridx}=
                    915: #                                       $directrel*$revrel*$revrevrel;
                    916: #                               }
                    917: #                            }
                    918: #                        }
                    919: #                     }
                    920: #                  }
                    921: #               }
                    922: #            }
                    923: #        }
                    924: #    }
                    925: #    return ();
                    926: #}
                    927: 
                    928: ###############################################################
                    929: 
                    930: =pod 
1.20      www       931: 
1.46      matthew   932: =item get_related_words
                    933: 
                    934: Look up a word in the thesaurus.  Takes a scalar arguement and returns
                    935: an array of words.  If the keyword is not in the thesaurus, an empty array
                    936: will be returned.  The order of the words returned is determined by the
                    937: database which holds them.
                    938: 
                    939: Uses global $thesaurus_db_file.
                    940: 
                    941: =cut
                    942: 
                    943: ###############################################################
                    944: 
                    945: sub get_related_words {
                    946:     my $keyword = shift;
                    947:     my %thesaurus_db;
                    948:     if (! -e $thesaurus_db_file) {
                    949:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
                    950:                                  "failed because the file does not exist");
                    951:         return ();
                    952:     }
                    953:     if (! tie(%thesaurus_db,'GDBM_File',
                    954:               $thesaurus_db_file,&GDBM_READER,0640)){
                    955:         return ();
                    956:     } 
                    957:     my @Words=();
                    958:     if (exists($thesaurus_db{$keyword})) {
                    959:         $_ = $thesaurus_db{$keyword};
                    960:         (undef,@Words) = split/:/;  # The first element is the number of times
                    961:                                     # the word appears.  We do not need it now.
                    962:         for (my $i=0;$i<=$#Words;$i++) {
                    963:             ($Words[$i],undef)= split/\,/,$Words[$i];
1.20      www       964:         }
                    965:     }
1.46      matthew   966:     untie %thesaurus_db;
                    967:     return @Words;
1.14      harris41  968: }
1.46      matthew   969: 
                    970: ###############################################################
                    971: ##              End Thesaurus Functions                      ##
                    972: ###############################################################
1.14      harris41  973: 
                    974: # ---------------------------------------------------------------- Language IDs
                    975: sub languageids {
1.16      harris41  976:     return sort(keys(%language));
1.14      harris41  977: }
                    978: 
                    979: # -------------------------------------------------------- Language Description
                    980: sub languagedescription {
1.16      harris41  981:     return $language{shift(@_)};
1.14      harris41  982: }
                    983: 
                    984: # --------------------------------------------------------------- Copyright IDs
                    985: sub copyrightids {
1.16      harris41  986:     return sort(keys(%cprtag));
1.14      harris41  987: }
                    988: 
                    989: # ------------------------------------------------------- Copyright Description
                    990: sub copyrightdescription {
1.16      harris41  991:     return $cprtag{shift(@_)};
1.14      harris41  992: }
                    993: 
                    994: # ------------------------------------------------------------- File Categories
                    995: sub filecategories {
1.41      ng        996:     return sort(keys(%category_extensions));
1.15      harris41  997: }
1.14      harris41  998: 
1.17      harris41  999: # -------------------------------------- File Types within a specified category
1.15      harris41 1000: sub filecategorytypes {
1.41      ng       1001:     return @{$category_extensions{lc($_[0])}};
1.14      harris41 1002: }
                   1003: 
                   1004: # ------------------------------------------------------------------ File Types
                   1005: sub fileextensions {
1.16      harris41 1006:     return sort(keys(%fe));
1.14      harris41 1007: }
                   1008: 
                   1009: # ------------------------------------------------------------- Embedding Style
                   1010: sub fileembstyle {
1.16      harris41 1011:     return $fe{lc(shift(@_))};
1.14      harris41 1012: }
                   1013: 
                   1014: # ------------------------------------------------------------ Description Text
                   1015: sub filedescription {
1.16      harris41 1016:     return $fd{lc(shift(@_))};
                   1017: }
                   1018: 
                   1019: # ------------------------------------------------------------ Description Text
                   1020: sub filedescriptionex {
                   1021:     my $ex=shift;
                   1022:     return '.'.$ex.' '.$fd{lc($ex)};
1.12      harris41 1023: }
1.1       albertel 1024: 
1.40      ng       1025: # ---- Retrieve attempts by students
                   1026: # input
                   1027: # $symb             - problem including path
                   1028: # $username,$domain - that of the student
                   1029: # $course           - course name
                   1030: # $getattempt       - leave blank if want all attempts, else put something.
1.43      ng       1031: # $regexp           - regular expression. If string matches regexp send to
                   1032: # $gradesub         - routine that process the string if it matches regexp
1.40      ng       1033: # 
                   1034: # output
                   1035: # formatted as a table all the attempts, if any.
                   1036: #
1.1       albertel 1037: sub get_previous_attempt {
1.43      ng       1038:   my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub)=@_;
1.1       albertel 1039:   my $prevattempts='';
1.43      ng       1040:   no strict 'refs';
1.1       albertel 1041:   if ($symb) {
1.3       albertel 1042:     my (%returnhash)=
                   1043:       &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1       albertel 1044:     if ($returnhash{'version'}) {
                   1045:       my %lasthash=();
                   1046:       my $version;
                   1047:       for ($version=1;$version<=$returnhash{'version'};$version++) {
1.19      harris41 1048:         foreach (sort(split(/\:/,$returnhash{$version.':keys'}))) {
1.1       albertel 1049: 	  $lasthash{$_}=$returnhash{$version.':'.$_};
1.19      harris41 1050:         }
1.1       albertel 1051:       }
1.43      ng       1052:       $prevattempts='<table border="0" width="100%"><tr><td bgcolor="#777777">';
1.40      ng       1053:       $prevattempts.='<table border="0" width="100%"><tr bgcolor="#e6ffff"><td>History</td>';
1.16      harris41 1054:       foreach (sort(keys %lasthash)) {
1.31      albertel 1055: 	my ($ign,@parts) = split(/\./,$_);
1.41      ng       1056: 	if ($#parts > 0) {
1.31      albertel 1057: 	  my $data=$parts[-1];
                   1058: 	  pop(@parts);
1.40      ng       1059: 	  $prevattempts.='<td>Part '.join('.',@parts).'<br />'.$data.'&nbsp;</td>';
1.31      albertel 1060: 	} else {
1.41      ng       1061: 	  if ($#parts == 0) {
                   1062: 	    $prevattempts.='<th>'.$parts[0].'</th>';
                   1063: 	  } else {
                   1064: 	    $prevattempts.='<th>'.$ign.'</th>';
                   1065: 	  }
1.31      albertel 1066: 	}
1.16      harris41 1067:       }
1.40      ng       1068:       if ($getattempt eq '') {
                   1069: 	for ($version=1;$version<=$returnhash{'version'};$version++) {
                   1070: 	  $prevattempts.='</tr><tr bgcolor="#ffffe6"><td>Transaction '.$version.'</td>';
                   1071: 	    foreach (sort(keys %lasthash)) {
                   1072: 	       my $value;
                   1073: 	       if ($_ =~ /timestamp/) {
                   1074: 		  $value=scalar(localtime($returnhash{$version.':'.$_}));
                   1075: 	       } else {
                   1076: 		  $value=$returnhash{$version.':'.$_};
                   1077: 	       }
                   1078: 	       $prevattempts.='<td>'.$value.'&nbsp;</td>';   
                   1079: 	    }
                   1080: 	 }
1.1       albertel 1081:       }
1.40      ng       1082:       $prevattempts.='</tr><tr bgcolor="#ffffe6"><td>Current</td>';
1.16      harris41 1083:       foreach (sort(keys %lasthash)) {
1.5       albertel 1084: 	my $value;
                   1085: 	if ($_ =~ /timestamp/) {
                   1086: 	  $value=scalar(localtime($lasthash{$_}));
                   1087: 	} else {
                   1088: 	  $value=$lasthash{$_};
                   1089: 	}
1.43      ng       1090: 	if ($_ =~/$regexp$/) {$value = &$gradesub($value)}
1.40      ng       1091: 	$prevattempts.='<td>'.$value.'&nbsp;</td>';
1.16      harris41 1092:       }
1.40      ng       1093:       $prevattempts.='</tr></table></td></tr></table>';
1.1       albertel 1094:     } else {
                   1095:       $prevattempts='Nothing submitted - no attempts.';
                   1096:     }
                   1097:   } else {
                   1098:     $prevattempts='No data.';
                   1099:   }
1.10      albertel 1100: }
                   1101: 
                   1102: sub get_student_view {
                   1103:   my ($symb,$username,$domain,$courseid) = @_;
                   1104:   my ($map,$id,$feedurl) = split(/___/,$symb);
                   1105:   my (%old,%moreenv);
                   1106:   my @elements=('symb','courseid','domain','username');
                   1107:   foreach my $element (@elements) {
                   1108:     $old{$element}=$ENV{'form.grade_'.$element};
                   1109:     $moreenv{'form.grade_'.$element}=eval '$'.$element #'
                   1110:   }
1.11      albertel 1111:   &Apache::lonnet::appenv(%moreenv);
                   1112:   my $userview=&Apache::lonnet::ssi('/res/'.$feedurl);
                   1113:   &Apache::lonnet::delenv('form.grade_');
                   1114:   foreach my $element (@elements) {
                   1115:     $ENV{'form.grade_'.$element}=$old{$element};
                   1116:   }
                   1117:   $userview=~s/\<body[^\>]*\>//gi;
                   1118:   $userview=~s/\<\/body\>//gi;
                   1119:   $userview=~s/\<html\>//gi;
                   1120:   $userview=~s/\<\/html\>//gi;
                   1121:   $userview=~s/\<head\>//gi;
                   1122:   $userview=~s/\<\/head\>//gi;
                   1123:   $userview=~s/action\s*\=/would_be_action\=/gi;
                   1124:   return $userview;
                   1125: }
                   1126: 
                   1127: sub get_student_answers {
                   1128:   my ($symb,$username,$domain,$courseid) = @_;
                   1129:   my ($map,$id,$feedurl) = split(/___/,$symb);
                   1130:   my (%old,%moreenv);
                   1131:   my @elements=('symb','courseid','domain','username');
                   1132:   foreach my $element (@elements) {
                   1133:     $old{$element}=$ENV{'form.grade_'.$element};
                   1134:     $moreenv{'form.grade_'.$element}=eval '$'.$element #'
                   1135:   }
                   1136:   $moreenv{'form.grade_target'}='answer';
1.10      albertel 1137:   &Apache::lonnet::appenv(%moreenv);
                   1138:   my $userview=&Apache::lonnet::ssi('/res/'.$feedurl);
                   1139:   &Apache::lonnet::delenv('form.grade_');
                   1140:   foreach my $element (@elements) {
                   1141:     $ENV{'form.grade_'.$element}=$old{$element};
                   1142:   }
                   1143:   return $userview;
1.1       albertel 1144: }
1.37      matthew  1145: 
                   1146: ###############################################
                   1147: 
                   1148: ###############################################
1.1       albertel 1149: 
1.6       albertel 1150: sub get_unprocessed_cgi {
1.25      albertel 1151:   my ($query,$possible_names)= @_;
1.26      matthew  1152:   # $Apache::lonxml::debug=1;
1.16      harris41 1153:   foreach (split(/&/,$query)) {
1.6       albertel 1154:     my ($name, $value) = split(/=/,$_);
1.25      albertel 1155:     $name = &Apache::lonnet::unescape($name);
                   1156:     if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
                   1157:       $value =~ tr/+/ /;
                   1158:       $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
                   1159:       &Apache::lonxml::debug("Seting :$name: to :$value:");
1.30      albertel 1160:       unless (defined($ENV{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25      albertel 1161:     }
1.16      harris41 1162:   }
1.6       albertel 1163: }
                   1164: 
1.7       albertel 1165: sub cacheheader {
1.23      www      1166:   unless ($ENV{'request.method'} eq 'GET') { return ''; }
1.8       albertel 1167:   my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
1.7       albertel 1168:   my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
                   1169:                 <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
                   1170:                 <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
                   1171:   return $output;
                   1172: }
                   1173: 
1.9       albertel 1174: sub no_cache {
                   1175:   my ($r) = @_;
1.23      www      1176:   unless ($ENV{'request.method'} eq 'GET') { return ''; }
1.24      albertel 1177:   #my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
1.9       albertel 1178:   $r->no_cache(1);
                   1179:   $r->header_out("Pragma" => "no-cache");
1.24      albertel 1180:   #$r->header_out("Expires" => $date);
1.9       albertel 1181: }
1.25      albertel 1182: 
                   1183: sub add_to_env {
                   1184:   my ($name,$value)=@_;
1.28      albertel 1185:   if (defined($ENV{$name})) {
1.27      albertel 1186:     if (ref($ENV{$name})) {
1.25      albertel 1187:       #already have multiple values
                   1188:       push(@{ $ENV{$name} },$value);
                   1189:     } else {
                   1190:       #first time seeing multiple values, convert hash entry to an arrayref
                   1191:       my $first=$ENV{$name};
                   1192:       undef($ENV{$name});
                   1193:       push(@{ $ENV{$name} },$first,$value);
                   1194:     }
                   1195:   } else {
                   1196:     $ENV{$name}=$value;
                   1197:   }
1.31      albertel 1198: }
                   1199: 
1.41      ng       1200: =pod
1.45      matthew  1201: 
                   1202: =back 
1.41      ng       1203: 
                   1204: =head2 CSV Upload/Handling functions
1.38      albertel 1205: 
1.41      ng       1206: =over 4
                   1207: 
                   1208: =item  upfile_store($r)
                   1209: 
                   1210: Store uploaded file, $r should be the HTTP Request object,
                   1211: needs $ENV{'form.upfile'}
                   1212: returns $datatoken to be put into hidden field
                   1213: 
                   1214: =cut
1.31      albertel 1215: 
                   1216: sub upfile_store {
                   1217:     my $r=shift;
                   1218:     $ENV{'form.upfile'}=~s/\r/\n/gs;
                   1219:     $ENV{'form.upfile'}=~s/\f/\n/gs;
                   1220:     $ENV{'form.upfile'}=~s/\n+/\n/gs;
                   1221:     $ENV{'form.upfile'}=~s/\n+$//gs;
                   1222: 
                   1223:     my $datatoken=$ENV{'user.name'}.'_'.$ENV{'user.domain'}.
                   1224: 	'_enroll_'.$ENV{'request.course.id'}.'_'.time.'_'.$$;
                   1225:     {
                   1226: 	my $fh=Apache::File->new('>'.$r->dir_config('lonDaemons').
                   1227: 				 '/tmp/'.$datatoken.'.tmp');
                   1228: 	print $fh $ENV{'form.upfile'};
                   1229:     }
                   1230:     return $datatoken;
                   1231: }
                   1232: 
1.41      ng       1233: =item load_tmp_file($r)
                   1234: 
                   1235: Load uploaded file from tmp, $r should be the HTTP Request object,
                   1236: needs $ENV{'form.datatoken'},
                   1237: sets $ENV{'form.upfile'} to the contents of the file
                   1238: 
                   1239: =cut
1.31      albertel 1240: 
                   1241: sub load_tmp_file {
                   1242:     my $r=shift;
                   1243:     my @studentdata=();
                   1244:     {
                   1245: 	my $fh;
                   1246: 	if ($fh=Apache::File->new($r->dir_config('lonDaemons').
                   1247: 				  '/tmp/'.$ENV{'form.datatoken'}.'.tmp')) {
                   1248: 	    @studentdata=<$fh>;
                   1249: 	}
                   1250:     }
                   1251:     $ENV{'form.upfile'}=join('',@studentdata);
                   1252: }
                   1253: 
1.41      ng       1254: =item upfile_record_sep()
                   1255: 
                   1256: Separate uploaded file into records
                   1257: returns array of records,
                   1258: needs $ENV{'form.upfile'} and $ENV{'form.upfiletype'}
                   1259: 
                   1260: =cut
1.31      albertel 1261: 
                   1262: sub upfile_record_sep {
                   1263:     if ($ENV{'form.upfiletype'} eq 'xml') {
                   1264:     } else {
                   1265: 	return split(/\n/,$ENV{'form.upfile'});
                   1266:     }
                   1267: }
                   1268: 
1.41      ng       1269: =item record_sep($record)
                   1270: 
                   1271: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $ENV{'form.upfiletype'}
                   1272: 
                   1273: =cut
                   1274: 
1.31      albertel 1275: sub record_sep {
                   1276:     my $record=shift;
                   1277:     my %components=();
                   1278:     if ($ENV{'form.upfiletype'} eq 'xml') {
                   1279:     } elsif ($ENV{'form.upfiletype'} eq 'space') {
                   1280:         my $i=0;
                   1281:         foreach (split(/\s+/,$record)) {
                   1282:             my $field=$_;
                   1283:             $field=~s/^(\"|\')//;
                   1284:             $field=~s/(\"|\')$//;
                   1285:             $components{$i}=$field;
                   1286:             $i++;
                   1287:         }
                   1288:     } elsif ($ENV{'form.upfiletype'} eq 'tab') {
                   1289:         my $i=0;
                   1290:         foreach (split(/\t+/,$record)) {
                   1291:             my $field=$_;
                   1292:             $field=~s/^(\"|\')//;
                   1293:             $field=~s/(\"|\')$//;
                   1294:             $components{$i}=$field;
                   1295:             $i++;
                   1296:         }
                   1297:     } else {
                   1298:         my @allfields=split(/\,/,$record);
                   1299:         my $i=0;
                   1300:         my $j;
                   1301:         for ($j=0;$j<=$#allfields;$j++) {
                   1302:             my $field=$allfields[$j];
                   1303:             if ($field=~/^\s*(\"|\')/) {
                   1304: 		my $delimiter=$1;
                   1305:                 while (($field!~/$delimiter$/) && ($j<$#allfields)) {
                   1306: 		    $j++;
                   1307: 		    $field.=','.$allfields[$j];
                   1308: 		}
                   1309:                 $field=~s/^\s*$delimiter//;
                   1310:                 $field=~s/$delimiter\s*$//;
                   1311:             }
                   1312:             $components{$i}=$field;
                   1313: 	    $i++;
                   1314:         }
                   1315:     }
                   1316:     return %components;
                   1317: }
                   1318: 
1.41      ng       1319: =item upfile_select_html()
                   1320: 
                   1321: return HTML code to select file and specify its type
                   1322: 
                   1323: =cut
                   1324: 
1.31      albertel 1325: sub upfile_select_html {
                   1326:     return (<<'ENDUPFORM');
                   1327: <input type="file" name="upfile" size="50">
                   1328: <br />Type: <select name="upfiletype">
                   1329: <option value="csv">CSV (comma separated values, spreadsheet)</option>
                   1330: <option value="space">Space separated</option>
                   1331: <option value="tab">Tabulator separated</option>
                   1332: <option value="xml">HTML/XML</option>
                   1333: </select>
                   1334: ENDUPFORM
                   1335: }
                   1336: 
1.41      ng       1337: =item csv_print_samples($r,$records)
                   1338: 
                   1339: Prints a table of sample values from each column uploaded $r is an
                   1340: Apache Request ref, $records is an arrayref from
                   1341: &Apache::loncommon::upfile_record_sep
                   1342: 
                   1343: =cut
                   1344: 
1.31      albertel 1345: sub csv_print_samples {
                   1346:     my ($r,$records) = @_;
                   1347:     my (%sone,%stwo,%sthree);
                   1348:     %sone=&record_sep($$records[0]);
                   1349:     if (defined($$records[1])) {%stwo=&record_sep($$records[1]);}
                   1350:     if (defined($$records[2])) {%sthree=&record_sep($$records[2]);}
                   1351: 
                   1352:     $r->print('Samples<br /><table border="2"><tr>');
                   1353:     foreach (sort({$a <=> $b} keys(%sone))) { $r->print('<th>Column&nbsp;'.($_+1).'</th>'); }
                   1354:     $r->print('</tr>');
                   1355:     foreach my $hash (\%sone,\%stwo,\%sthree) {
                   1356: 	$r->print('<tr>');
                   1357: 	foreach (sort({$a <=> $b} keys(%sone))) {
                   1358: 	    $r->print('<td>');
                   1359: 	    if (defined($$hash{$_})) { $r->print($$hash{$_}); }
                   1360: 	    $r->print('</td>');
                   1361: 	}
                   1362: 	$r->print('</tr>');
                   1363:     }
                   1364:     $r->print('</tr></table><br />'."\n");
                   1365: }
                   1366: 
1.41      ng       1367: =item csv_print_select_table($r,$records,$d)
                   1368: 
                   1369: Prints a table to create associations between values and table columns.
                   1370: $r is an Apache Request ref,
                   1371: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
                   1372: $d is an array of 2 element arrays (internal name, displayed name)
                   1373: 
                   1374: =cut
                   1375: 
1.31      albertel 1376: sub csv_print_select_table {
                   1377:     my ($r,$records,$d) = @_;
                   1378:     my $i=0;my %sone;
                   1379:     %sone=&record_sep($$records[0]);
                   1380:     $r->print('Associate columns with student attributes.'."\n".
                   1381: 	     '<table border="2"><tr><th>Attribute</th><th>Column</th></tr>'."\n");
                   1382:     foreach (@$d) {
                   1383: 	my ($value,$display)=@{ $_ };
                   1384: 	$r->print('<tr><td>'.$display.'</td>');
                   1385: 
                   1386: 	$r->print('<td><select name=f'.$i.
1.32      matthew  1387: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.31      albertel 1388: 	$r->print('<option value="none"></option>');
                   1389: 	foreach (sort({$a <=> $b} keys(%sone))) {
                   1390: 	    $r->print('<option value="'.$_.'">Column '.($_+1).'</option>');
                   1391: 	}
                   1392: 	$r->print('</select></td></tr>'."\n");
                   1393: 	$i++;
                   1394:     }
                   1395:     $i--;
                   1396:     return $i;
                   1397: }
                   1398: 
1.41      ng       1399: =item csv_samples_select_table($r,$records,$d)
                   1400: 
                   1401: Prints a table of sample values from the upload and can make associate samples to internal names.
                   1402: 
                   1403: $r is an Apache Request ref,
                   1404: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
                   1405: $d is an array of 2 element arrays (internal name, displayed name)
                   1406: 
                   1407: =cut
                   1408: 
1.31      albertel 1409: sub csv_samples_select_table {
                   1410:     my ($r,$records,$d) = @_;
                   1411:     my %sone; my %stwo; my %sthree;
                   1412:     my $i=0;
                   1413: 
                   1414:     $r->print('<table border=2><tr><th>Field</th><th>Samples</th></tr>');
                   1415:     %sone=&record_sep($$records[0]);
                   1416:     if (defined($$records[1])) {%stwo=&record_sep($$records[1]);}
                   1417:     if (defined($$records[2])) {%sthree=&record_sep($$records[2]);}
                   1418: 
                   1419:     foreach (sort keys %sone) {
                   1420: 	$r->print('<tr><td><select name=f'.$i.
1.32      matthew  1421: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.31      albertel 1422: 	foreach (@$d) {
                   1423: 	    my ($value,$display)=@{ $_ };
                   1424: 	    $r->print('<option value='.$value.'>'.$display.'</option>');
                   1425: 	}
                   1426: 	$r->print('</select></td><td>');
                   1427: 	if (defined($sone{$_})) { $r->print($sone{$_}."</br>\n"); }
                   1428: 	if (defined($stwo{$_})) { $r->print($stwo{$_}."</br>\n"); }
                   1429: 	if (defined($sthree{$_})) { $r->print($sthree{$_}."</br>\n"); }
                   1430: 	$r->print('</td></tr>');
                   1431: 	$i++;
                   1432:     }
                   1433:     $i--;
                   1434:     return($i);
1.25      albertel 1435: }
1.1       albertel 1436: 1;
                   1437: __END__;
1.17      harris41 1438: 
1.41      ng       1439: =pod
                   1440: 
                   1441: =back
                   1442: 
                   1443: =head2 Access .tab File Data
                   1444: 
                   1445: =over 4
                   1446: 
1.35      matthew  1447: =item languageids() 
1.17      harris41 1448: 
1.35      matthew  1449: returns list of all language ids
1.17      harris41 1450: 
1.35      matthew  1451: =item languagedescription() 
1.17      harris41 1452: 
1.35      matthew  1453: returns description of a specified language id
1.17      harris41 1454: 
1.35      matthew  1455: =item copyrightids() 
1.17      harris41 1456: 
1.35      matthew  1457: returns list of all copyrights
1.17      harris41 1458: 
1.35      matthew  1459: =item copyrightdescription() 
1.17      harris41 1460: 
1.35      matthew  1461: returns description of a specified copyright id
1.17      harris41 1462: 
1.35      matthew  1463: =item filecategories() 
1.17      harris41 1464: 
1.35      matthew  1465: returns list of all file categories
1.17      harris41 1466: 
1.35      matthew  1467: =item filecategorytypes() 
1.17      harris41 1468: 
1.35      matthew  1469: returns list of file types belonging to a given file
1.17      harris41 1470: category
                   1471: 
1.35      matthew  1472: =item fileembstyle() 
1.17      harris41 1473: 
1.35      matthew  1474: returns embedding style for a specified file type
1.17      harris41 1475: 
1.35      matthew  1476: =item filedescription() 
1.17      harris41 1477: 
1.35      matthew  1478: returns description for a specified file type
1.17      harris41 1479: 
1.35      matthew  1480: =item filedescriptionex() 
1.17      harris41 1481: 
1.35      matthew  1482: returns description for a specified file type with
1.17      harris41 1483: extra formatting
                   1484: 
1.41      ng       1485: =back
                   1486: 
                   1487: =head2 Alternate Problem Views
                   1488: 
                   1489: =over 4
                   1490: 
1.35      matthew  1491: =item get_previous_attempt() 
1.17      harris41 1492: 
1.35      matthew  1493: return string with previous attempt on problem
1.17      harris41 1494: 
1.35      matthew  1495: =item get_student_view() 
1.17      harris41 1496: 
1.35      matthew  1497: show a snapshot of what student was looking at
1.17      harris41 1498: 
1.35      matthew  1499: =item get_student_answers() 
1.17      harris41 1500: 
1.35      matthew  1501: show a snapshot of how student was answering problem
1.17      harris41 1502: 
1.41      ng       1503: =back
                   1504: 
                   1505: =head2 HTTP Helper
                   1506: 
                   1507: =over 4
                   1508: 
                   1509: =item get_unprocessed_cgi($query,$possible_names)
                   1510: 
                   1511: Modify the %ENV hash to contain unprocessed CGI form parameters held in
                   1512: $query.  The parameters listed in $possible_names (an array reference),
                   1513: will be set in $ENV{'form.name'} if they do not already exist.
1.17      harris41 1514: 
1.41      ng       1515: Typically called with $ENV{'QUERY_STRING'} as the first parameter.  
                   1516: $possible_names is an ref to an array of form element names.  As an example:
                   1517: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
                   1518: will result in $ENV{'form.uname'} and $ENV{'form.udom'} being set.
1.17      harris41 1519: 
1.35      matthew  1520: =item cacheheader() 
1.17      harris41 1521: 
1.35      matthew  1522: returns cache-controlling header code
1.17      harris41 1523: 
1.35      matthew  1524: =item nocache() 
1.17      harris41 1525: 
1.35      matthew  1526: specifies header code to not have cache
1.25      albertel 1527: 
1.35      matthew  1528: =item add_to_env($name,$value) 
1.25      albertel 1529: 
1.35      matthew  1530: adds $name to the %ENV hash with value
1.25      albertel 1531: $value, if $name already exists, the entry is converted to an array
                   1532: reference and $value is added to the array.
1.17      harris41 1533: 
                   1534: =back
                   1535: 
                   1536: =cut

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