1 |
dpavlin |
1.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; |