'SQL::Abstract::Limit' => 0.033,
'DBD::SQLite' => 1.08,
'Tie::IxHash' => 0,
+ 'Storable' => 0,
},
create_makefile_pl => 'passthrough',
create_readme => 1,
Revision history for DBIx::Class\r
\r
+0.03\r
+ - Paging support\r
+ - Join support on search\r
+ - Prefetch support on search\r
+\r
0.02 2005-08-12 18:00:00\r
- Test fixes.\r
- Performance improvements.\r
use vars qw($VERSION);
use base qw/DBIx::Class::Componentised/;
-$VERSION = '0.02';
+$VERSION = '0.03';
1;
$class->add_relationship($rel, $f_class,
{ "foreign.${f_key}" => "self.${self_key}" },
{ accessor => 'multi',
+ join_type => 'LEFT',
($cascade ? ('cascade_delete' => 1) : ()),
%$args } );
return 1;
_aliases => { self => $from, foreign => $to },
_action => 'join',
};
- my $join = $from_class->storage->sql_maker->where(
+ my $join = $from_class->storage->sql_maker->_join_condition(
$from_class->resolve_condition($rel_obj->{cond}, $attrs) );
- $join =~ s/^\s*WHERE//i;
return $join;
}
#warn %{$f_class->_columns};
return unless eval { %{$f_class->_columns}; }; # Foreign class not loaded
- my %join = (%$attrs, _action => 'join',
- _aliases => { 'self' => 'me', 'foreign' => $rel },
- _classes => { 'me' => $class, $rel => $f_class });
- eval { $class->resolve_condition($cond, \%join) };
+ eval { $class->_resolve_join($rel, 'me') };
if ($@) { # If the resolve failed, back out and re-throw the error
delete $rels{$rel}; #
1;
}
+sub _resolve_join {
+ my ($class, $join, $alias) = @_;
+ if (ref $join eq 'ARRAY') {
+ return map { $class->_resolve_join($_, $alias) } @$join;
+ } elsif (ref $join eq 'HASH') {
+ return map { $class->_resolve_join($_, $alias),
+ $class->_relationships->{$_}{class}->_resolve_join($join->{$_}, $_) }
+ keys %$join;
+ } elsif (ref $join) {
+ $class->throw("No idea how to resolve join reftype ".ref $join);
+ } else {
+ my $rel_obj = $class->_relationships->{$join};
+ $class->throw("No such relationship ${join}") unless $rel_obj;
+ my $j_class = $rel_obj->{class};
+ my %join = (_action => 'join',
+ _aliases => { 'self' => $alias, 'foreign' => $join },
+ _classes => { $alias => $class, $join => $j_class });
+ my $j_cond = $j_class->resolve_condition($rel_obj->{cond}, \%join);
+ return [ { $join => $j_class->_table_name,
+ -join_type => $rel_obj->{attrs}{join_type} || '' }, $j_cond ];
+ }
+}
+
sub resolve_condition {
my ($self, $cond, $attrs) = @_;
if (ref $cond eq 'HASH') {
my $class = $attrs->{_classes}{$alias};
$self->throw("Unknown column $field on $class as $alias")
unless exists $class->_columns->{$field};
- my $ret = join('.', $alias, $field);
- # return { '=' => \$ret }; # SQL::Abstract doesn't handle this yet :(
- $ret = " = ${ret}";
- return \$ret;
+ return join('.', $alias, $field);
} else {
$self->throw( "Unable to resolve type ${type}: only have aliases for ".
join(', ', keys %{$attrs->{_aliases} || {}}) );
#use Data::Dumper; warn Dumper(@_);
$it_class = ref $it_class if ref $it_class;
$attrs = { %{ $attrs || {} } };
- my $cols = [ $db_class->_select_columns ];
+ my %seen;
+ $attrs->{cols} ||= [ map { "me.$_" } $db_class->_select_columns ];
+ $attrs->{from} ||= [ { 'me' => $db_class->_table_name } ];
+ if ($attrs->{join}) {
+ foreach my $j (ref $attrs->{join} eq 'ARRAY'
+ ? (@{$attrs->{join}}) : ($attrs->{join})) {
+ if (ref $j eq 'HASH') {
+ $seen{$_} = 1 foreach keys %$j;
+ } else {
+ $seen{$j} = 1;
+ }
+ }
+ push(@{$attrs->{from}}, $db_class->_resolve_join($attrs->{join}, 'me'));
+ }
+ foreach my $pre (@{$attrs->{prefetch} || []}) {
+ push(@{$attrs->{from}}, $db_class->_resolve_join($pre, 'me'))
+ unless $seen{$pre};
+ push(@{$attrs->{cols}},
+ map { "$pre.$_" }
+ $db_class->_relationships->{$pre}->{class}->columns);
+ }
my $new = {
class => $db_class,
- cols => $cols,
+ cols => $attrs->{cols} || [ $db_class->_select_columns ],
cond => $attrs->{where},
+ from => $attrs->{from} || $db_class->_table_name,
count => undef,
pager => undef,
attrs => $attrs };
$attrs->{offset} = $self->pager->skipped;
}
return $self->{cursor}
- ||= $db_class->storage->select($db_class->_table_name, $self->{cols},
+ ||= $db_class->storage->select($self->{from}, $self->{cols},
$attrs->{where},$attrs);
}
my ($self) = @_;
my @row = $self->cursor->next;
return unless (@row);
- return $self->{class}->_row_to_object($self->{cols}, \@row);
+ return $self->_construct_object(@row);
+}
+
+sub _construct_object {
+ my ($self, @row) = @_;
+ my @cols = $self->{class}->_select_columns;
+ unless ($self->{attrs}{prefetch}) {
+ return $self->{class}->_row_to_object(\@cols, \@row);
+ } else {
+ my @main = splice(@row, 0, scalar @cols);
+ my $new = $self->{class}->_row_to_object(\@cols, \@main);
+ PRE: foreach my $pre (@{$self->{attrs}{prefetch}}) {
+ my $rel_obj = $self->{class}->_relationships->{$pre};
+ my @pre_cols = $rel_obj->{class}->columns;
+ my @vals = splice(@row, 0, scalar @pre_cols);
+ my $fetched = $rel_obj->{class}->_row_to_object(\@pre_cols, \@vals);
+ $self->{class}->throw("No accessor for prefetched $pre")
+ unless defined $rel_obj->{attrs}{accessor};
+ if ($rel_obj->{attrs}{accessor} eq 'single') {
+ foreach my $pri ($rel_obj->{class}->primary_columns) {
+ next PRE unless defined $fetched->get_column($pri);
+ }
+ $new->{_relationship_data}{$pre} = $fetched;
+ } elsif ($rel_obj->{attrs}{accessor} eq 'filter') {
+ $new->{_inflated_column}{$pre} = $fetched;
+ } else {
+ $self->{class}->throw("Don't know to to store prefetched $pre");
+ }
+ }
+ return $new;
+ }
}
sub count {
delete $attrs->{$_} for qw/offset order_by/;
my @cols = 'COUNT(*)';
- $self->{count} = $db_class->storage->select_single($db_class->_table_name, \@cols,
+ $self->{count} = $db_class->storage->select_single($self->{from}, \@cols,
$self->{cond}, $attrs);
}
return 0 unless $self->{count};
sub all {
my ($self) = @_;
- return map { $self->{class}->_row_to_object($self->{cols}, $_); }
+ return map { $self->_construct_object(@$_); }
$self->cursor->all;
}
use SQL::Abstract::Limit;
use DBIx::Class::Storage::DBI::Cursor;
+BEGIN {
+
+package DBIC::SQL::Abstract; # Temporary. Merge upstream.
+
+use base qw/SQL::Abstract::Limit/;
+
+sub select {
+ my ($self, $ident, @rest) = @_;
+ return $self->SUPER::select($self->from($ident), @rest);
+}
+
+sub from {
+ my ($self, $from) = @_;
+ if (ref $from eq 'ARRAY') {
+ return $self->_recurse_from(@$from);
+ } elsif (ref $from eq 'HASH') {
+ return $self->_make_as($from);
+ } else {
+ return $from;
+ }
+}
+
+sub _recurse_from {
+ my ($self, $from, @join) = @_;
+ my @sqlf;
+ push(@sqlf, $self->_make_as($from));
+ foreach my $j (@join) {
+ my ($to, $on) = @$j;
+
+ # check whether a join type exists
+ my $join_clause = '';
+ if (ref($to) eq 'HASH' and exists($to->{-join_type})) {
+ $join_clause = ' '.uc($to->{-join_type}).' JOIN ';
+ } else {
+ $join_clause = ' JOIN ';
+ }
+ push(@sqlf, $join_clause);
+
+ if (ref $to eq 'ARRAY') {
+ push(@sqlf, '(', $self->_recurse_from(@$to), ')');
+ } else {
+ push(@sqlf, $self->_make_as($to));
+ }
+ push(@sqlf, ' ON ', $self->_join_condition($on));
+ }
+ return join('', @sqlf);
+}
+
+sub _make_as {
+ my ($self, $from) = @_;
+ return join(' ', reverse each %{$self->_skip_options($from)});
+}
+
+sub _skip_options {
+ my ($self, $hash) = @_;
+ my $clean_hash = {};
+ $clean_hash->{$_} = $hash->{$_}
+ for grep {!/^-/} keys %$hash;
+ return $clean_hash;
+}
+
+sub _join_condition {
+ my ($self, $cond) = @_;
+ die "no chance" unless ref $cond eq 'HASH';
+ my %j;
+ for (keys %$cond) { my $x = '= '.$cond->{$_}; $j{$_} = \$x; };
+ return $self->_recurse_where(\%j);
+}
+
+} # End of BEGIN block
+
use base qw/DBIx::Class/;
__PACKAGE__->load_components(qw/Exception AccessorGroup/);
sub sql_maker {
my ($self) = @_;
unless ($self->_sql_maker) {
- $self->_sql_maker(new SQL::Abstract::Limit( limit_dialect => $self->dbh ));
+ $self->_sql_maker(new DBIC::SQL::Abstract( limit_dialect => $self->dbh ));
}
return $self->_sql_maker;
}
if (ref $condition eq 'SCALAR') {
$order = $1 if $$condition =~ s/ORDER BY (.*)$//i;
}
- $ident = $self->_build_from($ident) if ref $ident;
my @args = ('select', $attrs->{bind}, $ident, $select, $condition, $order);
if ($attrs->{software_limit} ||
$self->sql_maker->_default_limit_syntax eq "GenericSubQ") {
=head1 DESCRIPTION
-This provides a simple base class for DBIx::Class tests using SQLite.
-Each class for the test should inherit from this, provide a create_sql()
-method which returns a string representing the SQL used to create the
-table for the class, and then call set_table() to create the table, and
-tie it to the class.
+This provides a simple base class for DBIx::Class::CDBICompat tests using
+SQLite. Each class for the test should inherit from this, provide a
+create_sql() method which returns a string representing the SQL used to
+create the table for the class, and then call set_table() to create the
+table, and tie it to the class.
=cut
--- /dev/null
+use strict;
+use Test::More;
+
+BEGIN {
+ eval "use DBD::SQLite";
+ plan $@
+ ? ( skip_all => 'needs DBD::SQLite for testing' )
+ : ( tests => 21 );
+}
+
+use lib qw(t/lib);
+
+use_ok('DBICTest');
+
+# test the abstract join => SQL generator
+my $sa = new DBIC::SQL::Abstract;
+
+my @j = (
+ { child => 'person' },
+ [ { father => 'person' }, { 'father.person_id' => 'child.father_id' }, ],
+ [ { mother => 'person' }, { 'mother.person_id' => 'child.mother_id' } ],
+);
+my $match = 'person child JOIN person father ON ( father.person_id = '
+ . 'child.father_id ) JOIN person mother ON ( mother.person_id '
+ . '= child.mother_id )'
+ ;
+is( $sa->_recurse_from(@j), $match, 'join 1 ok' );
+
+my @j2 = (
+ { mother => 'person' },
+ [ [ { child => 'person' },
+ [ { father => 'person' },
+ { 'father.person_id' => 'child.father_id' }
+ ]
+ ],
+ { 'mother.person_id' => 'child.mother_id' }
+ ],
+);
+$match = 'person mother JOIN (person child JOIN person father ON ('
+ . ' father.person_id = child.father_id )) ON ( mother.person_id = '
+ . 'child.mother_id )'
+ ;
+is( $sa->_recurse_from(@j2), $match, 'join 2 ok' );
+
+my @j3 = (
+ { child => 'person' },
+ [ { father => 'person', -join_type => 'inner' }, { 'father.person_id' => 'child.father_id' }, ],
+ [ { mother => 'person', -join_type => 'inner' }, { 'mother.person_id' => 'child.mother_id' } ],
+);
+$match = 'person child INNER JOIN person father ON ( father.person_id = '
+ . 'child.father_id ) INNER JOIN person mother ON ( mother.person_id '
+ . '= child.mother_id )'
+ ;
+
+is( $sa->_recurse_from(@j3), $match, 'join 3 (inner join) ok');
+
+my $rs = DBICTest::CD->search(
+ { 'year' => 2001, 'artist.name' => 'Caterwauler McCrae' },
+ { from => [ { 'me' => 'cd' },
+ [
+ { artist => 'artist' },
+ { 'me.artist' => 'artist.artistid' }
+ ] ] }
+ );
+
+cmp_ok( $rs->count, '==', 1, "Single record in resultset");
+
+is($rs->first->title, 'Forkful of bees', 'Correct record returned');
+
+$rs = DBICTest::CD->search(
+ { 'year' => 2001, 'artist.name' => 'Caterwauler McCrae' },
+ { join => 'artist' });
+
+cmp_ok( $rs->count, '==', 1, "Single record in resultset");
+
+is($rs->first->title, 'Forkful of bees', 'Correct record returned');
+
+$rs = DBICTest::CD->search(
+ { 'artist.name' => 'We Are Goth',
+ 'liner_notes.notes' => 'Kill Yourself!' },
+ { join => [ qw/artist liner_notes/ ] });
+
+cmp_ok( $rs->count, '==', 1, "Single record in resultset");
+
+is($rs->first->title, 'Come Be Depressed With Us', 'Correct record returned');
+
+$rs = DBICTest::Artist->search(
+ { 'liner_notes.notes' => 'Kill Yourself!' },
+ { join => { 'cds' => 'liner_notes' } });
+
+cmp_ok( $rs->count, '==', 1, "Single record in resultset");
+
+is($rs->first->name, 'We Are Goth', 'Correct record returned');
+
+DBICTest::Schema::CD->add_relationship(
+ artist => 'DBICTest::Schema::Artist',
+ { 'foreign.artistid' => 'self.artist' },
+ { accessor => 'filter' },
+);
+
+DBICTest::Schema::CD->add_relationship(
+ liner_notes => 'DBICTest::Schema::LinerNotes',
+ { 'foreign.liner_id' => 'self.cdid' },
+ { join_type => 'LEFT', accessor => 'single' });
+
+
+$rs = DBICTest::CD->search(
+ { 'artist.name' => 'Caterwauler McCrae' },
+ { prefetch => [ qw/artist liner_notes/ ],
+ order_by => 'me.cdid' });
+
+cmp_ok($rs->count, '==', 3, 'Correct number of records returned');
+
+my @cd = $rs->all;
+
+is($cd[0]->title, 'Spoonful of bees', 'First record returned ok');
+
+ok(!exists $cd[0]->{_relationship_data}{liner_notes}, 'No prefetch for NULL LEFT JOIN');
+
+is($cd[1]->{_relationship_data}{liner_notes}->notes, 'Buy Whiskey!', 'Prefetch for present LEFT JOIN');
+
+is($cd[2]->{_inflated_column}{artist}->name, 'Caterwauler McCrae', 'Prefetch on parent object ok');
+
+my ($artist) = DBICTest::Artist->search({ 'cds.year' => 2001 },
+ { order_by => 'artistid DESC', join => 'cds' });
+
+is($artist->name, 'Random Boy Band', "Join search by object ok");
+
+my @cds = DBICTest::CD->search({ 'liner_notes.notes' => 'Buy Merch!' },
+ { join => 'liner_notes' });
+
+cmp_ok(scalar @cds, '==', 1, "Single CD retrieved via might_have");
+
+is($cds[0]->title, "Generic Manufactured Singles", "Correct CD retrieved");
+
+my @artists = DBICTest::Artist->search({ 'tags.tag' => 'Shiny' },
+ { join => { 'cds' => 'tags' } });
+
+cmp_ok( @artists, '==', 2, "two-join search ok" );
--- /dev/null
+use strict;
+use warnings;
+
+use Test::More;
+
+eval "use DBD::SQLite";
+plan skip_all => 'needs DBD::SQLite for testing' if $@;
+plan tests => 5;
+
+use lib 't/lib';
+
+use_ok('DBICTest');
+
+cmp_ok(DBICTest::CD->count({ 'artist.name' => 'Caterwauler McCrae' },
+ { join => 'artist' }),
+ '==', 3, 'Count by has_a ok');
+
+cmp_ok(DBICTest::CD->count({ 'tags.tag' => 'Blue' }, { join => 'tags' }),
+ '==', 4, 'Count by has_many ok');
+
+cmp_ok(DBICTest::CD->count(
+ { 'liner_notes.notes' => { '!=' => undef } },
+ { join => 'liner_notes' }),
+ '==', 3, 'Count by might_have ok');
+
+cmp_ok(DBICTest::CD->count(
+ { 'year' => { '>', 1998 }, 'tags.tag' => 'Cheesy',
+ 'liner_notes.notes' => { 'like' => 'Buy%' } },
+ { join => [ qw/tags liner_notes/ ] } ),
+ '==', 2, "Mixed count ok");
DBICTest::Schema::CD->set_primary_key('cdid');
DBICTest::Schema::CD->add_relationship(
artist => 'DBICTest::Schema::Artist',
- { 'foreign.artistid' => 'self.artist' }
+ { 'foreign.artistid' => 'self.artist' },
);
DBICTest::Schema::CD->add_relationship(
tracks => 'DBICTest::Schema::Track',
{ 'foreign.cd' => 'self.cdid' }
);
#DBICTest::Schema::CD->might_have(liner_notes => 'DBICTest::Schema::LinerNotes' => qw/notes/);
+DBICTest::Schema::CD->add_relationship(
+ liner_notes => 'DBICTest::Schema::LinerNotes',
+ { 'foreign.liner_id' => 'self.cdid' },
+ { join_type => 'LEFT' });
1;
projects / dbsrgits/DBIx-Class.git / commitdiff