Commit | Line | Data |
4cbddf8d |
1 | package DBIx::Class::Schema::Loader::DBI::InterBase; |
2 | |
3 | use strict; |
4 | use warnings; |
5 | use namespace::autoclean; |
6 | use Class::C3; |
7 | use base qw/DBIx::Class::Schema::Loader::DBI/; |
8 | use Carp::Clan qw/^DBIx::Class/; |
9 | |
10 | our $VERSION = '0.05003'; |
11 | |
12 | =head1 NAME |
13 | |
14 | DBIx::Class::Schema::Loader::DBI::InterBase - DBIx::Class::Schema::Loader::DBI |
15 | Firebird Implementation. |
16 | |
17 | =head1 DESCRIPTION |
18 | |
19 | See L<DBIx::Class::Schema::Loader::Base>. |
20 | |
21 | =cut |
22 | |
23 | sub _table_pk_info { |
24 | my ($self, $table) = @_; |
25 | |
26 | my $dbh = $self->schema->storage->dbh; |
27 | my $sth = $dbh->prepare(<<'EOF'); |
28 | SELECT iseg.rdb$field_name |
29 | FROM rdb$relation_constraints rc |
30 | JOIN rdb$index_segments iseg ON rc.rdb$index_name = iseg.rdb$index_name |
31 | WHERE rc.rdb$constraint_type = 'PRIMARY KEY' and rc.rdb$relation_name = ? |
32 | ORDER BY iseg.rdb$field_position |
33 | EOF |
34 | $sth->execute($table); |
35 | |
36 | my @keydata; |
37 | |
38 | while (my ($col) = $sth->fetchrow_array) { |
39 | s/^\s+//, s/\s+\z// for $col; |
40 | |
41 | push @keydata, lc $col; |
42 | } |
43 | |
44 | return \@keydata; |
45 | } |
46 | |
47 | sub _table_fk_info { |
48 | my ($self, $table) = @_; |
49 | |
50 | my ($local_cols, $remote_cols, $remote_table, @rels); |
51 | my $dbh = $self->schema->storage->dbh; |
52 | my $sth = $dbh->prepare(<<'EOF'); |
53 | SELECT rc.rdb$constraint_name fk, iseg.rdb$field_name local_col, ri.rdb$relation_name remote_tab, riseg.rdb$field_name remote_col |
54 | FROM rdb$relation_constraints rc |
55 | JOIN rdb$index_segments iseg ON rc.rdb$index_name = iseg.rdb$index_name |
56 | JOIN rdb$indices li ON rc.rdb$index_name = li.rdb$index_name |
57 | JOIN rdb$indices ri ON li.rdb$foreign_key = ri.rdb$index_name |
58 | JOIN rdb$index_segments riseg ON iseg.rdb$field_position = riseg.rdb$field_position and ri.rdb$index_name = riseg.rdb$index_name |
59 | WHERE rc.rdb$constraint_type = 'FOREIGN KEY' and rc.rdb$relation_name = ? |
60 | ORDER BY iseg.rdb$field_position |
61 | EOF |
62 | $sth->execute($table); |
63 | |
64 | while (my ($fk, $local_col, $remote_tab, $remote_col) = $sth->fetchrow_array) { |
65 | s/^\s+//, s/\s+\z// for $fk, $local_col, $remote_tab, $remote_col; |
66 | |
67 | push @{$local_cols->{$fk}}, lc $local_col; |
68 | push @{$remote_cols->{$fk}}, lc $remote_col; |
69 | $remote_table->{$fk} = $remote_tab; |
70 | } |
71 | |
72 | foreach my $fk (keys %$remote_table) { |
73 | push @rels, { |
74 | local_columns => $local_cols->{$fk}, |
75 | remote_columns => $remote_cols->{$fk}, |
76 | remote_table => $remote_table->{$fk}, |
77 | }; |
78 | } |
79 | return \@rels; |
80 | } |
81 | |
82 | sub _table_uniq_info { |
83 | my ($self, $table) = @_; |
84 | |
85 | my $dbh = $self->schema->storage->dbh; |
86 | my $sth = $dbh->prepare(<<'EOF'); |
87 | SELECT rc.rdb$constraint_name, iseg.rdb$field_name |
88 | FROM rdb$relation_constraints rc |
89 | JOIN rdb$index_segments iseg ON rc.rdb$index_name = iseg.rdb$index_name |
90 | WHERE rc.rdb$constraint_type = 'UNIQUE' and rc.rdb$relation_name = ? |
91 | ORDER BY iseg.rdb$field_position |
92 | EOF |
93 | $sth->execute($table); |
94 | |
95 | my $constraints; |
96 | while (my ($constraint_name, $column) = $sth->fetchrow_array) { |
97 | s/^\s+//, s/\s+\z// for $constraint_name, $column; |
98 | |
99 | push @{$constraints->{$constraint_name}}, lc $column; |
100 | } |
101 | |
102 | my @uniqs = map { [ $_ => $constraints->{$_} ] } keys %$constraints; |
103 | return \@uniqs; |
104 | } |
105 | |
106 | =head1 SEE ALSO |
107 | |
108 | L<DBIx::Class::Schema::Loader>, L<DBIx::Class::Schema::Loader::Base>, |
109 | L<DBIx::Class::Schema::Loader::DBI> |
110 | |
111 | =head1 AUTHOR |
112 | |
113 | See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>. |
114 | |
115 | =head1 LICENSE |
116 | |
117 | This library is free software; you can redistribute it and/or modify it under |
118 | the same terms as Perl itself. |
119 | |
120 | =cut |
121 | |
122 | 1; |