1 |
package Pg::Scheme; |
2 |
|
3 |
use strict; |
4 |
use warnings; |
5 |
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); |
6 |
use Carp; |
7 |
|
8 |
|
9 |
use Exporter (); |
10 |
our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS); |
11 |
|
12 |
$VERSION = 1.00; |
13 |
@ISA = qw(Exporter); |
14 |
@EXPORT = qw(&func1 &func2 &func4); |
15 |
%EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ], |
16 |
|
17 |
@EXPORT_OK = qw( |
18 |
&list_tables |
19 |
); |
20 |
|
21 |
my $debug; |
22 |
|
23 |
sub new { |
24 |
my ($class, %args) = @_; |
25 |
my $self = {}; |
26 |
bless($self, $class); |
27 |
$debug = $args{'DEBUG'}; |
28 |
$self->{dbh} = $args{'dbh'} || croak "new needs to be called with 'dbh' which is handle to opened database"; |
29 |
@{$self->{tables}} = (); |
30 |
$self ? return $self : return undef; |
31 |
# XXX begin transaction? |
32 |
} |
33 |
|
34 |
sub list_tables { |
35 |
my $self = shift; |
36 |
my $tables = shift; |
37 |
|
38 |
my @tables; |
39 |
|
40 |
if ($tables) { |
41 |
@tables = split(/,/,$tables); |
42 |
} else { |
43 |
# take all tables |
44 |
#$sql="select tablename from pg_tables where tablename not like 'pg_%' and tablename not like '_rserv_%'"; |
45 |
# show tables (based on psql \dt) |
46 |
my $sql = " |
47 |
SELECT c.relname as table |
48 |
FROM pg_catalog.pg_class c |
49 |
LEFT JOIN pg_catalog.pg_namespace n ON n.oid = c.relnamespace |
50 |
WHERE c.relkind = 'r' |
51 |
AND n.nspname NOT IN ('pg_catalog', 'pg_toast') |
52 |
AND pg_catalog.pg_table_is_visible(c.oid) |
53 |
and c.relname not like '_rserv_%' |
54 |
"; |
55 |
foreach my $table (@tables) { |
56 |
$sql .= " and c.relname like '$table' x"; |
57 |
} |
58 |
my $sth = $self->{'dbh'}->prepare($sql) || croak "can't prepare '$sql': ".$self->{'dbh'}->errstr; |
59 |
$sth->execute() || croak "can't execute '$sql': ".$sth->errstr; |
60 |
while(my $row = $sth->fetchrow_hashref()) { |
61 |
push @tables,$row->{table}; |
62 |
} |
63 |
} |
64 |
#@{$self->{'tables'}} = @tables; |
65 |
return @tables; |
66 |
} |
67 |
|
68 |
sub get_table_oid { |
69 |
my $self = shift; |
70 |
my $table = shift; |
71 |
|
72 |
# find table oid |
73 |
my $sql = " |
74 |
SELECT c.oid, n.nspname, c.relname |
75 |
FROM pg_catalog.pg_class c |
76 |
LEFT JOIN pg_catalog.pg_namespace n ON n.oid = c.relnamespace |
77 |
WHERE pg_catalog.pg_table_is_visible(c.oid) |
78 |
AND c.relname = '$table' |
79 |
ORDER BY 2, 3 |
80 |
"; |
81 |
|
82 |
my $sth = $self->{'dbh'}->prepare($sql); |
83 |
$sth->execute() || die; |
84 |
my $row = $sth->fetchrow_hashref(); |
85 |
croak "Can't find OID of table '$table'\n" if (! $row); |
86 |
$sth->finish(); |
87 |
|
88 |
return $row->{oid}; |
89 |
} |
90 |
|
91 |
sub explain_table { |
92 |
my $self = shift; |
93 |
my $table = shift; |
94 |
|
95 |
my @explain; |
96 |
|
97 |
my $oid = $self->get_table_oid($table); |
98 |
|
99 |
my $sql=" |
100 |
SELECT a.attname, |
101 |
pg_catalog.format_type(a.atttypid, a.atttypmod), |
102 |
a.attnotnull, a.atthasdef, a.attnum |
103 |
FROM pg_catalog.pg_attribute a |
104 |
WHERE a.attrelid = ? AND a.attnum > 0 AND NOT a.attisdropped |
105 |
ORDER BY a.attnum |
106 |
"; |
107 |
|
108 |
my $sth = $self->{'dbh'}->prepare($sql); |
109 |
$sth->execute($oid) || die; |
110 |
while(my $row = $sth->fetchrow_hashref()) { |
111 |
# attname | format_type | attnotnull | atthasdef | attnum |
112 |
push @explain, $row; |
113 |
} |
114 |
$sth->finish(); |
115 |
|
116 |
return @explain; |
117 |
} |
118 |
1; |