CDBICompat::LazyLoading
CDBICompat::AutoUpdate
CDBICompat::TempColumns
+ CDBICompat::Retrieve
CDBICompat::ColumnGroups
CDBICompat::ImaDBI/);
*{"${class}::${meth}"} =
sub {
my ($class, @args) = @_;
- return $class->retrieve_from_sql($sql, @args);
+ return $class->search_literal($sql, @args);
};
}
--- /dev/null
+package DBIx::Class::CDBICompat::Retrieve;
+
+use strict;
+use warnings FATAL => 'all';
+
+sub retrieve { shift->find(@_) }
+sub retrieve_all { shift->search_literal('1') }
+sub retrieve_from_sql { shift->search_literal(@_) }
+
+1;
$class->_primaries(\%pri);
}
-sub retrieve {
+sub find {
my ($class, @vals) = @_;
my $attrs = (@vals > 1 && ref $vals[$#vals] eq 'HASH' ? pop(@vals) : {});
my @pk = keys %{$class->_primaries};
- $class->throw( "Can't retrieve unless primary columns are defined" )
+ $class->throw( "Can't find unless primary columns are defined" )
unless @pk;
my $query;
if (ref $vals[0] eq 'HASH') {
$query = $vals[0];
} elsif (@pk == @vals) {
- my $ret = ($class->retrieve_from_sql($class->_ident_cond, @vals, $attrs))[0];
+ my $ret = ($class->search_literal($class->_ident_cond, @vals, $attrs))[0];
#warn "$class: ".join(', ', %{$ret->{_column_data}});
return $ret;
} else {
$query = {@vals};
}
- $class->throw( "Can't retrieve unless all primary keys are specified" )
+ $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
my $ret = ($class->search($query))[0];
my ($self) = @_;
delete $self->{_dirty_columns};
return unless $self->in_database; # Don't reload if we aren't real!
- my ($reload) = $self->retrieve($self->id);
+ my ($reload) = $self->find($self->id);
unless ($reload) { # If we got deleted in the mean-time
$self->in_database(0);
return $self;
sub search_related {
my $self = shift;
- return $self->_from_sql_related('retrieve', @_);
+ return $self->_literal_related('search', @_);
}
sub count_related {
my $self = shift;
- return $self->_from_sql_related('count', @_);
+ return $self->_literal_related('count', @_);
}
-sub _from_sql_related {
+sub _literal_related {
my $self = shift;
my $op = shift;
- my $meth = "${op}_from_sql";
+ my $meth = "${op}_literal";
my $rel = shift;
my $attrs = { };
if (@_ > 1 && ref $_[$#_] eq 'HASH') {
then in app code
- my @obj = My::DB::Foo->retrieve_all; # My::DB::Foo isa My::Schema::Foo My::DB
+ my @obj = My::DB::Foo->search({}); # My::DB::Foo isa My::Schema::Foo My::DB
=head1 DESCRIPTION
$class->_mk_column_accessors(@cols);
}
-=item retrieve_from_sql
+=item search_literal
- my @obj = $class->retrieve_from_sql($sql_where_cond, @bind);
- my $cursor = $class->retrieve_from_sql($sql_where_cond, @bind);
+ my @obj = $class->search_literal($literal_where_cond, @bind);
+ my $cursor = $class->search_literal($literal_where_cond, @bind);
=cut
-sub retrieve_from_sql {
+sub search_literal {
my ($class, $cond, @vals) = @_;
$cond =~ s/^\s*WHERE//i;
my $attrs = (ref $vals[$#vals] eq 'HASH' ? { %{ pop(@vals) } } : {});
return $class->search(\$cond, $attrs);
}
-=item count_from_sql
+=item count_literal
- my $count = $class->count($sql_where_cond);
+ my $count = $class->count_literal($literal_where_cond);
=cut
-sub count_from_sql {
+sub count_literal {
my ($class, $cond, @vals) = @_;
$cond =~ s/^\s*WHERE//i;
my $attrs = (ref $vals[$#vals] eq 'HASH' ? pop(@vals) : {});
return ($self->in_database ? $self->update : $self->insert);
}
-=item retrieve_all
-
- my @all = $class->retrieve_all;
-
-=cut
-
-sub retrieve_all {
- my ($class) = @_;
- return $class->retrieve_from_sql( '1' );
-}
-
=item is_changed
my @changed_col_names = $obj->is_changed
$new->update;
-$new_again = DBICTest::Artist->retrieve(4);
+$new_again = DBICTest::Artist->find(4);
is($new_again->name, 'Man With A Spoon', 'Retrieved correctly');
# test in update mode
$new->position(5);
$new->insert_or_update;
-is( DBICTest::Track->retrieve(100)->position, 5, 'insert_or_update update ok');
+is( DBICTest::Track->find(100)->position, 5, 'insert_or_update update ok');
} );
}
DBICTest::Artist->dbi_commit;
-my ($artist) = DBICTest::Artist->retrieve(15);
+my ($artist) = DBICTest::Artist->find(15);
is($artist->name, 'artist number 15', "Commit ok");
# repeat the test using AutoCommit = 1 to force the commit
} );
}
DBICTest::Artist->storage->dbh->{AutoCommit} = 1;
-($artist) = DBICTest::Artist->retrieve(20);
+($artist) = DBICTest::Artist->find(20);
is($artist->name, 'artist number 20', "Commit using AutoCommit ok");
# add some rows inside a transaction and roll it back
use_ok('DBICTest');
-ok(DBICTest::FourKeys->retrieve(1,2,3,4), "retrieve multiple pks without hash");
-ok(DBICTest::FourKeys->retrieve(5,4,3,6), "retrieve multiple pks without hash");
\ No newline at end of file
+ok(DBICTest::FourKeys->find(1,2,3,4), "find multiple pks without hash");
+ok(DBICTest::FourKeys->find(5,4,3,6), "find multiple pks without hash");
use_ok('DBICTest');
# has_a test
-my $cd = DBICTest::CD->retrieve(4);
+my $cd = DBICTest::CD->find(4);
my ($artist) = $cd->search_related('artist');
is($artist->name, 'Random Boy Band', 'has_a search_related ok');
# has_many test with an order_by clause defined
-$artist = DBICTest::Artist->retrieve(1);
+$artist = DBICTest::Artist->find(1);
is( ($artist->search_related('cds'))[1]->title, 'Spoonful of bees', 'has_many search_related with order_by ok' );
# search_related with additional abstract query
);
# inflation test
-my $cd = DBICTest::CD->retrieve(3);
+my $cd = DBICTest::CD->find(3);
is( ref($cd->year), 'DateTime', 'year is a DateTime, ok' );
);
# inflation test
-my $cd = DBICTest::CD->retrieve(3);
+my $cd = DBICTest::CD->find(3);
is( ref($cd->year), 'DateTime', 'year is a DateTime, ok' );
);
# inflation test
-$cd = DBICTest::CD->retrieve(3);
+$cd = DBICTest::CD->find(3);
is( ref($cd->year), 'DateTime', 'year is a DateTime, ok' );
use_ok('DBICTest');
-my $art = DBICTest::Artist->retrieve(1);
+my $art = DBICTest::Artist->find(1);
isa_ok $art => 'DBICTest::Artist';
{
package DieTest;
@DieTest::ISA = qw(DBIx::Class);
- DieTest->load_components(qw/Core/);
+ DieTest->load_components(qw/CDBICompat::Retrieve Core/);
package main;
local $SIG{__WARN__} = sub { };
eval { DieTest->retrieve(1) };
- like $@, qr/Can't retrieve unless primary columns are defined/, "Need primary key for retrieve";
+ like $@, qr/unless primary columns are defined/, "Need primary key for retrieve";
}
#-----------------------------------------------------------------------