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