pgdiff/Pg/Scheme.pm

package Pg::Scheme;

use strict;
use warnings;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
use Carp;


use Exporter   ();
our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);

$VERSION        = 1.00;
@ISA            = qw(Exporter);
@EXPORT         = qw(&func1 &func2 &func4);
%EXPORT_TAGS    = ( );     # eg: TAG => [ qw!name1 name2! ],
               
@EXPORT_OK      = qw(
                                &list_tables
                );

my $debug;

sub new {
        my ($class, %args) = @_;
        my $self = {};
        bless($self, $class);
        $debug = $args{'DEBUG'};
        $self->{dbh} = $args{'dbh'} || croak "new needs to be called with 'dbh' which is handle to opened database";
        @{$self->{tables}} = ();
        $self ? return $self : return undef;
        # XXX begin transaction?
}

sub list_tables {
        my $self = shift;
        my $tables = shift;

        my @tables;

        if ($tables) {
                @tables = split(/,/,$tables);
        } else {
                # take all tables
                #$sql="select tablename from pg_tables where tablename not like 'pg_%' and tablename not like '_rserv_%'";
                # show tables (based on psql \dt)
                my $sql = "
                SELECT c.relname as table
                FROM pg_catalog.pg_class c
                        LEFT JOIN pg_catalog.pg_namespace n ON n.oid = c.relnamespace
                WHERE c.relkind = 'r'
                        AND n.nspname NOT IN ('pg_catalog', 'pg_toast')
                        AND pg_catalog.pg_table_is_visible(c.oid)
                        and c.relname not like '_rserv_%'
                ";
                foreach my $table (@tables) {
                        $sql .= " and c.relname like '$table' x";
                }
                my $sth = $self->{'dbh'}->prepare($sql) || croak "can't prepare '$sql': ".$self->{'dbh'}->errstr;
                $sth->execute() || croak "can't execute '$sql': ".$sth->errstr;
                while(my $row = $sth->fetchrow_hashref()) {
                        push @tables,$row->{table};
                }
        }
        #@{$self->{'tables'}} = @tables;
        return @tables;
}

sub get_table_oid {
        my $self = shift;
        my $table = shift;

        # find table oid
        my $sql = "
        SELECT c.oid, n.nspname, c.relname
        FROM pg_catalog.pg_class c
        LEFT JOIN pg_catalog.pg_namespace n ON n.oid = c.relnamespace
        WHERE pg_catalog.pg_table_is_visible(c.oid)
        AND c.relname = '$table'
        ORDER BY 2, 3
        ";

        my $sth = $self->{'dbh'}->prepare($sql);
        $sth->execute() || die;
        my $row = $sth->fetchrow_hashref();
        croak "Can't find OID of table '$table'\n" if (! $row);
        $sth->finish();

        return $row->{oid};
}

sub explain_table {
        my $self = shift;
        my $table = shift;

        my @explain;

        my $oid = $self->get_table_oid($table);

        my $sql="
        SELECT a.attname,
        pg_catalog.format_type(a.atttypid, a.atttypmod),
        a.attnotnull, a.atthasdef, a.attnum
        FROM pg_catalog.pg_attribute a
        WHERE a.attrelid = ? AND a.attnum > 0 AND NOT a.attisdropped
        ORDER BY a.attnum
        ";

        my $sth = $self->{'dbh'}->prepare($sql);
        $sth->execute($oid) || die;
        while(my $row = $sth->fetchrow_hashref()) {
                # attname | format_type | attnotnull | atthasdef | attnum
                push @explain, $row;
        }
        $sth->finish();

        return @explain;
}
1;
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;