| 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; |
Parent Directory
| 
Revision Log