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
|
package SQL::Translator::Parser::DBI::Oracle;
=head1 NAME
SQL::Translator::Parser::DBI::Oracle - parser for DBD::Oracle
=head1 SYNOPSIS
See SQL::Translator::Parser::DBI.
=head1 DESCRIPTION
Uses DBI introspection methods to determine schema details.
=cut
use strict;
use warnings;
use DBI;
use SQL::Translator::Schema::Constants;
use SQL::Translator::Schema::Table;
use SQL::Translator::Schema::Field;
use SQL::Translator::Schema::Constraint;
our $VERSION = '1.66';
sub parse {
my ($tr, $dbh) = @_;
my $schema = $tr->schema;
my $db_user = uc $tr->parser_args()->{db_user};
my $sth = $dbh->table_info(undef, $db_user, '%', 'TABLE');
while (my $table_info = $sth->fetchrow_hashref('NAME_uc')) {
next if ($table_info->{TABLE_NAME} =~ /\$/);
# create the table
my $table = $schema->add_table(
name => $table_info->{TABLE_NAME},
type => $table_info->{TABLE_TYPE},
);
# add the fields (columns) for this table
my $sth;
$sth = $dbh->column_info(undef, $table_info->{TABLE_SCHEM}, $table_info->{TABLE_NAME}, '%');
while (my $column = $sth->fetchrow_hashref('NAME_uc')) {
my $f = $table->add_field(
name => $column->{COLUMN_NAME},
default_value => $column->{COLUMN_DEF},
data_type => $column->{TYPE_NAME},
order => $column->{ORDINAL_POSITION},
size => $column->{COLUMN_SIZE},
) || die $table->error;
$f->is_nullable($column->{NULLABLE} == 1);
}
# add the primary key info
$sth = $dbh->primary_key_info(undef, $table_info->{TABLE_SCHEM}, $table_info->{TABLE_NAME},);
while (my $primary_key = $sth->fetchrow_hashref('NAME_uc')) {
my $f = $table->get_field($primary_key->{COLUMN_NAME});
$f->is_primary_key(1);
}
# add the foreign key info (constraints)
$sth = $dbh->foreign_key_info(undef, undef, undef, undef, $table_info->{TABLE_SCHEM}, $table_info->{TABLE_NAME},);
my $cons = {};
while (my $foreign_key = $sth->fetchrow_hashref('NAME_uc')) {
my $name = $foreign_key->{FK_NAME};
$cons->{$name}->{reference_table} = $foreign_key->{UK_TABLE_NAME};
push @{ $cons->{$name}->{fields} }, $foreign_key->{FK_COLUMN_NAME};
push @{ $cons->{$name}->{reference_fields} }, $foreign_key->{UK_COLUMN_NAME};
}
for my $name (keys %$cons) {
my $c = $table->add_constraint(
type => FOREIGN_KEY,
name => $name,
fields => $cons->{$name}->{fields},
reference_fields => $cons->{$name}->{reference_fields},
reference_table => $cons->{$name}->{reference_table},
) || die $table->error;
}
}
return 1;
}
1;
=pod
=head1 AUTHOR
Earl Cahill E<lt>cpan@spack.netE<gt>.
=head1 ACKNOWLEDGEMENT
Initial revision of this module came almost entirely from work done by
Todd Hepler E<lt>thepler@freeshell.orgE<gt>. My changes were
quite minor (ensuring NAME_uc, changing a couple variable names,
skipping tables with a $ in them).
Todd claimed his work to be an almost verbatim copy of
SQL::Translator::Parser::DBI::PostgreSQL revision 1.7
For me, the real work happens in DBD::Oracle and DBI, which, also
for me, that is the beauty of having introspection methods in DBI.
=head1 SEE ALSO
SQL::Translator, DBD::Oracle.
=cut
|
