Annotation of loncom/cgi/graph.png, revision 1.28
1.1 minaeibi 1: #!/usr/bin/perl
2: #
1.28 ! matthew 3: # $Id: graph.png,v 1.27 2003/10/16 20:03:31 albertel Exp $
1.5 minaeibi 4: #
5: # Copyright Michigan State University Board of Trustees
6: #
7: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
8: #
9: # LON-CAPA is free software; you can redistribute it and/or modify
10: # it under the terms of the GNU General Public License as published by
11: # the Free Software Foundation; either version 2 of the License, or
12: # (at your option) any later version.
13: #
14: # LON-CAPA is distributed in the hope that it will be useful,
15: # but WITHOUT ANY WARRANTY; without even the implied warranty of
16: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17: # GNU General Public License for more details.
18: #
19: # You should have received a copy of the GNU General Public License
20: # along with LON-CAPA; if not, write to the Free Software
21: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
22: #
23: # /home/httpd/cgi-bin/graph.gif
24: #
25: # http://www.lon-capa.org/
26: #
1.1 minaeibi 27: # The LearningOnline Network with CAPA
1.22 matthew 28: #
1.1 minaeibi 29: # A CGI script that dynamically outputs a graphical chart for lonstatistics.
1.5 minaeibi 30: #
31: ####
1.22 matthew 32:
33: =pod
34:
35: =head1 NAME
36:
37: graph.png
38:
39: =head1 SYNOPSIS
40:
41: produces plots based on input
42:
43: =head1 DESCRIPTION
44:
45: graph.png is a cgi-bin script which produces plots based on input data.
46:
47: The query string is expected to be as follows (without whitespace):
48:
49: escape(Plot title) & escape(X label)& escape(Y label) & Maximum Y value &
50: Number of bars & $data1 & $data2
51:
52: $data1 and $data2 are expected to be comma seperated lists of numbers.
53: escape( value ) means the values must be run through lonnet::escape.
54:
55: =cut
1.1 minaeibi 56:
57: use strict;
1.24 matthew 58: use lib '/home/httpd/lib/perl';
1.9 minaeibi 59: use GD::Graph::bars;
1.1 minaeibi 60: use GD::Graph::colour;
61: use GD::Graph::Data;
1.24 matthew 62: use LONCAPA::loncgi();
1.1 minaeibi 63:
1.21 matthew 64: sub unescape {
65: my $str=shift;
66: $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
67: return $str;
68: }
69:
1.24 matthew 70: if (! &LONCAPA::loncgi::check_cookie_and_load_env()) {
71: print <<END;
72: Content-type: text/html
73:
74: <html>
75: <head><title>Bad Cookie</title></head>
76: <body>
1.28 ! matthew 77: Your cookie information is incorrect.
1.24 matthew 78: </body>
79: </html>
80: END
1.26 albertel 81: exit;
1.24 matthew 82: }
83:
1.4 matthew 84: $|=1; # Autoflush after each print/write
1.24 matthew 85: my $identifier = $ENV{'QUERY_STRING'};
1.27 albertel 86: my $Title = &unescape($ENV{'cgi.'.$identifier.'.title'});
87: my $xlabel = &unescape($ENV{'cgi.'.$identifier.'.xlabel'});
88: my $ylabel = &unescape($ENV{'cgi.'.$identifier.'.ylabel'});
89: my $Max = $ENV{'cgi.'.$identifier.'.Max'};
90: my $NumBars = $ENV{'cgi.'.$identifier.'.NumBars'};
91: my $NumSets = $ENV{'cgi.'.$identifier.'.NumSets'};
92: my @Colors = split(',',$ENV{'cgi.'.$identifier.'.Colors'});
1.1 minaeibi 93:
1.24 matthew 94: #
95: # Labels are always digits
1.1 minaeibi 96: my @xlabels;
1.23 matthew 97: for (my $nIdx=0; $nIdx<$NumBars; $nIdx++ ) {
98: $xlabels[$nIdx]=$nIdx+1;
99: }
1.25 matthew 100: my @data; # stores the data for the graph
101: push(@data,\@xlabels);
102: for (my $i=1;$i<=$NumSets;$i++) {
1.27 albertel 103: push(@data,[split(',',$ENV{'cgi.'.$identifier.'.data.'.$i})]);
1.25 matthew 104: }
1.23 matthew 105:
1.25 matthew 106: my $skip_x = 1;
107: my $bar_width=10;
1.1 minaeibi 108:
1.24 matthew 109: #
110: # Customize graph based on the
1.21 matthew 111: my $width;
112: my $height = 200;
1.12 minaeibi 113:
1.23 matthew 114: if ($NumBars < 10) {
115: $width = 120+$NumBars*15;
116: $skip_x = 1;
117: $bar_width = 15;
118: } elsif ($NumBars <= 25) {
119: $width = 120+$NumBars*11;
120: $skip_x = 5;
121: $bar_width = 8;
122: } elsif ($NumBars <= 50) {
123: $width = 120+$NumBars*8;
124: $skip_x = 5;
125: $bar_width = 4;
1.19 minaeibi 126: } else {
1.23 matthew 127: $width = 120+$NumBars*8;
128: $skip_x = 5;
129: $bar_width = 4;
1.11 minaeibi 130: }
1.1 minaeibi 131:
1.21 matthew 132: my $x_tick_offset = 0;
133: if ($skip_x > 1) {
134: $x_tick_offset = $skip_x - 1;
135: }
1.1 minaeibi 136:
1.21 matthew 137: my $MyGraph = GD::Graph::bars->new($width,$height);
1.24 matthew 138: my $error = '';
139: if (! $MyGraph->set( x_label => $xlabel,
140: y_label => $ylabel,
141: x_label_position => 0.5,
142: long_ticks => 1,
143: tick_length => 0,
144: x_ticks => 0,
145: title => $Title,
146: y_max_value => $Max,
147: x_label_skip => $skip_x,
148: x_tick_offset => $x_tick_offset,
149: #
1.25 matthew 150: dclrs => \@Colors,
1.24 matthew 151: bar_width => $bar_width,
152: cumulate => 2,
153: zero_axis => 1,
154: fgclr => 'black',
155: boxclr => 'white',
156: accentclr => 'dblue',
157: valuesclr => '#ffff77',
158: l_margin => 10,
159: b_margin => 10,
160: r_margin => 10,
161: t_margin => 10,
162: #
163: transparent => 0,
164: )) {
165: $error = $MyGraph->error;
166: print <<"END";
167: Content-type: text/html
168:
169: <html>
170: <head><title>Bad Graph</title></head>
171: <body>
172: <p>
173: There was an error producing the graph you requested.
174: </p><p>
175: $error
176: </p>
177: </body>
178: </html>
179: END
180: return;
181: }
1.1 minaeibi 182:
1.24 matthew 183: my $plot = $MyGraph->plot(\@data);
184: if (! defined($plot)) {
185: print <<"END";
186: Content-type: text/html
187:
188: <html>
189: <head><title>Bad Graph</title></head>
190: <body>
191: The system was unable to create the graph you requested.
192: </body>
193: </html>
194: END
195: return;
196: }
1.1 minaeibi 197:
1.24 matthew 198: my $BinaryData=$plot->png;
199: undef($MyGraph);
200: undef($plot);
201:
202: if (! defined($BinaryData)) {
203: print <<"END";
204: Content-type: text/html
205:
206: <html>
207: <head><title>Bad Graph</title></head>
208: <body>
209: The system was unable to produce a png image of the graph you requested.
210: </body>
211: </html>
212: END
213: return;
214: }
1.14 minaeibi 215:
1.12 minaeibi 216:
1.16 albertel 217: # Tell the server we are sending a png graphic
1.1 minaeibi 218: print <<END;
1.16 albertel 219: Content-type: image/png
1.1 minaeibi 220:
221: END
222:
223: binmode(STDOUT);
1.16 albertel 224: #open IMG,"|pngtopnm|ppmtogif 2>/dev/null"; # convert into a gif image
225: #print IMG $BinaryData; # output image
226: #$|=1; # be sure to flush before closing
227: #close IMG;
228: print $BinaryData;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>