From: Brandon Black Date: Mon, 5 Jun 2006 16:56:12 +0000 (+0000) Subject: Version bumped to 0.03001 X-Git-Tag: 0.03001~2 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=5223f24a6662ce33f7b60d2a3f6f83e83f5373cc;p=dbsrgits%2FDBIx-Class-Schema-Loader.git Version bumped to 0.03001 Changes updated Pg unique index code changed to look more like RDBOs caching improvements --- diff --git a/Changes b/Changes index bdfc636..b3f0ed7 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,10 @@ Revision history for Perl extension DBIx::Class::Schema::Loader +0.03001 XXX not yet released + - DBIx::Class required version number fixed + - Loader statement caching for better load-time performance + - Improved Pg unique index loader, based on RDBO + 0.03000 Tue May 23 12:56:05 UTC 2006 - weakened the circular schema reference diff --git a/lib/DBIx/Class/Schema/Loader.pm b/lib/DBIx/Class/Schema/Loader.pm index 39e9277..20ee8ff 100644 --- a/lib/DBIx/Class/Schema/Loader.pm +++ b/lib/DBIx/Class/Schema/Loader.pm @@ -13,7 +13,7 @@ use Scalar::Util qw/ weaken /; # Always remember to do all digits for the version even if they're 0 # i.e. first release of 0.XX *must* be 0.XX000. This avoids fBSD ports # brain damage and presumably various other packaging systems too -our $VERSION = '0.03000'; +our $VERSION = '0.03001'; __PACKAGE__->mk_classaccessor('dump_to_dir'); __PACKAGE__->mk_classaccessor('loader'); @@ -236,7 +236,8 @@ schema class. This function can be exported/imported by the normal means, as illustrated in these Examples: - # Simple example... + # Simple example, creates as a new class 'New::Schema::Name' in + # memory in the running perl interpreter. use DBIx::Class::Schema::Loader qw/ make_schema_at /; make_schema_at( 'New::Schema::Name', @@ -245,7 +246,7 @@ illustrated in these Examples: ); # Complex: dump loaded schema to disk, all from the commandline: - perl -MDBIx::Class::Schema::Loader=make_schema_at,dump_to_dir:./lib -e 'make_schema_at("New::Schema::Name", { relationships => 1 }, [ 'dbi:Pg:dbname="foo"','postgres' ])' + perl -MDBIx::Class::Schema::Loader=make_schema_at,dump_to_dir:./lib -e 'make_schema_at("New::Schema::Name", { relationships => 1 }, [ "dbi:Pg:dbname=foo","postgres" ])' # Same, but inside a script, and using a different way to specify the # dump directory: diff --git a/lib/DBIx/Class/Schema/Loader/Base.pm b/lib/DBIx/Class/Schema/Loader/Base.pm index 65109f4..a7397c3 100644 --- a/lib/DBIx/Class/Schema/Loader/Base.pm +++ b/lib/DBIx/Class/Schema/Loader/Base.pm @@ -294,6 +294,9 @@ sub load { $self->_load_external; $self->_dump_to_dir if $self->dump_directory; + # Drop temporary cache + delete $self->{_cache}; + 1; } diff --git a/lib/DBIx/Class/Schema/Loader/DBI/DB2.pm b/lib/DBIx/Class/Schema/Loader/DBI/DB2.pm index 5ec113f..18410e7 100644 --- a/lib/DBIx/Class/Schema/Loader/DBI/DB2.pm +++ b/lib/DBIx/Class/Schema/Loader/DBI/DB2.pm @@ -34,14 +34,14 @@ sub _table_uniq_info { my $dbh = $self->schema->storage->dbh; - my $sth = $dbh->prepare(<<'SQL') or die; -SELECT kcu.COLNAME, kcu.CONSTNAME, kcu.COLSEQ -FROM SYSCAT.TABCONST as tc -JOIN SYSCAT.KEYCOLUSE as kcu ON tc.CONSTNAME = kcu.CONSTNAME -WHERE tc.TABSCHEMA = ? and tc.TABNAME = ? and tc.TYPE = 'U' -SQL - - $sth->execute($self->db_schema, $table) or die; + my $sth = $self->{_cache}->{db2_uniq} ||= $dbh->prepare( + q{SELECT kcu.COLNAME, kcu.CONSTNAME, kcu.COLSEQ + FROM SYSCAT.TABCONST as tc + JOIN SYSCAT.KEYCOLUSE as kcu ON tc.CONSTNAME = kcu.CONSTNAME + WHERE tc.TABSCHEMA = ? and tc.TABNAME = ? and tc.TYPE = 'U'} + ); + + $sth->execute($self->db_schema, $table) or die $DBI::errstr; my %keydata; while(my $row = $sth->fetchrow_arrayref) { diff --git a/lib/DBIx/Class/Schema/Loader/DBI/Pg.pm b/lib/DBIx/Class/Schema/Loader/DBI/Pg.pm index dbc0470..08ddca8 100644 --- a/lib/DBIx/Class/Schema/Loader/DBI/Pg.pm +++ b/lib/DBIx/Class/Schema/Loader/DBI/Pg.pm @@ -39,28 +39,50 @@ sub _table_uniq_info { 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 ]); } } diff --git a/lib/DBIx/Class/Schema/Loader/DBI/SQLite.pm b/lib/DBIx/Class/Schema/Loader/DBI/SQLite.pm index 603c672..ab8bfef 100644 --- a/lib/DBIx/Class/Schema/Loader/DBI/SQLite.pm +++ b/lib/DBIx/Class/Schema/Loader/DBI/SQLite.pm @@ -33,8 +33,8 @@ sub _sqlite_parse_table { my @uniqs; my $dbh = $self->schema->storage->dbh; - my $sth = $dbh->prepare(<<""); -SELECT sql FROM sqlite_master WHERE tbl_name = ? + my $sth = $self->{_cache}->{sqlite_master} + ||= $dbh->prepare(q{SELECT sql FROM sqlite_master WHERE tbl_name = ?}); $sth->execute($table); my ($sql) = $sth->fetchrow_array; @@ -139,8 +139,9 @@ sub _table_uniq_info { sub _tables_list { my $self = shift; + my $dbh = $self->schema->storage->dbh; - my $sth = $dbh->prepare("SELECT * FROM sqlite_master"); + my $sth = $dbh->prepare("SELECT * FROM sqlite_master"); $sth->execute; my @tables; while ( my $row = $sth->fetchrow_hashref ) { diff --git a/lib/DBIx/Class/Schema/Loader/DBI/mysql.pm b/lib/DBIx/Class/Schema/Loader/DBI/mysql.pm index b93669c..3767639 100644 --- a/lib/DBIx/Class/Schema/Loader/DBI/mysql.pm +++ b/lib/DBIx/Class/Schema/Loader/DBI/mysql.pm @@ -29,13 +29,15 @@ See L. sub _table_fk_info { my ($self, $table) = @_; - my $dbh = $self->schema->storage->dbh; + my $dbh = $self->schema->storage->dbh; + my $sth = $dbh->prepare('SHOW CREATE TABLE ?'); + $sth->execute or die("Cannot get table definition for $table" + . " (execute failed): $DBI::errstr"); - my $query = "SHOW CREATE TABLE ${table}"; - my $sth = $dbh->prepare($query) - or die("Cannot get table definition: $table"); - $sth->execute; - my $table_def = $sth->fetchrow_arrayref->[1] || ''; + my $table_def_ref = $sth->fetchrow_arrayref + or die ("Cannot get table definition for $table (no rows)"); + + my $table_def = $table_def_ref->[1] || ''; $sth->finish; my (@reldata) = ($table_def =~ /CONSTRAINT `.*` FOREIGN KEY \(`(.*)`\) REFERENCES `(.*)` \(`(.*)`\)/ig); @@ -46,8 +48,11 @@ sub _table_fk_info { my $f_table = shift @reldata; my $f_cols = shift @reldata; - my @cols = map { s/\Q$self->{_quoter}\E//; lc $_ } split(/\s*,\s*/,$cols); - my @f_cols = map { s/\Q$self->{_quoter}\E//; lc $_ } split(/\s*,\s*/,$f_cols); + my @cols = map { s/\Q$self->{_quoter}\E//; lc $_ } + split(/\s*,\s*/, $cols); + + my @f_cols = map { s/\Q$self->{_quoter}\E//; lc $_ } + split(/\s*,\s*/, $f_cols); push(@rels, { local_columns => \@cols, @@ -64,7 +69,7 @@ sub _table_fk_info { sub _mysql_table_get_keys { my ($self, $table) = @_; - if(!exists($self->{_mysql_keys}->{$table})) { + if(!exists($self->{_cache}->{_mysql_keys}->{$table})) { my %keydata; my $dbh = $self->schema->storage->dbh; my $sth = $dbh->prepare("SHOW INDEX FROM $table"); @@ -80,10 +85,10 @@ sub _mysql_table_get_keys { @{$keydata{$keyname}}; $keydata{$keyname} = \@ordered_cols; } - $self->{_mysql_keys}->{$table} = \%keydata; + $self->{_cache}->{_mysql_keys}->{$table} = \%keydata; } - return $self->{_mysql_keys}->{$table}; + return $self->{_cache}->{_mysql_keys}->{$table}; } sub _table_pk_info { diff --git a/t/lib/dbixcsl_common_tests.pm b/t/lib/dbixcsl_common_tests.pm index 2b3fd65..8e9800c 100644 --- a/t/lib/dbixcsl_common_tests.pm +++ b/t/lib/dbixcsl_common_tests.pm @@ -140,8 +140,8 @@ sub run_tests { foreach my $ucname (keys %uniq2) { my $cols_arrayref = $uniq2{$ucname}; if(@$cols_arrayref == 2 - && $cols_arrayref->[0] eq 'dat' - && $cols_arrayref->[1] eq 'dat2') { + && $cols_arrayref->[0] eq 'dat2' + && $cols_arrayref->[1] eq 'dat') { $uniq2_test = 2; last; } @@ -477,7 +477,7 @@ sub create { id $self->{auto_inc_pk}, dat VARCHAR(32) NOT NULL, dat2 VARCHAR(32) NOT NULL, - UNIQUE (dat, dat2) + UNIQUE (dat2, dat) ) $self->{innodb} },