version 1.9, 2002/02/01 11:47:34
|
version 1.24, 2003/10/09 22:04:37
|
Line 25
|
Line 25
|
# http://www.lon-capa.org/ |
# http://www.lon-capa.org/ |
# |
# |
# The LearningOnline Network with CAPA |
# The LearningOnline Network with CAPA |
# Behrouz Minaei |
# |
# YEAR=2001 |
|
# 9/13/01, 9/25/01, 10/6/01, 10/9/01, 12/25/01 |
|
# YEAR=2002 |
|
# 2/1/02 |
|
# A CGI script that dynamically outputs a graphical chart for lonstatistics. |
# A CGI script that dynamically outputs a graphical chart for lonstatistics. |
# |
# |
#### |
#### |
|
|
|
=pod |
|
|
|
=head1 NAME |
|
|
|
graph.png |
|
|
|
=head1 SYNOPSIS |
|
|
|
produces plots based on input |
|
|
|
=head1 DESCRIPTION |
|
|
|
graph.png is a cgi-bin script which produces plots based on input data. |
|
|
|
The query string is expected to be as follows (without whitespace): |
|
|
|
escape(Plot title) & escape(X label)& escape(Y label) & Maximum Y value & |
|
Number of bars & $data1 & $data2 |
|
|
|
$data1 and $data2 are expected to be comma seperated lists of numbers. |
|
escape( value ) means the values must be run through lonnet::escape. |
|
|
|
=cut |
|
|
use strict; |
use strict; |
|
use lib '/home/httpd/lib/perl'; |
use GD::Graph::bars; |
use GD::Graph::bars; |
use GD::Graph::colour; |
use GD::Graph::colour; |
use GD::Graph::Data; |
use GD::Graph::Data; |
|
use LONCAPA::loncgi(); |
|
|
|
sub unescape { |
|
my $str=shift; |
|
$str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; |
|
return $str; |
|
} |
|
|
|
if (! &LONCAPA::loncgi::check_cookie_and_load_env()) { |
|
print <<END; |
|
Content-type: text/html |
|
|
|
<html> |
|
<head><title>Bad Cookie</title></head> |
|
<body> |
|
Your cookie information is incorrect. What\'s up with that? |
|
</body> |
|
</html> |
|
END |
|
return; |
|
} |
|
|
$|=1; # Autoflush after each print/write |
$|=1; # Autoflush after each print/write |
my ($cid, $Tag, $Max, $PNo, $data) = split(/&/,$ENV{'QUERY_STRING'}); |
my $identifier = $ENV{'QUERY_STRING'}; |
|
my $Title = &unescape($ENV{$identifier.'.title'}); |
|
my $xlabel = &unescape($ENV{$identifier.'.xlabel'}); |
|
my $ylabel = &unescape($ENV{$identifier.'.ylabel'}); |
|
my $Max = $ENV{$identifier.'.Max'}; |
|
my $NumBars = $ENV{$identifier.'.NumBars'}; |
|
my $data1 = $ENV{$identifier.'.data1'}; |
|
my $data2 = $ENV{$identifier.'.data2'}; |
|
|
|
my @data11=split(/\,/,$data1); |
|
my @data12=split(/\,/,$data2); |
|
my $skip_x = 1; |
|
my $bar_width=10; |
|
|
my @data1=split(/\,/,$data); |
# |
|
# Labels are always digits |
my @xlabels; |
my @xlabels; |
for (my $nIdx=0; $nIdx<$PNo; $nIdx++ ) { |
for (my $nIdx=0; $nIdx<$NumBars; $nIdx++ ) { |
$xlabels[$nIdx]=$nIdx+1; |
$xlabels[$nIdx]=$nIdx+1; |
} |
} |
my @data =(\@xlabels,\@data1); |
|
|
|
my $Range; |
my @data =(\@xlabels,\@data11,\@data12); |
if ( $PNo > 10 ) {$Range = 30*$PNo;} |
|
else { $Range = 400+30*$PNo; } |
|
|
|
$Max += (10 - $Max % 10); |
|
$Max = int($Max); |
|
|
|
my $MyGraph = GD::Graph::bars->new($Range, 400); |
|
|
|
$MyGraph->set( |
|
x_label => 'Problems #', |
|
y_label => $Tag, |
|
title => 'LON-CAPA Graphical Chart, Course: '.$cid, |
|
y_max_value => $Max, |
|
y_tick_number => 10, |
|
y_label_skip => 1, |
|
x_label_skip => 2, |
|
|
|
# colors |
|
dclrs => [ qw( green lblue lyellow lpurple cyan lorange)], |
|
|
|
# shadows |
|
bar_spacing => 4, |
|
shadow_depth => 1, |
|
shadowclr => 'dred', |
|
|
|
transparent => 0, |
# |
) or warn $MyGraph->error; |
# Customize graph based on the |
|
my $width; |
|
my $height = 200; |
|
|
|
if ($NumBars < 10) { |
|
$width = 120+$NumBars*15; |
|
$skip_x = 1; |
|
$bar_width = 15; |
|
} elsif ($NumBars <= 25) { |
|
$width = 120+$NumBars*11; |
|
$skip_x = 5; |
|
$bar_width = 8; |
|
} elsif ($NumBars <= 50) { |
|
$width = 120+$NumBars*8; |
|
$skip_x = 5; |
|
$bar_width = 4; |
|
} else { |
|
$width = 120+$NumBars*8; |
|
$skip_x = 5; |
|
$bar_width = 4; |
|
} |
|
|
|
my $x_tick_offset = 0; |
|
if ($skip_x > 1) { |
|
$x_tick_offset = $skip_x - 1; |
|
} |
|
|
|
my $MyGraph = GD::Graph::bars->new($width,$height); |
|
my $error = ''; |
|
if (! $MyGraph->set( x_label => $xlabel, |
|
y_label => $ylabel, |
|
x_label_position => 0.5, |
|
long_ticks => 1, |
|
tick_length => 0, |
|
x_ticks => 0, |
|
title => $Title, |
|
y_max_value => $Max, |
|
x_label_skip => $skip_x, |
|
x_tick_offset => $x_tick_offset, |
|
# |
|
dclrs => [ qw(lgreen dgreen lyellow |
|
lpurple cyan lorange)], |
|
bar_width => $bar_width, |
|
cumulate => 2, |
|
zero_axis => 1, |
|
fgclr => 'black', |
|
boxclr => 'white', |
|
accentclr => 'dblue', |
|
valuesclr => '#ffff77', |
|
l_margin => 10, |
|
b_margin => 10, |
|
r_margin => 10, |
|
t_margin => 10, |
|
# |
|
transparent => 0, |
|
)) { |
|
$error = $MyGraph->error; |
|
print <<"END"; |
|
Content-type: text/html |
|
|
|
<html> |
|
<head><title>Bad Graph</title></head> |
|
<body> |
|
<p> |
|
There was an error producing the graph you requested. |
|
</p><p> |
|
$error |
|
</p> |
|
</body> |
|
</html> |
|
END |
|
return; |
|
} |
|
|
# Tell the server we are sending a gif graphic |
my $plot = $MyGraph->plot(\@data); |
|
if (! defined($plot)) { |
|
print <<"END"; |
|
Content-type: text/html |
|
|
|
<html> |
|
<head><title>Bad Graph</title></head> |
|
<body> |
|
The system was unable to create the graph you requested. |
|
</body> |
|
</html> |
|
END |
|
return; |
|
} |
|
|
|
my $BinaryData=$plot->png; |
|
undef($MyGraph); |
|
undef($plot); |
|
|
|
if (! defined($BinaryData)) { |
|
print <<"END"; |
|
Content-type: text/html |
|
|
|
<html> |
|
<head><title>Bad Graph</title></head> |
|
<body> |
|
The system was unable to produce a png image of the graph you requested. |
|
</body> |
|
</html> |
|
END |
|
return; |
|
} |
|
|
|
|
|
# Tell the server we are sending a png graphic |
print <<END; |
print <<END; |
Content-type: image/gif |
Content-type: image/png |
|
|
END |
END |
|
|
my $BinaryData=$MyGraph->plot(\@data)->png; |
|
undef $MyGraph; |
|
binmode(STDOUT); |
binmode(STDOUT); |
open IMG,"|pngtopnm|ppmtogif 2>/dev/null"; # convert into a gif image |
#open IMG,"|pngtopnm|ppmtogif 2>/dev/null"; # convert into a gif image |
print IMG $BinaryData; # output image |
#print IMG $BinaryData; # output image |
$|=1; # be sure to flush before closing |
#$|=1; # be sure to flush before closing |
close IMG; |
#close IMG; |
|
print $BinaryData; |