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