Annotation of loncom/xml/lonplot.pm, revision 1.2
1.1 matthew 1: # The LearningOnline Network with CAPA
2: # Dynamic plot
3: #
1.2 ! matthew 4: # $Id: lonplot.pm,v 1.1 2001/12/17 21:43:12 matthew Exp $
1.1 matthew 5: #
6: # Copyright Michigan State University Board of Trustees
7: #
8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
9: #
10: # LON-CAPA is free software; you can redistribute it and/or modify
11: # it under the terms of the GNU General Public License as published by
12: # the Free Software Foundation; either version 2 of the License, or
13: # (at your option) any later version.
14: #
15: # LON-CAPA is distributed in the hope that it will be useful,
16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18: # GNU General Public License for more details.
19: #
20: # You should have received a copy of the GNU General Public License
21: # along with LON-CAPA; if not, write to the Free Software
22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23: #
24: # /home/httpd/html/adm/gpl.txt
25: #
26: # http://www.lon-capa.org/
27: #
28: # 2/21 Guy
29: package Apache::lonplot;
30: use strict;
31: use Apache::response;
1.2 ! matthew 32: use Apache::lonxml;
! 33: use Digest::MD5 qw(md5 md5_hex md5_base64);
1.1 matthew 34:
35: sub BEGIN {
36: &Apache::lonxml::register('Apache::lonplot',('plot'));
37: }
38:
39:
40: ##
41: ## Tests used in checking the validitity of input
42: ##
43: my $int_test = sub {$_[0]=~/^\d+$/};
44: my $real_test = sub {$_[0]=~/^[+-]?\d*\.?\d*$/};
45: my $color_test = sub {$_[0]=~/^x[\da-f]{6}$/};
46: my $onoff_test = sub {$_[0]=~/^(on|off)$/};
47: my $key_pos_test = sub {$_[0]=~/^(top|bottom|right|left|outside|below)+$/};
48: my $sml_test = sub {$_[0]=~/^(small|medium|large)$/};
49: my $linestyle_test = sub {$_[0]=~/^(lines|linespoints|dots|points|steps)$/};
50:
51: ##
52: ## Default values for attributes of elements
53: ##
54: my %plot_defaults =
55: (
56: height => {default => 200, test => $int_test },
57: width => {default => 200, test => $int_test },
58: bgcolor => {default => "xffffff", test => $color_test},
59: fgcolor => {default => "x000000", test => $color_test},
60: transparent => {default => "off", test => $onoff_test},
61: grid => {default => "off", test => $onoff_test},
62: border => {default => "on" , test => $onoff_test},
63: font => {default => "medium", test => $sml_test }
64: );
65:
66: my %key_defaults =
67: (
68: title => { default => "on" , test => $onoff_test },
69: box => { default => "off" , test => $onoff_test },
70: pos => { default => "top right" , test => $key_pos_test}
71: );
72:
73: my %label_defaults =
74: (
75: xpos => {default => 0, test => $real_test },
76: ypos => {default => 0, test => $real_test },
77: color => {default => "x000000", test => $color_test },
78: justify => {default => "left",
79: test => sub {$_[0]=~/^(left|right|center)$/}}
80: );
81:
82: my %axis_defaults =
83: (
84: color => {default => "x000000", test => $color_test},
85: thickness => {default => 1, test => $int_test },
86: xmin => {default => -10.0, test => $real_test },
87: xmax => {default => 10.0, test => $real_test },
88: ymin => {default => -10.0, test => $real_test },
89: ymax => {default => 10.0, test => $real_test }
90: );
91:
92: my %curve_defaults =
93: (
94: color => {default => "x000000", test => $color_test },
95: name => {default => "x000000", test => sub {$_[0]=~/^[\w ]*$/} },
96: linestyle => {default => "lines", test => $linestyle_test }
97: );
98:
99: ##
100: ## End of defaults
101: ##
102: my (%plot,%key,%axis,$title,$xlabel,$ylabel,@labels,@curves);
103:
104: sub start_plot {
105: %plot = ''; %key=''; %axis='';
106: $title=''; $xlabel=''; $ylabel='';
107: @labels = ''; @curves='';
1.2 ! matthew 108:
1.1 matthew 109: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
110: my $result='';
111: &Apache::lonxml::register('Apache::plot',
112: ('title','xlabel','ylabel','key','axis','label','curve'));
113: push (@Apache::lonxml::namespace,'plot');
1.2 ! matthew 114: ##-------------------------------------------------------
! 115: ## How do I do this? I need to "eval" and I need to keep the info
! 116: ## available for the parser.
! 117: ##
! 118: my $inside = &Apache::lonxml::get_all_text("/plot",$$parser[-1]);
! 119: my $eval=&Apache::lonxml::get_param('eval',$parstack,$safeeval);
! 120: if ($eval eq 'on') {
! 121: $inside=&Apache::run::evaluate($inside,$safeeval,$$parstack[-1]);
! 122: #&Apache::lonxml::debug("M is evaulated to:$inside:");
! 123: }
! 124: ##-------------------------------------------------------
! 125: &get_attributes(\%plot,\%plot_defaults,$parstack,$safeeval,'plot');
1.1 matthew 126: return '';
127: }
128:
129: sub end_plot {
130: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
131: pop @Apache::lonxml::namespace;
132: my $result;
133: ## Determine filename
1.2 ! matthew 134: my $tmpdir = '/home/httpd/perl/tmp/';
! 135: my $filename = $tmpdir.$ENV{'user.name'}.'_'.$ENV{'user.domain'}.
! 136: '_plot.data';
! 137: my $usersees=md5_base64($filename.'_'.$ENV{'REMOTE_ADDR'});
! 138:
1.1 matthew 139: ## Write the plot description to the file
1.2 ! matthew 140: my $fh=&Apache::File->new('/home/httpd/perl/tmp/'.$realname);
! 141: ## Ack!
1.1 matthew 142: ## return image tag for the plot
1.2 ! matthew 143: $result = '<img src=\"/cgi-bin/plot.cgi?'.$usersees.'"';
1.1 matthew 144: return $result;
145: }
1.2 ! matthew 146:
1.1 matthew 147: ##----------------------------------------------------------------- key
148: sub start_key {
149: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
150: my $result='';
1.2 ! matthew 151: &get_attributes(\%key,\%key_defaults,$parstack,$safeeval,'key');
1.1 matthew 152: return $result;
153: }
154:
155: sub end_key {
156: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
157: my $result = '';
158: return $result;
159: }
160: ##------------------------------------------------------------------- title
161: sub start_title {
162: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
163: $title = &Apache::lonxml::get_all_text("/title",$$parser[-1]);
164: my $result='';
165: return $result;
166: }
167:
168: sub end_title {
169: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
170: my $result = '';
171: return $result;
172: }
173: ##------------------------------------------------------------------- xlabel
174: sub start_xlabel {
175: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
176: my $result='';
177: $xlabel = &Apache::lonxml::get_all_text("/xlabel",$$parser[-1]);
178: return $result;
179: }
180:
181: sub end_xlabel {
182: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
183: my $result = '';
184: return $result;
185: }
186: ##------------------------------------------------------------------- ylabel
187: sub start_ylabel {
188: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
189: my $result='';
190: $ylabel = &Apache::lonxml::get_all_text("/ylabel",$$parser[-1]);
191: return $result;
192: }
193:
194: sub end_ylabel {
195: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
196: my $result = '';
197: return $result;
198: }
199: ##------------------------------------------------------------------- label
200: sub start_label {
201: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
202: my $result='';
203: my $label = &newhashref();
1.2 ! matthew 204: &get_attributes($label,\%label_defaults,$parstack,$safeeval,'label');
1.1 matthew 205: $label->{'text'} = &Apache::lonxml::get_all_text("/label",$$parser[-1]);
206: push(@labels,$label);
207: return $result;
208: }
209:
210: sub end_label {
211: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
212: my $result = '';
213: return $result;
214: }
215:
216: ##------------------------------------------------------------------- curve
217: sub start_curve {
218: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
219: my $result='';
220: my $curve = &newhashref();
1.2 ! matthew 221: &get_attributes($curve,\%curve_defaults,$parstack,$safeeval,'curve');
1.1 matthew 222: push (@curves,$curve);
223:
224: &Apache::lonxml::register('Apache::plot',('function','data'));
225: push (@Apache::lonxml::namespace,'curve');
226:
227: return $result;
228: }
229:
230: sub end_curve {
231: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
232: my $result = '';
233: return $result;
234: }
235:
236: ##------------------------------------------------------------ curve function
237: sub start_function {
238: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
239: my $result='';
240:
241: $curves[-1]->{'function'} =
242: &Apache::lonxml::get_all_text("/function",$$parser[-1]);
243: return $result;
244: }
245:
246: sub end_function {
247: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
248: my $result = '';
249: return $result;
250: }
251:
252: ##------------------------------------------------------------ curve data
253: sub start_data {
254: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
255: my $result='';
256: push( @{$curves[-1]->{'data'}},
257: &Apache::lonxml::get_all_text("/data",$$parser[-1]));
258: return $result;
259: }
260:
261: sub end_data {
262: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
263: my $result = '';
264: return $result;
265: }
266:
267: ##------------------------------------------------------------------- axis
268: sub start_axis {
269: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
270: my $result='';
1.2 ! matthew 271: &get_attributes(\%axis,\%label_defaults,$parstack,$safeeval,'axis');
1.1 matthew 272: return $result;
273: }
274:
275: sub end_axis {
276: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
277: my $result = '';
278: return $result;
279: }
280:
281: ##------------------------------------------------------------------- misc
282: sub newhashref{
283: my %hash;
284: return \%hash;
285: }
286:
1.2 ! matthew 287: sub get_attributes{
! 288: %values = %{shift};
! 289: %defaults = %{shift};
! 290: $parstack = shift;
! 291: $safeeval = shift;
! 292: $tag = shift;
! 293: my $attr;
! 294: foreach $attr (keys %defaults) {
! 295: $values{$attr} = &Apache::lonxml::get_param($attr,$parstack,$safeeval);
! 296: my $test = $defaults{$attr}->{'test'};
! 297: if (! &$test($values{$attr})) {
! 298: &Apache::lonxml::warning($tag.':'.$attr.': Bad value. Replacing your value with : '.$defaults{$attr});
! 299: $values{$attr} = $defaults{$attr};
! 300: }
! 301: return ;
! 302: }
1.1 matthew 303:
304: 1;
305: __END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonplot.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / xml