Revision history for DBIx::Class
+ - Another fix for count with scalar group_by.
+
+0.05005 2006-02-13 21:24:51
+ - remove build dependency on version.pm
+
+0.05004 2006-02-13 20:59:00
+ - allow specification of related columns via cols attr when primary
+ keys of the related table are not fetched
+ - fix count for group_by as scalar
- add horrific fix to make Oracle's retarded limit syntax work
- - changed UUIDColumns to use new UUIDMaker classes for uuid creation
- using whatever module may be available
+ - remove Carp require
0.05003 2006-02-08 17:50:20
- add component_class accessors and use them for *_class
t/20setuperrors.t
t/30dbicplain.t
t/40resultsetmanager.t
+t/41orrible.t
t/basicrels/01core.t
t/basicrels/04db.t
t/basicrels/05multipk.t
# i.e. first release of 0.XX *must* be 0.XX000. This avoids fBSD ports
# brain damage and presumably various other packaging systems too
-$VERSION = '0.05003';
+$VERSION = '0.05005';
sub MODIFY_CODE_ATTRIBUTES {
my ($class,$code,@attrs) = @_;
Brandon Black
-Christopher H. Laco
+Scotty Allen <scotty@scottyallen.com>
=head1 LICENSE
unless (@_) {
my $caller = caller;
- require Carp;
croak("'$caller' cannot access the value of '$field' on ".
"objects of class '$class'");
}
my $group_by;
my $select = { 'count' => '*' };
if( $group_by = delete $self->{attrs}{group_by} ) {
- my @distinct = @$group_by;
+ my @distinct = (ref $group_by ? @$group_by : ($group_by));
# todo: try CONCAT for multi-column pk
my @pk = $self->result_source->primary_columns;
if( scalar(@pk) == 1 ) {
my $pk = shift(@pk);
my $alias = $self->{attrs}{alias};
my $re = qr/^($alias\.)?$pk$/;
- foreach my $column ( @$group_by ) {
+ foreach my $column ( @distinct) {
if( $column =~ $re ) {
@distinct = ( $column );
last;
$new->{_columns} = { %{$new->{_columns}||{}} };
$new->{_relationships} = { %{$new->{_relationships}||{}} };
$new->{name} ||= "!!NAME NOT SET!!";
+ $new->{_columns_info_loaded} ||= 0;
return $new;
}
my ($self, $column) = @_;
$self->throw_exception("No such column $column")
unless exists $self->_columns->{$column};
- if ( (! $self->_columns->{$column}->{data_type})
+ #warn $self->{_columns_info_loaded}, "\n";
+ if ( ! $self->_columns->{$column}->{data_type}
+ && ! $self->{_columns_info_loaded}
&& $self->schema && $self->storage() ){
+ $self->{_columns_info_loaded}++;
my $info;
############ eval for the case of storage without table
eval{
__PACKAGE__->load_components(qw/AccessorGroup/);
__PACKAGE__->mk_group_accessors('simple' =>
- qw/connect_info _dbh _sql_maker debug debugfh cursor on_connect_do transaction_depth/);
+ qw/connect_info _dbh _sql_maker _connection_pid debug debugfh cursor
+ on_connect_do transaction_depth/);
sub new {
my $new = bless({}, ref $_[0] || $_[0]);
sub dbh {
my ($self) = @_;
+ $self->_dbh(undef)
+ if $self->_connection_pid && $self->_connection_pid != $$;
$self->ensure_connected;
return $self->_dbh;
}
foreach my $sql_statement (@{$self->on_connect_do || []}) {
$self->_dbh->do($sql_statement);
}
+
+ $self->_connection_pid($$);
}
sub _connect {
my ($self, @info) = @_;
- return DBI->connect(@info);
+
+ if ($INC{'Apache/DBI.pm'} && $ENV{MOD_PERL}) {
+ my $old_connect_via = $DBI::connect_via;
+ $DBI::connect_via = 'connect';
+ my $dbh = DBI->connect(@info);
+ $DBI::connect_via = $old_connect_via;
+ return $dbh;
+ }
+
+ DBI->connect(@info);
}
=head2 txn_begin
$self->debugfh->print("$sql: @debug_bind\n");
}
my $sth = $self->sth($sql,$op);
+ croak "no sth generated via sql: $sql" unless $sth;
@bind = map { ref $_ ? ''.$_ : $_ } @bind; # stringify args
my $rv;
if ($sth) {
sub run_tests {
my $schema = shift;
-plan tests => 38;
+plan tests => 39;
my @art = $schema->resultset("Artist")->search({ }, { order_by => 'name DESC'});
my $typeinfo = $schema->source("Artist")->column_info('artistid');
is($typeinfo->{data_type}, 'INTEGER', 'column_info ok');
+$schema->source("Artist")->column_info('artistid');
+ok($schema->source("Artist")->{_columns_info_loaded} == 1, 'Columns info flag set');
+
}
1;
sub run_tests {
-my $schema = shift;\r
-\r
-my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MSSQL_${_}" } qw/DSN USER PASS/};\r
-\r
-#warn "$dsn $user $pass";\r
-\r
-plan skip_all, 'Set $ENV{DBICTEST_MSSQL_DSN}, _USER and _PASS to run this test'\r
- unless ($dsn);\r
-\r
-plan tests => 4;\r
-\r
-$schema->resultset("Schema")->compose_connection( 'MSSQLTest' => $dsn, $user, $pass );\r
-\r
-my $dbh = MSSQLTest->schema->storage->dbh;\r
-\r
-$dbh->do("IF OBJECT_ID('artist', 'U') IS NOT NULL\r
- DROP TABLE artist");\r
-\r
-$dbh->do("CREATE TABLE artist (artistid INT IDENTITY PRIMARY KEY, name VARCHAR(255));");\r
-\r
-MSSQLTest::Artist->load_components('PK::Auto');\r
-\r
-# Test PK\r
-my $new = MSSQLTest::Artist->create( { name => 'foo' } );\r
-ok($new->artistid, "Auto-PK worked");\r
-\r
-# Test LIMIT\r
-for (1..6) {\r
- MSSQLTest::Artist->create( { name => 'Artist ' . $_ } );\r
-}\r
-\r
-my $it = MSSQLTest::Artist->search( { },\r
- { rows => 3,\r
- offset => 2,\r
- order_by => 'artistid'\r
- }\r
-);\r
-\r
-is( $it->count, 3, "LIMIT count ok" );\r
-is( $it->next->name, "Artist 2", "iterator->next ok" );\r
-$it->next;\r
-$it->next;\r
-is( $it->next, undef, "next past end of resultset ok" );\r
-\r
-}\r
-\r
-1;\r
+my $schema = shift;
+
+my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MSSQL_${_}" } qw/DSN USER PASS/};
+
+#warn "$dsn $user $pass";
+
+plan skip_all, 'Set $ENV{DBICTEST_MSSQL_DSN}, _USER and _PASS to run this test'
+ unless ($dsn);
+
+plan tests => 4;
+
+$schema->compose_connection( 'MSSQLTest' => $dsn, $user, $pass );
+
+my $dbh = MSSQLTest->schema->storage->dbh;
+
+$dbh->do("IF OBJECT_ID('artist', 'U') IS NOT NULL
+ DROP TABLE artist");
+
+$dbh->do("CREATE TABLE artist (artistid INT IDENTITY PRIMARY KEY, name VARCHAR(255));");
+
+MSSQLTest::Artist->load_components('PK::Auto::MSSQL');
+
+# Test PK
+my $new = MSSQLTest::Artist->create( { name => 'foo' } );
+ok($new->artistid, "Auto-PK worked");
+
+# Test LIMIT
+for (1..6) {
+ MSSQLTest::Artist->create( { name => 'Artist ' . $_ } );
+}
+
+my $it = MSSQLTest::Artist->search( { },
+ { rows => 3,
+ offset => 2,
+ order_by => 'artistid'
+ }
+);
+
+is( $it->count, 3, "LIMIT count ok" );
+is( $it->next->name, "Artist 2", "iterator->next ok" );
+$it->next;
+$it->next;
+is( $it->next, undef, "next past end of resultset ok" );
+
+}
+
+1;
: ( tests => 41 );
}
+# 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
+my $is_broken_sqlite = 0;
+my ($sqlite_major_ver,$sqlite_minor_ver,$sqlite_patch_ver) =
+ split /\./, $schema->storage->dbh->get_info(18);
+if( $schema->storage->dbh->get_info(17) eq 'SQLite' &&
+ ( ($sqlite_major_ver < 3) ||
+ ($sqlite_major_ver == 3 && $sqlite_minor_ver < 2) ||
+ ($sqlite_major_ver == 3 && $sqlite_minor_ver == 2 && $sqlite_patch_ver < 6) ) ) {
+ $is_broken_sqlite = 1;
+}
+
# test the abstract join => SQL generator
my $sa = new DBIC::SQL::Abstract;
{ group_by => [qw/ title me.cdid /] }
);
-cmp_ok( $rs->count, '==', 5, "count() ok after group_by on main pk" );
+SKIP: {
+ skip "SQLite < 3.2.6 doesn't understand COUNT(DISTINCT())", 1
+ if $is_broken_sqlite;
+ cmp_ok( $rs->count, '==', 5, "count() ok after group_by on main pk" );
+}
cmp_ok( scalar $rs->all, '==', 5, "all() returns same count as count() after group_by on main pk" );
{ join => [qw/ artist /], group_by => [qw/ artist.name /] }
);
-cmp_ok( $rs->count, '==', 3, "count() ok after group_by on related column" );
+SKIP: {
+ skip "SQLite < 3.2.6 doesn't understand COUNT(DISTINCT())", 1
+ if $is_broken_sqlite;
+ cmp_ok( $rs->count, '==', 3, "count() ok after group_by on related column" );
+}
cmp_ok( scalar $rs->all, '==', 3, "all() returns same count as count() after group_by on related column" );
'cds_2.title' => 'Forkful of bees' },
{ join => [ 'cds', 'cds' ] });
-cmp_ok($rs->count, '==', 1, "single artist returned from multi-join");
+SKIP: {
+ skip "SQLite < 3.2.6 doesn't understand COUNT(DISTINCT())", 1
+ if $is_broken_sqlite;
+ cmp_ok($rs->count, '==', 1, "single artist returned from multi-join");
+}
+
is($rs->next->name, 'Caterwauler McCrae', "Correct artist returned");
my $queries;