--- loncom/interface/loncommon.pm 2002/05/09 15:56:02 1.37
+++ loncom/interface/loncommon.pm 2002/07/09 17:15:58 1.45
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.37 2002/05/09 15:56:02 matthew Exp $
+# $Id: loncommon.pm,v 1.45 2002/07/09 17:15:58 matthew Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -33,6 +33,7 @@
# 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
@@ -40,6 +41,8 @@
# POD header:
+=pod
+
=head1 NAME
Apache::loncommon - pile of common routines
@@ -65,7 +68,7 @@ Current things done:
This is part of the LearningOnline Network with CAPA project
described at http://www.lon-capa.org.
-=head2 Subroutines
+=head2 General Subroutines
=over 4
@@ -79,14 +82,13 @@ use Apache::lonnet();
use POSIX qw(strftime);
use Apache::Constants qw(:common);
use Apache::lonmsg();
-
my $readit;
# ----------------------------------------------- Filetypes/Languages/Copyright
my %language;
my %cprtag;
my %fe; my %fd;
-my %fc;
+my %category_extensions;
# -------------------------------------------------------------- Thesaurus data
my @therelated;
@@ -99,12 +101,16 @@ my $thethreshold=0.1/$thefuzzy;
my $theavecount;
# ----------------------------------------------------------------------- BEGIN
+
+=pod
+
=item BEGIN()
Initialize values from language.tab, copyright.tab, filetypes.tab,
-and filecategories.tab.
+thesaurus.tab, and filecategories.tab.
=cut
+
# ----------------------------------------------------------------------- BEGIN
BEGIN {
@@ -144,8 +150,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;
}
}
}
@@ -188,6 +194,92 @@ BEGIN {
}
# ============================================================= 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(...)
@@ -213,14 +305,16 @@ linked_select_forms takes the following
=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 values is given in $menu{$choice1}->{'text'}. The values
+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" ,
+my %menu = ( A1 => { text =>"Choice A1" ,
default => "B3",
select2 => {
B1 => "Choice B1",
@@ -251,8 +345,6 @@ $menu{$choice1}->{'select2'}.
}
);
-=back
-
=cut
# ------------------------------------------------
@@ -337,6 +429,52 @@ END
###############################################################
+=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'
@@ -358,6 +496,8 @@ sub csv_translate {
###############################################################
#-------------------------------------------
+=pod
+
=item get_domains()
Returns an array containing each of the domains listed in the hosts.tab
@@ -378,6 +518,8 @@ sub get_domains {
#-------------------------------------------
+=pod
+
=item select_dom_form($defdom,$name)
Returns a string containing a <select name='$name' size='1'> form to
@@ -402,6 +544,8 @@ sub select_dom_form {
#-------------------------------------------
+=pod
+
=item get_home_servers($domain)
Returns a hash which contains keys like '103l3' and values like
@@ -424,6 +568,8 @@ sub get_home_servers {
#-------------------------------------------
+=pod
+
=item home_server_option_list($domain)
returns a string which contains an <option> list to be used in a
@@ -456,6 +602,8 @@ sub home_server_option_list {
## formname = the name given in the <form> tag.
#-------------------------------------------
+=pod
+
=item authform_xxxxxx
The authform_xxxxxx subroutines provide javascript and html forms which
@@ -739,12 +887,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
@@ -768,9 +916,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);
@@ -782,30 +943,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/) {
@@ -813,9 +981,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.';
}
@@ -865,31 +1034,11 @@ 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;
}
###############################################
-=item get_unprocessed_cgi($query,$possible_names)
-
-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.
-
-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.
-
-=cut
-
###############################################
sub get_unprocessed_cgi {
@@ -942,11 +1091,21 @@ sub add_to_env {
}
}
-#---CSV Upload/Handling functions
+=pod
+
+=back
+
+=head2 CSV Upload/Handling functions
+
+=over 4
+
+=item upfile_store($r)
-# ========================================================= Store uploaded file
-# needs $ENV{'form.upfile'}
-# return $datatoken to be put into hidden field
+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;
@@ -965,9 +1124,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;
@@ -982,10 +1145,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') {
@@ -994,9 +1160,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=();
@@ -1041,7 +1210,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">
@@ -1054,9 +1228,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);
@@ -1079,10 +1258,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;
@@ -1106,11 +1290,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;
@@ -1141,6 +1330,14 @@ sub csv_samples_select_table {
1;
__END__;
+=pod
+
+=back
+
+=head2 Access .tab File Data
+
+=over 4
+
=item languageids()
returns list of all language ids
@@ -1179,6 +1376,12 @@ returns description for a specified file
returns description for a specified file type with
extra formatting
+=back
+
+=head2 Alternate Problem Views
+
+=over 4
+
=item get_previous_attempt()
return string with previous attempt on problem
@@ -1191,9 +1394,22 @@ show a snapshot of what student was look
show a snapshot of how student was answering problem
-=item get_unprocessed_cgi()
+=back
+
+=head2 HTTP Helper
+
+=over 4
+
+=item get_unprocessed_cgi($query,$possible_names)
+
+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 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 cacheheader()