#! /usr/bin/env perl
# dbs_dumptabstruct - creates file set with SQL table schemas
# This script queries a SQL database and creates one file for each
# table in the database containing the schema of the table.
# Copyright (C) 1999-2012 Stefan Hornburg
# Author: Stefan Hornburg (Racke) <racke@linuxia.de>
# Maintainer: Stefan Hornburg (Racke) <racke@linuxia.de>
# Version: 0.19
# This file is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 2, or (at your option) any
# later version.
# This file is distributed in the hope that it will be
# useful, but WITHOUT ANY WARRANTY; without even the implied warranty
# of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# General Public License for more details.
# You should have received a copy of the GNU General Public License
# along with this file; see the file COPYING. If not, write to the Free
# Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
use strict;
use warnings;
use DBIx::Easy;
use Getopt::Long;
use Term::ReadKey;
# process commandline parameters
my %opts;
my $whandler = $SIG{__WARN__};
$SIG{__WARN__} = sub {print STDERR "$0: @_";};
unless (GetOptions (\%opts, 'dump-options|d|o=s', 'exclude-matching-tables=s',
'filter', 'pipe|p', 'tables|t=s')) {
exit 1;
}
$SIG{__WARN__} = $whandler;
# sanity check on commandline parameters
if (exists $opts{'exclude-matching-tables'}) {
eval {'' =~ /$opts{'exclude-matching-tables'}/;};
if ($@) {
$@ =~ s%at /.*$%%;
die "$0: $@";
}
}
my $dbif;
my $pwdused = 0;
my $pwd;
my @tables;
my ($driver, $database, $user) = @ARGV;
$dbif = new DBIx::Easy ($driver, $database, $user);
# handler for DBI error messages and missing password
$dbif -> install_handler (\&fatal);
# we need to explicitly establish the connection
# for the case that a password is needed
$dbif -> connect;
# dump procedures for the different drivers
my $dumpproc;
if ($driver eq 'mysql') {
if ($opts{filter}) {
$dumpproc = \&kvfilter;
} else {
$dumpproc = sub {
my ($database, $table) = @_;
my $header;
my $optstr = '';
if ($dbif -> {USER}) {
$optstr = " -u " . $dbif -> {USER};
}
if ($dbif -> {HOST}) {
$optstr .= " -h " . $dbif -> {HOST};
}
if (defined $pwd) {
$optstr .= " -p";
}
if ($opts{'dump-options'}) {
$optstr .= " $opts{'dump-options'}";
}
open (DUMP, qq{mysqldump -d $optstr "$database" "$table" |})
|| die ("$0: Couldn't launch mysqldump: $!\n");
while (<DUMP>) {
if ($header) {
print;
next;
}
# skip header
$header = 1 unless (/\S/);
}
close (DUMP)
|| die ("$0: mysqldump execution errors\n");
}
}
} elsif ($driver eq 'Pg') {
if ($opts{filter}) {
die "$0: --filter option not supported for PostgreSQL databases\n";
} else {
$dumpproc = sub {
my ($database, $table) = @_;
my $optstr = '';
if ($opts{'dump-options'}) {
$optstr = " $opts{'dump-options'}";
}
open (DUMP, qq{pg_dump "$database" -x -s $optstr -t "$table" |})
|| die ("$0: Couldn't launch pg_dump: $!\n");
while (<DUMP>) {
print;
}
close (DUMP)
|| die ("$0: pg_dump execution errors\n");
}
}
}
if ($opts{'tables'}) {
@tables = split (/,/, $opts{'tables'});
} else {
@tables = ($dbif->tables(), $dbif->sequences());
}
foreach my $table (@tables) {
my $outfile = lc($table) . '.sql';
my $regexp;
# skip tables unwanted by user
if (exists $opts{'exclude-matching-tables'}) {
next if $table =~ /$opts{'exclude-matching-tables'}/;
}
# call driver dependent dump procedure and fill
# output file with the results
unless ($opts{'pipe'}) {
open (OUT, ">$outfile") || die ("$0: Couldn't open $outfile: $!\n");
select (OUT);
}
&$dumpproc ($database, $table);
unless ($opts{'pipe'}) {
close (OUT);
}
select (STDOUT);
}
# Destroy Database object as written in manpage
undef $dbif;
# -----------------------------------
# FUNCTION: fatal
#
# Error handler called by DBIx::Easy.
# -----------------------------------
sub fatal {
my ($statement, $err, $msg) = @_;
if ($dbif->is_auth_error ($err)) {
unless ($pwdused) {
print "We need a password.\n";
$pwd = querypwd();
$pwdused = 1;
# retry the connection
if (length ($pwd)) {
$dbif = new DBIx::Easy ($driver, $database, $user, $pwd);
$dbif -> install_handler (\&fatal);
$dbif -> connect ();
return;
} else {
die ("$statement.\n");
}
}
}
die ("$statement.\n");
}
# ----------------------------
# FUNCTION: querypwd
#
# Queries user for a password.
# ----------------------------
sub querypwd () {
my $pwd;
print "Password: ";
ReadMode ('noecho'); # turn echo off
$pwd = ReadLine (0);
ReadMode ('restore'); # restore terminal
print "\n";
chomp ($pwd);
$pwd;
}
# FUNCTION: kvfilter
sub kvfilter {
my ($database, $table) = @_;
my $dbif = new DBIx::Easy ('mysql', $database);
my $sth = $dbif->process("describe $table");
my $row;
print join ("\t", @{$sth->{NAME}}), "\n";
while ($row = $sth->fetch()) {
print join("\t", map {$_ || ''} @$row), "\n";
}
}
=head1 NAME
dbs_dumptabstruct - Creates file set with SQL table schemas
=head1 DESCRIPTION
dbs_dumptabstruct is an utility to create a file set with SQL table schemas.
For each table in the database dbs_dumptabstruct calls the appropriate dumper
utility with the output directed to a file named I<table>.sql in the
current directory. dbs_dumptabstruct asks for a password if necessary.
=head1 COMMAND LINE PARAMETERS
Required command line parameters are the DBI driver
(C<Pg> for Postgres or C<mysql> for MySQL)
and the database name. The third parameter is optionally
and specifies the database user and/or the host where the
database resides (C<racke>, C<racke@linuxia.de> or C<@linuxia.de>).
=head1 COMMAND LINE OPTIONS
=head2 B<-d>=OPTIONS, B<-o>=OPTIONS, B<--dump-options>=OPTIONS
Pass options to the dumper utility, e.g. C<--compatible=mysql40>.
=head2 B<-p>, B<--pipe>
Prints the table dumps to standard output.
=head2 B<-t> TABLE[,TABLE,...], B<--tables>=TABLE[,TABLE,...]
Comma-separated list of tables to dump.
=head2 B<--exclude-matching-tables>=REGEXP
Excludes any table matching the regular expression REGEXP from dumping.
=head1 BUGS
Only mysql and Pg drivers are supported.
=head1 AUTHOR
Stefan Hornburg (Racke), racke@linuxia.de
=head1 VERSION
0.17
=head1 SEE ALSO
perl(1), DBIx::Easy(3)
=cut