X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema%2FLoader%2FDBI%2FPg.pm;h=d06d7c9fbd4023773bc4573949c5bc6d512f5acf;hb=dc767cd32c6728d4d9c3504acd259c0b2f19da2b;hp=dbc04702589721f3d6f0cfc83ee229b43dbff93b;hpb=996be9ee6e82ec9928f801ecdc69c9e07d64339c;p=dbsrgits%2FDBIx-Class-Schema-Loader.git diff --git a/lib/DBIx/Class/Schema/Loader/DBI/Pg.pm b/lib/DBIx/Class/Schema/Loader/DBI/Pg.pm index dbc0470..d06d7c9 100644 --- a/lib/DBIx/Class/Schema/Loader/DBI/Pg.pm +++ b/lib/DBIx/Class/Schema/Loader/DBI/Pg.pm @@ -2,21 +2,26 @@ package DBIx::Class::Schema::Loader::DBI::Pg; use strict; use warnings; -use base 'DBIx::Class::Schema::Loader::DBI'; +use base qw/ + DBIx::Class::Schema::Loader::DBI::Component::QuotedDefault + DBIx::Class::Schema::Loader::DBI +/; +use Carp::Clan qw/^DBIx::Class/; use Class::C3; +our $VERSION = '0.05001'; + =head1 NAME -DBIx::Class::Schema::Loader::DBI::Pg - DBIx::Class::Schema::Loader::DBI Postgres Implementation. +DBIx::Class::Schema::Loader::DBI::Pg - DBIx::Class::Schema::Loader::DBI +PostgreSQL Implementation. =head1 SYNOPSIS package My::Schema; use base qw/DBIx::Class::Schema::Loader/; - __PACKAGE__->loader_options( - relationships => 1, - ); + __PACKAGE__->loader_options( debug => 1 ); 1; @@ -33,45 +38,192 @@ sub _setup { $self->{db_schema} ||= 'public'; } + sub _table_uniq_info { my ($self, $table) = @_; + # Use the default support if available + return $self->next::method($table) + if $DBD::Pg::VERSION >= 1.50; + my @uniqs; my $dbh = $self->schema->storage->dbh; - my $sth = $dbh->prepare_cached( - qq{SELECT conname,indexdef FROM pg_indexes JOIN pg_constraint } - . qq{ON (pg_indexes.indexname = pg_constraint.conname) } - . qq{WHERE schemaname=? and tablename=? and contype = 'u'} - ,{}, 1); - - $sth->execute($self->db_schema, $table); - while(my $constr = $sth->fetchrow_arrayref) { - my $constr_name = $constr->[0]; - my $constr_def = $constr->[1]; - my @cols; - if($constr_def =~ /\(\s*([^)]+)\)\s*$/) { - my $cols_text = $1; - $cols_text =~ s/\s+$//; - @cols = map { lc } split(/\s*,\s*/, $cols_text); - s/\Q$self->{_quoter}\E// for @cols; + # Most of the SQL here is mostly based on + # Rose::DB::Object::Metadata::Auto::Pg, after some prodding from + # John Siracusa to use his superior SQL code :) + + my $attr_sth = $self->{_cache}->{pg_attr_sth} ||= $dbh->prepare( + q{SELECT attname FROM pg_catalog.pg_attribute + WHERE attrelid = ? AND attnum = ?} + ); + + my $uniq_sth = $self->{_cache}->{pg_uniq_sth} ||= $dbh->prepare( + q{SELECT x.indrelid, i.relname, x.indkey + FROM + pg_catalog.pg_index x + JOIN pg_catalog.pg_class c ON c.oid = x.indrelid + JOIN pg_catalog.pg_class i ON i.oid = x.indexrelid + JOIN pg_catalog.pg_constraint con ON con.conname = i.relname + LEFT JOIN pg_catalog.pg_namespace n ON n.oid = c.relnamespace + WHERE + x.indisunique = 't' AND + c.relkind = 'r' AND + i.relkind = 'i' AND + con.contype = 'u' AND + n.nspname = ? AND + c.relname = ?} + ); + + $uniq_sth->execute($self->db_schema, $table); + while(my $row = $uniq_sth->fetchrow_arrayref) { + my ($tableid, $indexname, $col_nums) = @$row; + $col_nums =~ s/^\s+//; + my @col_nums = split(/\s+/, $col_nums); + my @col_names; + + foreach (@col_nums) { + $attr_sth->execute($tableid, $_); + my $name_aref = $attr_sth->fetchrow_arrayref; + push(@col_names, $name_aref->[0]) if $name_aref; } - if(!@cols) { - warn "Failed to parse unique constraint $constr_name on $table"; + + if(!@col_names) { + warn "Failed to parse UNIQUE constraint $indexname on $table"; } else { - push(@uniqs, [ $constr_name => \@cols ]); + push(@uniqs, [ $indexname => \@col_names ]); } } return \@uniqs; } +sub _table_comment { + my ( $self, $table ) = @_; + my ($table_comment) = $self->schema->storage->dbh->selectrow_array( + q{SELECT obj_description(oid) + FROM pg_class + WHERE relname=? AND relnamespace=( + SELECT oid FROM pg_namespace WHERE nspname=?) + }, undef, $table, $self->db_schema + ); + return $table_comment +} + + +sub _column_comment { + my ( $self, $table, $column_number ) = @_; + my ($table_oid) = $self->schema->storage->dbh->selectrow_array( + q{SELECT oid + FROM pg_class + WHERE relname=? AND relnamespace=( + SELECT oid FROM pg_namespace WHERE nspname=?) + }, undef, $table, $self->db_schema + ); + return $self->schema->storage->dbh->selectrow_array('SELECT col_description(?,?)', undef, $table_oid, + $column_number ); +} + +# Make sure data_type's that don't need it don't have a 'size' column_info, and +# set the correct precision for datetime and varbit types. +sub _columns_info_for { + my $self = shift; + my ($table) = @_; + + my $result = $self->next::method(@_); + + foreach my $col (keys %$result) { + my $data_type = $result->{$col}{data_type}; + + # these types are fixed size + if ($data_type =~ +/^(?:bigint|int8|bigserial|serial8|bit|boolean|bool|box|bytea|cidr|circle|date|double precision|float8|inet|integer|int|int4|line|lseg|macaddr|money|path|point|polygon|real|float4|smallint|int2|serial|serial4|text)\z/i) { + delete $result->{$col}{size}; + } +# for datetime types, check if it has a precision or not + elsif ($data_type =~ /^(?:interval|time|timestamp)\b/i) { + my ($precision) = $self->schema->storage->dbh + ->selectrow_array(<{$col}{size}; + } + else { + my ($integer_datetimes) = $self->schema->storage->dbh + ->selectrow_array('show integer_datetimes'); + + my $max_precision = + $integer_datetimes =~ /^on\z/i ? 6 : 10; + + if ($precision == $max_precision) { + delete $result->{$col}{size}; + } + else { + $result->{$col}{size} = $precision; + } + } + } + elsif ((not $precision) || $precision !~ /^\d/ || $precision == 6) { + delete $result->{$col}{size}; + } + else { + $result->{$col}{size} = $precision; + } + } + elsif ($data_type =~ /^(?:bit varying|varbit)\z/i) { + my ($precision) = $self->schema->storage->dbh + ->selectrow_array(<{$col}{size} = $precision; + } + elsif ($data_type =~ /^(?:numeric|decimal)\z/i) { + my $size = $result->{$col}{size}; + $size =~ s/\s*//g; + + my ($scale, $precision) = split /,/, $size; + + $result->{$col}{size} = [ $precision, $scale ]; + } + } + + return $result; +} + +sub _extra_column_info { + my ($self, $info) = @_; + my %extra_info; + + if ($info->{COLUMN_DEF} && $info->{COLUMN_DEF} =~ /\bnextval\(/i) { + $extra_info{is_auto_increment} = 1; + } + + return \%extra_info; +} + =head1 SEE ALSO L, L, L +=head1 AUTHOR + +See L and L. + +=head1 LICENSE + +This library is free software; you can redistribute it and/or modify it under +the same terms as Perl itself. + =cut 1;