Revision history for Perl extension DBIx::Class::Schema::Loader
+0.02006 Fri Mar 17 04:55:55 UTC 2006
+ - Fix long-standing table/col-name case bugs
+
0.02005 Mon Feb 27 23:53:17 UTC 2006
- Move the external file loading to after everything else
loader does, in case people want to define, override, or
file: lib/DBIx/Class/Schema/Loader/Writing.pm
DBIx::Class::Schema::Loader::mysql:
file: lib/DBIx/Class/Schema/Loader/mysql.pm
-generated_by: Module::Build version 0.2611
+generated_by: Module::Build version 0.2612
return qw/PK::Auto::DB2/;
}
-sub _tables {
+sub _tables_list {
my $self = shift;
my %args = @_;
my $db_schema = uc $self->db_schema;
my ( $self, $table ) = @_;
# $|=1;
# print "_table_info($table)\n";
- my ($db_schema, $tabname) = split /\./, $table, 2;
- # print "DB_Schema: $db_schema, Table: $tabname\n";
+ my $db_schema = $self->db_schema;
# FIXME: Horribly inefficient and just plain evil. (JMM)
my $dbh = $self->schema->storage->dbh;
WHERE c.TABSCHEMA = ? and c.TABNAME = ?
SQL
- $sth->execute($db_schema, $tabname) or die;
+ $sth->execute($db_schema, $table) or die;
my @cols = map { lc } map { @$_ } @{$sth->fetchall_arrayref};
undef $sth;
WHERE tc.TABSCHEMA = ? and tc.TABNAME = ? and tc.TYPE = 'P'
SQL
- $sth->execute($db_schema, $tabname) or die;
+ $sth->execute($db_schema, $table) or die;
my @pri = map { lc } map { @$_ } @{$sth->fetchall_arrayref};
FROM SYSIBM.SYSRELS SR WHERE SR.TBNAME = ?
SQL
+ my $db_schema = $self->db_schema;
foreach my $table ( $self->tables ) {
- next if ! $sth->execute(uc $table);
+ $table =~ s/^$db_schema\.//;
+ next if ! $sth->execute($table);
while(my $res = $sth->fetchrow_arrayref()) {
- my ($colcount, $other, $other_column, $column) =
- map { lc } @$res;
+ my ($colcount, $other, $other_column, $column) = @$res;
- my @self_cols = split(' ',$column);
- my @other_cols = split(' ',$other_column);
+ my @self_cols = map { lc } split(' ',$column);
+ my @other_cols = map { lc } split(' ',$other_column);
if(@self_cols != $colcount || @other_cols != $colcount) {
die "Column count discrepancy while getting rel info";
}
drop_db_schema
debug
+ _tables
classes
monikers
/);
sub _load_external {
my $self = shift;
- foreach my $table_class (values %{$self->classes}) {
+ foreach my $table_class (map { $self->classes->{$_} } $self->tables) {
$table_class->require;
if($@ && $@ !~ /^Can't locate /) {
croak "Failed to load external class definition"
sub _load_classes {
my $self = shift;
- my @tables = $self->_tables();
my @db_classes = $self->_db_classes();
my $schema = $self->schema;
- foreach my $table (@tables) {
- my $constraint = $self->constraint;
- my $exclude = $self->exclude;
+ my $constraint = $self->constraint;
+ my $exclude = $self->exclude;
+ my @tables = sort grep
+ { /$constraint/ && (!$exclude || ! /$exclude/) }
+ $self->_tables_list;
+
+ $self->{_tables} = \@tables;
- next unless $table =~ /$constraint/;
- next if defined $exclude && $table =~ /$exclude/;
+ foreach my $table (@tables) {
my ($db_schema, $tbl) = split /\./, $table;
- my $tablename = lc $table;
if($tbl) {
- $tablename = $self->drop_db_schema ? $tbl : lc $table;
+ $table = $self->drop_db_schema ? $tbl : $table;
}
- my $lc_tblname = lc $tablename;
+ my $lc_table = lc $table;
my $table_moniker = $self->_table2moniker($db_schema, $tbl);
my $table_class = $schema . q{::} . $table_moniker;
if @{$self->resultset_components};
$self->_inject($table_class, @{$self->left_base_classes});
- warn qq/\# Initializing table "$tablename" as "$table_class"\n/
+ warn qq/\# Initializing table "$table" as "$table_class"\n/
if $self->debug;
- $table_class->table($lc_tblname);
+ $table_class->table($table);
my ( $cols, $pks ) = $self->_table_info($table);
carp("$table has no primary key") unless @$pks;
$table_class->add_columns(@$cols);
$table_class->set_primary_key(@$pks) if @$pks;
- warn qq/$table_class->table('$tablename');\n/ if $self->debug;
+ warn qq/$table_class->table('$table');\n/ if $self->debug;
my $columns = join "', '", @$cols;
warn qq/$table_class->add_columns('$columns')\n/ if $self->debug;
my $primaries = join "', '", @$pks;
if $self->debug && @$pks;
$schema->register_class($table_moniker, $table_class);
- $self->classes->{$lc_tblname} = $table_class;
- $self->monikers->{$lc_tblname} = $table_moniker;
+ $self->classes->{$lc_table} = $table_class;
+ $self->monikers->{$lc_table} = $table_moniker;
+ $self->classes->{$table} = $table_class;
+ $self->monikers->{$table} = $table_moniker;
}
}
=head2 tables
Returns a sorted list of loaded tables, using the original database table
-names. Actually generated from the keys of the C<monikers> hash below.
+names.
my @tables = $schema->loader->tables;
sub tables {
my $self = shift;
- return sort keys %{ $self->monikers };
+ return @{$self->_tables};
}
# Find and setup relationships
$self->db_schema, '', '', '', $table );
next if !$sth;
while(my $raw_rel = $sth->fetchrow_hashref) {
- my $uk_tbl = lc $raw_rel->{UK_TABLE_NAME};
+ my $uk_tbl = $raw_rel->{UK_TABLE_NAME};
my $uk_col = lc $raw_rel->{UK_COLUMN_NAME};
my $fk_col = lc $raw_rel->{FK_COLUMN_NAME};
- my $relid = lc $raw_rel->{UK_NAME};
+ my $relid = $raw_rel->{UK_NAME};
$uk_tbl =~ s/$quoter//g;
$uk_col =~ s/$quoter//g;
$fk_col =~ s/$quoter//g;
}
# Overload in driver class
-sub _tables { croak "ABSTRACT METHOD" }
+sub _tables_list { croak "ABSTRACT METHOD" }
sub _table_info { croak "ABSTRACT METHOD" }
=head2 monikers
Returns a hashref of loaded table-to-moniker mappings for the original
-database table names.
+database table names. In cases where the database driver returns table
+names as uppercase or mixed case, there will also be a duplicate entry
+here in all lowercase. Best practice would be to use lower-case table
+names when accessing this.
my $monikers = $schema->loader->monikers;
my $foo_tbl_moniker = $monikers->{foo_tbl};
=head2 classes
Returns a hashref of table-to-classname mappings for the original database
-table names. You probably shouldn't be using this for any normal or simple
+table names. Same lowercase stuff as above applies here.
+
+You probably shouldn't be using this for any normal or simple
usage of your Schema. The usual way to run queries on your tables is via
C<$schema-E<gt>resultset('FooTbl')>, where C<FooTbl> is a moniker as
returned by C<monikers> above.
return qw/PK::Auto::Pg/;
}
-sub _tables {
+sub _tables_list {
my $self = shift;
my $dbh = $self->schema->storage->dbh;
my $quoter = $dbh->get_info(29) || q{"};
my $quoter = $dbh->get_info(29) || q{"};
my $sth = $dbh->column_info(undef, $self->db_schema, $table, undef);
- my @cols = map { $_->[3] } @{ $sth->fetchall_arrayref };
+ my @cols = map { lc $_->[3] } @{ $sth->fetchall_arrayref };
s/$quoter//g for @cols;
- my @primary = $dbh->primary_key(undef, $self->db_schema, $table);
+ my @primary = map { lc } $dbh->primary_key(undef, $self->db_schema, $table);
s/$quoter//g for @primary;
my $cond;
if($f_cols) {
- my @cols = map { s/\s*//g; $_ } split(/\s*,\s*/,$cols);
- my @f_cols = map { s/\s*//g; $_ } split(/\s*,\s*/,$f_cols);
+ my @cols = map { s/\s*//g; lc $_ } split(/\s*,\s*/,$cols);
+ my @f_cols = map { s/\s*//g; lc $_ } split(/\s*,\s*/,$f_cols);
die "Mismatched column count in rel for $table => $f_table"
if @cols != @f_cols;
$cond = {};
eval { $self->_make_cond_rel( $table, $f_table, $cond ) };
}
else {
- eval { $self->_make_simple_rel( $table, $f_table, $cols ) };
+ eval { $self->_make_simple_rel( $table, $f_table, lc $cols ) };
}
warn qq/\# belongs_to_many failed "$@"\n\n/
}
}
-sub _tables {
+sub _tables_list {
my $self = shift;
my $dbh = $self->schema->storage->dbh;
my $sth = $dbh->prepare("SELECT * FROM sqlite_master");
$sth->execute();
my @columns;
while ( my $row = $sth->fetchrow_hashref ) {
- push @columns, $row->{name};
+ push @columns, lc $row->{name};
}
$sth->finish;
my @pks;
if ($primary) {
- @pks = ($primary);
+ @pks = (lc $primary);
}
else {
my ($pks) = $sql =~ m/PRIMARY\s+KEY\s*\(\s*([^)]+)\s*\)/i;
- @pks = split( m/\s*\,\s*/, $pks ) if $pks;
+ @pks = map { lc } split( m/\s*\,\s*/, $pks ) if $pks;
}
return ( \@columns, \@pks );
}
# You may want to return more, or less, than this.
}
- sub _tables {
+ sub _tables_list {
my $self = shift;
my $dbh = $self->schema->storage->dbh;
return $dbh->tables; # Your DBD may need something different
my $f_table = shift @reldata;
my $f_cols = shift @reldata;
- my @cols = map { s/$quoter//; $_ } split(/\s*,\s*/,$cols);
- my @f_cols = map { s/$quoter//; $_ } split(/\s*,\s*/,$f_cols);
+ my @cols = map { s/$quoter//; lc $_ } split(/\s*,\s*/,$cols);
+ my @f_cols = map { s/$quoter//; lc $_ } split(/\s*,\s*/,$f_cols);
die "Mismatched column count in rel for $table => $f_table"
if @cols != @f_cols;
}
}
-sub _tables {
+sub _tables_list {
my $self = shift;
my $dbh = $self->schema->storage->dbh;
my @tables;
my ( @cols, @pri );
while ( my $hash = $sth->fetchrow_hashref ) {
my ($col) = $hash->{Field} =~ /(\w+)/;
- push @cols, $col;
- push @pri, $col if $hash->{Key} eq "PRI";
+ push @cols, lc $col;
+ push @pri, lc $col if $hash->{Key} eq "PRI";
}
return ( \@cols, \@pri );
dsn => $dsn,
user => $user,
password => $password,
- db_schema => $user,
+ db_schema => uc $user,
drop_db_schema => 1,
);
projects / dbsrgits/DBIx-Class-Schema-Loader.git / commitdiff