perl_version '5.006001';
all_from 'lib/DBIx/Class.pm';
-requires 'DBD::SQLite' => 1.25;
-requires 'Data::Page' => 2.00;
-requires 'SQL::Abstract' => 1.56;
-requires 'SQL::Abstract::Limit' => 0.13;
-requires 'Class::C3::Componentised' => 1.0005;
-requires 'Carp::Clan' => 6.0;
-requires 'DBI' => 1.605;
-requires 'Module::Find' => 0.06;
-requires 'Class::Inspector' => 1.24;
-requires 'Class::Accessor::Grouped' => 0.08003;
-requires 'JSON::Any' => 1.18;
-requires 'Scope::Guard' => 0.03;
-requires 'Path::Class' => 0.16;
-requires 'Sub::Name' => 0.04;
-requires 'MRO::Compat' => 0.09;
+
+test_requires 'Test::Builder' => 0.33;
+test_requires 'Test::Deep' => 0;
+test_requires 'Test::Exception' => 0;
+test_requires 'Test::More' => 0.82;
+test_requires 'Test::Warn' => 0.11;
# Core
requires 'List::Util' => 0;
# Perl 5.8.0 doesn't have utf8::is_utf8()
requires 'Encode' => 0 if ($] <= 5.008000);
-test_requires 'Test::More' => 0.82;
-test_requires 'Test::Builder' => 0.33;
-test_requires 'Test::Warn' => 0.11;
-test_requires 'Test::Exception' => 0;
-test_requires 'Test::Deep' => 0;
+# Dependencies (keep in alphabetical order)
+requires 'Carp::Clan' => 6.0;
+requires 'Class::Accessor::Grouped' => 0.08003;
+requires 'Class::C3::Componentised' => 1.0005;
+requires 'Class::Inspector' => 1.24;
+requires 'Data::Page' => 2.00;
+requires 'DBD::SQLite' => 1.25;
+requires 'DBI' => 1.605;
+requires 'JSON::Any' => 1.18;
+requires 'MRO::Compat' => 0.09;
+requires 'Module::Find' => 0.06;
+requires 'Path::Class' => 0.16;
+requires 'Scope::Guard' => 0.03;
+requires 'SQL::Abstract' => 1.56;
+requires 'SQL::Abstract::Limit' => 0.13;
+requires 'Sub::Name' => 0.04;
recommends 'SQL::Translator' => 0.09004;
'Test::Memory::Cycle' => 0,
'Devel::Cycle' => 1.10,
- # t/inflate/datetime*.t
- # t/72.pg
# t/36datetime.t
# t/60core.t
'DateTime::Format::SQLite' => 0,
- 'DateTime::Format::MySQL' => 0,
- 'DateTime::Format::Pg' => 0,
# t/96_is_deteministic_value.t
- 'DateTime::Format::Strptime' => 0,
+ 'DateTime::Format::Strptime'=> 0,
- # t/72pg.t
+ # t/93storage_replication.t
+ 'Moose', => 0.77,
+ 'MooseX::AttributeHelpers' => 0.12,
+ 'MooseX::Types', => 0.10,
+ 'namespace::clean' => 0.11,
+ 'Hash::Merge', => 0.11,
+
+ # database-dependent reqs
+ #
$ENV{DBICTEST_PG_DSN}
- ? ('Sys::SigAction'=> 0)
- : ()
+ ? (
+ 'Sys::SigAction' => 0,
+ 'DateTime::Format::Pg' => 0,
+ ) : ()
,
- # t/93storage_replication.t
- 'Moose', => 0.77,
- 'MooseX::AttributeHelpers' => 0.12,
- 'MooseX::Types', => 0.10,
- 'namespace::clean' => 0.11,
- 'Hash::Merge', => 0.11,
+ $ENV{DBICTEST_MYSQL_DSN}
+ ? (
+ 'DateTime::Format::MySQL' => 0,
+ ) : ()
+ ,
+ $ENV{DBICTEST_ORACLE_DSN}
+ ? (
+ 'DateTime::Format::Oracle' => 0,
+ ) : ()
+ ,
);
if ($Module::Install::AUTHOR) {
EOW
- foreach my $module (keys %force_requires_if_author) {
+ foreach my $module (sort keys %force_requires_if_author) {
build_requires ($module => $force_requires_if_author{$module});
}
use strict;
use warnings;
use base qw/My::Schema::Result::User/;
+
+ # This line is important
+ __PACKAGE__->table('users');
sub hello
{
return defined $lsib ? $lsib : 0;
}
-# an optimised method to get the last sibling position without inflating a row object
-sub _last_sibling_pos {
+# an optimized method to get the last sibling position value without inflating a row object
+sub _last_sibling_posval {
my $self = shift;
my $position_column = $self->position_column;
my $cursor = $self->next_siblings->search(
{},
- { rows => 1, order_by => { '-desc' => $position_column }, columns => $position_column },
+ { rows => 1, order_by => { '-desc' => $position_column }, select => $position_column },
)->cursor;
my ($pos) = $cursor->next;
sub move_next {
my $self = shift;
- return 0 unless $self->next_siblings->count;
+ return 0 unless defined $self->_last_sibling_posval; # quick way to check for no more siblings
return $self->move_to ($self->_position + 1);
}
sub move_last {
my $self = shift;
- return $self->move_to( $self->_group_rs->count );
+ my $last_posval = $self->_last_sibling_posval;
+
+ return 0 unless defined $last_posval;
+
+ return $self->move_to( $self->_position_from_value ($last_posval) );
}
=head2 move_to
$self->move_last;
$self->set_inflated_columns({ %$to_group, $position_column => undef });
- my $new_group_count = $self->_group_rs->count;
+ my $new_group_last_posval = $self->_last_sibling_posval;
+ my $new_group_last_position = $self->_position_from_value (
+ $new_group_last_posval
+ );
- if ( not defined($to_position) or $to_position > $new_group_count) {
+ if ( not defined($to_position) or $to_position > $new_group_last_position) {
$self->set_column(
- $position_column => $new_group_count
- ? $self->_next_position_value ( $self->_last_sibling_pos )
+ $position_column => $new_group_last_position
+ ? $self->_next_position_value ( $new_group_last_posval )
: $self->_initial_position_value
);
}
else {
my $bumped_pos_val = $self->_position_value ($to_position);
- my @between = ($to_position, $new_group_count);
+ my @between = ($to_position, $new_group_last_position);
$self->_shift_siblings (1, @between); #shift right
$self->set_column( $position_column => $bumped_pos_val );
}
my $position_column = $self->position_column;
unless ($self->get_column($position_column)) {
- my $lsib_pos = $self->_last_sibling_pos;
+ my $lsib_posval = $self->_last_sibling_posval;
$self->set_column(
- $position_column => (defined $lsib_pos
- ? $self->_next_position_value ( $lsib_pos )
+ $position_column => (defined $lsib_posval
+ ? $self->_next_position_value ( $lsib_posval )
: $self->_initial_position_value
)
);
return $self->get_column ($self->position_column);
}
+=head2 _position_from_value
+
+ my $num_pos = $item->_position_of_value ( $pos_value )
+
+Returns the B<absolute numeric position> of an object with a B<position
+value> set to C<$pos_value>. By default simply returns C<$pos_value>.
+
+=cut
+sub _position_from_value {
+ my ($self, $val) = @_;
+
+ return 0 unless defined $val;
+
+# #the right way to do this
+# return $self -> _group_rs
+# -> search({ $self->position_column => { '<=', $val } })
+# -> count
+
+ return $val;
+}
+
=head2 _position_value
my $pos_value = $item->_position_value ( $pos )
"' has no such relationship $rel")
unless $rel_info;
- my ($from,$seen) = $self->_resolve_from($rel);
+ my ($from,$seen) = $self->_chain_relationship($rel);
my $join_count = $seen->{$rel};
my $alias = ($join_count > 1 ? join('_', $rel, $join_count) : $rel);
# in order to properly resolve prefetch aliases (any alias
# with a relation_chain_depth less than the depth of the
# current prefetch is not considered)
-sub _resolve_from {
+sub _chain_relationship {
my ($self, $rel) = @_;
my $source = $self->result_source;
my $attrs = $self->{attrs};
# ->_resolve_join as otherwise they get lost - captainL
my $merged = $self->_merge_attr( $attrs->{join}, $attrs->{prefetch} );
- push @$from, $source->_resolve_join($merged, $attrs->{alias}, $seen) if ($merged);
+ my @requested_joins = $source->_resolve_join($merged, $attrs->{alias}, $seen);
+
+ push @$from, @requested_joins;
++$seen->{-relation_chain_depth};
- push @$from, $source->_resolve_join($rel, $attrs->{alias}, $seen);
+ # if $self already had a join/prefetch specified on it, the requested
+ # $rel might very well be already included. What we do in this case
+ # is effectively a no-op (except that we bump up the chain_depth on
+ # the join in question so we could tell it *is* the search_related)
+ my $already_joined;
+
+ # we consider the last one thus reverse
+ for my $j (reverse @requested_joins) {
+ if ($rel eq $j->[0]{-join_path}[-1]) {
+ $j->[0]{-relation_chain_depth}++;
+ $already_joined++;
+ last;
+ }
+ }
+ unless ($already_joined) {
+ push @$from, $source->_resolve_join($rel, $attrs->{alias}, $seen);
+ }
++$seen->{-relation_chain_depth};
}
return unless $f_source; # Can't test rel without f_source
- eval { $self->_resolve_join($rel, 'me') };
+ eval { $self->_resolve_join($rel, 'me', {}) };
if ($@) { # If the resolve failed, back out and re-throw the error
delete $rels{$rel}; #
$self->throw_exception("No idea how to resolve join reftype ".ref $join);
} else {
+ return() unless defined $join;
+
my $count = ++$seen->{$join};
my $as = ($count > 1 ? "${join}_${count}" : $join);
else { # do a numeric comparison if datatype allows it
my $colinfo = $self->column_info ($column);
- # cache for speed
- if (not defined $colinfo->{is_numeric}) {
+ # cache for speed (the object may *not* have a resultsource instance)
+ if (not defined $colinfo->{is_numeric} && $self->_source_handle) {
$colinfo->{is_numeric} =
$self->result_source->schema->storage->is_datatype_numeric ($colinfo->{data_type})
? 1
use List::Util();
__PACKAGE__->mk_group_accessors('simple' =>
- qw/_connect_info _dbi_connect_info _dbh _sql_maker _sql_maker_opts
- _conn_pid _conn_tid transaction_depth _dbh_autocommit savepoints/
+ qw/_connect_info _dbi_connect_info _dbh _sql_maker _sql_maker_opts
+ _conn_pid _conn_tid transaction_depth _dbh_autocommit savepoints/
);
# the values for these accessors are picked out (and deleted) from
# the attribute hashref passed to connect_info
my @storage_options = qw/
- on_connect_do on_disconnect_do disable_sth_caching unsafe auto_savepoint
+ on_connect_call on_disconnect_call on_connect_do on_disconnect_do
+ disable_sth_caching unsafe auto_savepoint
/;
__PACKAGE__->mk_group_accessors('simple' => @storage_options);
Note, this only runs if you explicitly call L</disconnect> on the
storage object.
+=item on_connect_call
+
+A more generalized form of L</on_connect_do> that calls the specified
+C<connect_call_METHOD> methods in your storage driver.
+
+ on_connect_do => 'select 1'
+
+is equivalent to:
+
+ on_connect_call => [ [ do_sql => 'select 1' ] ]
+
+Its values may contain:
+
+=over
+
+=item a scalar
+
+Will call the C<connect_call_METHOD> method.
+
+=item a code reference
+
+Will execute C<< $code->($storage) >>
+
+=item an array reference
+
+Each value can be a method name or code reference.
+
+=item an array of arrays
+
+For each array, the first item is taken to be the C<connect_call_> method name
+or code reference, and the rest are parameters to it.
+
+=back
+
+Some predefined storage methods you may use:
+
+=over
+
+=item do_sql
+
+Executes a SQL string or a code reference that returns a SQL string. This is
+what L</on_connect_do> and L</on_disconnect_do> use.
+
+It can take:
+
+=over
+
+=item a scalar
+
+Will execute the scalar as SQL.
+
+=item an arrayref
+
+Taken to be arguments to L<DBI/do>, the SQL string optionally followed by the
+attributes hashref and bind values.
+
+=item a code reference
+
+Will execute C<< $code->($storage) >> and execute the return array refs as
+above.
+
+=back
+
+=item datetime_setup
+
+Execute any statements necessary to initialize the database session to return
+and accept datetime/timestamp values used with
+L<DBIx::Class::InflateColumn::DateTime>.
+
+Only necessary for some databases, see your specific storage driver for
+implementation details.
+
+=back
+
+=item on_disconnect_call
+
+Takes arguments in the same form as L</on_connect_call> and executes them
+immediately before disconnecting from the database.
+
+Calls the C<disconnect_call_METHOD> methods as opposed to the
+C<connect_call_METHOD> methods called by L</on_connect_call>.
+
+Note, this only runs if you explicitly call L</disconnect> on the
+storage object.
+
=item disable_sth_caching
If set to a true value, this option will disable the caching of
This method is deprecated in favour of setting via L</connect_info>.
+=cut
+
+=head2 on_disconnect_do
+
+This method is deprecated in favour of setting via L</connect_info>.
+
+=cut
+
+sub _parse_connect_do {
+ my ($self, $type) = @_;
+
+ my $val = $self->$type;
+ return () if not defined $val;
+
+ my @res;
+
+ if (not ref($val)) {
+ push @res, [ 'do_sql', $val ];
+ } elsif (ref($val) eq 'CODE') {
+ push @res, $val;
+ } elsif (ref($val) eq 'ARRAY') {
+ push @res, map { [ 'do_sql', $_ ] } @$val;
+ } else {
+ $self->throw_exception("Invalid type for $type: ".ref($val));
+ }
+
+ return \@res;
+}
=head2 dbh_do
my ($self) = @_;
if( $self->connected ) {
- my $connection_do = $self->on_disconnect_do;
- $self->_do_connection_actions($connection_do) if ref($connection_do);
+ my @actions;
+
+ push @actions, ( $self->on_disconnect_call || () );
+ push @actions, $self->_parse_connect_do ('on_disconnect_do');
+
+ $self->_do_connection_actions(disconnect_call_ => $_) for @actions;
$self->_dbh->rollback unless $self->_dbh_autocommit;
$self->_dbh->disconnect;
sub _sql_maker_args {
my ($self) = @_;
-
+
return ( bindtype=>'columns', array_datatypes => 1, limit_dialect => $self->dbh, %{$self->_sql_maker_opts} );
}
# there is no transaction in progress by definition
$self->{transaction_depth} = $self->_dbh_autocommit ? 0 : 1;
- my $connection_do = $self->on_connect_do;
- $self->_do_connection_actions($connection_do) if $connection_do;
+ my @actions;
+
+ push @actions, ( $self->on_connect_call || () );
+ push @actions, $self->_parse_connect_do ('on_connect_do');
+
+ $self->_do_connection_actions(connect_call_ => $_) for @actions;
}
sub _determine_driver {
}
sub _do_connection_actions {
- my $self = shift;
- my $connection_do = shift;
-
- if (!ref $connection_do) {
- $self->_do_query($connection_do);
- }
- elsif (ref $connection_do eq 'ARRAY') {
- $self->_do_query($_) foreach @$connection_do;
- }
- elsif (ref $connection_do eq 'CODE') {
- $connection_do->($self);
- }
- else {
- $self->throw_exception (sprintf ("Don't know how to process conection actions of type '%s'", ref $connection_do) );
+ my $self = shift;
+ my $method_prefix = shift;
+ my $call = shift;
+
+ if (not ref($call)) {
+ my $method = $method_prefix . $call;
+ $self->$method(@_);
+ } elsif (ref($call) eq 'CODE') {
+ $self->$call(@_);
+ } elsif (ref($call) eq 'ARRAY') {
+ if (ref($call->[0]) ne 'ARRAY') {
+ $self->_do_connection_actions($method_prefix, $_) for @$call;
+ } else {
+ $self->_do_connection_actions($method_prefix, @$_) for @$call;
+ }
+ } else {
+ $self->throw_exception (sprintf ("Don't know how to process conection actions of type '%s'", ref($call)) );
}
return $self;
}
+sub connect_call_do_sql {
+ my $self = shift;
+ $self->_do_query(@_);
+}
+
+sub disconnect_call_do_sql {
+ my $self = shift;
+ $self->_do_query(@_);
+}
+
+# override in db-specific backend when necessary
+sub connect_call_datetime_setup { 1 }
+
sub _do_query {
my ($self, $action) = @_;
sub datetime_parser_type { return "DateTime::Format::Oracle"; }
+=head2 connect_call_datetime_setup
+
+Used as:
+
+ on_connect_call => 'datetime_setup'
+
+In L<DBIx::Class::Storage::DBI/connect_info> to set the session nls date, and
+timestamp values for use with L<DBIx::Class::InflateColumn::DateTime> and the
+necessary environment variables for L<DateTime::Format::Oracle>, which is used
+by it.
+
+Maximum allowable precision is used, unless the environment variables have
+already been set.
+
+These are the defaults used:
+
+ $ENV{NLS_DATE_FORMAT} ||= 'YYYY-MM-DD HH24:MI:SS';
+ $ENV{NLS_TIMESTAMP_FORMAT} ||= 'YYYY-MM-DD HH24:MI:SS.FF';
+ $ENV{NLS_TIMESTAMP_TZ_FORMAT} ||= 'YYYY-MM-DD HH24:MI:SS.FF TZHTZM';
+
+To get more than second precision with L<DBIx::Class::InflateColumn::DateTime>
+for your timestamps, use something like this:
+
+ use Time::HiRes 'time';
+ my $ts = DateTime->from_epoch(epoch => time);
+
+=cut
+
+sub connect_call_datetime_setup {
+ my $self = shift;
+ my $dbh = $self->dbh;
+
+ my $date_format = $ENV{NLS_DATE_FORMAT} ||= 'YYYY-MM-DD HH24:MI:SS';
+ my $timestamp_format = $ENV{NLS_TIMESTAMP_FORMAT} ||=
+ 'YYYY-MM-DD HH24:MI:SS.FF';
+ my $timestamp_tz_format = $ENV{NLS_TIMESTAMP_TZ_FORMAT} ||=
+ 'YYYY-MM-DD HH24:MI:SS.FF TZHTZM';
+
+ $dbh->do("alter session set nls_date_format = '$date_format'");
+ $dbh->do("alter session set nls_timestamp_format = '$timestamp_format'");
+ $dbh->do("alter session set nls_timestamp_tz_format='$timestamp_tz_format'");
+}
+
sub _svp_begin {
my ($self, $name) = @_;
' as well as following sequences: \'pkid1_seq\', \'pkid2_seq\' and \'nonpkid_seq\''
unless ($dsn && $user && $pass);
-plan tests => 34;
+plan tests => 35;
DBICTest::Schema->load_classes('ArtistFQN');
my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
is( $new->artistid, 2, "Oracle Auto-PK worked with fully-qualified tablename" );
# test join with row count ambiguity
+
my $cd = $schema->resultset('CD')->create({ cdid => 1, artist => 1, title => 'EP C', year => '2003' });
-my $track = $schema->resultset('Track')->create({ trackid => 1, cd => 1, position => 1, title => 'Track1' });
+my $track = $schema->resultset('Track')->create({ trackid => 1, cd => 1,
+ position => 1, title => 'Track1' });
my $tjoin = $schema->resultset('Track')->search({ 'me.title' => 'Track1'},
{ join => 'cd',
rows => 2 }
);
-is($tjoin->next->title, 'Track1', "ambiguous column ok");
+ok(my $row = $tjoin->next);
+
+is($row->title, 'Track1', "ambiguous column ok");
# check count distinct with multiple columns
my $other_track = $schema->resultset('Track')->create({ trackid => 2, cd => 1, position => 1, title => 'Track2' });
my $rs3 = $rs2->search_related('cds');
-cmp_ok(scalar($rs3->all), '==', 45, "All cds for artist returned");
+cmp_ok(scalar($rs3->all), '==', 15, "All cds for artist returned");
-cmp_ok($rs3->count, '==', 45, "All cds for artist returned via count");
+cmp_ok($rs3->count, '==', 15, "All cds for artist returned via count");
my $rs4 = $schema->resultset("CD")->search({ 'artist.artistid' => '1' }, { join => ['tracks', 'artist'], prefetch => 'artist' });
my @rs4_results = $rs4->all;
--- /dev/null
+use strict;
+use warnings;
+no warnings qw/once redefine/;
+
+use lib qw(t/lib);
+use DBICTest;
+
+use Test::More tests => 9;
+
+my $schema = DBICTest->init_schema(
+ no_connect => 1,
+ no_deploy => 1,
+);
+
+local *DBIx::Class::Storage::DBI::connect_call_foo = sub {
+ isa_ok $_[0], 'DBIx::Class::Storage::DBI',
+ 'got storage in connect_call method';
+ is $_[1], 'bar', 'got param in connect_call method';
+};
+
+local *DBIx::Class::Storage::DBI::disconnect_call_foo = sub {
+ isa_ok $_[0], 'DBIx::Class::Storage::DBI',
+ 'got storage in disconnect_call method';
+};
+
+ok $schema->connection(
+ DBICTest->_database,
+ {
+ on_connect_call => [
+ [ do_sql => 'create table test1 (id integer)' ],
+ [ do_sql => [ 'insert into test1 values (?)', {}, 1 ] ],
+ [ do_sql => sub { ['insert into test1 values (2)'] } ],
+ [ sub { $_[0]->dbh->do($_[1]) }, 'insert into test1 values (3)' ],
+ # this invokes $storage->connect_call_foo('bar') (above)
+ [ foo => 'bar' ],
+ ],
+ on_connect_do => 'insert into test1 values (4)',
+ on_disconnect_call => 'foo',
+ },
+), 'connection()';
+
+is_deeply (
+ $schema->storage->dbh->selectall_arrayref('select * from test1'),
+ [ [ 1 ], [ 2 ], [ 3 ], [ 4 ] ],
+ 'on_connect_call/do actions worked'
+);
+
+local *DBIx::Class::Storage::DBI::connect_call_foo = sub {
+ isa_ok $_[0], 'DBIx::Class::Storage::DBI',
+ 'got storage in connect_call method';
+};
+
+local *DBIx::Class::Storage::DBI::connect_call_bar = sub {
+ isa_ok $_[0], 'DBIx::Class::Storage::DBI',
+ 'got storage in connect_call method';
+};
+
+$schema->storage->disconnect;
+
+ok $schema->connection(
+ DBICTest->_database,
+ {
+ # method list form
+ on_connect_call => [ 'foo', sub { ok 1, "coderef in list form" }, 'bar' ],
+ },
+), 'connection()';
+
+$schema->storage->ensure_connected;
plan skip_all => 'needs DateTime and DateTime::Format::Oracle for testing';
}
else {
- plan tests => 7;
+ plan tests => 10;
}
}
is( $track->last_updated_on->month, $dt->month, "deflate ok");
is( int $track->last_updated_at->nanosecond, int $dt->nanosecond, "deflate ok with nanosecond precision");
+# test datetime_setup
+
+$schema->storage->disconnect;
+
+delete $ENV{NLS_DATE_FORMAT};
+delete $ENV{NLS_TIMESTAMP_FORMAT};
+
+$schema->connection($dsn, $user, $pass, {
+ on_connect_call => 'datetime_setup'
+});
+
+$dt = DateTime->now();
+
+my $timestamp = $dt->clone;
+$timestamp->set_nanosecond( int 500_000_000 );
+
+$track = $schema->resultset('Track')->find( 1 );
+$track->update({ last_updated_on => $dt, last_updated_at => $timestamp });
+
+$track = $schema->resultset('Track')->find(1);
+
+is( $track->last_updated_on, $dt, 'DateTime round-trip as DATE' );
+is( $track->last_updated_at, $timestamp, 'DateTime round-trip as TIMESTAMP' );
+
+is( int $track->last_updated_at->nanosecond, int 500_000_000,
+ 'TIMESTAMP nanoseconds survived' );
+
# clean up our mess
END {
- if($dbh) {
+ if($schema && ($dbh = $schema->storage->dbh)) {
$dbh->do("DROP TABLE track");
}
}
my $cd2 = $schema->resultset('CD')->search ( { cdid => { '!=', $cd->cdid } }, {rows => 1} )->single; # retrieve a cd different from the first
$cd2->add_to_producers ({name => 'new m2m producer'}); # attach to an existing producer
- ok ($cd2->producers->find ({name => 'new m2m producer'}), 'Exsiting producer attached to existing cd');
+ ok ($cd2->producers->find ({name => 'new m2m producer'}), 'Existing producer attached to existing cd');
}, 'Test far-end find_or_create over many_to_many');
--- /dev/null
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+
+plan tests => 5;
+
+my $schema = DBICTest->init_schema();
+
+my $cd_rs = $schema->resultset('CD')->search (
+ { 'tracks.cd' => { '!=', undef } },
+ { prefetch => ['tracks', 'artist'] },
+);
+
+
+is($cd_rs->count, 5, 'CDs with tracks count');
+is($cd_rs->search_related('tracks')->count, 15, 'Tracks associated with CDs count (before SELECT()ing)');
+
+is($cd_rs->all, 5, 'Amount of CD objects with tracks');
+is($cd_rs->search_related('tracks')->count, 15, 'Tracks associated with CDs count (after SELECT()ing)');
+
+is($cd_rs->search_related ('tracks')->all, 15, 'Track objects associated with CDs (after SELECT()ing)');
use strict;
-use warnings;
+use warnings;
use Test::More;
use Test::Exception;
$tree_like = eval { $schema->resultset('TreeLike')->search(
{ 'children.id' => 3, 'children_2.id' => 6 },
- { join => [qw/children children/] }
+ { join => [qw/children children children/] }
)->search_related('children', { 'children_4.id' => 7 }, { prefetch => 'children' }
)->first->children->first; };
is(eval { $tree_like->name }, 'fong', 'Tree with multiple has_many joins ok');
-# test that collapsed joins don't get a _2 appended to the alias
-
-my $sql = '';
-$schema->storage->debugcb(sub { $sql = $_[1] });
-$schema->storage->debug(1);
-
-eval {
- my $row = $schema->resultset('Artist')->search_related('cds', undef, {
- join => 'tracks',
- prefetch => 'tracks',
- })->search_related('tracks')->first;
-};
-
-like( $sql, qr/^SELECT tracks_2\.trackid/, "join not collapsed for search_related" );
-
-$schema->storage->debug($orig_debug);
-$schema->storage->debugobj->callback(undef);
-
$rs = $schema->resultset('Artist');
$rs->create({ artistid => 4, name => 'Unknown singer-songwriter' });
$rs->create({ artistid => 5, name => 'Emo 4ever' });
projects / dbsrgits/DBIx-Class.git / commitdiff