use DBIx::Class::Storage::DBI::Cursor;
use DBIx::Class::Storage::Statistics;
use IO::File;
+use Scalar::Util qw/weaken/;
use Carp::Clan qw/DBIx::Class/;
BEGIN {
__PACKAGE__->mk_group_accessors('simple' =>
qw/_connect_info _dbh _sql_maker _sql_maker_opts _conn_pid _conn_tid
- debug debugobj cursor on_connect_do transaction_depth/);
+ debug debugobj cursor on_connect_do transaction_depth schema/);
=head1 NAME
=head2 new
+Constructor. Only argument is the schema which instantiated us.
+
=cut
sub new {
- my $new = bless({}, ref $_[0] || $_[0]);
+ my ($self, $schema) = @_;
+
+ my $new = bless({}, ref $self || $self);
+
+ $new->set_schema($schema);
$new->cursor("DBIx::Class::Storage::DBI::Cursor");
$new->transaction_depth(0);
return $new;
}
+=head2 set_schema
+
+Used to reset the schema class or object which owns this
+storage object, such as after a C<clone()>.
+
+=cut
+
+sub set_schema {
+ my ($self, $schema) = @_;
+ $self->schema($schema);
+ weaken($self->{schema}) if ref $self->{schema};
+}
+
+
=head2 throw_exception
Throws an exception - croaks.
=cut
sub throw_exception {
- my ($self, $msg) = @_;
- croak($msg);
+ my $self = shift;
+
+ $self->schema->throw_exception(@_) if $self->schema;
+ croak @_;
}
=head2 connect_info
these options will be cleared before setting the new ones, regardless of
whether any options are specified in the new C<connect_info>.
+Important note: DBIC expects the returned database handle provided by
+a subref argument to have RaiseError set on it. If it doesn't, things
+might not work very well, YMMV. If you don't use a subref, DBIC will
+force this setting for you anyways. Setting HandleError to anything
+other than simple exception object wrapper might cause problems too.
+
Examples:
# Simple SQLite connection
=head2 dbh_do
-Execute the given subref with the underlying
-database handle as its first argument, using our
-normal exception-based connection management. Example:
+Execute the given subref with the underlying database handle as its
+first argument, using the new exception-based connection management.
+Example:
- $schema->storage->dbh_do(sub { shift->do("blah blah") });
+ my @stuff = $schema->storage->dbh_do(
+ sub {
+ shift->selectrow_array("SELECT * FROM foo")
+ }
+ );
=cut
my $want_array = wantarray;
eval {
- $self->_verify_pid;
+ $self->_verify_pid if $self->_dbh;
$self->_populate_dbh if !$self->_dbh;
my $dbh = $self->_dbh;
- local $dbh->{RaiseError} = 1;
- local $dbh->{PrintError} = 0;
if($want_array) {
@result = $todo->($dbh);
}
- else {
+ elsif(defined $want_array) {
$result[0] = $todo->($dbh);
}
+ else {
+ $todo->($dbh);
+ }
};
+
if($@) {
my $exception = $@;
$self->connected
: $self->_populate_dbh;
my $dbh = $self->_dbh;
- local $dbh->{RaiseError} = 1;
- local $dbh->{PrintError} = 0;
- return $todo->($self->_dbh);
+ return $todo->($dbh);
}
+
return $want_array ? @result : $result[0];
}
if(defined $self->_conn_tid && $self->_conn_tid != threads->tid) {
return $self->_dbh(undef);
}
- $self->_verify_pid;
+ else {
+ $self->_verify_pid;
+ }
return ($dbh->FETCH('Active') && $dbh->ping);
}
}
# handle pid changes correctly
+# NOTE: assumes $self->_dbh is a valid $dbh
sub _verify_pid {
my ($self) = @_;
- return if !$self->_dbh || $self->_conn_pid == $$;
+ return if $self->_conn_pid == $$;
$self->_dbh->{InactiveDestroy} = 1;
$self->_dbh(undef);
}
eval {
- $dbh = ref $info[0] eq 'CODE'
- ? &{$info[0]}
- : DBI->connect(@info);
+ if(ref $info[0] eq 'CODE') {
+ $dbh = &{$info[0]}
+ }
+ else {
+ $dbh = DBI->connect(@info);
+ $dbh->{RaiseError} = 1;
+ $dbh->{PrintError} = 0;
+ }
};
$DBI::connect_via = $old_connect_via if $old_connect_via;
sub columns_info_for {
my ($self, $table) = @_;
- my $dbh = $self->dbh;
+ $self->dbh_do(sub {
+ my $dbh = shift;
+
+ if ($dbh->can('column_info')) {
+ my %result;
+ eval {
+ my ($schema,$tab) = $table =~ /^(.+?)\.(.+)$/ ? ($1,$2) : (undef,$table);
+ my $sth = $dbh->column_info( undef,$schema, $tab, '%' );
+ $sth->execute();
+ while ( my $info = $sth->fetchrow_hashref() ){
+ my %column_info;
+ $column_info{data_type} = $info->{TYPE_NAME};
+ $column_info{size} = $info->{COLUMN_SIZE};
+ $column_info{is_nullable} = $info->{NULLABLE} ? 1 : 0;
+ $column_info{default_value} = $info->{COLUMN_DEF};
+ my $col_name = $info->{COLUMN_NAME};
+ $col_name =~ s/^\"(.*)\"$/$1/;
+
+ $result{$col_name} = \%column_info;
+ }
+ };
+ return \%result if !$@;
+ }
- if ($dbh->can('column_info')) {
my %result;
- local $dbh->{RaiseError} = 1;
- local $dbh->{PrintError} = 0;
- eval {
- my ($schema,$tab) = $table =~ /^(.+?)\.(.+)$/ ? ($1,$2) : (undef,$table);
- my $sth = $dbh->column_info( undef,$schema, $tab, '%' );
- $sth->execute();
- while ( my $info = $sth->fetchrow_hashref() ){
- my %column_info;
- $column_info{data_type} = $info->{TYPE_NAME};
- $column_info{size} = $info->{COLUMN_SIZE};
- $column_info{is_nullable} = $info->{NULLABLE} ? 1 : 0;
- $column_info{default_value} = $info->{COLUMN_DEF};
- my $col_name = $info->{COLUMN_NAME};
- $col_name =~ s/^\"(.*)\"$/$1/;
-
- $result{$col_name} = \%column_info;
+ 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 && $dbh->can('type_info')) {
+ my $type_info = $dbh->type_info($type_num);
+ $type_name = $type_info->{TYPE_NAME} if $type_info;
}
- };
- return \%result if !$@;
- }
+ $column_info{data_type} = $type_name ? $type_name : $type_num;
+ $column_info{size} = $sth->{PRECISION}->[$i];
+ $column_info{is_nullable} = $sth->{NULLABLE}->[$i] ? 1 : 0;
- my %result;
- 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 && $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;
- $column_info{size} = $sth->{PRECISION}->[$i];
- $column_info{is_nullable} = $sth->{NULLABLE}->[$i] ? 1 : 0;
+ if ($column_info{data_type} =~ m/^(.*?)\((.*?)\)$/) {
+ $column_info{data_type} = $1;
+ $column_info{size} = $2;
+ }
- if ($column_info{data_type} =~ m/^(.*?)\((.*?)\)$/) {
- $column_info{data_type} = $1;
- $column_info{size} = $2;
+ $result{$columns[$i]} = \%column_info;
}
- $result{$columns[$i]} = \%column_info;
- }
-
- return \%result;
+ return \%result;
+ });
}
=head2 last_insert_id
return $type;
}
-sub DESTROY { shift->_dbh(undef) }
+sub DESTROY {
+ my $self = shift;
+ return if !$self->_dbh;
+
+ $self->_verify_pid;
+ $self->_dbh(undef);
+}
1;
projects / dbsrgits/DBIx-Class.git / blobdiff