--- loncom/interface/loncommon.pm 2002/04/22 18:04:19 1.33
+++ loncom/interface/loncommon.pm 2002/07/12 14:36:16 1.46
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.33 2002/04/22 18:04:19 matthew Exp $
+# $Id: loncommon.pm,v 1.46 2002/07/12 14:36:16 matthew Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -33,40 +33,112 @@
# 12/25,12/28 Gerd Kortemeyer
# YEAR=2002
# 1/4 Gerd Kortemeyer
+# 6/24,7/2 H. K. Ng
# Makes a table out of the previous attempts
# Inputs result_from_symbread, user, domain, course_id
# Reads in non-network-related .tab files
+# POD header:
+
+=pod
+
+=head1 NAME
+
+Apache::loncommon - pile of common routines
+
+=head1 SYNOPSIS
+
+Referenced by other mod_perl Apache modules.
+
+Invocation:
+ &Apache::loncommon::SUBROUTINENAME(ARGUMENTS);
+
+=head1 INTRODUCTION
+
+Common collection of used subroutines. This collection helps remove
+redundancy from other modules and increase efficiency of memory usage.
+
+Current things done:
+
+ Makes a table out of the previous homework attempts
+ Inputs result_from_symbread, user, domain, course_id
+ Reads in non-network-related .tab files
+
+This is part of the LearningOnline Network with CAPA project
+described at http://www.lon-capa.org.
+
+=head2 General Subroutines
+
+=over 4
+
+=cut
+
+# End of POD header
package Apache::loncommon;
use strict;
use Apache::lonnet();
+use GDBM_File;
use POSIX qw(strftime);
use Apache::Constants qw(:common);
use Apache::lonmsg();
-
my $readit;
+=pod
+
+=item Global Variables
+
+=over 4
+
+=cut
# ----------------------------------------------- Filetypes/Languages/Copyright
my %language;
my %cprtag;
my %fe; my %fd;
-my %fc;
+my %category_extensions;
+
+# ---------------------------------------------- Thesaurus variables
-# -------------------------------------------------------------- Thesaurus data
-my @therelated;
-my @theword;
-my @thecount;
-my %theindex;
-my $thetotalcount;
-my $thefuzzy=2;
-my $thethreshold=0.1/$thefuzzy;
-my $theavecount;
+=pod
+
+=item %Keywords
+
+A hash used by &keyword to determine if a word is considered a keyword.
+
+=item $thesaurus_db_file
+
+Scalar containing the full path to the thesaurus database.
+
+=cut
+
+my %Keywords;
+my $thesaurus_db_file;
+
+
+=pod
+
+=back
+
+=cut
# ----------------------------------------------------------------------- BEGIN
-BEGIN {
+=pod
+
+=item BEGIN()
+
+Initialize values from language.tab, copyright.tab, filetypes.tab,
+thesaurus.tab, and filecategories.tab.
+
+=cut
+
+# ----------------------------------------------------------------------- BEGIN
+
+BEGIN {
+ # Variable initialization
+ $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
+ #
unless ($readit) {
# ------------------------------------------------------------------- languages
{
@@ -102,8 +174,8 @@ BEGIN {
while (<$fh>) {
next if /^\#/;
chomp;
- my ($key,$val)=(split(/\s+/,$_,2));
- push @{$fc{$key}},$val;
+ my ($extension,$category)=(split(/\s+/,$_,2));
+ push @{$category_extensions{lc($category)}},$extension;
}
}
}
@@ -123,32 +195,372 @@ BEGIN {
}
}
}
-# -------------------------------------------------------------- Thesaurus data
- {
- my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
- '/thesaurus.dat');
- if ($fh) {
- while (<$fh>) {
- my ($tword,$tindex,$tcount,$trelated)=split(/\@/,$_);
- $theindex{$tword}=$tindex;
- $theword[$tindex]=$tword;
- $thecount[$tindex]=$tcount;
- $thetotalcount+=$tcount;
- $therelated[$tindex]=$trelated;
- }
- }
- $theavecount=$thetotalcount/$#thecount;
- }
&Apache::lonnet::logthis(
- "<font color=yellow>INFO: Read file types and thesaurus</font>");
+ "<font color=yellow>INFO: Read file types</font>");
$readit=1;
-}
+ } # end of unless($readit)
}
# ============================================================= END BEGIN BLOCK
###############################################################
+## HTML and Javascript Helper Functions ##
+###############################################################
+
+=pod
+
+=item browser_and_searcher_javascript
+
+Returns scalar containing javascript to open a browser window
+or a searcher window. Also creates
+
+=over 4
+
+=item openbrowser(formname,elementname,only,omit) [javascript]
+
+inputs: formname, elementname, only, omit
+
+formname and elementname indicate the name of the html form and name of
+the element that the results of the browsing selection are to be placed in.
+
+Specifying 'only' will restrict the browser to displaying only files
+with the given extension. Can be a comma seperated list.
+
+Specifying 'omit' will restrict the browser to NOT displaying files
+with the given extension. Can be a comma seperated list.
+
+=item opensearcher(formname, elementname) [javascript]
+
+Inputs: formname, elementname
+
+formname and elementname specify the name of the html form and the name
+of the element the selection from the search results will be placed in.
+
+=back
+
+=cut
+
+###############################################################
+sub browser_and_searcher_javascript {
+ return <<END;
+ var editbrowser;
+ function openbrowser(formname,elementname,only,omit) {
+ var url = '/res/?';
+ if (editbrowser == null) {
+ url += 'launch=1&';
+ }
+ url += 'catalogmode=interactive&';
+ url += 'mode=edit&';
+ url += 'form=' + formname + '&';
+ if (only != null) {
+ url += 'only=' + only + '&';
+ }
+ if (omit != null) {
+ url += 'omit=' + omit + '&';
+ }
+ url += 'element=' + elementname + '';
+ var title = 'Browser';
+ var options = 'scrollbars=1,resizable=1,menubar=0';
+ options += ',width=700,height=600';
+ editbrowser = open(url,title,options,'1');
+ editbrowser.focus();
+ }
+ var editsearcher;
+ function opensearcher(formname,elementname) {
+ var url = '/adm/searchcat?';
+ if (editsearcher == null) {
+ url += 'launch=1&';
+ }
+ url += 'catalogmode=interactive&';
+ url += 'mode=edit&';
+ url += 'form=' + formname + '&';
+ url += 'element=' + elementname + '';
+ var title = 'Search';
+ var options = 'scrollbars=1,resizable=1,menubar=0';
+ options += ',width=700,height=600';
+ editsearcher = open(url,title,options,'1');
+ editsearcher.focus();
+ }
+END
+}
+
+
+
+###############################################################
+
+=pod
+
+=item linked_select_forms(...)
+
+linked_select_forms returns a string containing a <script></script> block
+and html for two <select> menus. The select menus will be linked in that
+changing the value of the first menu will result in new values being placed
+in the second menu. The values in the select menu will appear in alphabetical
+order.
+
+linked_select_forms takes the following ordered inputs:
+
+=over 4
+
+=item $formname, the name of the <form> tag
+
+=item $middletext, the text which appears between the <select> tags
+
+=item $firstdefault, the default value for the first menu
+
+=item $firstselectname, the name of the first <select> tag
+
+=item $secondselectname, the name of the second <select> tag
+
+=item $hashref, a reference to a hash containing the data for the menus.
+
+=back
+
+Below is an example of such a hash. Only the 'text', 'default', and
+'select2' keys must appear as stated. keys(%menu) are the possible
+values for the first select menu. The text that coincides with the
+first menu value is given in $menu{$choice1}->{'text'}. The values
+and text for the second menu are given in the hash pointed to by
+$menu{$choice1}->{'select2'}.
+
+my %menu = ( A1 => { text =>"Choice A1" ,
+ default => "B3",
+ select2 => {
+ B1 => "Choice B1",
+ B2 => "Choice B2",
+ B3 => "Choice B3",
+ B4 => "Choice B4"
+ }
+ },
+ A2 => { text =>"Choice A2" ,
+ default => "C2",
+ select2 => {
+ C1 => "Choice C1",
+ C2 => "Choice C2",
+ C3 => "Choice C3"
+ }
+ },
+ A3 => { text =>"Choice A3" ,
+ default => "D6",
+ select2 => {
+ D1 => "Choice D1",
+ D2 => "Choice D2",
+ D3 => "Choice D3",
+ D4 => "Choice D4",
+ D5 => "Choice D5",
+ D6 => "Choice D6",
+ D7 => "Choice D7"
+ }
+ }
+ );
+
+=cut
+
+# ------------------------------------------------
+
+sub linked_select_forms {
+ my ($formname,
+ $middletext,
+ $firstdefault,
+ $firstselectname,
+ $secondselectname,
+ $hashref
+ ) = @_;
+ my $second = "document.$formname.$secondselectname";
+ my $first = "document.$formname.$firstselectname";
+ # output the javascript to do the changing
+ my $result = '';
+ $result.="<script>\n";
+ $result.="var select2data = new Object();\n";
+ $" = '","';
+ my $debug = '';
+ foreach my $s1 (sort(keys(%$hashref))) {
+ $result.="select2data.d_$s1 = new Object();\n";
+ $result.="select2data.d_$s1.def = new String('".
+ $hashref->{$s1}->{'default'}."');\n";
+ $result.="select2data.d_$s1.values = new Array(";
+ my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
+ $result.="\"@s2values\");\n";
+ $result.="select2data.d_$s1.texts = new Array(";
+ my @s2texts;
+ foreach my $value (@s2values) {
+ push @s2texts, $hashref->{$s1}->{'select2'}->{$value};
+ }
+ $result.="\"@s2texts\");\n";
+ }
+ $"=' ';
+ $result.= <<"END";
+
+function select1_changed() {
+ // Determine new choice
+ var newvalue = "d_" + $first.value;
+ // update select2
+ var values = select2data[newvalue].values;
+ var texts = select2data[newvalue].texts;
+ var select2def = select2data[newvalue].def;
+ var i;
+ // out with the old
+ for (i = 0; i < $second.options.length; i++) {
+ $second.options[i] = null;
+ }
+ // in with the nuclear
+ for (i=0;i<values.length; i++) {
+ $second.options[i] = new Option(values[i]);
+ $second.options[i].text = texts[i];
+ if (values[i] == select2def) {
+ $second.options[i].selected = true;
+ }
+ }
+}
+</script>
+END
+ # output the initial values for the selection lists
+ $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed()\">\n";
+ foreach my $value (sort(keys(%$hashref))) {
+ $result.=" <option value=\"$value\" ";
+ $result.=" selected=\"true\" " if ($value eq $firstdefault);
+ $result.=">$hashref->{$value}->{'text'}</option>\n";
+ }
+ $result .= "</select>\n";
+ my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
+ $result .= $middletext;
+ $result .= "<select size=\"1\" name=\"$secondselectname\">\n";
+ my $seconddefault = $hashref->{$firstdefault}->{'default'};
+ foreach my $value (sort(keys(%select2))) {
+ $result.=" <option value=\"$value\" ";
+ $result.=" selected=\"true\" " if ($value eq $seconddefault);
+ $result.=">$select2{$value}</option>\n";
+ }
+ $result .= "</select>\n";
+ # return $debug;
+ return $result;
+} # end of sub linked_select_forms {
+
+###############################################################
+
+=pod
+
+=item help_open_topic($topic, $stayOnPage, $width, $height)
+
+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.
+
+$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.)
+
+$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.
+
+=cut
+
+sub help_open_topic {
+ my ($topic, $stayOnPage, $width, $height) = @_;
+ $stayOnPage = 0 if (not defined $stayOnPage);
+ $width = 350 if (not defined $width);
+ $height = 400 if (not defined $height);
+ my $filename = $topic;
+ $filename =~ s/ /_/g;
+
+ my $template;
+
+ if (!$stayOnPage)
+ {
+ $template = <<"ENDTEMPLATE";
+<a href="javascript:void(open('/adm/help/${filename}.hlp', 'Help for $topic', 'menubar=0,s
+crollbars=1,width=$width,height=$height'))"><image
+ src="/adm/help/gif/smallHelp.gif"
+ border="0" alt="(Help: $topic)"></a>
+ENDTEMPLATE
+ }
+ else
+ {
+ $template = <<"ENDTEMPLATE";
+<a href="/adm/help/${filename}.hlp"><image
+ src="/adm/help/gif/smallHelp.gif"
+ border="0" alt="(Help: $topic)"></a>
+ENDTEMPLATE
+ }
+
+ return $template;
+
+}
+
+=pod
+
+=item csv_translate($text)
+
+Translate $text to allow it to be output as a 'comma seperated values'
+format.
+
+=cut
+
+sub csv_translate {
+ my $text = shift;
+ $text =~ s/\"/\"\"/g;
+ $text =~ s/\n//g;
+ return $text;
+}
+
+###############################################################
## Home server <option> list generating code ##
###############################################################
+#-------------------------------------------
+
+=pod
+
+=item get_domains()
+
+Returns an array containing each of the domains listed in the hosts.tab
+file.
+
+=cut
+
+#-------------------------------------------
+sub get_domains {
+ # The code below was stolen from "The Perl Cookbook", p 102, 1st ed.
+ my @domains;
+ my %seen;
+ foreach (sort values(%Apache::lonnet::hostdom)) {
+ push (@domains,$_) unless $seen{$_}++;
+ }
+ return @domains;
+}
+
+#-------------------------------------------
+
+=pod
+
+=item select_dom_form($defdom,$name)
+
+Returns a string containing a <select name='$name' size='1'> form to
+allow a user to select the domain to preform an operation in.
+See loncreateuser.pm for an example invocation and use.
+
+=cut
+
+#-------------------------------------------
+sub select_dom_form {
+ my ($defdom,$name) = @_;
+ my @domains = get_domains();
+ my $selectdomain = "<select name=\"$name\" size=\"1\">\n";
+ foreach (@domains) {
+ $selectdomain.="<option value=\"$_\" ".
+ ($_ eq $defdom ? 'selected' : '').
+ ">$_</option>\n";
+ }
+ $selectdomain.="</select>";
+ return $selectdomain;
+}
+
+#-------------------------------------------
+
+=pod
+
+=item get_home_servers($domain)
+
+Returns a hash which contains keys like '103l3' and values like
+'kirk.lite.msu.edu'. All of the keys will be for machines in the
+given $domain.
+
+=cut
+
+#-------------------------------------------
sub get_home_servers {
my $domain = shift;
my %home_servers;
@@ -160,6 +572,18 @@ sub get_home_servers {
return %home_servers;
}
+#-------------------------------------------
+
+=pod
+
+=item home_server_option_list($domain)
+
+returns a string which contains an <option> list to be used in a
+<select> form input. See loncreateuser.pm for an example.
+
+=cut
+
+#-------------------------------------------
sub home_server_option_list {
my $domain = shift;
my %servers = &get_home_servers($domain);
@@ -182,6 +606,37 @@ sub home_server_option_list {
## hash, and have reasonable default values.
##
## formname = the name given in the <form> tag.
+#-------------------------------------------
+
+=pod
+
+=item authform_xxxxxx
+
+The authform_xxxxxx subroutines provide javascript and html forms which
+handle some of the conveniences required for authentication forms.
+This is not an optimal method, but it works.
+
+See loncreateuser.pm for invocation and use examples.
+
+=over 4
+
+=item authform_header
+
+=item authform_authorwarning
+
+=item authform_nochange
+
+=item authform_kerberos
+
+=item authform_internal
+
+=item authform_filesystem
+
+=back
+
+=cut
+
+#-------------------------------------------
sub authform_header{
my %in = (
formname => 'cu',
@@ -356,66 +811,166 @@ END
## End Authentication changing form generation functions ##
###############################################################
+###############################################################
+## Thesaurus Functions ##
+###############################################################
+=pod
-# ---------------------------------------------------------- Is this a keyword?
+=item initialize_keywords
-sub keyword {
- my $newword=shift;
- $newword=~s/\W//g;
- $newword=~tr/A-Z/a-z/;
- my $tindex=$theindex{$newword};
- if ($tindex) {
- if ($thecount[$tindex]>$theavecount) {
- return 1;
- }
+Initializes the package variable %Keywords if it is empty. Uses the
+package variable $thesaurus_db_file.
+
+=cut
+
+###################################################
+
+sub initialize_keywords {
+ return 1 if (scalar keys(%Keywords));
+ # If we are here, %Keywords is empty, so fill it up
+ # Make sure the file we need exists...
+ if (! -e $thesaurus_db_file) {
+ &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
+ " failed because it does not exist");
+ return 0;
+ }
+ # Set up the hash as a database
+ my %thesaurus_db;
+ if (! tie(%thesaurus_db,'GDBM_File',
+ $thesaurus_db_file,&GDBM_READER,0640)){
+ &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
+ $thesaurus_db_file);
+ return 0;
+ }
+ # Get the average number of appearances of a word.
+ my $avecount = $thesaurus_db{'average.count'};
+ # Put keywords (those that appear > average) into %Keywords
+ while (my ($word,$data)=each (%thesaurus_db)) {
+ my ($count,undef) = split /:/,$data;
+ $Keywords{$word}++ if ($count > $avecount);
+ }
+ untie %thesaurus_db;
+ # Remove special values from %Keywords.
+ foreach ('total.count','average.count') {
+ delete($Keywords{$_}) if (exists($Keywords{$_}));
}
- return 0;
+ return 1;
+}
+
+###################################################
+
+=pod
+
+=item keyword($word)
+
+Returns true if $word is a keyword. A keyword is a word that appears more
+than the average number of times in the thesaurus database. Calls
+&initialize_keywords
+
+=cut
+
+###################################################
+
+sub keyword {
+ return if (!&initialize_keywords());
+ my $word=lc(shift());
+ $word=~s/\W//g;
+ return exists($Keywords{$word});
}
+
+###################################################
+# Old code, to be removed soon #
+###################################################
# -------------------------------------------------------- Return related words
+#sub related {
+# my $newword=shift;
+# $newword=~s/\W//g;
+# $newword=~tr/A-Z/a-z/;
+# my $tindex=$theindex{$newword};
+# if ($tindex) {
+# my %found=();
+# foreach (split(/\,/,$therelated[$tindex])) {
+## - Related word found
+# my ($ridx,$rcount)=split(/\:/,$_);
+## - Direct relation index
+# my $directrel=$rcount/$thecount[$tindex];
+# if ($directrel>$thethreshold) {
+# foreach (split(/\,/,$therelated[$ridx])) {
+# my ($rridx,$rrcount)=split(/\:/,$_);
+# if ($rridx==$tindex) {
+## - Determine reverse relation index
+# my $revrel=$rrcount/$thecount[$ridx];
+## - Calculate full index
+# $found{$ridx}=$directrel*$revrel;
+# if ($found{$ridx}>$thethreshold) {
+# foreach (split(/\,/,$therelated[$ridx])) {
+# my ($rrridx,$rrrcount)=split(/\:/,$_);
+# unless ($found{$rrridx}) {
+# my $revrevrel=$rrrcount/$thecount[$ridx];
+# if (
+# $directrel*$revrel*$revrevrel>$thethreshold
+# ) {
+# $found{$rrridx}=
+# $directrel*$revrel*$revrevrel;
+# }
+# }
+# }
+# }
+# }
+# }
+# }
+# }
+# }
+# return ();
+#}
-sub related {
- my $newword=shift;
- $newword=~s/\W//g;
- $newword=~tr/A-Z/a-z/;
- my $tindex=$theindex{$newword};
- if ($tindex) {
- my %found=();
- foreach (split(/\,/,$therelated[$tindex])) {
-# - Related word found
- my ($ridx,$rcount)=split(/\:/,$_);
-# - Direct relation index
- my $directrel=$rcount/$thecount[$tindex];
- if ($directrel>$thethreshold) {
- foreach (split(/\,/,$therelated[$ridx])) {
- my ($rridx,$rrcount)=split(/\:/,$_);
- if ($rridx==$tindex) {
-# - Determine reverse relation index
- my $revrel=$rrcount/$thecount[$ridx];
-# - Calculate full index
- $found{$ridx}=$directrel*$revrel;
- if ($found{$ridx}>$thethreshold) {
- foreach (split(/\,/,$therelated[$ridx])) {
- my ($rrridx,$rrrcount)=split(/\:/,$_);
- unless ($found{$rrridx}) {
- my $revrevrel=$rrrcount/$thecount[$ridx];
- if (
- $directrel*$revrel*$revrevrel>$thethreshold
- ) {
- $found{$rrridx}=
- $directrel*$revrel*$revrevrel;
- }
- }
- }
- }
- }
- }
- }
+###############################################################
+
+=pod
+
+=item get_related_words
+
+Look up a word in the thesaurus. Takes a scalar arguement and returns
+an array of words. If the keyword is not in the thesaurus, an empty array
+will be returned. The order of the words returned is determined by the
+database which holds them.
+
+Uses global $thesaurus_db_file.
+
+=cut
+
+###############################################################
+
+sub get_related_words {
+ my $keyword = shift;
+ my %thesaurus_db;
+ if (! -e $thesaurus_db_file) {
+ &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
+ "failed because the file does not exist");
+ return ();
+ }
+ if (! tie(%thesaurus_db,'GDBM_File',
+ $thesaurus_db_file,&GDBM_READER,0640)){
+ return ();
+ }
+ my @Words=();
+ if (exists($thesaurus_db{$keyword})) {
+ $_ = $thesaurus_db{$keyword};
+ (undef,@Words) = split/:/; # The first element is the number of times
+ # the word appears. We do not need it now.
+ for (my $i=0;$i<=$#Words;$i++) {
+ ($Words[$i],undef)= split/\,/,$Words[$i];
}
}
- return ();
+ untie %thesaurus_db;
+ return @Words;
}
+###############################################################
+## End Thesaurus Functions ##
+###############################################################
+
# ---------------------------------------------------------------- Language IDs
sub languageids {
return sort(keys(%language));
@@ -438,12 +993,12 @@ sub copyrightdescription {
# ------------------------------------------------------------- File Categories
sub filecategories {
- return sort(keys(%fc));
+ return sort(keys(%category_extensions));
}
# -------------------------------------- File Types within a specified category
sub filecategorytypes {
- return @{$fc{lc(shift(@_))}};
+ return @{$category_extensions{lc($_[0])}};
}
# ------------------------------------------------------------------ File Types
@@ -467,9 +1022,22 @@ sub filedescriptionex {
return '.'.$ex.' '.$fd{lc($ex)};
}
+# ---- Retrieve attempts by students
+# input
+# $symb - problem including path
+# $username,$domain - that of the student
+# $course - course name
+# $getattempt - leave blank if want all attempts, else put something.
+# $regexp - regular expression. If string matches regexp send to
+# $gradesub - routine that process the string if it matches regexp
+#
+# output
+# formatted as a table all the attempts, if any.
+#
sub get_previous_attempt {
- my ($symb,$username,$domain,$course)=@_;
+ my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub)=@_;
my $prevattempts='';
+ no strict 'refs';
if ($symb) {
my (%returnhash)=
&Apache::lonnet::restore($symb,$course,$domain,$username);
@@ -481,30 +1049,37 @@ sub get_previous_attempt {
$lasthash{$_}=$returnhash{$version.':'.$_};
}
}
- $prevattempts='<table border=2></tr><th>History</th>';
+ $prevattempts='<table border="0" width="100%"><tr><td bgcolor="#777777">';
+ $prevattempts.='<table border="0" width="100%"><tr bgcolor="#e6ffff"><td>History</td>';
foreach (sort(keys %lasthash)) {
my ($ign,@parts) = split(/\./,$_);
- if (@parts) {
+ if ($#parts > 0) {
my $data=$parts[-1];
pop(@parts);
- $prevattempts.='<th>Part '.join('.',@parts).'<br />'.$data.'</th>';
+ $prevattempts.='<td>Part '.join('.',@parts).'<br />'.$data.' </td>';
} else {
- $prevattempts.='<th>'.$ign.'</th>';
- }
- }
- for ($version=1;$version<=$returnhash{'version'};$version++) {
- $prevattempts.='</tr><tr><th>Attempt '.$version.'</th>';
- foreach (sort(keys %lasthash)) {
- my $value;
- if ($_ =~ /timestamp/) {
- $value=scalar(localtime($returnhash{$version.':'.$_}));
+ if ($#parts == 0) {
+ $prevattempts.='<th>'.$parts[0].'</th>';
} else {
- $value=$returnhash{$version.':'.$_};
+ $prevattempts.='<th>'.$ign.'</th>';
}
- $prevattempts.='<td>'.$value.'</td>';
- }
+ }
+ }
+ if ($getattempt eq '') {
+ for ($version=1;$version<=$returnhash{'version'};$version++) {
+ $prevattempts.='</tr><tr bgcolor="#ffffe6"><td>Transaction '.$version.'</td>';
+ foreach (sort(keys %lasthash)) {
+ my $value;
+ if ($_ =~ /timestamp/) {
+ $value=scalar(localtime($returnhash{$version.':'.$_}));
+ } else {
+ $value=$returnhash{$version.':'.$_};
+ }
+ $prevattempts.='<td>'.$value.' </td>';
+ }
+ }
}
- $prevattempts.='</tr><tr><th>Current</th>';
+ $prevattempts.='</tr><tr bgcolor="#ffffe6"><td>Current</td>';
foreach (sort(keys %lasthash)) {
my $value;
if ($_ =~ /timestamp/) {
@@ -512,9 +1087,10 @@ sub get_previous_attempt {
} else {
$value=$lasthash{$_};
}
- $prevattempts.='<td>'.$value.'</td>';
+ if ($_ =~/$regexp$/) {$value = &$gradesub($value)}
+ $prevattempts.='<td>'.$value.' </td>';
}
- $prevattempts.='</tr></table>';
+ $prevattempts.='</tr></table></td></tr></table>';
} else {
$prevattempts='Nothing submitted - no attempts.';
}
@@ -564,16 +1140,13 @@ sub get_student_answers {
foreach my $element (@elements) {
$ENV{'form.grade_'.$element}=$old{$element};
}
- $userview=~s/\<body[^\>]*\>//gi;
- $userview=~s/\<\/body\>//gi;
- $userview=~s/\<html\>//gi;
- $userview=~s/\<\/html\>//gi;
- $userview=~s/\<head\>//gi;
- $userview=~s/\<\/head\>//gi;
- $userview=~s/action\s*\=/would_be_action\=/gi;
return $userview;
}
+###############################################
+
+###############################################
+
sub get_unprocessed_cgi {
my ($query,$possible_names)= @_;
# $Apache::lonxml::debug=1;
@@ -624,11 +1197,21 @@ sub add_to_env {
}
}
-#---CSV Upload/Handling functions
+=pod
+
+=back
-# ========================================================= Store uploaded file
-# needs $ENV{'form.upfile'}
-# return $datatoken to be put into hidden field
+=head2 CSV Upload/Handling functions
+
+=over 4
+
+=item upfile_store($r)
+
+Store uploaded file, $r should be the HTTP Request object,
+needs $ENV{'form.upfile'}
+returns $datatoken to be put into hidden field
+
+=cut
sub upfile_store {
my $r=shift;
@@ -647,9 +1230,13 @@ sub upfile_store {
return $datatoken;
}
-# ================================================= Load uploaded file from tmp
-# needs $ENV{'form.datatoken'}
-# sets $ENV{'form.upfile'} to the contents of the file
+=item load_tmp_file($r)
+
+Load uploaded file from tmp, $r should be the HTTP Request object,
+needs $ENV{'form.datatoken'},
+sets $ENV{'form.upfile'} to the contents of the file
+
+=cut
sub load_tmp_file {
my $r=shift;
@@ -664,10 +1251,13 @@ sub load_tmp_file {
$ENV{'form.upfile'}=join('',@studentdata);
}
-# ========================================= Separate uploaded file into records
-# returns array of records
-# needs $ENV{'form.upfile'}
-# needs $ENV{'form.upfiletype'}
+=item upfile_record_sep()
+
+Separate uploaded file into records
+returns array of records,
+needs $ENV{'form.upfile'} and $ENV{'form.upfiletype'}
+
+=cut
sub upfile_record_sep {
if ($ENV{'form.upfiletype'} eq 'xml') {
@@ -676,9 +1266,12 @@ sub upfile_record_sep {
}
}
-# =============================================== Separate a record into fields
-# needs $ENV{'form.upfiletype'}
-# takes $record as arg
+=item record_sep($record)
+
+Separate a record into fields $record should be an item from the upfile_record_sep(), needs $ENV{'form.upfiletype'}
+
+=cut
+
sub record_sep {
my $record=shift;
my %components=();
@@ -723,7 +1316,12 @@ sub record_sep {
return %components;
}
-# =============================== HTML code to select file and specify its type
+=item upfile_select_html()
+
+return HTML code to select file and specify its type
+
+=cut
+
sub upfile_select_html {
return (<<'ENDUPFORM');
<input type="file" name="upfile" size="50">
@@ -736,9 +1334,14 @@ sub upfile_select_html {
ENDUPFORM
}
-# ===================Prints a table of sample values from each column uploaded
-# $r is an Apache Request ref
-# $records is an arrayref from &Apache::loncommon::upfile_record_sep
+=item csv_print_samples($r,$records)
+
+Prints a table of sample values from each column uploaded $r is an
+Apache Request ref, $records is an arrayref from
+&Apache::loncommon::upfile_record_sep
+
+=cut
+
sub csv_print_samples {
my ($r,$records) = @_;
my (%sone,%stwo,%sthree);
@@ -761,10 +1364,15 @@ sub csv_print_samples {
$r->print('</tr></table><br />'."\n");
}
-# ======Prints a table to create associations between values and table columns
-# $r is an Apache Request ref
-# $records is an arrayref from &Apache::loncommon::upfile_record_sep
-# $d is an array of 2 element arrays (internal name, displayed name)
+=item csv_print_select_table($r,$records,$d)
+
+Prints a table to create associations between values and table columns.
+$r is an Apache Request ref,
+$records is an arrayref from &Apache::loncommon::upfile_record_sep,
+$d is an array of 2 element arrays (internal name, displayed name)
+
+=cut
+
sub csv_print_select_table {
my ($r,$records,$d) = @_;
my $i=0;my %sone;
@@ -788,11 +1396,16 @@ sub csv_print_select_table {
return $i;
}
-# ===================Prints a table of sample values from the upload and
-# can make associate samples to internal names
-# $r is an Apache Request ref
-# $records is an arrayref from &Apache::loncommon::upfile_record_sep
-# $d is an array of 2 element arrays (internal name, displayed name)
+=item csv_samples_select_table($r,$records,$d)
+
+Prints a table of sample values from the upload and can make associate samples to internal names.
+
+$r is an Apache Request ref,
+$records is an arrayref from &Apache::loncommon::upfile_record_sep,
+$d is an array of 2 element arrays (internal name, displayed name)
+
+=cut
+
sub csv_samples_select_table {
my ($r,$records,$d) = @_;
my %sone; my %stwo; my %sthree;
@@ -823,110 +1436,98 @@ sub csv_samples_select_table {
1;
__END__;
+=pod
-=head1 NAME
-
-Apache::loncommon - pile of common routines
-
-=head1 SYNOPSIS
-
-Referenced by other mod_perl Apache modules.
-
-Invocation:
- &Apache::loncommon::SUBROUTINENAME(ARGUMENTS);
-
-=head1 INTRODUCTION
-
-Common collection of used subroutines. This collection helps remove
-redundancy from other modules and increase efficiency of memory usage.
+=back
-Current things done:
+=head2 Access .tab File Data
- Makes a table out of the previous homework attempts
- Inputs result_from_symbread, user, domain, course_id
- Reads in non-network-related .tab files
+=over 4
-This is part of the LearningOnline Network with CAPA project
-described at http://www.lon-capa.org.
+=item languageids()
-=head1 HANDLER SUBROUTINE
+returns list of all language ids
-There is no handler subroutine.
+=item languagedescription()
-=head1 OTHER SUBROUTINES
+returns description of a specified language id
-=over 4
+=item copyrightids()
-=item *
+returns list of all copyrights
-BEGIN() : initialize values from language.tab, copyright.tab, filetypes.tab,
-and filecategories.tab.
+=item copyrightdescription()
-=item *
+returns description of a specified copyright id
-languageids() : returns list of all language ids
+=item filecategories()
-=item *
+returns list of all file categories
-languagedescription() : returns description of a specified language id
+=item filecategorytypes()
-=item *
+returns list of file types belonging to a given file
+category
-copyrightids() : returns list of all copyrights
+=item fileembstyle()
-=item *
+returns embedding style for a specified file type
-copyrightdescription() : returns description of a specified copyright id
+=item filedescription()
-=item *
+returns description for a specified file type
-filecategories() : returns list of all file categories
+=item filedescriptionex()
-=item *
+returns description for a specified file type with
+extra formatting
-filecategorytypes() : returns list of file types belonging to a given file
-category
+=back
-=item *
+=head2 Alternate Problem Views
-fileembstyle() : returns embedding style for a specified file type
+=over 4
-=item *
+=item get_previous_attempt()
-filedescription() : returns description for a specified file type
+return string with previous attempt on problem
-=item *
+=item get_student_view()
-filedescriptionex() : returns description for a specified file type with
-extra formatting
+show a snapshot of what student was looking at
-=item *
+=item get_student_answers()
-get_previous_attempt() : return string with previous attempt on problem
+show a snapshot of how student was answering problem
-=item *
+=back
-get_student_view() : show a snapshot of what student was looking at
+=head2 HTTP Helper
-=item *
+=over 4
-get_student_answers() : show a snapshot of how student was answering problem
+=item get_unprocessed_cgi($query,$possible_names)
-=item *
+Modify the %ENV hash to contain unprocessed CGI form parameters held in
+$query. The parameters listed in $possible_names (an array reference),
+will be set in $ENV{'form.name'} if they do not already exist.
-get_unprocessed_cgi() : get unparsed CGI parameters
+Typically called with $ENV{'QUERY_STRING'} as the first parameter.
+$possible_names is an ref to an array of form element names. As an example:
+get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
+will result in $ENV{'form.uname'} and $ENV{'form.udom'} being set.
-=item *
+=item cacheheader()
-cacheheader() : returns cache-controlling header code
+returns cache-controlling header code
-=item *
+=item nocache()
-nocache() : specifies header code to not have cache
+specifies header code to not have cache
-=item *
+=item add_to_env($name,$value)
-add_to_env($name,$value) : adds $name to the %ENV hash with value
+adds $name to the %ENV hash with value
$value, if $name already exists, the entry is converted to an array
reference and $value is added to the array.