# Following for CDBICompat only
'Class::Trigger' => 0,
'DBIx::ContextualFetch' => 0,
+ 'Carp::Clan' => 0,
},
recommends => {
'Data::UUID' => 0,
Revision history for DBIx::Class
+ - Removed DBIx::Class::Exception
+ - unified throw_exception stuff, using Carp::Clan
+ - report query when sth generation fails.
- multi-step prefetch!
- inheritance fixes
- test tweaks
lib/DBIx/Class/Core.pm
lib/DBIx/Class/Cursor.pm
lib/DBIx/Class/DB.pm
-lib/DBIx/Class/Exception.pm
lib/DBIx/Class/InflateColumn.pm
lib/DBIx/Class/Manual.pod
lib/DBIx/Class/Manual/Cookbook.pod
use strict;
use warnings;
+use Carp::Clan qw/^DBIx::Class/;
+
=head1 NAME
DBIx::Class::AccessorGroup - Lets you build groups of accessors
foreach my $field (@fields) {
if( $field eq 'DESTROY' ) {
- require Carp;
- &Carp::carp("Having a data accessor named DESTROY in ".
+ carp("Having a data accessor named DESTROY in ".
"'$class' is unwise.");
}
if(@_) {
my $caller = caller;
- require Carp;
- Carp::croak("'$caller' cannot alter the value of '$field' on ".
+ croak("'$caller' cannot alter the value of '$field' on ".
"objects of class '$class'");
}
else {
unless (@_) {
my $caller = caller;
require Carp;
- Carp::croak("'$caller' cannot access the value of '$field' on ".
+ croak("'$caller' cannot access the value of '$field' on ".
"objects of class '$class'");
}
else {
sub new {
my ($class, $attrs, @rest) = @_;
- $class->throw( "create needs a hashref" ) unless ref $attrs eq 'HASH';
+ $class->throw_exception( "create needs a hashref" ) unless ref $attrs eq 'HASH';
foreach my $col ($class->columns) {
if ($class->can('accessor_name')) {
my $acc = $class->accessor_name($col);
sub constrain_column {
my $class = shift;
my $col = $class->find_column(+shift)
- or return $class->throw("constraint_column needs a valid column");
+ or return $class->throw_exception("constraint_column needs a valid column");
my $how = shift
- or return $class->throw("constrain_column needs a constraint");
+ or return $class->throw_exception("constrain_column needs a constraint");
if (ref $how eq "ARRAY") {
my %hash = map { $_ => 1 } @$how;
$class->add_constraint(list => $col => sub { exists $hash{ +shift } });
if (my $dispatch = $class->can($try_method)) {
$class->$dispatch($col => ($how, @_));
} else {
- $class->throw("Don't know how to constrain $col with $how");
+ $class->throw_exception("Don't know how to constrain $col with $how");
}
}
}
sub add_constraint {
my $class = shift;
$class->_invalid_object_method('add_constraint()') if ref $class;
- my $name = shift or return $class->throw("Constraint needs a name");
+ my $name = shift or return $class->throw_exception("Constraint needs a name");
my $column = $class->find_column(+shift)
- or return $class->throw("Constraint $name needs a valid column");
+ or return $class->throw_exception("Constraint $name needs a valid column");
my $code = shift
- or return $class->throw("Constraint $name needs a code reference");
- return $class->throw("Constraint $name '$code' is not a code reference")
+ or return $class->throw_exception("Constraint $name needs a code reference");
+ return $class->throw_exception("Constraint $name '$code' is not a code reference")
unless ref($code) eq "CODE";
#$column->is_constrained(1);
"before_set_$column" => sub {
my ($self, $value, $column_values) = @_;
$code->($value, $self, $column, $column_values)
- or return $self->throw(
+ or return $self->throw_exception(
"$class $column fails '$name' constraint with '$value'");
}
);
sub has_a {
my ($self, $col, $f_class, %args) = @_;
- $self->throw( "No such column ${col}" ) unless $self->has_column($col);
+ $self->throw_exception( "No such column ${col}" ) unless $self->has_column($col);
eval "require $f_class";
if ($args{'inflate'} || $args{'deflate'}) { # Non-database has_a
if (!ref $args{'inflate'}) {
map { $from_class->relationship_info($_) }
$from_class->relationships;
}
- $self->throw( "No relationship to JOIN from ${from_class} to ${to_class}" )
+ $self->throw_exception( "No relationship to JOIN from ${from_class} to ${to_class}" )
unless $rel_obj;
my $join = $from_class->storage->sql_maker->_join_condition(
$from_class->result_source_instance->resolve_condition(
sub make_read_only {
my $proto = shift;
- $proto->add_trigger("before_$_" => sub { shift->throw("$proto is read only") })
+ $proto->add_trigger("before_$_" => sub { shift->throw_exception("$proto is read only") })
foreach qw/create delete update/;
return $proto;
}
sub get_temp {
my ($self, $column) = @_;
- $self->throw( "Can't fetch data as class method" ) unless ref $self;
- $self->throw( "No such TEMP column '${column}'" ) unless $self->_temp_columns->{$column} ;
+ $self->throw_exception( "Can't fetch data as class method" ) unless ref $self;
+ $self->throw_exception( "No such TEMP column '${column}'" ) unless $self->_temp_columns->{$column} ;
return $self->{_temp_column_data}{$column}
if exists $self->{_temp_column_data}{$column};
return undef;
sub set_temp {
my ($self, $column, $value) = @_;
- $self->throw( "No such TEMP column '${column}'" )
+ $self->throw_exception( "No such TEMP column '${column}'" )
unless $self->_temp_columns->{$column};
- $self->throw( "set_temp called for ${column} without value" )
+ $self->throw_exception( "set_temp called for ${column} without value" )
if @_ < 3;
return $self->{_temp_column_data}{$column} = $value;
}
PK
Row
ResultSourceProxy::Table
- Exception
AccessorGroup/);
1;
=item L<DBIx::Class::ResultSourceProxy::Table>
-=item L<DBIx::Class::Exception>
-
=item L<DBIx::Class::AccessorGroup>
=back
+++ /dev/null
-package DBIx::Class::Exception;
-
-use strict;
-use vars qw[@ISA $DBIC_EXCEPTION_CLASS];
-use UNIVERSAL::require;
-
-BEGIN {
- push( @ISA, $DBIC_EXCEPTION_CLASS || 'DBIx::Class::Exception::Base' );
-}
-
-package DBIx::Class::Exception::Base;
-
-use strict;
-use Carp ();
-
-=head1 NAME
-
-DBIx::Class::Exception - DBIC Exception Class
-
-=head1 SYNOPSIS
-
- DBIx::Class::Exception->throw( qq/Fatal exception/ );
-
-See also L<DBIx::Class>.
-
-=head1 DESCRIPTION
-
-This is a generic Exception class for DBIx::Class. You can easily
-replace this with any mechanism implementing 'throw' by setting
-$DBix::Class::Exception::DBIC_EXCEPTION_CLASS
-
-=head1 METHODS
-
-=head2 throw( $message )
-
-=head2 throw( message => $message )
-
-=head2 throw( error => $error )
-
-Throws a fatal exception.
-
-=cut
-
-sub throw {
- my $class = shift;
- my %params = @_ == 1 ? ( error => $_[0] ) : @_;
-
- my $message = $params{message} || $params{error} || $! || '';
-
- local $Carp::CarpLevel = (caller(1) eq 'NEXT' ? 2 : 1);
-
- Carp::croak($message);
-}
-
-=head1 AUTHOR
-
-Marcus Ramberg <mramberg@cpan.org>
-
-=head1 THANKS
-
-Thanks to the L<Catalyst> framework, where this module was borrowed
-from.
-
-=head1 COPYRIGHT
-
-This program is free software, you can redistribute it and/or modify
-it under the same terms as Perl itself.
-
-=cut
-
-1;
use strict;
use warnings;
-use Carp qw/croak/;
use base qw/DBIx::Class::Row/;
sub inflate_column {
my ($self, $col, $attrs) = @_;
- croak "No such column $col to inflate" unless $self->has_column($col);
- croak "inflate_column needs attr hashref" unless ref $attrs eq 'HASH';
+ $self->throw_exception("No such column $col to inflate") unless $self->has_column($col);
+ $self->throw_exception("inflate_column needs attr hashref") unless ref $attrs eq 'HASH';
$self->column_info($col)->{_inflate_info} = $attrs;
$self->mk_group_accessors('inflated_column' => $col);
return 1;
sub _inflated_column {
my ($self, $col, $value) = @_;
return $value unless defined $value; # NULL is NULL is NULL
- my $info = $self->column_info($col) || croak "No column info for $col";
+ my $info = $self->column_info($col) || $self->throw_exception("No column info for $col");
return $value unless exists $info->{_inflate_info};
my $inflate = $info->{_inflate_info}{inflate};
- croak "No inflator for $col" unless defined $inflate;
+ $self->throw_exception("No inflator for $col") unless defined $inflate;
return $inflate->($value, $self);
}
sub _deflated_column {
my ($self, $col, $value) = @_;
return $value unless ref $value; # If it's not an object, don't touch it
- my $info = $self->column_info($col) || croak "No column info for $col";
+ my $info = $self->column_info($col) || $self->throw_exception("No column info for $col");
return $value unless exists $info->{_inflate_info};
my $deflate = $info->{_inflate_info}{deflate};
- croak "No deflator for $col" unless defined $deflate;
+ $self->throw_exception("No deflator for $col") unless defined $deflate;
return $deflate->($value, $self);
}
sub get_inflated_column {
my ($self, $col) = @_;
- $self->throw("$col is not an inflated column") unless
+ $self->throw_exception("$col is not an inflated column") unless
exists $self->column_info($col)->{_inflate_info};
return $self->{_inflated_column}{$col}
sub id {
my ($self) = @_;
- $self->throw( "Can't call id() as a class method" ) unless ref $self;
+ $self->throw_exception( "Can't call id() as a class method" ) unless ref $self;
my @pk = $self->_ident_values;
return (wantarray ? @pk : $pk[0]);
}
sub ID {
my ($self) = @_;
- $self->throw( "Can't call ID() as a class method" ) unless ref $self;
+ $self->throw_exception( "Can't call ID() as a class method" ) unless ref $self;
return undef unless $self->in_storage;
return $self->_create_ID(map { $_ => $self->{_column_data}{$_} } $self->primary_columns);
}
(grep { $self->column_info($_)->{'auto_increment'} }
$self->primary_columns)
|| $self->primary_columns;
- $self->throw( "More than one possible key found for auto-inc on ".ref $self )
+ $self->throw_exception( "More than one possible key found for auto-inc on ".ref $self )
if $too_many;
unless (defined $self->get_column($pri)) {
- $self->throw( "Can't auto-inc for $pri on ".ref $self.": no _last_insert_id method" )
+ $self->throw_exception( "Can't auto-inc for $pri on ".ref $self.": no _last_insert_id method" )
unless $self->can('last_insert_id');
my $id = $self->last_insert_id;
- $self->throw( "Can't get last insert id" ) unless $id;
+ $self->throw_exception( "Can't get last insert id" ) unless $id;
$self->store_column($pri => $id);
}
return $ret;
}
};
} elsif ($acc_type eq 'filter') {
- $class->throw("No such column $rel to filter")
+ $class->throw_exception("No such column $rel to filter")
unless $class->has_column($rel);
my $f_class = $class->relationship_info($rel)->{class};
$class->inflate_column($rel,
},
deflate => sub {
my ($val, $self) = @_;
- $self->throw("$val isn't a $f_class") unless $val->isa($f_class);
+ $self->throw_exception("$val isn't a $f_class") unless $val->isa($f_class);
return ($val->_ident_values)[0];
# WARNING: probably breaks for multi-pri sometimes. FIXME
}
$meth{$rel} = sub { shift->search_related($rel, @_) };
$meth{"add_to_${rel}"} = sub { shift->create_related($rel, @_); };
} else {
- $class->throw("No such relationship accessor type $acc_type");
+ $class->throw_exception("No such relationship accessor type $acc_type");
}
{
no strict 'refs';
$attrs = { %{ pop(@_) } };
}
my $rel_obj = $self->relationship_info($rel);
- $self->throw( "No such relationship ${rel}" ) unless $rel_obj;
+ $self->throw_exception( "No such relationship ${rel}" ) unless $rel_obj;
$attrs = { %{$rel_obj->{attrs} || {}}, %{$attrs || {}} };
- $self->throw( "Invalid query: @_" ) if (@_ > 1 && (@_ % 2 == 1));
+ $self->throw_exception( "Invalid query: @_" ) if (@_ > 1 && (@_ % 2 == 1));
my $query = ((@_ > 1) ? {@_} : shift);
my ($cond) = $self->result_source->resolve_condition($rel_obj->{cond}, $rel, $self);
sub set_from_related {
my ($self, $rel, $f_obj) = @_;
my $rel_obj = $self->relationship_info($rel);
- $self->throw( "No such relationship ${rel}" ) unless $rel_obj;
+ $self->throw_exception( "No such relationship ${rel}" ) unless $rel_obj;
my $cond = $rel_obj->{cond};
- $self->throw( "set_from_related can only handle a hash condition; the "
+ $self->throw_exception( "set_from_related can only handle a hash condition; the "
."condition for $rel is of type ".(ref $cond ? ref $cond : 'plain scalar'))
unless ref $cond eq 'HASH';
my $f_class = $self->result_source->schema->class($rel_obj->{class});
- $self->throw( "Object $f_obj isn't a ".$f_class )
+ $self->throw_exception( "Object $f_obj isn't a ".$f_class )
unless $f_obj->isa($f_class);
foreach my $key (keys %$cond) {
next if ref $cond->{$key}; # Skip literals and complex conditions
- $self->throw("set_from_related can't handle $key as key")
+ $self->throw_exception("set_from_related can't handle $key as key")
unless $key =~ m/^foreign\.([^\.]+)$/;
my $val = $f_obj->get_column($1);
- $self->throw("set_from_related can't handle ".$cond->{$key}." as value")
+ $self->throw_exception("set_from_related can't handle ".$cond->{$key}." as value")
unless $cond->{$key} =~ m/^self\.([^\.]+)$/;
$self->set_column($1 => $val);
}
my ($class, $rel, $f_class, $cond, $attrs) = @_;
eval "require $f_class";
if ($@) {
- $class->throw($@) unless $@ =~ /Can't locate/;
+ $class->throw_exception($@) unless $@ =~ /Can't locate/;
}
my %f_primaries;
# single key relationship
if (!ref $cond) {
- $class->throw("Can't infer join condition for ${rel} on ${class}; unable to load ${f_class}")
+ $class->throw_exception("Can't infer join condition for ${rel} on ${class}; unable to load ${f_class}")
unless $f_loaded;
my ($pri, $too_many) = keys %f_primaries;
- $class->throw("Can't infer join condition for ${rel} on ${class}; ${f_class} has no primary keys")
+ $class->throw_exception("Can't infer join condition for ${rel} on ${class}; ${f_class} has no primary keys")
unless defined $pri;
- $class->throw("Can't infer join condition for ${rel} on ${class}; ${f_class} has multiple primary key")
+ $class->throw_exception("Can't infer join condition for ${rel} on ${class}; ${f_class} has multiple primary key")
if $too_many;
my $fk = defined $cond ? $cond : $rel;
- $class->throw("Can't infer join condition for ${rel} on ${class}; $fk is not a column")
+ $class->throw_exception("Can't infer join condition for ${rel} on ${class}; $fk is not a column")
unless $class->has_column($fk);
my $acc_type = $class->has_column($rel) ? 'filter' : 'single';
);
}
else {
- $class->throw('third argument for belongs_to must be undef, a column name, or a join condition');
+ $class->throw_exception('third argument for belongs_to must be undef, a column name, or a join condition');
}
return 1;
}
eval "require $f_class";
if ($@) {
- $class->throw($@) unless $@ =~ /Can't locate/;
+ $class->throw_exception($@) unless $@ =~ /Can't locate/;
}
unless (ref $cond) {
my ($pri, $too_many) = $class->primary_columns;
- $class->throw( "has_many can only infer join for a single primary key; ${class} has more" )
+ $class->throw_exception( "has_many can only infer join for a single primary key; ${class} has more" )
if $too_many;
my $f_key;
my $f_class_loaded = eval { $f_class->columns };
$f_key = lc $1; # go ahead and guess; best we can do
$guess = "using our class name '$class' as foreign key";
}
- $class->throw("No such column ${f_key} on foreign class ${f_class} ($guess)")
+ $class->throw_exception("No such column ${f_key} on foreign class ${f_class} ($guess)")
if $f_class_loaded && !$f_class->has_column($f_key);
$cond = { "foreign.${f_key}" => "self.${pri}" },
}
my ($class, $join_type, $rel, $f_class, $cond, $attrs) = @_;
eval "require $f_class";
if ($@) {
- $class->throw($@) unless $@ =~ /Can't locate/;
+ $class->throw_exception($@) unless $@ =~ /Can't locate/;
}
unless (ref $cond) {
my ($pri, $too_many) = $class->primary_columns;
- $class->throw( "might_have/has_one can only infer join for a single primary key; ${class} has more" )
+ $class->throw_exception( "might_have/has_one can only infer join for a single primary key; ${class} has more" )
if $too_many;
my $f_key;
my $f_class_loaded = eval { $f_class->columns };
$guess = "using given relationship '$rel' for foreign key";
} else {
($f_key, $too_many) = $f_class->primary_columns;
- $class->throw( "might_have/has_one can only infer join for a single primary key; ${f_class} has more" )
+ $class->throw_exception( "might_have/has_one can only infer join for a single primary key; ${f_class} has more" )
if $too_many;
$guess = "using primary key of foreign class for foreign key";
}
- $class->throw("No such column ${f_key} on foreign class ${f_class} ($guess)")
+ $class->throw_exception("No such column ${f_key} on foreign class ${f_class} ($guess)")
if $f_class_loaded && !$f_class->has_column($f_key);
$cond = { "foreign.${f_key}" => "self.${pri}" };
}
use strict;
use warnings;
-use Carp qw/croak/;
use overload
'0+' => 'count',
'bool' => sub { 1; },
use Data::Page;
use Storable;
+use base qw/DBIx::Class/;
+__PACKAGE__->load_components(qw/AccessorGroup/);
+__PACKAGE__->mk_group_accessors('simple' => 'result_source');
+
=head1 NAME
DBIx::Class::ResultSet - Responsible for fetching and creating resultset.
$attrs->{offset} += ($attrs->{rows} * ($attrs->{page} - 1));
}
my $new = {
- source => $source,
+ result_source => $source,
cond => $attrs->{where},
from => $attrs->{from},
count => undef,
$attrs->{where} = $where;
}
- my $rs = (ref $self)->new($self->{source}, $attrs);
+ my $rs = (ref $self)->new($self->result_source, $attrs);
return (wantarray ? $rs->all : $rs);
}
my ($self, @vals) = @_;
my $attrs = (@vals > 1 && ref $vals[$#vals] eq 'HASH' ? pop(@vals) : {});
- my @cols = $self->{source}->primary_columns;
+ my @cols = $self->result_source->primary_columns;
if (exists $attrs->{key}) {
- my %uniq = $self->{source}->unique_constraints;
+ my %uniq = $self->result_source->unique_constraints;
$self->( "Unknown key " . $attrs->{key} . " on " . $self->name )
unless exists $uniq{$attrs->{key}};
@cols = @{ $uniq{$attrs->{key}} };
}
#use Data::Dumper; warn Dumper($attrs, @vals, @cols);
- $self->{source}->result_class->throw( "Can't find unless a primary key or unique constraint is defined" )
+ $self->throw_exception( "Can't find unless a primary key or unique constraint is defined" )
unless @cols;
my $query;
$query = {@vals};
}
#warn Dumper($query);
- # Useless -> disabled
- #$self->{source}->result_class->throw( "Can't find unless all primary keys are specified" )
- # unless (keys %$query >= @pk); # If we check 'em we run afoul of uc/lc
- # column names etc. Not sure what to do yet
return $self->search($query)->next;
}
sub search_related {
my ($self, $rel, @rest) = @_;
- my $rel_obj = $self->{source}->relationship_info($rel);
- $self->{source}->result_class->throw(
+ my $rel_obj = $self->result_source->relationship_info($rel);
+ $self->throw_exception(
"No such relationship ${rel} in search_related")
unless $rel_obj;
my $rs = $self->search(undef, { join => $rel });
- return $self->{source}->schema->resultset($rel_obj->{class}
+ return $self->result_source->schema->resultset($rel_obj->{class}
)->search( undef,
{ %{$rs->{attrs}},
alias => $rel,
sub cursor {
my ($self) = @_;
- my ($source, $attrs) = @{$self}{qw/source attrs/};
+ my ($attrs) = $self->{attrs};
$attrs = { %$attrs };
return $self->{cursor}
- ||= $source->storage->select($self->{from}, $attrs->{select},
+ ||= $self->result_source->storage->select($self->{from}, $attrs->{select},
$attrs->{where},$attrs);
}
$attrs->{offset} ||= 0;
$attrs->{offset} += $min;
$attrs->{rows} = ($max ? ($max - $min + 1) : 1);
- my $slice = (ref $self)->new($self->{source}, $attrs);
+ my $slice = (ref $self)->new($self->result_source, $attrs);
return (wantarray ? $slice->all : $slice);
}
$target->[0]->{$col} = shift @row;
}
#use Data::Dumper; warn Dumper(\@as, $info);
- my $new = $self->{source}->result_class->inflate_result(
- $self->{source}, @$info);
+ my $new = $self->result_source->result_class->inflate_result(
+ $self->result_source, @$info);
$new = $self->{attrs}{record_filter}->($new)
if exists $self->{attrs}{record_filter};
return $new;
}
+=head2 result_source
+
+Returns a reference to the result source for this recordset.
+
+=cut
+
+
=head2 count
Performs an SQL C<COUNT> with the same query as the resultset was built
sub count {
my $self = shift;
return $self->search(@_)->count if @_ && defined $_[0];
- croak "Unable to ->count with a GROUP BY" if defined $self->{attrs}{group_by};
+ $self->throw_exception(
+ "Unable to ->count with a GROUP BY"
+ ) if defined $self->{attrs}{group_by};
unless (defined $self->{count}) {
my $attrs = { %{ $self->{attrs} },
select => { 'count' => '*' },
# offset, order by and page are not needed to count. record_filter is cdbi
delete $attrs->{$_} for qw/rows offset order_by page pager record_filter/;
- ($self->{count}) = (ref $self)->new($self->{source}, $attrs)->cursor->next;
+ ($self->{count}) = (ref $self)->new($self->result_source, $attrs)->cursor->next;
}
return 0 unless $self->{count};
my $count = $self->{count};
sub update {
my ($self, $values) = @_;
- croak "Values for update must be a hash" unless ref $values eq 'HASH';
- return $self->{source}->storage->update(
- $self->{source}->from, $values, $self->{cond});
+ $self->throw_exception("Values for update must be a hash") unless ref $values eq 'HASH';
+ return $self->result_source->storage->update(
+ $self->result_source->from, $values, $self->{cond});
}
=head2 update_all(\%values)
sub update_all {
my ($self, $values) = @_;
- croak "Values for update must be a hash" unless ref $values eq 'HASH';
+ $self->throw_exception("Values for update must be a hash") unless ref $values eq 'HASH';
foreach my $obj ($self->all) {
$obj->set_columns($values)->update;
}
sub delete {
my ($self) = @_;
- $self->{source}->storage->delete($self->{source}->from, $self->{cond});
+ $self->result_source->storage->delete($self->result_source->from, $self->{cond});
return 1;
}
sub pager {
my ($self) = @_;
my $attrs = $self->{attrs};
- croak "Can't create pager for non-paged rs" unless $self->{page};
+ $self->throw_exception("Can't create pager for non-paged rs") unless $self->{page};
$attrs->{rows} ||= 10;
$self->count;
return $self->{pager} ||= Data::Page->new(
my ($self, $page) = @_;
my $attrs = { %{$self->{attrs}} };
$attrs->{page} = $page;
- return (ref $self)->new($self->{source}, $attrs);
+ return (ref $self)->new($self->result_source, $attrs);
}
=head2 new_result(\%vals)
sub new_result {
my ($self, $values) = @_;
- $self->{source}->result_class->throw( "new_result needs a hash" )
+ $self->throw_exception( "new_result needs a hash" )
unless (ref $values eq 'HASH');
- $self->{source}->result_class->throw( "Can't abstract implicit construct, condition not a hash" )
+ $self->throw_exception( "Can't abstract implicit construct, condition not a hash" )
if ($self->{cond} && !(ref $self->{cond} eq 'HASH'));
my %new = %$values;
my $alias = $self->{attrs}{alias};
foreach my $key (keys %{$self->{cond}||{}}) {
$new{$1} = $self->{cond}{$key} if ($key =~ m/^(?:$alias\.)?([^\.]+)$/);
}
- my $obj = $self->{source}->result_class->new(\%new);
- $obj->result_source($self->{source}) if $obj->can('result_source');
+ my $obj = $self->result_source->result_class->new(\%new);
+ $obj->result_source($self->result_source) if $obj->can('result_source');
$obj;
}
sub create {
my ($self, $attrs) = @_;
- $self->{source}->result_class->throw( "create needs a hashref" ) unless ref $attrs eq 'HASH';
+ $self->throw_exception( "create needs a hashref" ) unless ref $attrs eq 'HASH';
return $self->new_result($attrs)->insert;
}
my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
my $hash = ref $_[0] eq "HASH" ? shift : {@_};
- my %unique_constraints = $self->{source}->unique_constraints;
+ my %unique_constraints = $self->result_source->unique_constraints;
my @constraint_names = (exists $attrs->{key}
? ($attrs->{key})
: keys %unique_constraints);
return $row;
}
+=head2 throw_exception
+
+See Schema's throw_exception
+
+=cut
+
+sub throw_exception {
+ my $self=shift;
+ $self->result_source->schema->throw_exception(@_);
+}
+
=head1 ATTRIBUTES
The resultset takes various attributes that modify its behavior. Here's an
use warnings;
use DBIx::Class::ResultSet;
-
-use Carp qw/croak/;
+use Carp::Clan qw/^DBIx::Class/;
use Storable;
sub column_info {
my ($self, $column) = @_;
- croak "No such column $column" unless exists $self->_columns->{$column};
+ $self->throw_exception("No such column $column")
+ unless exists $self->_columns->{$column};
if ( (! $self->_columns->{$column}->{data_type})
&& $self->schema && $self->storage() ){
my $info;
=cut
sub columns {
- croak "columns() is a read-only accessor, did you mean add_columns()?" if (@_ > 1);
- return @{shift->{_ordered_columns}||[]};
+ my $self=shift;
+ $self->throw_exception("columns() is a read-only accessor, did you mean add_columns()?") if (@_ > 1);
+ return @{$self->{_ordered_columns}||[]};
}
=head2 set_primary_key(@cols)
my ($self, @cols) = @_;
# check if primary key columns are valid columns
for (@cols) {
- $self->throw("No such column $_ on table ".$self->name)
+ $self->throw_exception("No such column $_ on table ".$self->name)
unless $self->has_column($_);
}
$self->_primaries(\@cols);
my ($self, $name, $cols) = @_;
for (@$cols) {
- $self->throw("No such column $_ on table ".$self->name)
+ $self->throw_exception("No such column $_ on table ".$self->name)
unless $self->has_column($_);
}
sub add_relationship {
my ($self, $rel, $f_source_name, $cond, $attrs) = @_;
- croak "Can't create relationship without join condition" unless $cond;
+ $self->throw_exception("Can't create relationship without join condition") unless $cond;
$attrs ||= {};
my %rels = %{ $self->_relationships };
if ($@) { # If the resolve failed, back out and re-throw the error
delete $rels{$rel}; #
$self->_relationships(\%rels);
- croak "Error creating relationship $rel: $@";
+ $self->throw_exception("Error creating relationship $rel: $@");
}
1;
}
$self->related_source($_)->resolve_join($join->{$_}, $_) }
keys %$join;
} elsif (ref $join) {
- croak ("No idea how to resolve join reftype ".ref $join);
+ $self->throw_exception("No idea how to resolve join reftype ".ref $join);
} else {
my $rel_info = $self->relationship_info($join);
- croak("No such relationship ${join}") unless $rel_info;
+ $self->throw_exception("No such relationship ${join}") unless $rel_info;
my $type = $rel_info->{attrs}{join_type} || '';
return [ { $join => $self->related_source($join)->from,
-join_type => $type },
my %ret;
while (my ($k, $v) = each %{$cond}) {
# XXX should probably check these are valid columns
- $k =~ s/^foreign\.// || croak "Invalid rel cond key ${k}";
- $v =~ s/^self\.// || croak "Invalid rel cond val ${v}";
+ $k =~ s/^foreign\.// || $self->throw_exception("Invalid rel cond key ${k}");
+ $v =~ s/^self\.// || $self->throw_exception("Invalid rel cond val ${v}");
if (ref $for) { # Object
#warn "$self $k $for $v";
$ret{$k} = $for->get_column($v);
return @ret;
}
elsif( ref $pre ) {
- croak( "don't know how to resolve prefetch reftype " . ref $pre);
+ $self->throw_exception( "don't know how to resolve prefetch reftype " . ref $pre);
}
else {
my $rel_info = $self->relationship_info( $pre );
- croak( $self->name . " has no such relationship '$pre'" ) unless $rel_info;
+ $self->throw_exception( $self->name . " has no such relationship '$pre'" ) unless $rel_info;
my $prefix = $alias && $alias ne 'me' ? "$alias.$pre" : $pre;
my @ret = map { "$prefix.$_" } $self->related_source($pre)->columns;
#warn $alias, Dumper (\@ret);
sub related_source {
my ($self, $rel) = @_;
if( !$self->has_relationship( $rel ) ) {
- croak "No such relationship '$rel'";
+ $self->throw_exception("No such relationship '$rel'");
}
return $self->schema->source($self->relationship_info($rel)->{source});
}
1;
+=head2 throw_exception
+
+See schema's throw_exception
+
+=cut
+
+sub throw_exception {
+ my $self = shift;
+ if (defined $self->schema) {
+ $self->schema->throw_exception(@_);
+ } else {
+ croak(@_);
+ }
+}
+
+
=head1 AUTHORS
Matt S. Trout <mst@shadowcatsystems.co.uk>
use strict;
use warnings;
-use Carp qw/croak/;
-
use base qw/DBIx::Class/;
+use Carp::Clan qw/^DBIx::Class/;
__PACKAGE__->load_components(qw/AccessorGroup/);
$class = ref $class if ref $class;
my $new = bless({ _column_data => { } }, $class);
if ($attrs) {
- $new->throw("attrs must be a hashref" ) unless ref($attrs) eq 'HASH';
+ $new->throw_exception("attrs must be a hashref" ) unless ref($attrs) eq 'HASH';
while (my ($k, $v) = each %{$attrs}) {
- croak "No such column $k on $class" unless $class->has_column($k);
+ $new->throw_exception("No such column $k on $class") unless $class->has_column($k);
$new->store_column($k => $v);
}
}
$self->{result_source} ||= $self->result_source_instance
if $self->can('result_source_instance');
my $source = $self->{result_source};
- croak "No result_source set on this object; can't insert" unless $source;
+ $self->throw_exception("No result_source set on this object; can't insert") unless $source;
#use Data::Dumper; warn Dumper($self);
$source->storage->insert($source->from, { $self->get_columns });
$self->in_storage(1);
sub update {
my ($self, $upd) = @_;
- $self->throw( "Not in database" ) unless $self->in_storage;
+ $self->throw_exception( "Not in database" ) unless $self->in_storage;
my %to_update = $self->get_dirty_columns;
return $self unless keys %to_update;
my $rows = $self->result_source->storage->update(
$self->result_source->from, \%to_update, $self->ident_condition);
if ($rows == 0) {
- $self->throw( "Can't update ${self}: row not found" );
+ $self->throw_exception( "Can't update ${self}: row not found" );
} elsif ($rows > 1) {
- $self->throw("Can't update ${self}: updated more than one row");
+ $self->throw_exception("Can't update ${self}: updated more than one row");
}
$self->{_dirty_columns} = {};
return $self;
sub delete {
my $self = shift;
if (ref $self) {
- $self->throw( "Not in database" ) unless $self->in_storage;
+ $self->throw_exception( "Not in database" ) unless $self->in_storage;
$self->result_source->storage->delete(
$self->result_source->from, $self->ident_condition);
$self->in_storage(undef);
} else {
- croak "Can't do class delete without a ResultSource instance"
+ $self->throw_exception("Can't do class delete without a ResultSource instance")
unless $self->can('result_source_instance');
my $attrs = { };
if (@_ > 1 && ref $_[$#_] eq 'HASH') {
sub get_column {
my ($self, $column) = @_;
- $self->throw( "Can't fetch data as class method" ) unless ref $self;
+ $self->throw_exception( "Can't fetch data as class method" ) unless ref $self;
return $self->{_column_data}{$column}
if exists $self->{_column_data}{$column};
- $self->throw( "No such column '${column}'" ) unless $self->has_column($column);
+ $self->throw_exception( "No such column '${column}'" ) unless $self->has_column($column);
return undef;
}
sub store_column {
my ($self, $column, $value) = @_;
- $self->throw( "No such column '${column}'" )
+ $self->throw_exception( "No such column '${column}'" )
unless exists $self->{_column_data}{$column} || $self->has_column($column);
- $self->throw( "set_column called for ${column} without value" )
+ $self->throw_exception( "set_column called for ${column} without value" )
if @_ < 3;
return $self->{_column_data}{$column} = $value;
}
my $schema;
PRE: foreach my $pre (keys %{$prefetch||{}}) {
my $pre_source = $source->related_source($pre);
- croak "Can't prefetch non-existant relationship ${pre}" unless $pre_source;
+ $class->throw_exception("Can't prefetch non-existant relationship ${pre}") unless $pre_source;
my $fetched = $pre_source->result_class->inflate_result(
$pre_source, @{$prefetch->{$pre}});
my $accessor = $source->relationship_info($pre)->{attrs}{accessor};
- $class->throw("No accessor for prefetched $pre")
+ $class->throw_exception("No accessor for prefetched $pre")
unless defined $accessor;
PRIMARY: foreach my $pri ($pre_source->primary_columns) {
unless (defined $fetched->get_column($pri)) {
} elsif ($accessor eq 'filter') {
$new->{_inflated_column}{$pre} = $fetched;
} else {
- $class->throw("Don't know how to store prefetched $pre");
+ $class->throw_exception("Don't know how to store prefetched $pre");
}
}
return $new;
$class->mk_group_accessors('column' => $col);
}
+
+=item throw_exception
+
+See Schema's throw_exception.
+
+=cut
+
+sub throw_exception {
+ my $self=shift;
+ if (ref $self && ref $self->result_source) {
+ $self->result_source->schema->throw_exception(@_);
+ } else {
+ croak(@_);
+ }
+}
+
1;
=head1 AUTHORS
use strict;
use warnings;
-use Carp qw/croak/;
+use Carp::Clan qw/^DBIx::Class/;
use UNIVERSAL::require;
use base qw/DBIx::Class/;
-__PACKAGE__->load_components(qw/Exception/);
__PACKAGE__->mk_classdata('class_mappings' => {});
__PACKAGE__->mk_classdata('source_registrations' => {});
__PACKAGE__->mk_classdata('storage_type' => '::DBI');
# if we got here, they probably passed a full class name
my $mapped = $self->class_mappings->{$moniker};
- croak "Can't find source for ${moniker}"
+ $self->throw_exception("Can't find source for ${moniker}")
unless $mapped && exists $sreg->{$mapped};
return $sreg->{$mapped};
}
}
} else {
eval "require Module::Find;";
- $class->throw("No arguments to load_classes and couldn't load".
+ $class->throw_exception("No arguments to load_classes and couldn't load".
" Module::Find ($@)") if $@;
my @comp = map { substr $_, length "${class}::" } Module::Find::findallmod($class);
$comps_for{$class} = \@comp;
return $clone;
}
+=item throw_exception
+
+Defaults to using Carp::Clan to report errors from user perspective.
+
+=cut
+
+sub throw_exception {
+ my ($self) = shift;
+ croak @_;
+}
+
1;
=head1 AUTHORS
use SQL::Abstract::Limit;
use DBIx::Class::Storage::DBI::Cursor;
use IO::File;
+use Carp::Clan qw/DBIx::Class/;
BEGIN {
$new->transaction_depth(0);
if (defined($ENV{DBIX_CLASS_STORAGE_DBI_DEBUG}) &&
($ENV{DBIX_CLASS_STORAGE_DBI_DEBUG} =~ /=(.+)$/)) {
- $new->debugfh(IO::File->new($1, 'w')||die "Cannot open trace file $1");
+ $new->debugfh(IO::File->new($1, 'w')||croak "Cannot open trace file $1");
} else {
$new->debugfh(IO::File->new('>&STDERR'));
}
$self->debugfh->print("$sql: @bind\n") if $self->debug;
my $sth = $self->sth($sql,$op);
@bind = map { ref $_ ? ''.$_ : $_ } @bind; # stringify args
- my $rv = $sth->execute(@bind);
+ my $rv;
+ if ($sth) {
+ $rv = $sth->execute(@bind);
+ } else {
+ croak "'$sql' did not generate a statement.";
+ }
return (wantarray ? ($rv, $sth, @bind) : $rv);
}
sub insert {
my ($self, $ident, $to_insert) = @_;
- $self->throw( "Couldn't insert ".join(', ', map "$_ => $to_insert->{$_}", keys %$to_insert)." into ${ident}" )
+ croak( "Couldn't insert ".join(', ', map "$_ => $to_insert->{$_}", keys %$to_insert)." into ${ident}" )
unless ($self->_execute('insert' => [], $ident, $to_insert));
return $to_insert;
}
package DBIx::Class::UUIDColumns;
use base qw/DBIx::Class/;
-use Carp qw/croak/;
-
use Data::UUID;
__PACKAGE__->mk_classdata( 'uuid_auto_columns' => [] );
sub uuid_columns {
my $self = shift;
for (@_) {
- croak "column $_ doesn't exist" unless $self->has_column($_);
+ $self->throw_exception("column $_ doesn't exist") unless $self->has_column($_);
}
$self->uuid_auto_columns(\@_);
}
use warnings;
use base qw( DBIx::Class );
-use Carp qw( croak );
use English qw( -no_match_vars );
#local $^W = 0; # Silence C:D:I redefined sub errors.
my $module = shift;
eval("use $module");
- croak("Unable to load the validation module '$module' because $EVAL_ERROR") if ($EVAL_ERROR);
- croak("The '$module' module does not support the check method") if (!$module->can('check'));
+ $class->throw_exception("Unable to load the validation module '$module' because $EVAL_ERROR") if ($EVAL_ERROR);
+ $class->throw_exception("The '$module' module does not support the check method") if (!$module->can('check'));
$class->_validation_module_accessor( $module );
}
my $profile = $self->validation_profile();
my $result = $module->check( \%data => $profile );
return $result if ($result->success());
- croak( $result );
+ $self->throw_exception( $result );
}
sub insert {
__PACKAGE__->columns qw/this doesnt work as expected/;
};
-like($@,qr/^columns\(\) is a read-only/,
+like($@,qr/\bcolumns\(\) is a read-only/,
"columns() error when apparently misused");
projects / dbsrgits/DBIx-Class.git / commitdiff