X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema%2FLoader%2FDBI%2FPg.pm;h=55732764cbfc3079f79388a6f7f2af3fae2d3018;hb=3b71e53bd47bd29213e8fe12b3f9a2d1a229b587;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..5573276 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 Class::C3; +use base qw/ + DBIx::Class::Schema::Loader::DBI::Component::QuotedDefault + DBIx::Class::Schema::Loader::DBI +/; +use Carp::Clan qw/^DBIx::Class/; +use mro 'c3'; + +our $VERSION = '0.07007'; =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; @@ -30,48 +35,258 @@ sub _setup { my $self = shift; $self->next::method(@_); + $self->{db_schema} ||= 'public'; + + if (not defined $self->preserve_case) { + $self->preserve_case(0); + } + elsif ($self->preserve_case) { + $self->schema->storage->sql_maker->quote_char('"'); + $self->schema->storage->sql_maker->name_sep('.'); + } } 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(@_); + + while (my ($col, $info) = each %$result) { + my $data_type = $info->{data_type}; + + # these types are fixed size + # XXX should this be a negative match? + if ($data_type =~ +/^(?:bigint|int8|bigserial|serial8|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 $info->{size}; + } +# for datetime types, check if it has a precision or not + elsif ($data_type =~ /^(?:interval|time|timestamp)\b/i) { + if (lc($data_type) eq 'timestamp without time zone') { + $info->{data_type} = 'timestamp'; + } + elsif (lc($data_type) eq 'time without time zone') { + $info->{data_type} = 'time'; + } + + my ($precision) = $self->schema->storage->dbh + ->selectrow_array(<{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 $info->{size}; + } + else { + $info->{size} = $precision; + } + } + } + elsif ((not $precision) || $precision !~ /^\d/ || $precision == 6) { + delete $info->{size}; + } + else { + $info->{size} = $precision; + } + } + elsif ($data_type =~ /^(?:bit(?: varying)?|varbit)\z/i) { + $info->{data_type} = 'varbit' if $data_type =~ /var/i; + + my ($precision) = $self->schema->storage->dbh + ->selectrow_array(<{size} = $precision if $precision; + + $info->{size} = 1 if (not $precision) && lc($data_type) eq 'bit'; + } + elsif ($data_type =~ /^(?:numeric|decimal)\z/i && (my $size = $info->{size})) { + $size =~ s/\s*//g; + + my ($scale, $precision) = split /,/, $size; + + $info->{size} = [ $precision, $scale ]; + } + elsif (lc($data_type) eq 'character varying') { + $info->{data_type} = 'varchar'; + + if (not $info->{size}) { + $info->{data_type} = 'text'; + $info->{original}{data_type} = 'varchar'; + } + } + elsif (lc($data_type) eq 'character') { + $info->{data_type} = 'char'; + } + else { + my ($typetype) = $self->schema->storage->dbh + ->selectrow_array(<schema->storage->dbh + ->selectall_arrayref(<{data_type}); +SELECT e.enumlabel +FROM pg_catalog.pg_enum e +JOIN pg_catalog.pg_type t ON t.oid = e.enumtypid +WHERE t.typname = ? +EOF + + $info->{extra}{list} = [ map { $_->[0] } @$typevalues ]; + + # Store its original name in extra for SQLT to pick up. + $info->{extra}{custom_type_name} = $info->{data_type}; + + $info->{data_type} = 'enum'; + + delete $info->{size}; + } + } + +# process SERIAL columns + if (ref($info->{default_value}) eq 'SCALAR' && ${ $info->{default_value} } =~ /\bnextval\(['"]([.\w]+)/i) { + $info->{is_auto_increment} = 1; + $info->{sequence} = $1; + delete $info->{default_value}; + } + +# alias now() to current_timestamp for deploying to other DBs + if ((eval { lc ${ $info->{default_value} } }||'') eq 'now()') { + # do not use a ref to a constant, that breaks Data::Dump output + ${$info->{default_value}} = 'current_timestamp'; + + my $now = 'now()'; + $info->{original}{default_value} = \$now; + } + } + + return $result; +} + =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;