1# displaytable(TABLENAME, CONFIG...):
2#
3#   stolen from sqltohtml in the ucd-snmp package
4#
5
6package NetSNMP::manager::displaytable;
7use POSIX (isprint);
8
9BEGIN {
10    use Exporter ();
11    use vars qw(@ISA @EXPORT_OK $tableparms $headerparms);
12    @ISA = qw(Exporter);
13    @EXPORT=qw(&displaytable &displaygraph);
14
15    require DBI;
16    require CGI;
17
18    use GD::Graph();
19    use GD::Graph::lines();
20    use GD::Graph::bars();
21    use GD::Graph::points();
22    use GD::Graph::linespoints();
23    use GD::Graph::area();
24    use GD::Graph::pie();
25};
26
27$tableparms="border=1 bgcolor=\"#c0c0e0\"";
28$headerparms="border=1 bgcolor=\"#b0e0b0\"";
29
30sub displaygraph {
31    my $dbh = shift;
32    my $tablename = shift;
33    my %config = @_;
34    my $type = $config{'-type'} || "lines";
35    my $x = $config{'-x'} || "640";
36    my $y = $config{'-y'} || "480";
37    my $bgcolor = $config{'-bgcolor'} || "white";
38    my $datecol = $config{'-xcol'} || "updated";
39    my $xtickevery = $config{'-xtickevery'} || 50;
40    my ($thetable);
41
42#    print STDERR join(",",@_),"\n";
43
44    return -1 if (!defined($dbh) || !defined($tablename) ||
45		  !defined ($config{'-columns'}) ||
46		  ref($config{'-columns'}) ne "ARRAY" ||
47		  !defined ($config{'-indexes'}) ||
48		  ref($config{'-indexes'}) ne "ARRAY");
49
50
51    my $cmd = "SELECT " .
52	join(",",@{$config{'-columns'}},
53	     @{$config{'-indexes'}}, $datecol) .
54		 " FROM $tablename $config{'-clauses'}";
55    ( $thetable = $dbh->prepare($cmd))
56	or return -1;
57    ( $thetable->execute )
58	or return -1;
59
60    my %data;
61    my $count = 0;
62
63    while( $row = $thetable->fetchrow_hashref() ) {
64	# XXX: multiple indexe columns -> unique name
65	# save all the row's data based on the index column(s)
66	foreach my $j (@{$config{'-columns'}}) {
67	    if ($config{'-difference'} || $config{'-rate'}) {
68		if (defined($lastval{$row->{$config{'-indexes'}[0]}}{$j}{'value'})) {
69		    $data{$row->{$config{'-indexes'}[0]}}{$row->{$datecol}}{$j}=
70			$row->{$j} -
71			    $lastval{$row->{$config{'-indexes'}[0]}}{$j}{'value'};
72		    #
73		    # convert to a rate if desired.
74		    #
75		    if ($config{'-rate'}) {
76			if (($row->{$datecol} - $lastval{$row->{$config{'-indexes'}[0]}}{$j}{'index'})) {
77			    $data{$row->{$config{'-indexes'}[0]}}{$row->{$datecol}}{$j} = $data{$row->{$config{'-indexes'}[0]}}{$row->{$datecol}}{$j}*$config{'-rate'}/($row->{$datecol} - $lastval{$row->{$config{'-indexes'}[0]}}{$j}{'index'});
78			} else {
79			    $data{$row->{$config{'-indexes'}[0]}}{$row->{$datecol}}{$j} = -1;
80			}
81		    }
82
83		}
84		$lastval{$row->{$config{'-indexes'}[0]}}{$j}{'value'} = $row->{$j};
85		$lastval{$row->{$config{'-indexes'}[0]}}{$j}{'index'} = $row->{$datecol};
86	    } else {
87		$data{$row->{$config{'-indexes'}[0]}}{$row->{$datecol}}{$j} = $row->{$j};
88	    }
89
90	    #
91	    # limit the data to a vertical range.
92	    #
93	    if (defined($config{'-max'}) &&
94		$data{$row->{$config{'-indexes'}[0]}}{$row->{$datecol}}{$j} >
95		$config{'-max'}) {
96		# set to max value
97		$data{$row->{$config{'-indexes'}[0]}}{$row->{$datecol}}{$j} =
98		    $config{'-max'};
99	    }
100
101	    if (defined($config{'-min'}) &&
102		$data{$row->{$config{'-indexes'}[0]}}{$row->{$datecol}}{$j} <
103		$config{'-min'}) {
104		# set to min value
105		$data{$row->{$config{'-indexes'}[0]}}{$row->{$datecol}}{$j} =
106		    $config{'-min'};
107	    }
108	}
109	push @xdata,$row->{$datecol};
110    }
111
112    my @pngdata;
113
114    if (defined($config{'-createdata'})) {
115	&{$config{'-createdata'}}(\@pngdata, \@xdata, \%data);
116    } else {
117	push @pngdata, \@xdata;
118
119	my @datakeys = keys(%data);
120
121#    open(O,">/tmp/data");
122	foreach my $i (@datakeys) {
123	    foreach my $j (@{$config{'-columns'}}) {
124		my @newrow;
125		foreach my $k (@xdata) {
126#		print O "i=$i k=$k j=$j :: $data{$i}{$k}{$j}\n";
127		    push @newrow, ($data{$i}{$k}{$j} || 0);
128		}
129		push @pngdata,\@newrow;
130	    }
131	}
132    }
133#    close O;
134
135    if ($#pngdata > 0) {
136    # create the graph itself
137	my $graph = new GD::Graph::lines($x, $y);
138	$graph->set('bgclr' => $bgcolor);
139#	print STDERR "columns: ", join(",",@{$config{'-columns'}}), "\n";
140 	if (defined($config{'-legend'})) {
141# 	    print STDERR "legend: ", join(",",@{$config{'-legend'}}), "\n";
142 	    $graph->set_legend(@{$config{'-legend'}});
143 	} else {
144 	    my @legend;
145 	    foreach my $xxx (@{$config{'-columns'}}) {
146 		push @legend, "$xxx = $config{'-indexes'}[0]";
147 	    }
148 	    $graph->set_legend(@legend);
149 	}
150	foreach my $i (qw(title x_label_skip x_labels_vertical x_tick_number x_number_format y_number_format x_min_value x_max_value y_min_value y_max_value)) {
151#	    print STDERR "setting $i from -$i = " . $config{"-$i"} . "\n";
152	    $graph->set("$i" => $config{"-$i"}) if ($config{"-$i"});
153	}
154	if ($config{'-pngparms'}) {
155	    $graph->set(@{$config{'-pngparms'}});
156	}
157	print $graph->plot(\@pngdata);
158	return $#{$pngdata[0]};
159    }
160    return -1;
161}
162
163sub displaytable {
164    my $dbh = shift;
165    my $tablename = shift;
166    my %config = @_;
167    my $clauses = $config{'-clauses'};
168    my $dolink = $config{'-dolink'};
169    my $datalink = $config{'-datalink'};
170    my $beginhook = $config{'-beginhook'};
171    my $modifiedhook = $config{'-modifiedhook'};
172    my $endhook = $config{'-endhook'};
173    my $selectwhat = $config{'-select'};
174#    my $printonly = $config{'-printonly'};
175    $selectwhat = "*" if (!defined($selectwhat));
176    my $tableparms = $config{'-tableparms'} || $displaytable::tableparms;
177    my $headerparms = $config{'-headerparms'} || $displaytable::headerparms;
178    my ($thetable, $data, $ref, $prefs, $xlattable);
179
180    if ($config{'-dontdisplaycol'}) {
181	($prefs = $dbh->prepare($config{'-dontdisplaycol'}) )
182	    or die "\nnot ok: $DBI::errstr\n";
183    }
184
185    # get a list of data from the table we want to display
186    ( $thetable = $dbh->prepare("SELECT $selectwhat FROM $tablename $clauses"))
187	or return -1;
188    ( $thetable->execute )
189	or return -1;
190
191    # get a list of data from the table we want to display
192    if ($config{'-xlat'}) {
193	( $xlattable =
194	 $dbh->prepare("SELECT newname FROM $config{'-xlat'} where oldname = ?"))
195	    or die "\nnot ok: $DBI::errstr\n";
196    }
197
198    # editable/markable setup
199    my $edited = 0;
200    my $editable = 0;
201    my $markable = 0;
202    my (@indexkeys, @valuekeys, $uph, %indexhash, $q);
203    if (defined($config{'-editable'})) {
204	$editable = 1;
205    }
206
207    if (defined($config{'-mark'}) || defined($config{'-onmarked'})) {
208	$markable = 1;
209    }
210
211    if (defined($config{'-CGI'}) && ref($config{'-CGI'}) eq "CGI") {
212	$q = $config{'-CGI'};
213    }
214
215    if (($editable || $markable)) {
216	if (ref($config{'-indexes'}) eq ARRAY && defined($q)) {
217	    @indexkeys = @{$config{'-indexes'}};
218	    foreach my $kk (@indexkeys) {
219		$indexhash{$kk} = 1;
220	    }
221	} else {
222	    $editable = $markable = 0;
223	    print STDERR "displaytable error: no -indexes option specified or -CGI not specified\n";
224	}
225    }
226
227    if (($editable || $markable) &&
228	$q->param('edited_' . toalpha($tablename))) {
229	$edited = 1;
230    }
231
232    # table header
233    my $doheader = 1;
234    my @keys;
235    my $rowcount = 0;
236    $thetable->execute();
237    if ($editable || $markable) {
238	print "<input type=hidden name=\"edited_" . toalpha($tablename) . "\" value=1>\n";
239    }
240
241    while( $data = $thetable->fetchrow_hashref() ) {
242	$rowcount++;
243	if ($edited && $editable && !defined($uph)) {
244	    foreach my $kk (keys(%$data)) {
245		push (@valuekeys, maybe_from_hex($kk)) if (!defined($indexhash{$kk}));
246	    }
247	    my $cmd = "update $tablename set " .
248		join(" = ?, ",@valuekeys) .
249		    " = ? where " .
250			join(" = ? and ",@indexkeys) .
251			    " = ?";
252	    $uph = $dbh->prepare($cmd);
253#	    print STDERR "setting up: $cmd<br>\n";
254	}
255	if ($doheader) {
256	    if ($config{'-selectorder'} &&
257		     ref($config{'-selectorder'}) eq "ARRAY") {
258		@keys = @{$config{'-selectorder'}};
259	    } elsif ($config{'-selectorder'}) {
260		$_ = $selectwhat;
261		@keys = split(/, */);
262	    } else {
263		@keys = (sort keys(%$data));
264	    }
265	    if (defined($config{'-title'})) {
266		print "<br><b>$config{'-title'}</b>\n";
267	    } elsif (!defined($config{'-notitle'})) {
268		print "<br><b>";
269		print "<a href=\"$ref\">" if (defined($dolink) &&
270					      defined($ref = &$dolink($tablename)));
271		if ($config{'-xlat'}) {
272		    my $toval = $xlattable->execute($tablename);
273		    if ($toval > 0) {
274			print $xlattable->fetchrow_array;
275		    } else {
276			print "$tablename";
277		    }
278		} else {
279		    print "$tablename";
280		}
281		print "</a>" if (defined($ref));
282		print "</b>\n";
283	    }
284	    print "<br>\n";
285	    print "<table $tableparms>\n";
286	    if (!$config{'-noheaders'}) {
287		print "<tr $headerparms>";
288	    }
289	    if (defined($beginhook)) {
290		&$beginhook($dbh, $tablename);
291	    }
292	    if (!$config{'-noheaders'}) {
293		if ($markable) {
294		    my $ukey = to_unique_key($key, $data, @indexkeys);
295		    print "<td>Mark</td>\n";
296		}
297		foreach $l (@keys) {
298		    if (!defined($prefs) ||
299			$prefs->execute($tablename, $l) eq "0E0") {
300			print "<th>";
301			print "<a href=\"$ref\">" if (defined($dolink) &&
302						      defined($ref = &$dolink($l)));
303			if ($config{'-xlat'}) {
304			    my $toval = $xlattable->execute($l);
305			    if ($toval > 0) {
306				print $xlattable->fetchrow_array;
307			    } else {
308				print "$l";
309			    }
310			} else {
311			    print "$l";
312			}
313			print "</a>" if (defined($ref));
314			print "</th>";
315		    }
316		}
317	    }
318	    if (defined($endhook)) {
319		&$endhook($dbh, $tablename);
320	    }
321	    if (!$config{'-noheaders'}) {
322		print "</tr>\n";
323	    }
324	    $doheader = 0;
325	}
326
327	print "<tr>";
328	if (defined($beginhook)) {
329	    &$beginhook($dbh, $tablename, $data);
330	}
331	if ($edited && $editable) {
332	    my @indexvalues = getvalues($data, @indexkeys);
333	    if ($modifiedhook) {
334		foreach my $valkey (@valuekeys) {
335		    my ($value) = getquery($q, $data, \@indexkeys, $valkey);
336		    if ($value ne $data->{$valkey}) {
337			&$modifiedhook($dbh, $tablename, $valkey,
338				       $data, @indexvalues);
339		    }
340		}
341	    }
342
343	    my $ret = $uph->execute(getquery($q, $data, \@indexkeys, @valuekeys),
344				    @indexvalues);
345	    foreach my $x (@indexkeys) {
346		next if (defined($indexhash{$x}));
347		$data->{$x} = $q->param(to_unique_key($x, $data, @indexkeys));
348	    }
349#	    print "ret: $ret, $DBI::errstr<br>\n";
350	}
351	if ($markable) {
352	    my $ukey = to_unique_key("mark", $data, @indexkeys);
353	    print "<td><input type=checkbox value=Y name=\"$ukey\"" .
354		(($q->param($ukey) eq "Y") ? " checked" : "") . "></td>\n";
355	    if ($q->param($ukey) eq "Y" && $config{'-onmarked'}) {
356		&{$config{'-onmarked'}}($dbh, $tablename, $data);
357	    }
358	}
359
360	foreach $key (@keys) {
361	    if (!defined($prefs) ||
362		$prefs->execute($tablename, $key) eq "0E0") {
363		print "<td>";
364		print "<a href=\"$ref\">" if (defined($datalink) &&
365					      defined($ref = &$datalink($key, $data->{$key})));
366		if ($editable && !defined($indexhash{$key})) {
367		    my $ukey = to_unique_key($key, $data, @indexkeys);
368		    my $sz;
369		    if ($config{'-sizehash'}) {
370			$sz = "size=" . $config{'-sizehash'}{$key};
371		    }
372		    if (!$sz && $config{'-inputsize'}) {
373			$sz = "size=" . $config{'-inputsize'};
374		    }
375		    print STDERR "size $key: $sz from $config{'-sizehash'}{$key} / $config{'-inputsize'}\n";
376		    print "<input type=text name=\"$ukey\" value=\"" .
377			maybe_to_hex($data->{$key}) . "\" $sz>";
378		} else {
379		    if ($config{'-printer'}) {
380			&{$config{'-printer'}}($key, $data->{$key}, $data);
381		    } elsif ($data->{$key} ne "") {
382			print $data->{$key};
383		    } else {
384			print "&nbsp";
385		    }
386		}
387		print "</a>" if (defined($ref));
388		print "</td>";
389	    }
390	}
391
392	if (defined($endhook)) {
393	    &$endhook($dbh, $tablename, $data);
394	}
395	print "</tr>\n";
396	last if (defined($config{'-maxrows'}) &&
397		 $rowcount >= $config{'-maxrows'});
398    }
399    if ($rowcount > 0) {
400	print "</table>\n";
401    }
402    return $rowcount;
403}
404
405sub to_unique_key {
406    my $ret = shift;
407    $ret .= "_";
408    my $data = shift;
409    if (!defined($data)) {
410	$ret .= join("_",@_);
411    } else {
412	foreach my $i (@_) {
413	    $ret .= "_" . $data->{$i};
414	}
415    }
416    return toalpha($ret);
417}
418
419sub toalpha {
420    my $ret = join("",@_);
421    $ret =~ s/([^A-Za-z0-9_])/ord($1)/eg;
422    return $ret;
423}
424
425sub getvalues {
426    my $hash = shift;
427    my @ret;
428    foreach my $i (@_) {
429	push @ret, maybe_from_hex($hash->{$i});
430    }
431    return @ret;
432}
433
434sub getquery {
435    my $q = shift;
436    my $data = shift;
437    my $keys = shift;
438    my @ret;
439    foreach my $i (@_) {
440	push @ret, maybe_from_hex($q->param(to_unique_key($i, $data, @$keys)));
441    }
442    return @ret;
443}
444
445sub maybe_to_hex {
446    my $str = shift;
447    if (!isprint($str)) {
448	$str = "0x" . (unpack("H*", $str))[0];
449    }
450    $str =~ s/\"/&quot;/g;
451    return $str;
452}
453
454sub maybe_from_hex {
455    my $str = shift;
456    if (substr($str,0,2) eq "0x") {
457	($str) = pack("H*", substr($str,2));
458    }
459    return $str;
460}
461
4621;
463__END__
464
465=head1 NAME
466
467SNMP - The Perl5 'SNMP' Extension Module v3.1.0 for the UCD SNMPv3 Library
468
469=head1 SYNOPSIS
470
471 use DBI;
472 use displaytable;
473
474 $dbh = DBI->connect(...);
475 $numshown = displaytable($dbh, 'tablename', [options]);
476
477=head1 DESCRIPTION
478
479The displaytable and displaygraph functions format the output of a DBI
480database query into an html or graph output.
481
482=head1 DISPLAYTABLE OPTIONS
483
484=over 4
485
486=item -select => VALUE
487
488Selects a set of columns, or functions to be displayed in the resulting table.
489
490Example: -select => 'column1, column2'
491
492Default: *
493
494=item -title => VALUE
495
496Use VALUE as the title of the table.
497
498=item -notitle => 1
499
500Don't print a title for the table.
501
502=item -noheaders => 1
503
504Don't print a header row at the top of the table.
505
506=item -selectorder => 1
507
508=item -selectorder => [qw(column1 column2)]
509
510Defines the order of the columns.  A value of 1 will use the order of
511the -select statement by textually parsing it's comma seperated list.
512If an array is passed containing the column names, that order will be
513used.
514
515Example:
516
517  -select => distinct(column1) as foo, -selectorder => [qw(foo)]
518
519=item -maxrows => NUM
520
521Limits the number of display lines to NUM.
522
523=item -tableparms => PARAMS
524
525=item -headerparms => PARAMS
526
527The parameters to be used for formating the table contents and the
528header contents.
529
530Defaults:
531
532  -tableparms  => "border=1 bgcolor='#c0c0e0'"
533
534  -headerparms => "border=1 bgcolor='#b0e0b0'"
535
536=item -dolink => \&FUNC
537
538If passed, FUNC(name) will be called on the tablename or header.  The
539function should return a web url that the header/table name should be
540linked to.
541
542=item -datalink => \&FUNC
543
544Identical to -dolink, but called for the data portion of the table.
545Arguments are the column name and the data element for that column.
546
547=item -printer => \&FUNC
548
549Calls FUNC(COLUMNNAME, COLUMNDATA, DATA) to print the data from each
550column.  COLUMNDATA is the data itself, and DATA is a reference to the
551hash for the entire row (IE, COLUMNDATA = $DATA->{$COLUMNNAME}).
552
553=item -beginhook => \&FUNC
554
555=item -endhook => \&FUNC
556
557displaytable will call these functions at the beginning and end of the
558printing of a row.  Useful for inserting new columns at the beginning
559or end of the table.  When the headers to the table are being printed,
560they will be called like FUNC($dbh, TABLENAME).  When the data is
561being printed, they will be called like FUNC($dbh, TABLENAME, DATA),
562which DATA is a reference to the hash containing the row data.
563
564Example:
565
566  -endhook => sub {
567      my ($d, $t, $data) = @_;
568      if (defined($data)) {
569	  print "<td>",(100 * $data->{'column1'} / $data->{'column2'}),"</td>";
570      } else {
571	  print "<td>Percentage</td>";
572      }
573  }
574
575=item -clauses => sql_clauses
576
577Adds clauses to the sql expression.
578
579Example: -clauses => "where column1 = 'value' limit 10 order by column2"
580
581=item -xlat => xlattable
582
583Translates column headers and the table name by looking in a table for
584the appropriate translation.  Essentially uses:
585
586  SELECT newname FROM xlattable where oldname = ?
587
588to translate everything.
589
590=item -editable => 1
591
592=item -indexes   => [qw(INDEX_COLUMNS)]
593
594=item -CGI      => CGI_REFERENCE
595
596If both of these are passed as arguments, the table is printed in
597editable format.  The INDEX_COLUMNS should be a list of columns that
598can be used to uniquely identify a row.  They will be the non-editable
599columns shown in the table.  Everything else will be editable.  The
600form and the submit button written by the rest of the script must loop
601back to the same displaytable clause for the edits to be committed to
602the database.  CGI_REFERENCE should be a reference to the CGI object
603used to query web parameters from ($CGI_REFERENCE = new CGI);
604
605=item -mark     => 1
606
607=item -indexes  => [qw(INDEX_COLUMNS)]
608
609=item -CGI      => CGI_REFERENCE
610
611=item -onmarked => \&FUNC
612
613When the first three of these are specified, the left hand most column
614will be a check box that allows users to mark the row for future work.
615
616FUNC($dbh, TABLENAME, DATA) will be called for each marked entry when
617a submission data has been processed.  $DATA is a hash reference to
618the rows dataset.  See -editable above for more information.
619
620-onmarked => \&FUNC implies -mark => 1.
621
622=back
623
624=head1 Author
625
626wjhardaker@ucdavis.edu
627
628=cut
629