--- loncom/interface/loncommon.pm 2002/04/22 18:04:19 1.33
+++ loncom/interface/loncommon.pm 2002/05/09 15:56:02 1.37
@@ -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.37 2002/05/09 15:56:02 matthew Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -38,6 +38,40 @@
# Inputs result_from_symbread, user, domain, course_id
# Reads in non-network-related .tab files
+# POD header:
+
+=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 Subroutines
+
+=over 4
+
+=cut
+
+# End of POD header
package Apache::loncommon;
use strict;
@@ -65,6 +99,14 @@ my $thethreshold=0.1/$thefuzzy;
my $theavecount;
# ----------------------------------------------------------------------- BEGIN
+=item BEGIN()
+
+Initialize values from language.tab, copyright.tab, filetypes.tab,
+and filecategories.tab.
+
+=cut
+# ----------------------------------------------------------------------- BEGIN
+
BEGIN {
unless ($readit) {
@@ -146,9 +188,229 @@ BEGIN {
}
# ============================================================= END BEGIN BLOCK
+
+=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.
+
+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
+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"
+ }
+ }
+ );
+
+=back
+
+=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 {
+
+###############################################################
+
+=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 ##
###############################################################
+#-------------------------------------------
+
+=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;
+}
+
+#-------------------------------------------
+
+=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;
+}
+
+#-------------------------------------------
+
+=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 +422,16 @@ sub get_home_servers {
return %home_servers;
}
+#-------------------------------------------
+
+=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 +454,35 @@ sub home_server_option_list {
## hash, and have reasonable default values.
##
## formname = the name given in the <form> tag.
+#-------------------------------------------
+
+=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',
@@ -574,6 +875,23 @@ sub get_student_answers {
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 {
my ($query,$possible_names)= @_;
# $Apache::lonxml::debug=1;
@@ -823,110 +1141,71 @@ sub csv_samples_select_table {
1;
__END__;
+=item languageids()
-=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.
-
-=head1 HANDLER SUBROUTINE
-
-There is no handler subroutine.
-
-=head1 OTHER SUBROUTINES
-
-=over 4
-
-=item *
-
-BEGIN() : initialize values from language.tab, copyright.tab, filetypes.tab,
-and filecategories.tab.
-
-=item *
-
-languageids() : returns list of all language ids
+returns list of all language ids
-=item *
+=item languagedescription()
-languagedescription() : returns description of a specified language id
+returns description of a specified language id
-=item *
+=item copyrightids()
-copyrightids() : returns list of all copyrights
+returns list of all copyrights
-=item *
+=item copyrightdescription()
-copyrightdescription() : returns description of a specified copyright id
+returns description of a specified copyright id
-=item *
+=item filecategories()
-filecategories() : returns list of all file categories
+returns list of all file categories
-=item *
+=item filecategorytypes()
-filecategorytypes() : returns list of file types belonging to a given file
+returns list of file types belonging to a given file
category
-=item *
+=item fileembstyle()
-fileembstyle() : returns embedding style for a specified file type
+returns embedding style for a specified file type
-=item *
+=item filedescription()
-filedescription() : returns description for a specified file type
+returns description for a specified file type
-=item *
+=item filedescriptionex()
-filedescriptionex() : returns description for a specified file type with
+returns description for a specified file type with
extra formatting
-=item *
+=item get_previous_attempt()
-get_previous_attempt() : return string with previous attempt on problem
+return string with previous attempt on problem
-=item *
+=item get_student_view()
-get_student_view() : show a snapshot of what student was looking at
+show a snapshot of what student was looking at
-=item *
+=item get_student_answers()
-get_student_answers() : show a snapshot of how student was answering problem
+show a snapshot of how student was answering problem
-=item *
+=item get_unprocessed_cgi()
-get_unprocessed_cgi() : get unparsed CGI parameters
+get unparsed CGI parameters
-=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.