| # 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 |