bin/sqlt-dumper.pl

   1 #!/usr/bin/perl
   2
   3 # -------------------------------------------------------------------
   4 # $Id: sqlt-dumper.pl,v 1.1 2003-06-24 03:24:02 kycl4rk Exp $
   5 # -------------------------------------------------------------------
   6 # Copyright (C) 2003 Ken Y. Clark <kclark@cpan.org>
   7 #
   8 # This program is free software; you can redistribute it and/or
   9 # modify it under the terms of the GNU General Public License as
  10 # published by the Free Software Foundation; version 2.
  11 #
  12 # This program is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15 # General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with this program; if not, write to the Free Software
  19 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
  20 # 02111-1307  USA
  21 # -------------------------------------------------------------------
  22
  23 =head1 sqlt-dumper.pl - create a dumper script from a schema
  24
  25 =head1 DESCRIPTION
  26
  27 This script uses SQL::Translator to parse the SQL schema and
  28 create a Perl script that can connect to the database and dump the
  29 data as INSERT statements a la mysqldump.
  30
  31 =head1 SYNOPSIS
  32
  33   ./sqlt-dumper.pl -d Oracle [options] schema.sql > dumper.pl
  34   ./dumper.pl > data.sql
  35
  36   Options:
  37
  38     --add-truncate  Add "TRUNCATE TABLE" statements for each table
  39
  40 =cut
  41
  42 use strict;
  43 use Pod::Usage;
  44 use Getopt::Long;
  45 use SQL::Translator;
  46
  47 my ( $db, $add_truncate );
  48 GetOptions(
  49     'd:s'          => \$db,
  50     'add-truncate' => \$add_truncate,
  51 );
  52
  53 my $file = shift @ARGV or pod2usage( -msg => 'No input file' );
  54
  55 my $t = SQL::Translator->new(
  56     from     => $db,
  57     filename => $file,
  58 );
  59
  60 my $parser = $t->parser or die $t->error;
  61 $parser->($t, $t->data);
  62 my $schema = $t->schema;
  63
  64 my $out = <<"EOF";
  65 #!/usr/bin/perl
  66
  67 use strict;
  68 use DBI;
  69
  70 my \$db = DBI->connect('dbi:$db:', 'user', 'passwd');
  71
  72 EOF
  73
  74 for my $table ( $schema->get_tables ) {
  75     my $table_name  = $table->name;
  76     my ( @field_names, %types );
  77     for my $field ( $table->get_fields ) {
  78         $types{ $field->name } = $field->data_type =~ m/(char|str|long|text)/
  79             ? 'string' : 'number';
  80         push @field_names, $field->name;
  81     }
  82
  83     $out .= join('',
  84         "#\n# Data for table '$table_name'\n#\n{\n",
  85         "    print \"#\\n# Data for table '$table_name'\\n#\\n\";\n",
  86     );
  87
  88     my $insert = "INSERT INTO $table_name (". join(', ', @field_names).
  89             ') VALUES (';
  90
  91     if ( $add_truncate ) {
  92         $out .= "    print \"TRUNCATE TABLE $table_name;\\n\";\n";
  93     }
  94
  95     $out .= join('',
  96         "    my \%types = (\n",
  97         join("\n", map { "        $_ => '$types{ $_ }'," } @field_names),
  98         "\n    );\n\n",
  99         "    my \$data  = \$db->selectall_arrayref(\n",
 100         "        'select ", join(', ', @field_names), " from $table_name',\n",
 101         "        { Columns => {} },\n",
 102         "    );\n\n",
 103         "    for my \$rec ( \@{ \$data } ) {\n",
 104         "        my \@vals;\n",
 105         "        for my \$fld ( qw[", join(' ', @field_names), "] ) {\n",
 106         "            my \$val = \$rec->{ \$fld };\n",
 107         "            if ( \$types{ \$fld } eq 'string' ) {\n",
 108         "                \$val =~ s/'/\\'/g;\n",
 109         "                \$val = defined \$val ? qq['\$val'] : qq[''];\n",
 110         "            }\n",
 111         "            else {\n",
 112         "                \$val = defined \$val ? \$val : 'NULL';\n",
 113         "            }\n",
 114         "            push \@vals, \$val;\n",
 115         "        }\n",
 116         "        print \"$insert\", join(', ', \@vals), \");\\n\";\n",
 117         "    }\n",
 118         "    print \"\\n\\n\";\n",
 119         "}\n\n",
 120     );
 121 }
 122
 123 print $out;