X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI.pm;h=dcc41774fd98e53c8a2ec2bec6b382423a5488ce;hb=c0f61310b99afbd58564d971aaea89bc196172b5;hp=7058f0ba04246922e85a4eec9d869704997fe9b5;hpb=1268518c73a3d1d581849746f8094c5a09f4937d;p=dbsrgits%2FDBIx-Class-Historic.git diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm index 7058f0b..dcc4177 100644 --- a/lib/DBIx/Class/Storage/DBI.pm +++ b/lib/DBIx/Class/Storage/DBI.pm @@ -1,4 +1,5 @@ package DBIx::Class::Storage::DBI; +# -*- mode: cperl; cperl-indent-level: 2 -*- use base 'DBIx::Class::Storage'; @@ -240,7 +241,7 @@ use base qw/DBIx::Class/; __PACKAGE__->load_components(qw/AccessorGroup/); __PACKAGE__->mk_group_accessors('simple' => - qw/connect_info _dbh _sql_maker _conn_pid _conn_tid debug debugfh + qw/_connect_info _dbh _sql_maker _conn_pid _conn_tid debug debugfh cursor on_connect_do transaction_depth/); sub new { @@ -277,6 +278,25 @@ This class represents the connection to the database =cut +=head2 connect_info + +Connection information arrayref. Can either be the same arguments +one would pass to DBI->connect, or a code-reference which returns +a connected database handle. In either case, there is an optional +final element in the arrayref, which can hold a hashref of +connection-specific Storage::DBI options. These include +C, and the sql_maker options C, +C, and C. Examples: + + ->connect_info([ 'dbi:SQLite:./foo.db' ]); + ->connect_info(sub { DBI->connect(...) }); + ->connect_info([ 'dbi:Pg:dbname=foo', + 'postgres', + '', + { AutoCommit => 0 }, + { quote_char => q{`}, name_sep => q{@} }, + ]); + =head2 on_connect_do Executes the sql statements given as a listref on every db connect. @@ -345,6 +365,12 @@ sub ensure_connected { } } +=head2 dbh + +Returns the dbh - a data base handle of class L. + +=cut + sub dbh { my ($self) = @_; @@ -360,9 +386,40 @@ sub sql_maker { return $self->_sql_maker; } +sub connect_info { + my ($self, $info_arg) = @_; + + if($info_arg) { + my $info = [ @$info_arg ]; # copy because we can alter it + my $last_info = $info->[-1]; + if(ref $last_info eq 'HASH') { + my $used; + if(my $on_connect_do = $last_info->{on_connect_do}) { + $used = 1; + $self->on_connect_do($on_connect_do); + } + for my $sql_maker_opt (qw/limit_dialect quote_char name_sep/) { + if(my $opt_val = $last_info->{$sql_maker_opt}) { + $used = 1; + $self->sql_maker->$sql_maker_opt($opt_val); + } + } + + # remove our options hashref if it was there, to avoid confusing + # DBI in the case the user didn't use all 4 DBI options, as in: + # [ 'dbi:SQLite:foo.db', { quote_char => q{`} } ] + pop(@$info) if $used; + } + + $self->_connect_info($info); + } + + $self->_connect_info; +} + sub _populate_dbh { my ($self) = @_; - my @info = @{$self->connect_info || []}; + my @info = @{$self->_connect_info || []}; $self->_dbh($self->_connect(@info)); my $driver = $self->_dbh->{Driver}->{Name}; eval "require DBIx::Class::Storage::DBI::${driver}"; @@ -391,17 +448,20 @@ sub _connect { $DBI::connect_via = 'connect'; } - if(ref $info[0] eq 'CODE') { - $dbh = &{$info[0]}; - } - else { - $dbh = DBI->connect(@info); - } + eval { + if(ref $info[0] eq 'CODE') { + $dbh = &{$info[0]}; + } + else { + $dbh = DBI->connect(@info); + } + }; $DBI::connect_via = $old_connect_via if $old_connect_via; - $self->throw_exception("DBI Connection failed: $DBI::errstr") - unless $dbh; + if (!$dbh || $@) { + $self->throw_exception("DBI Connection failed: " . ($@ || $DBI::errstr)); + } $dbh; } @@ -417,8 +477,14 @@ an entire code block to be executed transactionally. sub txn_begin { my $self = shift; - $self->dbh->begin_work - if $self->{transaction_depth}++ == 0 and $self->dbh->{AutoCommit}; + if ($self->{transaction_depth}++ == 0) { + my $dbh = $self->dbh; + if ($dbh->{AutoCommit}) { + $self->debugfh->print("BEGIN WORK\n") + if ($self->debug); + $dbh->begin_work; + } + } } =head2 txn_commit @@ -430,10 +496,19 @@ Issues a commit against the current dbh. sub txn_commit { my $self = shift; if ($self->{transaction_depth} == 0) { - $self->dbh->commit unless $self->dbh->{AutoCommit}; + my $dbh = $self->dbh; + unless ($dbh->{AutoCommit}) { + $self->debugfh->print("COMMIT\n") + if ($self->debug); + $dbh->commit; + } } else { - $self->dbh->commit if --$self->{transaction_depth} == 0; + if (--$self->{transaction_depth} == 0) { + $self->debugfh->print("COMMIT\n") + if ($self->debug); + $self->dbh->commit; + } } } @@ -450,12 +525,22 @@ sub txn_rollback { eval { if ($self->{transaction_depth} == 0) { - $self->dbh->rollback unless $self->dbh->{AutoCommit}; + my $dbh = $self->dbh; + unless ($dbh->{AutoCommit}) { + $self->debugfh->print("ROLLBACK\n") + if ($self->debug); + $dbh->rollback; + } } else { - --$self->{transaction_depth} == 0 ? - $self->dbh->rollback : + if (--$self->{transaction_depth} == 0) { + $self->debugfh->print("ROLLBACK\n") + if ($self->debug); + $self->dbh->rollback; + } + else { die DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION->new; + } } }; @@ -473,16 +558,23 @@ sub _execute { my ($sql, @bind) = $self->sql_maker->$op($ident, @args); unshift(@bind, @$extra_bind) if $extra_bind; if ($self->debug) { - my @debug_bind = map { defined $_ ? qq{`$_'} : q{`NULL'} } @bind; + my @debug_bind = map { defined $_ ? qq{'$_'} : q{'NULL'} } @bind; $self->debugfh->print("$sql: " . join(', ', @debug_bind) . "\n"); } - my $sth = $self->sth($sql,$op); - $self->throw_exception('no sth generated via sql (' . $self->_dbh->errstr . "): $sql") unless $sth; + my $sth = eval { $self->sth($sql,$op) }; + + if (!$sth || $@) { + $self->throw_exception('no sth generated via sql (' . ($@ || $self->_dbh->errstr) . "): $sql"); + } + @bind = map { ref $_ ? ''.$_ : $_ } @bind; # stringify args my $rv; if ($sth) { - $rv = $sth->execute(@bind) - or $self->throw_exception("Error executing '$sql': " . $sth->errstr); + $rv = eval { $sth->execute(@bind) }; + + if ($@ || !$rv) { + $self->throw_exception("Error executing '$sql': ".($@ || $sth->errstr)); + } } else { $self->throw_exception("'$sql' did not generate a statement."); } @@ -561,14 +653,16 @@ Returns database type info for a given table columns. sub columns_info_for { my ($self, $table) = @_; - if ($self->dbh->can('column_info')) { + my $dbh = $self->dbh; + + if ($dbh->can('column_info')) { my %result; - my $old_raise_err = $self->dbh->{RaiseError}; - my $old_print_err = $self->dbh->{PrintError}; - $self->dbh->{RaiseError} = 1; - $self->dbh->{PrintError} = 0; + my $old_raise_err = $dbh->{RaiseError}; + my $old_print_err = $dbh->{PrintError}; + $dbh->{RaiseError} = 1; + $dbh->{PrintError} = 0; eval { - my $sth = $self->dbh->column_info( undef, undef, $table, '%' ); + my $sth = $dbh->column_info( undef, undef, $table, '%' ); $sth->execute(); while ( my $info = $sth->fetchrow_hashref() ){ my %column_info; @@ -580,21 +674,21 @@ sub columns_info_for { $result{$info->{COLUMN_NAME}} = \%column_info; } }; - $self->dbh->{RaiseError} = $old_raise_err; - $self->dbh->{PrintError} = $old_print_err; + $dbh->{RaiseError} = $old_raise_err; + $dbh->{PrintError} = $old_print_err; return \%result if !$@; } my %result; - my $sth = $self->dbh->prepare("SELECT * FROM $table WHERE 1=0"); + my $sth = $dbh->prepare("SELECT * FROM $table WHERE 1=0"); $sth->execute; my @columns = @{$sth->{NAME_lc}}; for my $i ( 0 .. $#columns ){ my %column_info; my $type_num = $sth->{TYPE}->[$i]; my $type_name; - if(defined $type_num && $self->dbh->can('type_info')) { - my $type_info = $self->dbh->type_info($type_num); + if(defined $type_num && $dbh->can('type_info')) { + my $type_info = $dbh->type_info($type_num); $type_name = $type_info->{TYPE_NAME} if $type_info; } $column_info{data_type} = $type_name ? $type_name : $type_num; @@ -621,24 +715,97 @@ sub last_insert_id { sub sqlt_type { shift->dbh->{Driver}->{Name} } -sub deployment_statements { - my ($self, $schema, $type, $sqltargs) = @_; - $type ||= $self->sqlt_type; +sub create_ddl_dir +{ + my ($self, $schema, $databases, $version, $dir, $sqltargs) = @_; + + if(!$dir || !-d $dir) + { + warn "No directory given, using ./\n"; + $dir = "./"; + } + $databases ||= ['MySQL', 'SQLite', 'PostgreSQL']; + $databases = [ $databases ] if(ref($databases) ne 'ARRAY'); + $version ||= $schema->VERSION || '1.x'; + eval "use SQL::Translator"; $self->throw_exception("Can't deploy without SQL::Translator: $@") if $@; - eval "use SQL::Translator::Parser::DBIx::Class;"; - $self->throw_exception($@) if $@; - eval "use SQL::Translator::Producer::${type};"; - $self->throw_exception($@) if $@; - my $tr = SQL::Translator->new(%$sqltargs); - SQL::Translator::Parser::DBIx::Class::parse( $tr, $schema ); - return "SQL::Translator::Producer::${type}"->can('produce')->($tr); + + my $sqlt = SQL::Translator->new({ +# debug => 1, + add_drop_table => 1, + }); + foreach my $db (@$databases) + { + $sqlt->reset(); + $sqlt->parser('SQL::Translator::Parser::DBIx::Class'); +# $sqlt->parser_args({'DBIx::Class' => $schema); + $sqlt->data($schema); + $sqlt->producer($db); + + my $file; + my $filename = $schema->ddl_filename($db, $dir, $version); + if(-e $filename) + { + $self->throw_exception("$filename already exists, skipping $db"); + next; + } + open($file, ">$filename") + or $self->throw_exception("Can't open $filename for writing ($!)"); + my $output = $sqlt->translate; +#use Data::Dumper; +# print join(":", keys %{$schema->source_registrations}); +# print Dumper($sqlt->schema); + if(!$output) + { + $self->throw_exception("Failed to translate to $db. (" . $sqlt->error . ")"); + next; + } + print $file $output; + close($file); + } + +} + +sub deployment_statements { + my ($self, $schema, $type, $version, $dir, $sqltargs) = @_; + $type ||= $self->sqlt_type; + $version ||= $schema->VERSION || '1.x'; + $dir ||= './'; +# eval "use SQL::Translator"; +# $self->throw_exception("Can't deploy without SQL::Translator: $@") if $@; +# eval "use SQL::Translator::Parser::DBIx::Class;"; +# $self->throw_exception($@) if $@; +# eval "use SQL::Translator::Producer::${type};"; +# $self->throw_exception($@) if $@; +# my $tr = SQL::Translator->new(%$sqltargs); +# SQL::Translator::Parser::DBIx::Class::parse( $tr, $schema ); +# return "SQL::Translator::Producer::${type}"->can('produce')->($tr); + + my $filename = $schema->ddl_filename($type, $dir, $version); + if(!-f $filename) + { + $schema->create_ddl_dir([ $type ], $version, $dir, $sqltargs); + } + my $file; + open($file, "<$filename") + or $self->throw_exception("Can't open $filename ($!)"); + my @rows = <$file>; + close($file); + + return join('', @rows); + } sub deploy { my ($self, $schema, $type, $sqltargs) = @_; - foreach my $statement ( $self->deployment_statements($schema, $type, $sqltargs) ) { + foreach my $statement ( $self->deployment_statements($schema, $type, undef, undef, $sqltargs) ) { for ( split(";\n", $statement)) { + next if($_ =~ /^--/); + next if(!$_); +# next if($_ =~ /^DROP/m); + next if($_ =~ /^BEGIN TRANSACTION/m); + next if($_ =~ /^COMMIT/m); $self->debugfh->print("$_\n") if $self->debug; $self->dbh->do($_) or warn "SQL was:\n $_"; }