--- loncom/interface/loncommon.pm 2003/10/27 21:21:08 1.136
+++ loncom/interface/loncommon.pm 2003/11/17 15:14:48 1.155
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.136 2003/10/27 21:21:08 matthew Exp $
+# $Id: loncommon.pm,v 1.155 2003/11/17 15:14:48 www Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -69,6 +69,7 @@ use Apache::Constants qw(:common :http :
use Apache::lonmsg();
use Apache::lonmenu();
use Apache::lonlocal;
+use HTML::Entities;
my $readit;
@@ -90,50 +91,19 @@ my %category_extensions;
my %designhash;
# ---------------------------------------------- Thesaurus variables
-
-# FIXME: I don't think it's necessary to document these things;
-# they're privately used - Jeremy
-
-=pod
-
-=over 4
-
-=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.
-
-=back
-
-=cut
+#
+# %Keywords:
+# A hash used by &keyword to determine if a word is considered a keyword.
+# $thesaurus_db_file
+# Scalar containing the full path to the thesaurus database.
my %Keywords;
my $thesaurus_db_file;
-# ----------------------------------------------------------------------- BEGIN
-
-# FIXME: I don't think this needs to be documented, it prepares
-# private data structures - Jeremy
-=pod
-
-=head1 General Subroutines
-
-=over 4
-
-=item * BEGIN()
-
-Initialize values from language.tab, copyright.tab, filetypes.tab,
-thesaurus.tab, and filecategories.tab.
-
-=back
-
-=cut
-
-# ----------------------------------------------------------------------- BEGIN
-
+#
+# Initialize values from language.tab, copyright.tab, filetypes.tab,
+# thesaurus.tab, and filecategories.tab.
+#
BEGIN {
# Variable initialization
$thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
@@ -234,6 +204,10 @@ BEGIN {
=pod
+=head1 General Subroutines
+
+=over 4
+
=head1 HTML and Javascript Functions
=over 4
@@ -520,6 +494,7 @@ function select1_changed() {
// in with the nuclear
for (i=0;i<values.length; i++) {
$second.options[i] = new Option(values[i]);
+ $second.options[i].value = values[i];
$second.options[i].text = texts[i];
if (values[i] == select2def) {
$second.options[i].selected = true;
@@ -1086,10 +1061,10 @@ END
sub authform_authorwarning{
my $result='';
- $result=<<"END";
-<i>As a general rule, only authors or co-authors should be filesystem
-authenticated (which allows access to the server filesystem).</i>
-END
+ $result='<i>'.
+ &mt('As a general rule, only authors or co-authors should be '.
+ 'filesystem authenticated '.
+ '(which allows access to the server filesystem).')."</i>\n";
return $result;
}
@@ -1099,12 +1074,10 @@ sub authform_nochange{
kerb_def_dom => 'MSU.EDU',
@_,
);
- my $result='';
- $result.=<<"END";
-<input type="radio" name="login" value="nochange" checked="checked"
- onclick="javascript:changed_radio('nochange',$in{'formname'});" />
-Do not change login data
-END
+ my $result = &mt('[_1] Do not change login data',
+ '<input type="radio" name="login" value="nochange" '.
+ 'checked="checked" onclick="'.
+ "javascript:changed_radio('nochange',$in{'formname'});".'" />');
return $result;
}
@@ -1115,24 +1088,23 @@ sub authform_kerberos{
kerb_def_auth => 'krb4',
@_,
);
- my $result='';
- my $check4;
- my $check5;
+ my ($check4,$check5);
if ($in{'kerb_def_auth'} eq 'krb5') {
$check5 = " checked=\"on\"";
} else {
$check4 = " checked=\"on\"";
}
- $result.=<<"END";
-<input type="radio" name="login" value="krb"
- onclick="javascript:changed_radio('krb',$in{'formname'});"
- onchange="javascript:changed_radio('krb',$in{'formname'});" />
-Kerberos authenticated with domain
-<input type="text" size="10" name="krbarg" value="$in{'kerb_def_dom'}"
- onchange="javascript:changed_text('krb',$in{'formname'});" />
-<input type="radio" name="krbver" value="4" $check4 />Version 4
-<input type="radio" name="krbver" value="5" $check5 />Version 5
-END
+ my $jscall = "javascript:changed_radio('krb',$in{'formname'});";
+ my $result .= &mt
+ ('[_1] Kerberos authenticated with domain [_2] '.
+ '[_3] Version 4 [_4] Version 5',
+ '<input type="radio" name="login" value="krb" '.
+ 'onclick="'.$jscall.'" onchange="'.$jscall.'" />',
+ '<input type="text" size="10" name="krbarg" '.
+ 'value="'.$in{'kerb_def_dom'}.'" '.
+ 'onchange="'.$jscall.'" />',
+ '<input type="radio" name="krbver" value="4" '.$check4.' />',
+ '<input type="radio" name="krbver" value="5" '.$check5.' />');
return $result;
}
@@ -1142,15 +1114,13 @@ sub authform_internal{
kerb_def_dom => 'MSU.EDU',
@_,
);
- my $result='';
- $result.=<<"END";
-<input type="radio" name="login" value="int"
- onchange="javascript:changed_radio('int',$args{'formname'});"
- onclick="javascript:changed_radio('int',$args{'formname'});" />
-Internally authenticated (with initial password
-<input type="text" size="10" name="intarg" value=""
- onchange="javascript:changed_text('int',$args{'formname'});" />)
-END
+ my $jscall = "javascript:changed_radio('int',$args{'formname'});";
+ my $result.=&mt
+ ('[_1] Internally authenticated (with initial password [_2])',
+ '<input type="radio" name="login" value="int" '.
+ 'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
+ '<input type="text" size="10" name="intarg" value="" '.
+ 'onchange="'.$jscall.'" />');
return $result;
}
@@ -1160,15 +1130,12 @@ sub authform_local{
kerb_def_dom => 'MSU.EDU',
@_,
);
- my $result='';
- $result.=<<"END";
-<input type="radio" name="login" value="loc"
- onchange="javascript:changed_radio('loc',$in{'formname'});"
- onclick="javascript:changed_radio('loc',$in{'formname'});" />
-Local Authentication with argument
-<input type="text" size="10" name="locarg" value=""
- onchange="javascript:changed_text('loc',$in{'formname'});" />
-END
+ my $jscall = "javascript:changed_radio('loc',$in{'formname'});";
+ my $result.=&mt('[_1] Local Authentication with arguement [_2]',
+ '<input type="radio" name="login" value="loc" '.
+ 'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
+ '<input type="text" size="10" name="locarg" value="" '.
+ 'onchange="'.$jscall.'" />');
return $result;
}
@@ -1178,15 +1145,13 @@ sub authform_filesystem{
kerb_def_dom => 'MSU.EDU',
@_,
);
- my $result='';
- $result.=<<"END";
-<input type="radio" name="login" value="fsys"
- onchange="javascript:changed_radio('fsys',$in{'formname'});"
- onclick="javascript:changed_radio('fsys',$in{'formname'});" />
-Filesystem authenticated (with initial password
-<input type="text" size="10" name="fsysarg" value=""
- onchange="javascript:changed_text('fsys',$in{'formname'});">)
-END
+ my $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
+ my $result.= &mt
+ ('[_1] Filesystem Authenticated (with initial password [_2])',
+ '<input type="radio" name="login" value="fsys" '.
+ 'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
+ '<input type="text" size="10" name="fsysarg" value="" '.
+ 'onchange="'.$jscall.'" />');
return $result;
}
@@ -1534,6 +1499,16 @@ sub languagedescription {
($supported_language{$code}?' ('.&mt('interface available').')':'');
}
+sub plainlanguagedescription {
+ my $code=shift;
+ return $language{$code};
+}
+
+sub supportedlanguagecode {
+ my $code=shift;
+ return $supported_language{$code};
+}
+
=pod
=item * copyrightids()
@@ -1770,7 +1745,7 @@ sub get_previous_attempt {
} else {
$value=$returnhash{$version.':'.$_};
}
- $prevattempts.='<td>'.$value.' </td>';
+ $prevattempts.='<td>'.&Apache::lonnet::unescape($value).' </td>';
}
}
}
@@ -1782,6 +1757,7 @@ sub get_previous_attempt {
} else {
$value=$lasthash{$_};
}
+ $value=&Apache::lonnet::unescape($value);
if ($_ =~/$regexp$/ && (defined &$gradesub)) {$value = &$gradesub($value)}
$prevattempts.='<td>'.$value.' </td>';
}
@@ -2031,7 +2007,7 @@ sub domainlogo {
my $lonhttpdPort=$Apache::lonnet::perlvar{'lonhttpdPort'};
if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; }
return '<img src="http://'.$ENV{'HTTP_HOST'}.':'.$lonhttpdPort.
- '/adm/lonDomLogos/'.$domain.'.gif" />';
+ '/adm/lonDomLogos/'.$domain.'.gif" alt="'.$domain.'" />';
} elsif(exists($Apache::lonnet::domaindescription{$domain})) {
return $Apache::lonnet::domaindescription{$domain};
} else {
@@ -2142,8 +2118,9 @@ sub bodytag {
my $sidebg=&designparm($function.'.sidebg',$domain);
# Accessibility font enhance
unless ($addentries) { $addentries=''; }
+ my $addstyle='';
if ($ENV{'browser.fontenhance'} eq 'on') {
- $addentries.=' style="font-size: x-large"';
+ $addstyle=' font-size: x-large;';
}
# role and realm
my ($role,$realm)
@@ -2161,11 +2138,15 @@ sub bodytag {
if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; }
# construct main body tag
my $bodytag = <<END;
+<style>
+h1, h2, h3, th { font-family: Arial, Helvetica, sans-serif }
+a:focus { color: red; background: yellow }
+</style>
<body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link"
-$addentries>
+style="margin-top: 0px;$addstyle" $addentries>
END
my $upperleft='<img src="http://'.$ENV{'HTTP_HOST'}.':'.
- $lonhttpdPort.$img.'" />';
+ $lonhttpdPort.$img.'" alt="'.$function.'" />';
if ($bodyonly) {
return $bodytag;
} elsif ($ENV{'browser.interface'} eq 'textual') {
@@ -2177,7 +2158,7 @@ END
# No Remote
return $bodytag.&Apache::lonmenu::menubuttons($forcereg,'web',
$forcereg).
- '<table bgcolor="'.$pgbg.'" width="100%" border="0" cellspacing="3" cellpadding="3"><tr><td bgcolor="'.$tabbg.'"><font size="+3" color="'.$font.'"><b>'.$title.
+ '<table bgcolor="'.$pgbg.'" width="100%" border="0" cellspacing="3" cellpadding="3"><tr><td bgcolor="'.$tabbg.'"><font face="Arial, Helvetica, sans-serif" size="+3" color="'.$font.'"><b>'.$title.
'</b></font></td></tr></table>';
}
@@ -2193,9 +2174,9 @@ $upperleft</td>
</tr>
<tr>
<td rowspan="3" bgcolor="$tabbg">
- <font size="5"><b>$title</b></font>
-<td bgcolor="$tabbg" align="right">
-<font size="2">
+ <font size="5" face="Arial, Helvetica, sans-serif"><b>$title</b></font>
+<td bgcolor="$tabbg" align="right">
+<font size="2" face="Arial, Helvetica, sans-serif">
$ENV{'environment.firstname'}
$ENV{'environment.middlename'}
$ENV{'environment.lastname'}
@@ -2204,10 +2185,10 @@ $upperleft</td>
</td>
</tr>
<tr><td bgcolor="$tabbg" align="right">
-<font size="2">$role</font>
+<font size="2" face="Arial, Helvetica, sans-serif">$role</font>
</td></tr>
<tr>
-<td bgcolor="$tabbg" align="right"><font size="2">$realm</font> </td></tr>
+<td bgcolor="$tabbg" align="right"><font size="2" face="Arial, Helvetica, sans-serif">$realm</font> </td></tr>
</table><br>
ENDBODY
}
@@ -2384,6 +2365,32 @@ sub add_to_env {
=pod
+=item * get_env_multiple($name)
+
+gets $name from the %ENV hash, it seemlessly handles the cases where multiple
+values may be defined and end up as an array ref.
+
+returns an array of values
+
+=cut
+
+sub get_env_multiple {
+ my ($name) = @_;
+ my @values;
+ if (defined($ENV{$name})) {
+ # exists is it an array
+ if (ref($ENV{$name})) {
+ @values=@{ $ENV{$name} };
+ } else {
+ $values[0]=$ENV{$name};
+ }
+ }
+ return(@values);
+}
+
+
+=pod
+
=back
=head1 CSV Upload/Handling functions
@@ -2507,26 +2514,39 @@ sub record_sep {
return %components;
}
+######################################################
+######################################################
+
=pod
=item * upfile_select_html()
-return HTML code to select file and specify its type
+Return HTML code to select a file from the users machine and specify
+the file type.
=cut
+######################################################
+######################################################
sub upfile_select_html {
- return (<<'ENDUPFORM');
-<input type="file" name="upfile" size="50" />
-<br />Type: <select name="upfiletype">
-<option value="csv">CSV (comma separated values, spreadsheet)</option>
-<option value="space">Space separated</option>
-<option value="tab">Tabulator separated</option>
-<option value="xml">HTML/XML</option>
-</select>
-ENDUPFORM
+ my %Types = (
+ csv => &mt('CSV (comma separated values, spreadsheet)'),
+ space => &mt('Space separated'),
+ tab => &mt('Tabulator separated'),
+# xml => &mt('HTML/XML'),
+ );
+ my $Str = '<input type="file" name="upfile" size="50" />'.
+ '<br />Type: <select name="upfiletype">';
+ foreach my $type (sort(keys(%Types))) {
+ $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
+ }
+ $Str .= "</select>\n";
+ return $Str;
}
+######################################################
+######################################################
+
=pod
=item * csv_print_samples($r,$records)
@@ -2537,15 +2557,18 @@ Apache Request ref, $records is an array
=cut
+######################################################
+######################################################
sub csv_print_samples {
my ($r,$records) = @_;
my (%sone,%stwo,%sthree);
%sone=&record_sep($$records[0]);
if (defined($$records[1])) {%stwo=&record_sep($$records[1]);}
if (defined($$records[2])) {%sthree=&record_sep($$records[2]);}
-
- $r->print('Samples<br /><table border="2"><tr>');
- foreach (sort({$a <=> $b} keys(%sone))) { $r->print('<th>Column '.($_+1).'</th>'); }
+ #
+ $r->print(&mt('Samples').'<br /><table border="2"><tr>');
+ foreach (sort({$a <=> $b} keys(%sone))) {
+ $r->print('<th>'.&mt('Column [_1]',($_+1)).'</th>'); }
$r->print('</tr>');
foreach my $hash (\%sone,\%stwo,\%sthree) {
$r->print('<tr>');
@@ -2559,23 +2582,31 @@ sub csv_print_samples {
$r->print('</tr></table><br />'."\n");
}
+######################################################
+######################################################
+
=pod
=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;
%sone=&record_sep($$records[0]);
- $r->print('Associate columns with student attributes.'."\n".
- '<table border="2"><tr><th>Attribute</th><th>Column</th></tr>'."\n");
+ $r->print(&mt('Associate columns with student attributes.')."\n".
+ '<table border="2"><tr>'.
+ '<th>'.&mt('Attribute').'</th>'.
+ '<th>'.&mt('Column').'</th></tr>'."\n");
foreach (@$d) {
my ($value,$display)=@{ $_ };
$r->print('<tr><td>'.$display.'</td>');
@@ -2593,6 +2624,9 @@ sub csv_print_select_table {
return $i;
}
+######################################################
+######################################################
+
=pod
=item * csv_samples_select_table($r,$records,$d)
@@ -2605,22 +2639,25 @@ $d is an array of 2 element arrays (inte
=cut
+######################################################
+######################################################
sub csv_samples_select_table {
my ($r,$records,$d) = @_;
my %sone; my %stwo; my %sthree;
my $i=0;
-
- $r->print('<table border=2><tr><th>Field</th><th>Samples</th></tr>');
+ #
+ $r->print('<table border=2><tr><th>'.
+ &mt('Field').'</th><th>'.&mt('Samples').'</th></tr>');
%sone=&record_sep($$records[0]);
if (defined($$records[1])) {%stwo=&record_sep($$records[1]);}
if (defined($$records[2])) {%sthree=&record_sep($$records[2]);}
-
+ #
foreach (sort keys %sone) {
- $r->print('<tr><td><select name=f'.$i.
+ $r->print('<tr><td><select name="f'.$i.'"'.
' onchange="javascript:flip(this.form,'.$i.');">');
foreach (@$d) {
my ($value,$display)=@{ $_ };
- $r->print('<option value='.$value.'>'.$display.'</option>');
+ $r->print('<option value="'.$value.'">'.$display.'</option>');
}
$r->print('</select></td><td>');
if (defined($sone{$_})) { $r->print($sone{$_}."</br>\n"); }
@@ -2633,6 +2670,9 @@ sub csv_samples_select_table {
return($i);
}
+######################################################
+######################################################
+
=pod
=item clean_excel_name($name)
@@ -2641,6 +2681,8 @@ Returns a replacement for $name which do
=cut
+######################################################
+######################################################
sub clean_excel_name {
my ($name) = @_;
$name =~ s/[:\*\?\/\\]//g;
@@ -2671,15 +2713,41 @@ sub check_if_partid_hidden {
my ($id,$symb,$udom,$uname) = @_;
my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
$symb,$udom,$uname);
+ my $truth=1;
+ #if the string starts with !, then the list is the list to show not hide
+ if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
my @hiddenlist=split(/,/,$hiddenparts);
foreach my $checkid (@hiddenlist) {
- if ($checkid =~ /^\s*\Q$id\E\s*$/) { return 1; }
+ if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
}
- return undef;
+ return !$truth;
}
+
+############################################################
+############################################################
+
+=pod
+
+=head1 cgi-bin script and graphing routines
+
+=item get_cgi_id
+
+Inputs: none
+
+Returns an id which can be used to pass environment variables
+to various cgi-bin scripts. These environment variables will
+be removed from the users environment after a given time by
+the routine &Apache::lonnet::transfer_profile_to_env.
+
+=cut
+
+############################################################
+############################################################
+my $uniq=0;
sub get_cgi_id {
- return (time.'_'.int(rand(1000)));
+ $uniq=($uniq+1)%100000;
+ return (time.'_'.$uniq);
}
############################################################
@@ -2689,6 +2757,37 @@ sub get_cgi_id {
=item DrawBarGraph
+Facilitates the plotting of data in a (stacked) bar graph.
+Puts plot definition data into the users environment in order for
+graph.png to plot it. Returns an <img> tag for the plot.
+The bars on the plot are labeled '1','2',...,'n'.
+
+Inputs:
+
+=over 4
+
+=item $Title: string, the title of the plot
+
+=item $xlabel: string, text describing the X-axis of the plot
+
+=item $ylabel: string, text describing the Y-axis of the plot
+
+=item $Max: scalar, the maximum Y value to use in the plot
+If $Max is < any data point, the graph will not be rendered.
+
+=item $colors: array ref holding the colors to be used for the data sets when
+they are plotted. If undefined, default values will be used.
+
+=item @Values: An array of array references. Each array reference holds data
+to be plotted in a stacked bar chart.
+
+=back
+
+Returns:
+
+An <img> tag which references graph.png and the appropriate identifying
+information for the plot.
+
=cut
############################################################
@@ -2741,13 +2840,18 @@ sub DrawBarGraph {
push (@Labels,$i+1);
}
#
+ $Max = 1 if ($Max < 1);
+ if ( int($Max) < $Max ) {
+ $Max++;
+ $Max = int($Max);
+ }
$Title = '' if (! defined($Title));
$xlabel = '' if (! defined($xlabel));
$ylabel = '' if (! defined($ylabel));
$ValuesHash{$id.'.title'} = &Apache::lonnet::escape($Title);
$ValuesHash{$id.'.xlabel'} = &Apache::lonnet::escape($xlabel);
$ValuesHash{$id.'.ylabel'} = &Apache::lonnet::escape($ylabel);
- $ValuesHash{$id.'.Max'} = $Max;
+ $ValuesHash{$id.'.y_max_value'} = $Max;
$ValuesHash{$id.'.NumBars'} = $NumBars;
$ValuesHash{$id.'.NumSets'} = $NumSets;
$ValuesHash{$id.'.PlotType'} = 'bar';
@@ -2758,12 +2862,6 @@ sub DrawBarGraph {
$ValuesHash{$id.'.bar_width'} = $bar_width;
$ValuesHash{$id.'.labels'} = join(',',@Labels);
#
- $Max = 1 if ($Max < 1);
- if ( int($Max) < $Max ) {
- $Max++;
- $Max = int($Max);
- }
- #
&Apache::lonnet::appenv(%ValuesHash);
return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
}
@@ -2775,12 +2873,145 @@ sub DrawBarGraph {
=item DrawXYGraph
+Facilitates the plotting of data in an XY graph.
+Puts plot definition data into the users environment in order for
+graph.png to plot it. Returns an <img> tag for the plot.
+
+Inputs:
+
+=over 4
+
+=item $Title: string, the title of the plot
+
+=item $xlabel: string, text describing the X-axis of the plot
+
+=item $ylabel: string, text describing the Y-axis of the plot
+
+=item $Max: scalar, the maximum Y value to use in the plot
+If $Max is < any data point, the graph will not be rendered.
+
+=item $colors: Array ref containing the hex color codes for the data to be
+plotted in. If undefined, default values will be used.
+
+=item $Xlabels: Array ref containing the labels to be used for the X-axis.
+
+=item $Ydata: Array ref containing Array refs.
+Each of the contained arrays will be plotted as a seperate curve.
+
+=item %Values: hash indicating or overriding any default values which are
+passed to graph.png.
+Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
+
+=back
+
+Returns:
+
+An <img> tag which references graph.png and the appropriate identifying
+information for the plot.
+
=cut
############################################################
############################################################
sub DrawXYGraph {
- my ($Title,$xlabel,$ylabel,$Max,$Xlabels,$Ydata,%Values)=@_;
+ my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
+ #
+ # Create the identifier for the graph
+ my $identifier = &get_cgi_id();
+ my $id = 'cgi.'.$identifier;
+ #
+ $Title = '' if (! defined($Title));
+ $xlabel = '' if (! defined($xlabel));
+ $ylabel = '' if (! defined($ylabel));
+ my %ValuesHash =
+ (
+ $id.'.title' => &Apache::lonnet::escape($Title),
+ $id.'.xlabel' => &Apache::lonnet::escape($xlabel),
+ $id.'.ylabel' => &Apache::lonnet::escape($ylabel),
+ $id.'.y_max_value'=> $Max,
+ $id.'.labels' => join(',',@$Xlabels),
+ $id.'.PlotType' => 'XY',
+ );
+ #
+ if (defined($colors) && ref($colors) eq 'ARRAY') {
+ $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
+ }
+ #
+ if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
+ return '';
+ }
+ my $NumSets=1;
+ foreach my $array (@{$Ydata}){
+ next if (! ref($array));
+ $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
+ }
+ $ValuesHash{$id.'.NumSets'} = $NumSets-1;
+ #
+ # Deal with other parameters
+ while (my ($key,$value) = each(%Values)) {
+ $ValuesHash{$id.'.'.$key} = $value;
+ }
+ #
+ &Apache::lonnet::appenv(%ValuesHash);
+ return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
+}
+
+############################################################
+############################################################
+
+=pod
+
+=item DrawXYYGraph
+
+Facilitates the plotting of data in an XY graph with two Y axes.
+Puts plot definition data into the users environment in order for
+graph.png to plot it. Returns an <img> tag for the plot.
+
+Inputs:
+
+=over 4
+
+=item $Title: string, the title of the plot
+
+=item $xlabel: string, text describing the X-axis of the plot
+
+=item $ylabel: string, text describing the Y-axis of the plot
+
+=item $colors: Array ref containing the hex color codes for the data to be
+plotted in. If undefined, default values will be used.
+
+=item $Xlabels: Array ref containing the labels to be used for the X-axis.
+
+=item $Ydata1: The first data set
+
+=item $Min1: The minimum value of the left Y-axis
+
+=item $Max1: The maximum value of the left Y-axis
+
+=item $Ydata2: The second data set
+
+=item $Min2: The minimum value of the right Y-axis
+
+=item $Max2: The maximum value of the left Y-axis
+
+=item %Values: hash indicating or overriding any default values which are
+passed to graph.png.
+Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
+
+=back
+
+Returns:
+
+An <img> tag which references graph.png and the appropriate identifying
+information for the plot.
+
+=cut
+
+############################################################
+############################################################
+sub DrawXYYGraph {
+ my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
+ $Ydata2,$Min2,$Max2,%Values)=@_;
#
# Create the identifier for the graph
my $identifier = &get_cgi_id();
@@ -2794,21 +3025,35 @@ sub DrawXYGraph {
$id.'.title' => &Apache::lonnet::escape($Title),
$id.'.xlabel' => &Apache::lonnet::escape($xlabel),
$id.'.ylabel' => &Apache::lonnet::escape($ylabel),
- $id.'.Max' => $Max,
$id.'.labels' => join(',',@$Xlabels),
$id.'.PlotType' => 'XY',
$id.'.NumSets' => 2,
+ $id.'.two_axes' => 1,
+ $id.'.y1_max_value' => $Max1,
+ $id.'.y1_min_value' => $Min1,
+ $id.'.y2_max_value' => $Max2,
+ $id.'.y2_min_value' => $Min2,
);
#
- if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
+ if (defined($colors) && ref($colors) eq 'ARRAY') {
+ $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
+ }
+ #
+ if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
+ ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
return '';
}
my $NumSets=1;
- foreach my $array ($Ydata){
+ foreach my $array ($Ydata1,$Ydata2){
next if (! ref($array));
$ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
}
#
+ # Deal with other parameters
+ while (my ($key,$value) = each(%Values)) {
+ $ValuesHash{$id.'.'.$key} = $value;
+ }
+ #
&Apache::lonnet::appenv(%ValuesHash);
return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
}
@@ -2818,6 +3063,155 @@ sub DrawXYGraph {
=pod
+=head1 Statistics helper routines?
+
+Bad place for them but what the hell.
+
+=item &chartlink
+
+Returns a link to the chart for a specific student.
+
+Inputs:
+
+=over 4
+
+=item $linktext: The text of the link
+
+=item $sname: The students username
+
+=item $sdomain: The students domain
+
+=back
+
+=cut
+
+############################################################
+############################################################
+sub chartlink {
+ my ($linktext, $sname, $sdomain) = @_;
+ my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
+ '&SelectedStudent='.&Apache::lonnet::escape($sname.':'.$sdomain).
+ '&chartoutputmode='.HTML::Entities::encode('html, with all links').
+ '">'.$linktext.'</a>';
+}
+
+#######################################################
+#######################################################
+
+=pod
+
+=head1 Course Environment Routines
+
+=item &restore_course_settings
+
+=item &store_course_settings
+
+Restores/Store indicated form parameters from the course environment.
+Will not overwrite existing values of the form parameters.
+
+Inputs:
+a scalar describing the data (e.g. 'chart', 'problem_analysis')
+
+a hash ref describing the data to be stored. For example:
+
+%Save_Parameters = ('Status' => 'scalar',
+ 'chartoutputmode' => 'scalar',
+ 'chartoutputdata' => 'scalar',
+ 'Section' => 'array',
+ 'StudentData' => 'array',
+ 'Maps' => 'array');
+
+Returns: both routines return nothing
+
+=cut
+
+#######################################################
+#######################################################
+sub store_course_settings {
+ # save to the environment
+ # appenv the same items, just to be safe
+ my $courseid = $ENV{'request.course.id'};
+ my $coursedom = $ENV{'course.'.$courseid.'.domain'};
+ my ($prefix,$Settings) = @_;
+ my %SaveHash;
+ my %AppHash;
+ while (my ($setting,$type) = each(%$Settings)) {
+ my $basename = 'env.internal.'.$prefix.'.'.$setting;
+ my $envname = 'course.'.$courseid.'.'.$basename;
+ if (exists($ENV{'form.'.$setting})) {
+ # Save this value away
+ if ($type eq 'scalar' &&
+ (! exists($ENV{$envname}) ||
+ $ENV{$envname} ne $ENV{'form.'.$setting})) {
+ $SaveHash{$basename} = $ENV{'form.'.$setting};
+ $AppHash{$envname} = $ENV{'form.'.$setting};
+ } elsif ($type eq 'array') {
+ my $stored_form;
+ if (ref($ENV{'form.'.$setting})) {
+ $stored_form = join(',',
+ map {
+ &Apache::lonnet::escape($_);
+ } sort(@{$ENV{'form.'.$setting}}));
+ } else {
+ $stored_form =
+ &Apache::lonnet::escape($ENV{'form.'.$setting});
+ }
+ # Determine if the array contents are the same.
+ if ($stored_form ne $ENV{$envname}) {
+ $SaveHash{$basename} = $stored_form;
+ $AppHash{$envname} = $stored_form;
+ }
+ }
+ }
+ }
+ my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
+ $coursedom,
+ $ENV{'course.'.$courseid.'.num'});
+ if ($put_result !~ /^(ok|delayed)/) {
+ &Apache::lonnet::logthis('unable to save form parameters, '.
+ 'got error:'.$put_result);
+ }
+ # Make sure these settings stick around in this session, too
+ &Apache::lonnet::appenv(%AppHash);
+ return;
+}
+
+sub restore_course_settings {
+ my $courseid = $ENV{'request.course.id'};
+ my ($prefix,$Settings) = @_;
+ while (my ($setting,$type) = each(%$Settings)) {
+ next if (exists($ENV{'form.'.$setting}));
+ my $envname = 'course.'.$courseid.'.env.internal.'.$prefix.
+ '.'.$setting;
+ if (exists($ENV{$envname})) {
+ if ($type eq 'scalar') {
+ $ENV{'form.'.$setting} = $ENV{$envname};
+ } elsif ($type eq 'array') {
+ $ENV{'form.'.$setting} = [
+ map {
+ &Apache::lonnet::unescape($_);
+ } split(',',$ENV{$envname})
+ ];
+ }
+ }
+ }
+}
+
+############################################################
+############################################################
+
+sub propath {
+ my ($udom,$uname)=@_;
+ $udom=~s/\W//g;
+ $uname=~s/\W//g;
+ my $subdir=$uname.'__';
+ $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;
+ my $proname="$Apache::lonnet::perlvar{'lonUsersDir'}/$udom/$subdir/$uname";
+ return $proname;
+}
+
+=pod
+
=back
=cut