sub _attr_cache {
my $self = shift;
my $cache = $self->can('__attr_cache') ? $self->__attr_cache : {};
- my $rest;
- my $exception;
- try {
- $rest = $self->next::method;
- } catch {
- $exception = 1;
+
+ return {
+ %$cache,
+ %{ $self->maybe::next::method || {} },
};
- return $exception ? $cache : { %$cache, %$rest };
}
1;
sub _build_config {
my ($self) = @_;
- eval { require Config::Any }
- or die ("Config::Any is required to parse the config file.\n");
+ try { require Config::Any }
+ catch { die ("Config::Any is required to parse the config file.\n") };
my $cfg = Config::Any->load_files ( {files => [$self->config_file], use_ext =>1, flatten_to_hash=>1});
use strict;
use warnings;
-use Carp::Clan qw/^DBIx::Class/;
+use Carp::Clan qw/^DBIx::Class|^Try::Tiny/;
use Scalar::Util qw/blessed/;
use Try::Tiny;
inflate => sub {
my ($value, $obj) = @_;
- my ($dt, $err);
- try { $dt = $obj->_inflate_to_datetime( $value, \%info ) }
- catch {
- $err = 1;
- if (! $undef_if_invalid) {
- $self->throw_exception ("Error while inflating ${value} for ${column} on ${self}: $_");
- }
- };
- return undef if $err;
-
- return $obj->_post_inflate_datetime( $dt, \%info );
+ my $dt = try
+ { $obj->_inflate_to_datetime( $value, \%info ) }
+ catch {
+ $self->throw_exception ("Error while inflating ${value} for ${column} on ${self}: $_")
+ unless $undef_if_invalid;
+ undef; # rv
+ };
+
+ return (defined $dt)
+ ? $obj->_post_inflate_datetime( $dt, \%info )
+ : undef
+ ;
},
deflate => sub {
my ($value, $obj) = @_;
$guess = "using our class name '$class' as foreign key";
}
- my $f_class_loaded = eval { $f_class->columns };
+ my $f_class_loaded = try { $f_class->columns };
$class->throw_exception(
"No such column ${f_key} on foreign class ${f_class} ($guess)"
) if $f_class_loaded && !$f_class->has_column($f_key);
"${class} has none"
) if !defined $pri && (!defined $cond || !length $cond);
- my $f_class_loaded = eval { $f_class->columns };
+ my $f_class_loaded = try { $f_class->columns };
my ($f_key,$too_many,$guess);
if (defined $cond && length $cond) {
$f_key = $cond;
$target_class ||= $class;
my ($pri, $too_many) = try { $target_class->_pri_cols }
catch {
- $class->throw_exception("Can't infer join condition on ${target_class}: $@");
+ $class->throw_exception("Can't infer join condition on ${target_class}: $_");
};
$class->throw_exception(
use DBIx::Class::Exception;
use Scalar::Util ();
+use Try::Tiny;
###
### Internal method
my ($self, $column, $new_value) = @_;
# if we can't get an ident condition on first try - mark the object as unidentifiable
- $self->{_orig_ident} ||= (eval { $self->ident_condition }) || {};
+ $self->{_orig_ident} ||= (try { $self->ident_condition }) || {};
my $old_value = $self->get_column($column);
$new_value = $self->store_column($column, $new_value);
use DBIx::Class::Exception;
use Carp::Clan qw/^DBIx::Class/;
+use Try::Tiny;
use Scalar::Util ();
use File::Spec;
use Sub::Name ();
$storage_class = 'DBIx::Class::Storage'.$storage_class
if $storage_class =~ m/^::/;
- eval { $self->ensure_class_loaded ($storage_class) };
- $self->throw_exception(
- "No arguments to load_classes and couldn't load ${storage_class} ($@)"
- ) if $@;
+ try {
+ $self->ensure_class_loaded ($storage_class);
+ }
+ catch {
+ $self->throw_exception(
+ "No arguments to load_classes and couldn't load ${storage_class} ($_)"
+ );
+ };
my $storage = $storage_class->new($self=>$args);
$storage->connect_info(\@info);
$self->storage($storage);
unless ($INC{"DBIx/Class/CDBICompat.pm"} || $warn++);
my $base = 'DBIx::Class::ResultSetProxy';
- eval "require ${base};";
- $self->throw_exception
- ("No arguments to load_classes and couldn't load ${base} ($@)")
- if $@;
+ try {
+ eval "require ${base};"
+ }
+ catch {
+ $self->throw_exception
+ ("No arguments to load_classes and couldn't load ${base} ($_)")
+ };
if ($self eq $target) {
# Pathological case, largely caused by the docs on early C::M::DBIC::Plain
use Carp::Clan qw/^DBIx::Class/;
use Time::HiRes qw/gettimeofday/;
+use Try::Tiny;
__PACKAGE__->mk_classdata('_filedata');
__PACKAGE__->mk_classdata('upgrade_directory');
my ($self, $rs) = @_;
my $vtable = $self->{vschema}->resultset('Table');
- my $version = eval {
+ my $version = try {
$vtable->search({}, { order_by => { -desc => 'installed' }, rows => 1 } )
->get_column ('version')
->next;
$self->txn_begin; # If this throws an exception, no rollback is needed
my $wantarray = wantarray; # Need to save this since the context
- # inside the eval{} block is independent
+ # inside the try{} block is independent
# of the context that called txn_do()
try {
my %info;
- my $server_version = do {
- local $@; # might be happenin in some sort of destructor
- try { $self->_get_server_version };
- };
+ my $server_version = try { $self->_get_server_version };
if (defined $server_version) {
$info{dbms_version} = $server_version;
if ($opts->{returning}) {
my @ret_cols = @{$opts->{returning}};
- my @ret_vals = eval {
+ my @ret_vals = try {
local $SIG{__WARN__} = sub {};
my @r = $sth->fetchrow_array;
$sth->finish;
sub _dbh_last_insert_id {
my ($self, $dbh, $source, $col) = @_;
- my $id = eval { $dbh->last_insert_id (undef, undef, $source->name, $col) };
+ my $id = try { $dbh->last_insert_id (undef, undef, $source->name, $col) };
return $id if defined $id;
# place (even though we will ignore errors)
$self->dbh_do (sub { $_[1]->do($line) });
} catch {
- carp qq{$@ (running "${line}")};
+ carp qq{$_ (running "${line}")};
};
$self->_query_end($line);
};
use base qw/DBIx::Class::Cursor/;
+use Try::Tiny;
+
__PACKAGE__->mk_group_accessors('simple' =>
qw/sth/
);
my ($self) = @_;
# No need to care about failures here
- eval { $self->sth->finish if $self->sth && $self->sth->{Active} };
+ try { $self->sth->finish if $self->sth && $self->sth->{Active} };
$self->_soft_reset;
return undef;
}
my ($self) = @_;
# None of the reasons this would die matter if we're in DESTROY anyways
- local $@;
- eval { $self->sth->finish if $self->sth && $self->sth->{Active} };
+ try { $self->sth->finish if $self->sth && $self->sth->{Active} };
}
1;
# this should bring back the result of SELECT SCOPE_IDENTITY() we tacked
# on in _prep_for_execute above
- my ($identity) = eval { $sth->fetchrow_array };
+ my ($identity) = try { $sth->fetchrow_array };
# SCOPE_IDENTITY failed, but we can do something else
if ( (! $identity) && $self->_identity_method) {
# stored procedures like xp_msver, or version detection failed for some
# other reason.
# So, we use a query to check if RNO is implemented.
- $have_rno = 1 if (eval { local $@; ($self->_get_dbh
- ->selectrow_array('SELECT row_number() OVER (ORDER BY rand())')
- )[0] });
+ try {
+ $self->_get_dbh->selectrow_array('SELECT row_number() OVER (ORDER BY rand())');
+ $have_rno = 1;
+ };
}
$self->{_sql_maker_opts} = {
$sqltargs->{quote_table_names} = $quote_char ? 1 : 0;
$sqltargs->{quote_field_names} = $quote_char ? 1 : 0;
- my $oracle_version = eval { $self->_get_dbh->get_info(18) };
+ my $oracle_version = try { $self->_get_dbh->get_info(18) };
$sqltargs->{producer_args}{oracle_version} = $oracle_version;
} catch {
$replicant->debugobj->print(sprintf(
"Exception trying to $name for replicant %s, error is %s",
- $replicant->_dbi_connect_info->[0], $@)
+ $replicant->_dbi_connect_info->[0], $_)
);
$rc = undef;
};
around '_query_start' => sub {
my ($method, $self, $sql, @bind) = @_;
- my $dsn = eval { $self->dsn } || $self->_dbi_connect_info->[0];
+ my $dsn = (try { $self->dsn }) || $self->_dbi_connect_info->[0];
my($op, $rest) = (($sql=~m/^(\w+)(.+)$/),'NOP', 'NO SQL');
my $storage_type = $self->can('active') ? 'REPLICANT' : 'MASTER';
if ((reftype($dsn)||'') ne 'CODE') {
"$op [DSN_$storage_type=$dsn]$rest";
}
- elsif (my $id = eval { $self->id }) {
+ elsif (my $id = try { $self->id }) {
"$op [$storage_type=$id]$rest";
}
else {
my $table_name = $source->from;
$table_name = $$table_name if ref $table_name;
- my ($identity) = eval {
- local $@; $dbh->selectrow_array("SELECT GET_IDENTITY('$table_name')")
+ my ($identity) = try {
+ $dbh->selectrow_array("SELECT GET_IDENTITY('$table_name')")
};
if (defined $identity) {
sub build_datetime_parser {
my $self = shift;
my $type = "DateTime::Format::Strptime";
- eval "use ${type}";
- $self->throw_exception("Couldn't load ${type}: $@") if $@;
+ try {
+ eval "use ${type}"
+ }
+ catch {
+ $self->throw_exception("Couldn't load ${type}: $_");
+ };
+
return $type->new( pattern => '%Y-%m-%d %H:%M:%S.%6N' );
}
if ($dbh->{syb_no_child_con}) {
# if extra connections are not allowed, then ->ping is reliable
- my $ping = eval { $dbh->ping };
- return $@ ? 0 : $ping;
+ my $alive;
+ try { $alive = $dbh->ping } catch { $alive = 0 };
+ return $alive;
}
my $rc = 1;
sub set_textsize {
my $self = shift;
- my $text_size = shift ||
- eval { $self->_dbi_connect_info->[-1]->{LongReadLen} } ||
+ my $text_size =
+ shift
+ ||
+ try { $self->_dbi_connect_info->[-1]->{LongReadLen} }
+ ||
32768; # the DBD::Sybase default
return unless defined $text_size;
sub _update_blobs {
my ($self, $source, $blob_cols, $where) = @_;
- my @primary_cols = eval { $source->_pri_cols };
- $self->throw_exception("Cannot update TEXT/IMAGE column(s): $@")
- if $@;
+ my @primary_cols = try
+ { $source->_pri_cols }
+ catch {
+ $self->throw_exception("Cannot update TEXT/IMAGE column(s): $_")
+ };
# check if we're updating a single row by PK
my $pk_cols_in_where = 0;
my $table = $source->name;
my %row = %$row;
- my @primary_cols = eval { $source->_pri_cols} ;
- $self->throw_exception("Cannot update TEXT/IMAGE column(s): $@")
- if $@;
+ my @primary_cols = try
+ { $source->_pri_cols }
+ catch {
+ $self->throw_exception("Cannot update TEXT/IMAGE column(s): $_")
+ };
$self->throw_exception('Cannot update TEXT/IMAGE column(s) without primary key values')
if ((grep { defined $row{$_} } @primary_cols) != @primary_cols);
my $sth = $cursor->sth;
if (not $sth) {
-
$self->throw_exception(
"Could not find row in table '$table' for blob update:\n"
. Data::Dumper::Concise::Dumper (\%where)
);
}
- eval {
+ try {
do {
$sth->func('CS_GET', 1, 'ct_data_info') or die $sth->errstr;
} while $sth->fetch;
$sth->func($blob, length($blob), 'ct_send_data') or die $sth->errstr;
$sth->func('ct_finish_send') or die $sth->errstr;
- };
- my $exception = $@;
- $sth->finish if $sth;
- if ($exception) {
+ }
+ catch {
if ($self->using_freetds) {
$self->throw_exception (
- 'TEXT/IMAGE operation failed, probably because you are using FreeTDS: '
- . $exception
+ "TEXT/IMAGE operation failed, probably because you are using FreeTDS: $_"
);
- } else {
- $self->throw_exception($exception);
+ }
+ else {
+ $self->throw_exception($_);
}
}
+ finally {
+ $sth->finish if $sth;
+ };
}
}
use Exporter;
use SQL::Translator::Utils qw(debug normalize_name);
-use Carp::Clan qw/^SQL::Translator|^DBIx::Class/;
+use Carp::Clan qw/^SQL::Translator|^DBIx::Class|^Try::Tiny/;
use Scalar::Util ();
+use Try::Tiny;
use base qw(Exporter);
croak 'No DBIx::Class::Schema' unless ($dbicschema);
if (!ref $dbicschema) {
- eval "use $dbicschema;";
- croak "Can't load $dbicschema ($@)" if($@);
+ try {
+ eval "require $dbicschema;"
+ }
+ catch {
+ croak "Can't load $dbicschema ($_)";
+ }
}
my $schema = $tr->schema;
projects / dbsrgits/DBIx-Class.git / commitdiff