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

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

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