pod fixes
[dbsrgits/DBIx-Class-Historic.git] / lib / DBIx / Class / Storage / DBI / Pg.pm
CommitLineData
843f8ecd 1package DBIx::Class::Storage::DBI::Pg;
2
3use strict;
4use warnings;
5
a71859b4 6use DBD::Pg qw(:pg_types);
2feba391 7
843f8ecd 8use base qw/DBIx::Class::Storage::DBI/;
9
10# __PACKAGE__->load_components(qw/PK::Auto/);
11
17614944 12# Warn about problematic versions of DBD::Pg
13warn "DBD::Pg 1.49 is strongly recommended"
14 if ($DBD::Pg::VERSION < 1.49);
15
d4f16b21 16sub _dbh_last_insert_id {
17 my ($self, $dbh, $seq) = @_;
18 $dbh->last_insert_id(undef, undef, undef, undef, {sequence => $seq});
0680ac39 19}
20
843f8ecd 21sub last_insert_id {
ca48cd7d 22 my ($self,$source,$col) = @_;
23 my $seq = ($source->column_info($col)->{sequence} ||= $self->get_autoinc_seq($source,$col));
d12926f6 24 $self->throw_exception("could not fetch primary key for " . $source->name . ", could not "
25 . "get autoinc sequence for $col (check that table and column specifications are correct "
26 . "and in the correct case)") unless defined $seq;
373940e1 27 $self->dbh_do('_dbh_last_insert_id', $seq);
0680ac39 28}
29
d4f16b21 30sub _dbh_get_autoinc_seq {
31 my ($self, $dbh, $schema, $table, @pri) = @_;
0680ac39 32
33 while (my $col = shift @pri) {
34 my $info = $dbh->column_info(undef,$schema,$table,$col)->fetchrow_hashref;
35 if(defined $info->{COLUMN_DEF} and
36 $info->{COLUMN_DEF} =~ /^nextval\(+'([^']+)'::(?:text|regclass)\)/) {
37 my $seq = $1;
38 # may need to strip quotes -- see if this works
39 return $seq =~ /\./ ? $seq : $info->{TABLE_SCHEM} . "." . $seq;
40 }
41 }
42 return;
843f8ecd 43}
44
45sub get_autoinc_seq {
ca48cd7d 46 my ($self,$source,$col) = @_;
47
843f8ecd 48 my @pri = $source->primary_columns;
34470972 49 my ($schema,$table) = $source->name =~ /^(.+)\.(.+)$/ ? ($1,$2)
50 : (undef,$source->name);
a9f32dbc 51
373940e1 52 $self->dbh_do('_dbh_get_autoinc_seq', $schema, $table, @pri);
843f8ecd 53}
54
4f533e8c 55sub sqlt_type {
56 return 'PostgreSQL';
57}
58
45fa8288 59sub datetime_parser_type { return "DateTime::Format::Pg"; }
60
a71859b4 61sub bind_attribute_by_data_type {
62 my ($self,$data_type) = @_;
63
64 my $bind_attributes = {
eda28767 65 bytea => { pg_type => DBD::Pg::PG_BYTEA },
a71859b4 66 };
67
68 if( defined $bind_attributes->{$data_type} ) {
9fdf90df 69 return $bind_attributes->{$data_type};
a71859b4 70 }
71 else {
72 return;
73 }
74}
75
f04b2839 76sub _sequence_fetch {
77 my ( $self, $type, $seq ) = @_;
78 my ($id) = $self->dbh->selectrow_array("SELECT nextval('${seq}')");
79 return $id;
80}
81
843f8ecd 821;
83
75d07914 84=head1 NAME
843f8ecd 85
86DBIx::Class::Storage::DBI::Pg - Automatic primary key class for PostgreSQL
87
88=head1 SYNOPSIS
89
90 # In your table classes
91 __PACKAGE__->load_components(qw/PK::Auto Core/);
92 __PACKAGE__->set_primary_key('id');
93 __PACKAGE__->sequence('mysequence');
94
95=head1 DESCRIPTION
96
97This class implements autoincrements for PostgreSQL.
98
99=head1 AUTHORS
100
101Marcus Ramberg <m.ramberg@cpan.org>
102
103=head1 LICENSE
104
105You may distribute this code under the same terms as Perl itself.
106
107=cut