userapps/opensource/net-snmp/perl/manager/displaytable.pm

   1 # displaytable(TABLENAME, CONFIG...):
   2 #
   3 #   stolen from sqltohtml in the ucd-snmp package
   4 #
   5
   6 package NetSNMP::manager::displaytable;
   7 use POSIX (isprint);
   8
   9 BEGIN {
  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
  30 sub 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
 163 sub 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
 405 sub 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
 419 sub toalpha {
 420     my $ret = join("",@_);
 421     $ret =~ s/([^A-Za-z0-9_])/ord($1)/eg;
 422     return $ret;
 423 }
 424
 425 sub 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
 434 sub 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
 445 sub 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
 454 sub 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
 462 1;
 463 __END__
 464 =head1 NAME
 465
 466 SNMP - The Perl5 'SNMP' Extension Module v3.1.0 for the UCD SNMPv3 Library
 467
 468 =head1 SYNOPSIS
 469
 470  use DBI;
 471  use displaytable;
 472
 473  $dbh = DBI->connect(...);
 474  $numshown = displaytable($dbh, 'tablename', [options]);
 475
 476 =head1 DESCRIPTION
 477
 478 The displaytable and displaygraph functions format the output of a DBI
 479 database query into an html or graph output.
 480
 481 =head1 DISPLAYTABLE OPTIONS
 482
 483 =over 4
 484
 485 =item -select => VALUE
 486
 487 Selects a set of columns, or functions to be displayed in the resulting table.
 488
 489 Example: -select => 'column1, column2'
 490
 491 Default: *
 492
 493 =item -title => VALUE
 494
 495 Use VALUE as the title of the table.
 496
 497 =item -notitle => 1
 498
 499 Don't print a title for the table.
 500
 501 =item -noheaders => 1
 502
 503 Don't print a header row at the top of the table.
 504
 505 =item -selectorder => 1
 506
 507 =item -selectorder => [qw(column1 column2)]
 508
 509 Defines the order of the columns.  A value of 1 will use the order of
 510 the -select statement by textually parsing it's comma seperated list.
 511 If an array is passed containing the column names, that order will be
 512 used.
 513
 514 Example:
 515
 516   -select => distinct(column1) as foo, -selectorder => [qw(foo)]
 517
 518 =item -maxrows => NUM
 519
 520 Limits the number of display lines to NUM.
 521
 522 =item -tableparms => PARAMS
 523
 524 =item -headerparms => PARAMS
 525
 526 The parameters to be used for formating the table contents and the
 527 header contents.
 528
 529 Defaults:
 530
 531   -tableparms  => "border=1 bgcolor='#c0c0e0'"
 532
 533   -headerparms => "border=1 bgcolor='#b0e0b0'"
 534
 535 =item -dolink => \&FUNC
 536
 537 If passed, FUNC(name) will be called on the tablename or header.  The
 538 function should return a web url that the header/table name should be
 539 linked to.
 540
 541 =item -datalink => \&FUNC
 542
 543 Identical to -dolink, but called for the data portion of the table.
 544 Arguments are the column name and the data element for that column.
 545
 546 =item -printer => \&FUNC
 547
 548 Calls FUNC(COLUMNNAME, COLUMNDATA, DATA) to print the data from each
 549 column.  COLUMNDATA is the data itself, and DATA is a reference to the
 550 hash for the entire row (IE, COLUMNDATA = $DATA->{$COLUMNNAME}).
 551
 552 =item -beginhook => \&FUNC
 553
 554 =item -endhook => \&FUNC
 555
 556 displaytable will call these functions at the beginning and end of the
 557 printing of a row.  Useful for inserting new columns at the beginning
 558 or end of the table.  When the headers to the table are being printed,
 559 they will be called like FUNC($dbh, TABLENAME).  When the data is
 560 being printed, they will be called like FUNC($dbh, TABLENAME, DATA),
 561 which DATA is a reference to the hash containing the row data.
 562
 563 Example:
 564
 565   -endhook => sub {
 566       my ($d, $t, $data) = @_;
 567       if (defined($data)) {
 568           print "<td>",(100 * $data->{'column1'} / $data->{'column2'}),"</td>";
 569       } else {
 570           print "<td>Percentage</td>";
 571       }
 572   }
 573
 574 =item -clauses => sql_clauses
 575
 576 Adds clauses to the sql expression.
 577
 578 Example: -clauses => "where column1 = 'value' limit 10 order by column2"
 579
 580 =item -xlat => xlattable
 581
 582 Translates column headers and the table name by looking in a table for
 583 the appropriate translation.  Essentially uses:
 584
 585   SELECT newname FROM xlattable where oldname = ?
 586
 587 to translate everything.
 588
 589 =item -editable => 1
 590
 591 =item -indexes   => [qw(INDEX_COLUMNS)]
 592
 593 =item -CGI      => CGI_REFERENCE
 594
 595 If both of these are passed as arguments, the table is printed in
 596 editable format.  The INDEX_COLUMNS should be a list of columns that
 597 can be used to uniquely identify a row.  They will be the non-editable
 598 columns shown in the table.  Everything else will be editable.  The
 599 form and the submit button written by the rest of the script must loop
 600 back to the same displaytable clause for the edits to be committed to
 601 the database.  CGI_REFERENCE should be a reference to the CGI object
 602 used to query web parameters from ($CGI_REFERENCE = new CGI);
 603
 604 =item -mark     => 1
 605
 606 =item -indexes  => [qw(INDEX_COLUMNS)]
 607
 608 =item -CGI      => CGI_REFERENCE
 609
 610 =item -onmarked => \&FUNC
 611
 612 When the first three of these are specified, the left hand most column
 613 will be a check box that allows users to mark the row for future work.
 614
 615 FUNC($dbh, TABLENAME, DATA) will be called for each marked entry when
 616 a submission data has been processed.  $DATA is a hash reference to
 617 the rows dataset.  See -editable above for more information.
 618
 619 -onmarked => \&FUNC implies -mark => 1.
 620
 621 =back
 622
 623 =head1 Author
 624
 625 wjhardaker@ucdavis.edu
 626
 627 =cut