diff --git a/dbi/dumpsql b/dbi/dumpsql new file mode 100755 index 0000000..cf77810 --- /dev/null +++ b/dbi/dumpsql @@ -0,0 +1,143 @@ +#!/usr/local/bin/perl + +=head1 NAME + +dumpsql - dump output of an SQL query + +=head1 SYNOPSIS + +dumpsql +query + +Connects to the database identified by the environment variable +DBI_CREDENTIAL_FILE, executes the query given on the command line and +prints the output to stdout. + +=cut + +use warnings; +use strict; +use DBI; +use Getopt::Long; +use Encode qw(:fallbacks encode); + +my $help; +my $vertical; # use vertical output format +my $escape; # escape non-printable characters +my $xhtml; # produce XHTML output +my $style; # produce XHTML output + +GetOptions( + 'help|?' => \$help, + 'vertical' => \$vertical, + 'xhtml' => \$xhtml, + 'escape' => \$escape, + 'style:s' => \$style, +) || pod2usage(2); +pod2usage(1) if $help; + + +# read credits from file +sub _read_cred { + my ($fn) = @_; + + open(FN, "<$fn") or die "cannot open $fn: $!"; + my $line = ; + close(FN); + my @cred = split(/[\s\n]/, $line); + return @cred; +} + + +my $dbh; + +sub dbiconnect { + my $cred_file = $ENV{DBI_CREDENTIAL_FILE}; + if (! defined($cred_file)) { + $cred_file = "$ENV{HOME}/.dbi/default"; + } elsif ($cred_file !~ m{/}) { + $cred_file = "$ENV{HOME}/.dbi/$cred_file"; + } + + $dbh = DBI->connect(_read_cred($cred_file), {RaiseError => 1, AutoCommit => 0}); + return $dbh; +} + +$dbh = dbiconnect(); +$dbh->{LongReadLen} = 0x1_0000; + +my $query = shift(@ARGV); +my @args = @ARGV; +my $sth = $dbh->prepare($query); +$sth->execute(@args); +if ($xhtml) { + print qq{\n}; + print qq{\n}; + print qq{\n}; + print qq{}, xmlencode($query), qq{\n}; + if ($style) { + print qq{\n}; + } + print qq{\n}; + print qq{\n}; + print qq{\n}; + print qq{

}, xmlencode($query), qq{

\n}; + if (@args) { + print qq{\n}; + } + print qq{\n}; + print qq{}, + ( + map { + "" + } @{$sth->{NAME}} + ), + "\n"; + while (my @a = $sth->fetchrow_array()) { + print qq{}, + ( + map { + "" + } @a + ), + "\n"; + } + print qq{
" . xmlencode($_) . "
" + . (defined($_) ? xmlencode($_) : 'NULL') + . "
\n}; + print qq{\n}; + print qq{\n}; +} elsif ($vertical) { + while (my @a = $sth->fetchrow_array()) { + for my $i (0 .. $#a) { + print $sth->{NAME}[$i], ": "; + if ($escape) { + if (defined($a[$i])) { + print encode("us-ascii", $a[$i], FB_PERLQQ), "\n"; + } else { + print "NULL\n"; + } + } else { + print "$a[$i]\n"; + } + } + print "\n"; + } +} else { + no warnings 'uninitialized'; + print join("\t", @{$sth->{NAME}}), "\n"; + while (my @a = $sth->fetchrow_array()) { + print join("\t", @a), "\n"; + } +} + +sub xmlencode { + my ($s) = @_; + return encode("us-ascii", $s, FB_XMLCREF); +}