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

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

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