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

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

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