X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema%2FLoader%2FDB2.pm;h=9bfa285ee6903dcf7400ec34221a2c392ff32e5e;hb=9fa996830cb2c629201a73f80e265f8f65c8c62e;hp=10e7ca3c9af25cf6049feb62b2642edf9d0ba7c6;hpb=3385ac62745352cbb60586bb1c906151c353e60b;p=dbsrgits%2FDBIx-Class-Schema-Loader.git diff --git a/lib/DBIx/Class/Schema/Loader/DB2.pm b/lib/DBIx/Class/Schema/Loader/DB2.pm index 10e7ca3..9bfa285 100644 --- a/lib/DBIx/Class/Schema/Loader/DB2.pm +++ b/lib/DBIx/Class/Schema/Loader/DB2.pm @@ -1,8 +1,9 @@ package DBIx::Class::Schema::Loader::DB2; use strict; +use warnings; use base 'DBIx::Class::Schema::Loader::Generic'; -use Carp; +use Class::C3; =head1 NAME @@ -10,10 +11,10 @@ DBIx::Class::Schema::Loader::DB2 - DBIx::Class::Schema::Loader DB2 Implementatio =head1 SYNOPSIS - use DBIx::Schema::Class::Loader; + package My::Schema; + use base qw/DBIx::Class::Schema::Loader/; - # $loader is a DBIx::Class::Schema::Loader::DB2 - my $loader = DBIx::Class::Schema::Loader->new( + __PACKAGE__->load_from_connection( dsn => "dbi:DB2:dbname", user => "myuser", password => "", @@ -21,21 +22,24 @@ DBIx::Class::Schema::Loader::DB2 - DBIx::Class::Schema::Loader DB2 Implementatio drop_schema => 1, ); + 1; + =head1 DESCRIPTION See L. =cut -sub _loader_db_classes { - return qw/DBIx::Class::PK::Auto::DB2/; +sub _db_classes { + return qw/PK::Auto::DB2/; } -sub _loader_tables { - my $class = shift; +sub _tables { + my $self = shift; my %args = @_; - my $db_schema = uc $class->_loader_data->{db_schema}; - my $dbh = $class->storage->dbh; + my $db_schema = uc $self->db_schema; + my $dbh = $self->schema->storage->dbh; + my $quoter = $dbh->get_info(29) || q{"}; # this is split out to avoid version parsing errors... my $is_dbd_db2_gte_114 = ( $DBD::DB2::VERSION >= 1.14 ); @@ -44,21 +48,21 @@ sub _loader_tables { : $dbh->tables; # People who use table or schema names that aren't identifiers deserve # what they get. Still, FIXME? - s/\"//g for @tables; + s/$quoter//g for @tables; @tables = grep {!/^SYSIBM\./ and !/^SYSCAT\./ and !/^SYSSTAT\./} @tables; @tables = grep {/^$db_schema\./} @tables if($db_schema); return @tables; } -sub _loader_table_info { - my ( $class, $table ) = @_; +sub _table_info { + my ( $self, $table ) = @_; # $|=1; -# print "_loader_table_info($table)\n"; +# print "_table_info($table)\n"; my ($db_schema, $tabname) = split /\./, $table, 2; # print "DB_Schema: $db_schema, Table: $tabname\n"; # FIXME: Horribly inefficient and just plain evil. (JMM) - my $dbh = $class->storage->dbh; + my $dbh = $self->schema->storage->dbh; $dbh->{RaiseError} = 1; my $sth = $dbh->prepare(<<'SQL') or die; @@ -70,7 +74,7 @@ SQL $sth->execute($db_schema, $tabname) or die; my @cols = map { lc } map { @$_ } @{$sth->fetchall_arrayref}; - $sth->finish; + undef $sth; $sth = $dbh->prepare(<<'SQL') or die; SELECT kcu.COLNAME @@ -83,43 +87,40 @@ SQL my @pri = map { lc } map { @$_ } @{$sth->fetchall_arrayref}; - $sth->finish; - return ( \@cols, \@pri ); } # Find and setup relationships -sub _loader_relationships { - my $class = shift; +sub _load_relationships { + my $self = shift; - my $dbh = $class->storage->dbh; + my $dbh = $self->schema->storage->dbh; my $sth = $dbh->prepare(<<'SQL') or die; SELECT SR.COLCOUNT, SR.REFTBNAME, SR.PKCOLNAMES, SR.FKCOLNAMES FROM SYSIBM.SYSRELS SR WHERE SR.TBNAME = ? SQL - foreach my $table ( $class->tables ) { - if ($sth->execute(uc $table)) { - while(my $res = $sth->fetchrow_arrayref()) { - my ($colcount, $other, $other_column, $column) = - map { lc } @$res; - - my @self_cols = split(' ',$column); - my @other_cols = split(' ',$other_column); - if(@self_cols != $colcount || @other_cols != $colcount) { - die "Column count discrepancy while getting rel info"; - } - - my %cond; - for(my $i = 0; $i < @self_cols; $i++) { - $cond{$other_cols[$i]} = $self_cols[$i]; - } - - eval { $class->_loader_make_relations ($table, $other, \%cond); }; - warn qq/\# belongs_to_many failed "$@"\n\n/ - if $@ && $class->_loader_debug; + foreach my $table ( $self->tables ) { + next if ! $sth->execute(uc $table); + while(my $res = $sth->fetchrow_arrayref()) { + my ($colcount, $other, $other_column, $column) = + map { lc } @$res; + + my @self_cols = split(' ',$column); + my @other_cols = split(' ',$other_column); + if(@self_cols != $colcount || @other_cols != $colcount) { + die "Column count discrepancy while getting rel info"; + } + + my %cond; + for(my $i = 0; $i < @self_cols; $i++) { + $cond{$other_cols[$i]} = $self_cols[$i]; } + + eval { $self->_make_cond_rel ($table, $other, \%cond); }; + warn qq/\# belongs_to_many failed "$@"\n\n/ + if $@ && $self->debug; } }