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
|
package Class::DBI::Pg;
use strict;
require Class::DBI;
use base 'Class::DBI';
use vars qw($VERSION);
$VERSION = '0.06';
=head1 NAME
Class::DBI::Pg - Class::DBI extension for Postgres
=head1 SYNOPSIS
use strict;
use base qw(Class::DBI::Pg);
__PACKAGE__->set_db(Main => 'dbi:Pg:dbname=dbname', 'user', 'password');
__PACKAGE__->set_up_table('film');
=head1 DESCRIPTION
Class::DBI::Pg automate the setup of Class::DBI columns and primary key
for Postgres.
select Postgres system catalog and find out all columns, primary key and
SERIAL type column.
create table.
CREATE TABLE cd (
id SERIAL NOT NULL PRIMARY KEY,
title TEXT,
artist TEXT,
release_date DATE
);
setup your class.
package CD;
use strict;
use base qw(Class::DBI::Pg);
__PACKAGE__->set_db(Main => 'dbi:Pg:dbname=db', 'user', 'password');
__PACKAGE__->set_up_table('cd');
This is almost the same as the following way.
package CD;
use strict;
use base qw(Class::DBI);
__PACKAGE__->set_db(Main => 'dbi:Pg:dbname=db', 'user', 'password');
__PACKAGE__->table('cd');
__PACKAGE__->columns(Primary => 'id');
__PACKAGE__->columns(All => qw(id title artist release_date));
__PACKAGE__->sequence('cd_id_seq');
=cut
sub _croak { require Carp; Carp::croak(@_); }
sub set_up_table {
my ( $class, $table ) = @_;
my $dbh = $class->db_Main;
my $catalog = "";
if ( $class->pg_version >= 7.3 ) {
$catalog = 'pg_catalog.';
}
# find primary key
my $sth = $dbh->prepare(<<"SQL");
SELECT indkey FROM ${catalog}pg_index
WHERE indisprimary=true AND indrelid=(
SELECT oid FROM ${catalog}pg_class
WHERE relname = ?)
SQL
$sth->execute($table);
my %prinum = map { $_ => 1 } split ' ', $sth->fetchrow_array;
$sth->finish;
# find all columns
$sth = $dbh->prepare(<<"SQL");
SELECT a.attname, a.attnum
FROM ${catalog}pg_class c, ${catalog}pg_attribute a
WHERE c.relname = ?
AND a.attnum > 0 AND a.attrelid = c.oid
ORDER BY a.attnum
SQL
$sth->execute($table);
my $columns = $sth->fetchall_arrayref;
$sth->finish;
# find SERIAL type.
# nextval('"table_id_seq"'::text)
$sth = $dbh->prepare(<<"SQL");
SELECT adsrc FROM ${catalog}pg_attrdef
WHERE
adrelid=(SELECT oid FROM ${catalog}pg_class WHERE relname=?)
SQL
$sth->execute($table);
my ($nextval_str) = $sth->fetchrow_array;
$sth->finish;
my ($sequence) =
$nextval_str ? $nextval_str =~ m/^nextval\('"?([^"']+)"?'::text\)/ : '';
my ( @cols, @primary );
foreach my $col (@$columns) {
# skip dropped column.
next if $col->[0] =~ /^\.+pg\.dropped\.\d+\.+$/;
push @cols, $col->[0];
next unless $prinum{ $col->[1] };
push @primary, $col->[0];
}
_croak("$table has no primary key") unless @primary;
$class->table($table);
$class->columns( Primary => @primary );
$class->columns( All => @cols );
$class->sequence($sequence) if $sequence;
}
sub pg_version {
my $class = shift;
my $dbh = $class->db_Main;
my $sth = $dbh->prepare("SELECT version()");
$sth->execute;
my ($ver_str) = $sth->fetchrow_array;
$sth->finish;
my ($ver) = $ver_str =~ m/^PostgreSQL ([\d\.]{3})/;
return $ver;
}
=head1 AUTHOR
Sebastian Riedel, C<sri@oook.de>
=head1 AUTHOR EMERITUS
IKEBE Tomohiro, C<ikebe@edge.co.jp>
=head1 LICENSE
This library is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.
=head1 SEE ALSO
L<Class::DBI> L<Class::DBI::mysql> L<DBD::Pg>
=cut
1;
|
