lib/SQL/Translator/Parser/DBI.pm

   1 package SQL::Translator::Parser::DBI;
   2
   3 # -------------------------------------------------------------------
   4 # $Id: DBI.pm,v 1.9 2006-05-24 14:45:21 schiffbruechige Exp $
   5 # -------------------------------------------------------------------
   6 # Copyright (C) 2002-4 SQLFairy Authors
   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 NAME
  24
  25 SQL::Translator::Parser::DBI - "parser" for DBI handles
  26
  27 =head1 SYNOPSIS
  28
  29   use DBI;
  30   use SQL::Translator;
  31
  32   my $dbh = DBI->connect('dsn', 'user', 'pass',
  33       {
  34           RaiseError       => 1,
  35           FetchHashKeyName => 'NAME_lc',
  36       }
  37   );
  38
  39   my $translator  =  SQL::Translator->new(
  40       parser      => 'DBI',
  41       dbh         => $dbh,
  42   );
  43
  44 Or:
  45
  46   use SQL::Translator;
  47
  48   my $translator      =  SQL::Translator->new(
  49       parser          => 'DBI',
  50       parser_args     => {
  51           dsn         => 'dbi:mysql:FOO',
  52           db_user     => 'guest',
  53           db_password => 'password',
  54     }
  55   );
  56
  57 =head1 DESCRIPTION
  58
  59 This parser accepts an open database handle (or the arguments to create
  60 one) and queries the database directly for the information.
  61
  62 The following are acceptable arguments:
  63
  64 =over 4
  65
  66 =item * dbh
  67
  68 An open DBI database handle.  NB:  Be sure to create the database with the
  69 "FetchHashKeyName => 'NAME_lc'" option as all the DBI parsers expect
  70 lowercased column names.
  71
  72 =item * dsn
  73
  74 The DSN to use for connecting to a database.
  75
  76 =item * db_user
  77
  78 The user name to use for connecting to a database.
  79
  80 =item * db_password
  81
  82 The password to use for connecting to a database.
  83
  84 =back
  85
  86 There is no need to specify which type of database you are querying as
  87 this is determined automatically by inspecting $dbh->{'Driver'}{'Name'}.
  88 If a parser exists for your database, it will be used automatically;
  89 if not, the code will fail automatically (and you can write the parser
  90 and contribute it to the project!).
  91
  92 Currently parsers exist for the following databases:
  93
  94 =over 4
  95
  96 =item * MySQL
  97
  98 =item * SQLite
  99
 100 =item * Sybase
 101
 102 =item * PostgreSQL (still experimental)
 103
 104 =back
 105
 106 Most of these parsers are able to query the database directly for the
 107 structure rather than parsing a text file.  For large schemas, this is
 108 probably orders of magnitude faster than traditional parsing (which
 109 uses Parse::RecDescent, an amazing module but really quite slow).
 110
 111 Though no Oracle parser currently exists, it would be fairly easy to
 112 query an Oracle database directly by using DDL::Oracle to generate a
 113 DDL for the schema and then using the normal Oracle parser on this.
 114 Perhaps future versions of SQL::Translator will include the ability to
 115 query Oracle directly and skip the parsing of a text file, too.
 116
 117 =cut
 118
 119 # -------------------------------------------------------------------
 120
 121 use strict;
 122 use DBI;
 123 use vars qw($VERSION @EXPORT);
 124 $VERSION = sprintf "%d.%02d", q$Revision: 1.9 $ =~ /(\d+)\.(\d+)/;
 125
 126 use constant DRIVERS => {
 127     mysql            => 'MySQL',
 128     odbc             => 'SQLServer',
 129     oracle           => 'Oracle',
 130     pg               => 'PostgreSQL',
 131     sqlite           => 'SQLite',
 132     sybase           => 'Sybase',
 133     pg               => 'PostgreSQL',
 134     db2              => 'DB2',
 135 };
 136
 137 use Exporter;
 138
 139 use SQL::Translator::Utils qw(debug);
 140
 141 use SQL::Translator::Parser::DBI::MySQL;
 142 use SQL::Translator::Parser::DBI::SQLServer;
 143 use SQL::Translator::Parser::DBI::SQLite;
 144 use SQL::Translator::Parser::DBI::Sybase;
 145 use SQL::Translator::Parser::DBI::PostgreSQL;
 146 <<<<<<< DBI.pm
 147 use SQL::Translator::Parser::DBI::DB2;
 148 =======
 149 use SQL::Translator::Parser::DBI::Oracle;
 150 >>>>>>> 1.8
 151
 152 use base qw(Exporter);
 153 @EXPORT = qw(parse);
 154
 155 #
 156 # Passed a SQL::Translator instance and a string containing the data
 157 #
 158 sub parse {
 159     my ( $tr, $data ) = @_;
 160
 161     my $args          = $tr->parser_args;
 162     my $dbh           = $args->{'dbh'};
 163     my $dsn           = $args->{'dsn'};
 164     my $db_user       = $args->{'db_user'};
 165     my $db_password   = $args->{'db_password'};
 166
 167     unless ( $dbh ) {
 168         die 'No DSN' unless $dsn;
 169         $dbh = DBI->connect( $dsn, $db_user, $db_password,
 170             {
 171                 FetchHashKeyName => 'NAME_lc',
 172                 LongReadLen      => 3000,
 173                 LongTruncOk      => 1,
 174                 RaiseError       => 1,
 175             }
 176         );
 177     }
 178
 179     die 'No database handle' unless defined $dbh;
 180
 181     my $db_type = $dbh->{'Driver'}{'Name'} or die 'Cannot determine DBI type';
 182     my $driver  = DRIVERS->{ lc $db_type } or die "$db_type not supported";
 183     my $pkg     = "SQL::Translator::Parser::DBI::$driver";
 184     my $sub     = $pkg.'::parse';
 185
 186     #
 187     # I can't get this to work.  I seem to have to have the "use"
 188     # statements above.
 189     #
 190 #    $tr->load( $pkg );
 191
 192     eval {
 193         no strict 'refs';
 194         &{ $sub }( $tr, $dbh ) or die "No result from $pkg";
 195     };
 196
 197     $dbh->disconnect if defined $dbh;
 198
 199     die $@ if $@;
 200
 201     return 1;
 202 }
 203
 204 1;
 205
 206 # -------------------------------------------------------------------
 207 =pod
 208
 209 =head1 AUTHOR
 210
 211 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
 212
 213 =head1 SEE ALSO
 214
 215 DBI, SQL::Translator.
 216
 217 =cut