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 " "; 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/\"/"/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