},
create_makefile_pl => 'passthrough',
create_readme => 1,
- test_files => [ glob('t/*.t'), glob('t/*/*.t') ]
+ test_files => [ glob('t/*.t'), glob('t/*/*.t') ],
+ script_files => [ glob('script/*') ],
);
Module::Build->new(%arguments)->create_build_script;
{ prefetch => [qw/book/],
});
my @book_objs = $obj->books;
+ my $books_rs = $obj->books;
+ ( $books_rs ) = $obj->books_rs;
$obj->add_to_books(\%col_data);
columns. You should pass the name of the column in the foreign class as the
$cond argument, or specify a complete join condition.
-As well as the accessor method, a method named C<< add_to_<relname> >>
-will also be added to your Row items, this allows you to insert new
-related items, using the same mechanism as in L<DBIx::Class::Relationship::Base/"create_related">.
+Three methods are created when you create a has_many relationship. The first
+method is the expected accessor method. The second is almost exactly the same
+as the accessor method but "_rs" is added to the end of the method name. This
+method works just like the normal accessor, except that it returns a resultset
+no matter what, even in list context. The third method, named
+C<< add_to_<relname> >>, will also be added to your Row items, this allows
+you to insert new related items, using the same mechanism as in
+L<DBIx::Class::Relationship::Base/"create_related">.
If you delete an object in a class with a C<has_many> relationship, all
related objects will be deleted as well. However, any database-level
);
} elsif ($acc_type eq 'multi') {
$meth{$rel} = sub { shift->search_related($rel, @_) };
+ $meth{"${rel}_rs"} = sub { shift->search_related_rs($rel, @_) };
$meth{"add_to_${rel}"} = sub { shift->create_related($rel, @_); };
} else {
$class->throw_exception("No such relationship accessor type $acc_type");
=head2 search_related
- $rs->search_related('relname', $cond, $attrs);
+ @objects = $rs->search_related('relname', $cond, $attrs);
+ $objects_rs = $rs->search_related('relname', $cond, $attrs);
Run a search on a related resultset. The search will be restricted to the
item or items represented by the L<DBIx::Class::ResultSet> it was called
return shift->related_resultset(shift)->search(@_);
}
+=head2 search_related_rs
+
+ ( $objects_rs ) = $rs->search_related_rs('relname', $cond, $attrs);
+
+This method works exactly the same as search_related, except that
+it garauntees a restultset, even in list context.
+
+=cut
+
+sub search_related_rs {
+ return shift->related_resultset(shift)->search_rs(@_);
+}
+
=head2 count_related
$obj->count_related('relname', $cond, $attrs);
sub search {
my $self = shift;
-
+ my $rs = $self->search_rs( @_ );
+ return (wantarray ? $rs->all : $rs);
+}
+
+=head2 search_rs
+
+=over 4
+
+=item Arguments: $cond, \%attrs?
+
+=item Return Value: $resultset
+
+=back
+
+This method does the same exact thing as search() except it will
+always return a resultset, even in list context.
+
+=cut
+
+sub search_rs {
+ my $self = shift;
+
my $our_attrs = { %{$self->{attrs}} };
my $having = delete $our_attrs->{having};
my $attrs = {};
}
delete $attrs->{$key};
}
- $our_attrs = { %{$our_attrs}, %{$attrs} };
+ my $new_attrs = { %{$our_attrs}, %{$attrs} };
# merge new where and having into old
my $where = (@_
: {@_}))
: undef());
if (defined $where) {
- $our_attrs->{where} = (defined $our_attrs->{where}
+ $new_attrs->{where} = (defined $new_attrs->{where}
? { '-and' =>
[ map { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ }
- $where, $our_attrs->{where} ] }
+ $where, $new_attrs->{where} ] }
: $where);
}
if (defined $having) {
- $our_attrs->{having} = (defined $our_attrs->{having}
+ $new_attrs->{having} = (defined $new_attrs->{having}
? { '-and' =>
[ map { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ }
- $having, $our_attrs->{having} ] }
+ $having, $new_attrs->{having} ] }
: $having);
}
-# use Data::Dumper; warn "attrs: " . Dumper($our_attrs);
- my $rs = (ref $self)->new($self->result_source, $our_attrs);
+ my $rs = (ref $self)->new($self->result_source, $new_attrs);
$rs->{_parent_rs} = $self->{_parent_rs} if ($self->{_parent_rs}); #XXX - hack to pass through parent of related resultsets
unless (@_) { # no search, effectively just a clone
my $rows = $self->get_cache;
- if( @{$rows} ) {
+ if ($rows) {
$rs->set_cache($rows);
}
}
- return (wantarray ? $rs->all : $rs);
+ return $rs;
}
=head2 search_literal
$hash = {};
@{$hash}{@cols} = @_;
}
+ elsif (@_) {
+ # For backwards compatibility
+ $hash = {@_};
+ }
else {
$self->throw_exception(
"Arguments to find must be a hashref or match the number of columns in the "
- . exists $attrs->{key} ? "$attrs->{key} unique constraint" : "primary key"
+ . (exists $attrs->{key} ? "$attrs->{key} unique constraint" : "primary key")
);
}
sub next {
my ($self) = @_;
- if (@{$self->{all_cache} || []}) {
+ if (my $cache = $self->get_cache) {
$self->{all_cache_position} ||= 0;
- return $self->{all_cache}->[$self->{all_cache_position}++];
+ return $cache->[$self->{all_cache_position}++];
}
if ($self->{attrs}{cache}) {
$self->{all_cache_position} = 1;
$row = $self->{stashed_row} = \@raw;
$tree = $self->_collapse_result($as, $row, $c_prefix);
}
- @$target = @final;
+ @$target = (@final ? @final : [ {}, {} ]);
+ # single empty result to indicate an empty prefetched has_many
}
return $info;
}
sub count {
my $self = shift;
return $self->search(@_)->count if @_ and defined $_[0];
- return scalar @{ $self->get_cache } if @{ $self->get_cache };
+ return scalar @{ $self->get_cache } if $self->get_cache;
my $count = $self->_count;
return 0 unless $count;
sub all {
my ($self) = @_;
- return @{ $self->get_cache } if @{ $self->get_cache };
+ return @{ $self->get_cache } if $self->get_cache;
my @obj;
my $row = $self->find($hash, $attrs);
if (defined $row) {
- $row->set_columns($hash);
- $row->update;
+ $row->update($hash);
return $row;
}
=cut
sub get_cache {
- shift->{all_cache} || [];
+ shift->{all_cache};
}
=head2 set_cache
sub set_cache {
my ( $self, $data ) = @_;
$self->throw_exception("set_cache requires an arrayref")
- if ref $data ne 'ARRAY';
- my $result_class = $self->result_class;
- foreach( @$data ) {
- $self->throw_exception(
- "cannot cache object of type '$_', expected '$result_class'"
- ) if ref $_ ne $result_class;
- }
+ if defined($data) && (ref $data ne 'ARRAY');
$self->{all_cache} = $data;
}
=cut
sub clear_cache {
- shift->set_cache([]);
+ shift->set_cache(undef);
}
=head2 related_resultset
If the value is of the form C<1=/path/name> then the trace output is
written to the file C</path/name>.
+This environment variable is checked when the storage object is first
+created (when you call connect on your schema). So, run-time changes
+to this environment variable will not take effect unless you also
+re-connect on your schema.
+
=head1 AUTHORS
Matt S. Trout <mst@shadowcatsystems.co.uk>
print ''.ref($resultset).' ID: '.join(',',$obj->id())."\n";
}
elsif ($op eq 'update') {
- $resultset = $resultset->search( $where );
+ $resultset = $resultset->search( ($where||{}) );
my $count = $resultset->count();
print "This action will modify $count ".ref($resultset)." records.\n" if (!$quiet);
if ( $force || confirm() ) {
}
elsif ($op eq 'delete') {
die('Do not use the set option with the delete op') if ($set);
- $resultset = $resultset->search( $where, $attrs );
+ $resultset = $resultset->search( ($where||{}), ($attrs||()) );
my $count = $resultset->count();
print "This action will delete $count ".ref($resultset)." records.\n" if (!$quiet);
if ( $force || confirm() ) {
my $csv = $csv_class->new({
sep_char => ( $format eq 'tsv' ? "\t" : ',' ),
});
- $resultset = $resultset->search( $where, $attrs );
+ $resultset = $resultset->search( ($where||{}), ($attrs||()) );
my @columns = $resultset->result_source->columns();
$csv->combine( @columns );
print $csv->string()."\n";
--- /dev/null
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use DBICTest::BasicRels;
+
+require "t/run/146db2_400.tl";
+run_tests(DBICTest->schema);
--- /dev/null
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use DBICTest::HelperRels;
+
+require "t/run/146db2_400.tl";
+run_tests(DBICTest->schema);
sub run_tests {
my $schema = shift;
-plan tests => 57;
+plan tests => 59;
# figure out if we've got a version of sqlite that is older than 3.2.6, in
# which case COUNT(DISTINCT()) doesn't work
is($new_again->ID, 'DBICTest::Artist|artist|artistid=4', 'unique object id generated correctly');
+# Test backwards compatibility
+{
+ my $artist_by_hash = $schema->resultset('Artist')->find(artistid => 4);
+ is($artist_by_hash->name, 'Man With A Spoon', 'Retrieved correctly');
+ is($artist_by_hash->ID, 'DBICTest::Artist|artist|artistid=4', 'unique object id generated correctly');
+}
+
is($schema->resultset("Artist")->count, 4, 'count ok');
# test find_or_new
my $search = [ { 'tags.tag' => 'Cheesy' }, { 'tags.tag' => 'Blue' } ];
-my $or_rs = $schema->resultset("CD")->search($search, { join => 'tags',
+my( $or_rs ) = $schema->resultset("CD")->search_rs($search, { join => 'tags',
order_by => 'cdid' });
cmp_ok($or_rs->count, '==', 5, 'Search with OR ok');
use strict;
use warnings;
-plan tests => 30;
+plan tests => 32;
# has_a test
my $cd = $schema->resultset("CD")->find(4);
is( ($artist->search_related('cds'))[3]->title, 'Big Flop', 'create_related ok' );
+my( $rs_from_list ) = $artist->search_related_rs('cds');
+is( ref($rs_from_list), 'DBIx::Class::ResultSet', 'search_related_rs in list context returns rs' );
+
+( $rs_from_list ) = $artist->cds_rs();
+is( ref($rs_from_list), 'DBIx::Class::ResultSet', 'relation_rs in list context returns rs' );
+
# count_related
is( $artist->count_related('cds'), 4, 'count_related ok' );
--- /dev/null
+sub run_tests {
+my $schema = shift;
+
+my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_DB2_400_${_}" } qw/DSN USER PASS/};
+
+#warn "$dsn $user $pass";
+
+# Probably best to pass the DBQ option in the DSN to specify a specific
+# libray. Something like:
+# DBICTEST_DB2_400_DSN='dbi:ODBC:dsn=MyAS400;DBQ=MYLIB'
+plan skip_all, 'Set $ENV{DBICTEST_DB2_400_DSN}, _USER and _PASS to run this test'
+ unless ($dsn && $user);
+
+plan tests => 6;
+
+DBICTest::Schema->compose_connection('DB2Test' => $dsn, $user, $pass);
+
+my $dbh = DB2Test->schema->storage->dbh;
+
+$dbh->do("DROP TABLE artist", { RaiseError => 0, PrintError => 0 });
+
+$dbh->do("CREATE TABLE artist (artistid INTEGER GENERATED BY DEFAULT AS IDENTITY (START WITH 1, INCREMENT BY 1), name VARCHAR(255), charfield CHAR(10))");
+
+DB2Test::Artist->load_components('PK::Auto');
+
+# test primary key handling
+my $new = DB2Test::Artist->create({ name => 'foo' });
+ok($new->artistid, "Auto-PK worked");
+
+# test LIMIT support
+for (1..6) {
+ DB2Test::Artist->create({ name => 'Artist ' . $_ });
+}
+my $it = DB2Test::Artist->search( {},
+ { rows => 3,
+ order_by => 'artistid'
+ }
+);
+is( $it->count, 3, "LIMIT count ok" );
+is( $it->next->name, "foo", "iterator->next ok" );
+$it->next;
+is( $it->next->name, "Artist 2", "iterator->next ok" );
+is( $it->next, undef, "next past end of resultset ok" );
+
+my $test_type_info = {
+ 'artistid' => {
+ 'data_type' => 'INTEGER',
+ 'is_nullable' => 0,
+ 'size' => 10
+ },
+ 'name' => {
+ 'data_type' => 'VARCHAR',
+ 'is_nullable' => 1,
+ 'size' => 255
+ },
+ 'charfield' => {
+ 'data_type' => 'CHAR',
+ 'is_nullable' => 1,
+ 'size' => 10
+ },
+};
+
+
+my $type_info = DB2Test->schema->storage->columns_info_for('artist');
+is_deeply($type_info, $test_type_info, 'columns_info_for - column data types');
+
+
+
+# clean up our mess
+$dbh->do("DROP TABLE artist");
+
+}
+
+1;
eval "use DBD::SQLite";
plan skip_all => 'needs DBD::SQLite for testing' if $@;
-plan tests => 23;
+plan tests => 22;
my $rs = $schema->resultset("Artist")->search(
{ artistid => 1 }
my $artist = $rs->first;
-is( scalar @{ $rs->get_cache }, 0, 'cache is not populated without cache attribute' );
+ok( !defined($rs->get_cache), 'cache is not populated without cache attribute' );
$rs = $schema->resultset('Artist')->search( undef, { cache => 1 } );
my $artists = [ $rs->all ];
$rs->clear_cache;
-is( scalar @{$rs->get_cache}, 0, 'clear_cache is functional' );
+ok( !defined($rs->get_cache), 'clear_cache is functional' );
$rs->next;
$rs->clear_cache;
-eval {
- $rs->set_cache( [ $cd ] );
-};
-
-is( scalar @{$rs->get_cache}, 0, 'set_cache() only accepts objects of correct type for the resultset' );
-
$queries = 0;
$schema->storage->debug(1);
projects / dbsrgits/DBIx-Class.git / commitdiff