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
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
|
package DBD::Firebird::TableInfo::Basic;
use strict;
=pod
=head1 NAME
DBD::Firebird::TableInfo::Basic - A base class for lowest-common denominator Interbase table_info() querying.
=head1 SYNOPSIS
# Add support for a hypothetical IB derivative
package DBD::Firebird::TableInfo::HypotheticalIBDerivative
@ISA = qw(DBD::Firebird::TableInfo::Basic);
# What table types are supported?
sub supported_types {
('SYSTEM TABLE', 'TABLE', 'VIEW', 'SPECIAL TABLE TYPE');
}
sub table_info {
my ($self, $dbh, $table, @types) = @_;
}
=head1 INTERFACE
=over 4
=item I<list_catalogs>
$ti->list_catalogs($dbh); # $dbh->table_info('%', '', '')
Returns a statement handle with an empty result set, as IB does not support
the DBI concept of catalogs. (Rule 19a)
=item I<list_schema>
$ti->list_schema($dbh); # $dbh->table_info('', '%', '')
Returns a statement handle with an empty result set, as IB does not support
the DBI concept of schema. (Rule 19b)
=item I<list_tables>
$ti->list_tables($dbh, $table, @types); # $dbh->table_info('', '',
# 'FOO%',
# 'TABLE,VIEW');
Called in response to $dbh->table_info($cat, $schem, $table, $types). C<$cat>
and C<$schem> are presently ignored.
This is the workhorse method that must return an appropriate statement handle
of tables given the requested C<$table> pattern and C<@types>. A blank
C<$table> pattern means "any table," and an empty C<@types> list means "any
type."
C<@types> is a list of user-supplied, requested types.
C<DBD::Firebird::db::table_info> will normalize the user-supplied types,
stripping quote marks, uppercasing, and removing duplicates.
=item I<list_types>
$tbl_info->list_types($dbh); # $dbh->table_info('', '', '', '%')
Called in response to $dbh->table_info('', '', '', '%'), returning a
statement handle with a TABLE_TYPE column populated with the results of
I<supported_types>. (Rule 19c)
Normally not overridden. Override I<supported_types>, instead.
=item I<supported_types>
$tbl_info->supported_types($dbh);
Returns a list of supported DBI TABLE_TYPE entries. The default
implementation supports 'TABLE', 'SYSTEM TABLE' and 'VIEW'.
This method is called by the default implementation of C<list_types>.
=back
=cut
sub new { bless {}, shift; }
my %IbTableTypes = (
'SYSTEM TABLE' => '((rdb$system_flag = 1) AND rdb$view_blr IS NULL)',
'SYSTEM VIEW' => '((rdb$system_flag = 1) AND rdb$view_blr IS NOT NULL)',
'TABLE' => '((rdb$system_flag = 0 OR rdb$system_flag IS NULL) AND rdb$view_blr IS NULL)',
'VIEW' => '((rdb$system_flag = 0 OR rdb$system_flag IS NULL) AND rdb$view_blr IS NOT NULL)',
);
sub supported_types {
sort keys %IbTableTypes;
}
sub sponge {
# no warnings 'once';
my ($self, $dbh, $stmt, $attrib_hash) = @_;
my $sponge = DBI->connect('dbi:Sponge:', '', '')
or return $dbh->DBI::set_err($DBI::err, "DBI::Sponge: $DBI::errstr");
return ($sponge->prepare($stmt, $attrib_hash)
or
$dbh->DBI::set_err($sponge->err(), $sponge->errstr()));
}
sub list_catalogs {
my ($self, $dbh) = @_;
return $self->sponge($dbh, 'catalog_info', {
NAME => [qw(TABLE_CAT TABLE_SCHEM TABLE_NAME TABLE_TYPE REMARKS)],
rows => [],
});
}
sub list_schema {
my ($self, $dbh) = @_;
$self->sponge($dbh, 'schema_info', {
NAME => [qw(TABLE_CAT TABLE_SCHEM TABLE_NAME TABLE_TYPE REMARKS)],
rows => [],
});
}
sub list_types {
my ($self, $dbh) = @_;
my @rows = map { [undef, undef, undef, $_, undef] } $self->supported_types;
$self->sponge($dbh, 'supported_type_info', {
NAME => [qw(TABLE_CAT TABLE_SCHEM TABLE_NAME TABLE_TYPE REMARKS)],
rows => \@rows
});
}
#
# Fetch a listing of tables matching the desired TABLE_NAME pattern
# and desired TABLE_TYPEs. Do not presume support for CASE/END,
# COALESCE nor derived tables.
#
# We could put more work on the server than we do here. However,
# rdb$relation_name is very likely to be space padded, and we cannot
# presume a TRIM() function. So, $dbh->table_info('', '', 'F%T')
# cannot be implemented as "rdb$relation_name LIKE 'F%T'", since, in
# strict SQL, the padded string 'FOOT ' is NOT LIKE 'F%T'.
#
sub list_tables {
my ($self, $dbh, $name_pattern, @types) = @_;
my ($name_ok, $type_ok);
my @data;
# no warnings 'uninitialized'
if (!defined($name_pattern) or $name_pattern eq '%' or $name_pattern eq '') {
$name_ok = sub {1};
} else {
my $re = quotemeta($name_pattern);
for ($re) { s/_/./g; s/%/.*/g; }
$name_ok = sub { $_[0] =~ /$re/ };
}
if (@types) {
my %desired = map { $_ => 1 } grep { exists $IbTableTypes{$_} } @types;
$type_ok = sub { exists $desired{$_[0]} };
} else {
$type_ok = sub { 1 };
}
my $sth = $dbh->prepare(<<'__eosql');
SELECT v.rdb$relation_name AS TABLE_NAME,
CAST('VIEW' AS CHAR(5)) AS TABLE_TYPE,
v.rdb$description AS REMARKS,
v.rdb$owner_name AS ib_owner_name,
v.rdb$system_flag AS flag_sys
FROM rdb$relations v
WHERE v.rdb$view_blr IS NOT NULL
UNION ALL
SELECT t.rdb$relation_name AS TABLE_NAME,
CAST('TABLE' AS CHAR(5)) AS TABLE_TYPE,
t.rdb$description AS REMARKS,
t.rdb$owner_name AS ib_owner_name,
t.rdb$system_flag AS flag_sys
FROM rdb$relations t
WHERE t.rdb$view_blr IS NULL
__eosql
if ($sth) {
$sth->{ChopBlanks} = 1;
$sth->execute or return undef;
}
while (my $r = $sth->fetch) {
my ($name, $type, $remarks, $owner, $flag_sys) = @$r;
$type = "SYSTEM $type" if $flag_sys;
next unless $name_ok->($name);
next unless $type_ok->($type);
push @data, [undef, undef, $name, $type, $remarks, $owner];
}
return $self->sponge($dbh, 'table_info', {
NAME => [qw(TABLE_CAT TABLE_SCHEM TABLE_NAME TABLE_TYPE REMARKS ib_owner_name)],
rows => \@data
});
}
1;
__END__
# vim:set et ts=4:
|
