Annotation of loncom/cgi/graph.png, revision 1.35
1.1 minaeibi 1: #!/usr/bin/perl
2: #
1.35 ! albertel 3: # $Id: graph.png,v 1.34 2005/04/07 06:56:21 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:
1.31 matthew 41: produces plots from data stored in users environment.
1.22 matthew 42:
43: =head1 DESCRIPTION
44:
1.31 matthew 45: graph.png is a cgi-bin script which produces plots based on data stored
46: in the users environment. The users cookie is checked prior to producing
47: a plot. The query string is expected to be an identifier, $id.
48: The parameters defining the plot must be stored in the environment as
49: $ENV{'cgi.'.$id.'.'.$dataname}. Two types of plots can be produced, 'bar'
50: and 'xy'. The 'xy' graph can will 1 or 2 y-axes if the parameter
51: 'two_axes' is set to false or true respectively. See perldoc GD::Graph and
52: loncommon::DrawBarGraph, loncommon::DrawXYGraph, and loncommon::DrawXYYGraph.
1.22 matthew 53:
54: =cut
1.1 minaeibi 55:
56: use strict;
1.24 matthew 57: use lib '/home/httpd/lib/perl';
1.9 minaeibi 58: use GD::Graph::bars;
1.29 matthew 59: use GD::Graph::lines;
1.1 minaeibi 60: use GD::Graph::colour;
61: use GD::Graph::Data;
1.34 albertel 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.29 matthew 70: sub error {
71: my ($error) = @_;
72: my $Str = <<"END";
73: Content-type: text/html
74:
75: <html>
76: <head><title>Bad Graph</title></head>
77: <body>
78: <p>
79: There was an error producing the graph you requested.
80: </p><p>
81: $error
82: </p>
83: </body>
84: </html>
85: END
86: return $Str;
87: }
88:
89: my $id = $ENV{'QUERY_STRING'};
90:
91: #
1.31 matthew 92: # usage: &get_env($name,$default)
1.29 matthew 93: sub get_env {
94: my $key = 'cgi.'.$id.'.'.(shift());
1.35 ! albertel 95: return shift if (! exists($Apache::lonnet::env{$key}));
! 96: return $Apache::lonnet::env{$key};
1.29 matthew 97: }
98:
1.24 matthew 99: if (! &LONCAPA::loncgi::check_cookie_and_load_env()) {
100: print <<END;
101: Content-type: text/html
102:
103: <html>
104: <head><title>Bad Cookie</title></head>
105: <body>
1.28 matthew 106: Your cookie information is incorrect.
1.24 matthew 107: </body>
108: </html>
109: END
1.26 albertel 110: exit;
1.24 matthew 111: }
112:
1.4 matthew 113: $|=1; # Autoflush after each print/write
1.1 minaeibi 114:
1.31 matthew 115: ##
116: ## Set up the plot
117: ##
1.29 matthew 118: my $colordefaults = join(',',
119: ('#33ff00',
120: '#0033cc','#990000','#aaaa66','#663399','#ff9933',
121: '#66ccff','#ff9999','#cccc33','#660000','#33cc66',
122: ));
123:
124: my $height = &get_env('height',300);
125: my $width = &get_env('width', 400);
126: my $PlotType = &get_env('PlotType','bar');
127:
128: my %GraphSettings = (
129: title => &unescape(&get_env('title','')),
130: x_label => &unescape(&get_env('xlabel','')),
131: y_label => &unescape(&get_env('ylabel','')),
1.24 matthew 132: x_label_position => 0.5,
1.29 matthew 133: dclrs => [split(',',&get_env('Colors',
134: $colordefaults))],
1.24 matthew 135: fgclr => 'black',
136: boxclr => 'white',
137: accentclr => 'dblue',
138: valuesclr => '#ffff77',
139: l_margin => 10,
140: b_margin => 10,
141: r_margin => 10,
142: t_margin => 10,
143: transparent => 0,
1.29 matthew 144: );
1.24 matthew 145:
1.29 matthew 146: $GraphSettings{'x_label_skip'} = &get_env('xskip',1);
147: $GraphSettings{'x_tick_offset'} = &get_env('x_tick_offset',0);
1.31 matthew 148: $GraphSettings{'y_max_value'} = &get_env('y_max_value',1);
1.29 matthew 149:
150: my $MyGraph;
151: if ($PlotType eq 'bar') {
152: # Pick up bar graph settings
153: $GraphSettings{'bar_width'} = &get_env('bar_width',undef);
154: $GraphSettings{'long_ticks'} = 1;
155: $GraphSettings{'tick_length'} = 0;
156: $GraphSettings{'x_ticks'} = 0;
157: $GraphSettings{'cumulate'} = 2;
158: $GraphSettings{'zero_axis'} = 1;
159: } else {
160: #
161: # X label skip setup
162: my $skip_x = &get_env('xskip',1);
163: my $x_tick_offset = &get_env('x_tick_offset',$skip_x-1);
164: my $zero_axis = &get_env('zero_axis',1);
165: #
166: # Fill up %GraphSettings
167: $GraphSettings{'long_ticks'} = 1;
168: $GraphSettings{'tick_length'} = 0;
169: $GraphSettings{'x_ticks'} = &get_env('x_ticks',0),;
170: $GraphSettings{'x_label_skip'} = $skip_x;
171: $GraphSettings{'x_tick_offset'} = $x_tick_offset;
172: $GraphSettings{'zero_axis'} = 1;
1.30 matthew 173: if (&get_env('two_axes',0)) {
174: $GraphSettings{'two_axes'} = 1;
1.32 matthew 175: $GraphSettings{'y1_label'} = &get_env('y1_label',
176: $GraphSettings{'y_label'});
177: $GraphSettings{'y2_label'} = &get_env('y2_label','');
1.30 matthew 178: $GraphSettings{'y1_max_value'} = &get_env('y1_max_value',0);
179: $GraphSettings{'y1_min_value'} = &get_env('y1_min_value',1);
180: $GraphSettings{'y2_max_value'} = &get_env('y2_max_value',1);
181: $GraphSettings{'y2_min_value'} = &get_env('y2_min_value',1);
182: }
1.29 matthew 183: }
184: #
185: # Pick up miscellanious values passed in by the user
186: #
187: # Create the plot and check it out
188: if ($PlotType eq 'bar') {
189: $MyGraph = GD::Graph::bars->new($width,$height);
190: } else {
191: $MyGraph = GD::Graph::lines->new($width,$height);
192: }
193: if (! defined($MyGraph)) {
194: print &error('Unable to create initial graph');
1.24 matthew 195: return;
196: }
1.1 minaeibi 197:
1.29 matthew 198: ##
199: ## Build the @Data array
200: my $NumSets = &get_env('NumSets');
1.33 matthew 201: my @Data; # stores the data for the graph
202: my @Legend; # one entry per data set
1.29 matthew 203: my @xlabels = split(',',&get_env('labels'));
204: push(@Data,\@xlabels);
205: for (my $i=1;$i<=$NumSets;$i++) {
206: push(@Data,[split(',',&get_env('data.'.$i))]);
1.33 matthew 207: push(@Legend,&get_env('data.'.$i.'.label',undef));
1.29 matthew 208: }
1.24 matthew 209:
1.29 matthew 210: my $error = '';
211: if (! $MyGraph->set(%GraphSettings)) {
212: print &error($MyGraph->error);
1.24 matthew 213: return;
214: }
1.33 matthew 215:
216: if (join('',@Legend) ne '') {
217: $MyGraph->set_legend(@Legend);
218: }
219:
1.1 minaeibi 220:
1.29 matthew 221: my $plot = $MyGraph->plot(\@Data);
222: if (! defined($plot)) {
223: my $error = 'Unable to plot the data provided.';
1.30 matthew 224: # Debugging code:
225: # $error .= '<pre>'.join(',',@{$Data[0]}).'</pre>';
226: # $error .= '<pre>'.join(',',@{$Data[1]}).'</pre>';
227: # $error .= '<pre>'.join(',',@{$Data[2]}).'</pre>' if (ref($Data[2]));
228: # $error .= '<pre>'.join(',',@{$Data[3]}).'</pre>' if (ref($Data[3]));
1.29 matthew 229: print &error($error);
230: exit;
231: }
232:
1.24 matthew 233: my $BinaryData=$plot->png;
234: undef($MyGraph);
235: undef($plot);
236:
237: if (! defined($BinaryData)) {
1.29 matthew 238: print &error('Unable to render graph as image');
239: exit;
1.24 matthew 240: }
1.12 minaeibi 241:
1.16 albertel 242: # Tell the server we are sending a png graphic
1.1 minaeibi 243: print <<END;
1.16 albertel 244: Content-type: image/png
1.1 minaeibi 245:
246: END
247:
248: binmode(STDOUT);
1.16 albertel 249: #open IMG,"|pngtopnm|ppmtogif 2>/dev/null"; # convert into a gif image
250: #print IMG $BinaryData; # output image
251: #$|=1; # be sure to flush before closing
252: #close IMG;
253: print $BinaryData;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](./graph.png?only_with_tag=version_2_0_2#rev1.35){kind=small}
Return to graph.png CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / cgi