#!/usr/bin/perl -w
use strict;
use warnings;
use Test::More;
BEGIN { require "t/utils.pl" }
our (@AvailableDrivers);
use constant TESTS_PER_DRIVER => 98;
my $total = scalar(@AvailableDrivers) * TESTS_PER_DRIVER;
plan tests => $total;
foreach my $d ( @AvailableDrivers ) {
SKIP: {
unless( has_schema( 'TestApp', $d ) ) {
skip "No schema for '$d' driver", TESTS_PER_DRIVER;
}
unless( should_test( $d ) ) {
skip "ENV is not defined for driver '$d'", TESTS_PER_DRIVER;
}
my $handle = get_handle( $d );
connect_handle( $handle );
isa_ok($handle->dbh, 'DBI::db');
my $ret = init_schema( 'TestApp', $handle );
isa_ok($ret,'DBI::st', "Inserted the schema. got a statement handle back");
my $lowest = ($d ne 'Pg' && $d ne 'Oracle')? '-': 'z';
diag "generate data" if $ENV{TEST_VERBOSE};
{
my @tags = qw(a b c d);
foreach my $i ( 1..30 ) {
my $number_of_tags = int(rand(4));
my @t;
push @t, $tags[int rand scalar @tags] while $number_of_tags--;
my %seen = ();
@t = grep !$seen{$_}++, @t;
my $obj = TestApp::Object->new($handle);
my ($oid) = $obj->Create( Name => join(",", sort @t) || $lowest );
ok($oid,"Created record ". $oid);
ok($obj->Load($oid), "Loaded the record");
my $tags_ok = 1;
foreach my $t( @t ) {
my $tag = TestApp::Tag->new($handle);
my ($tid) = $tag->Create( Object => $oid, Name => $t );
$tags_ok = 0 unless $tid;
}
ok($tags_ok, "Added tags");
}
}
# ASC order
foreach my $direction ( qw(ASC DESC) ) {
my $objs = TestApp::Objects->new($handle);
$objs->UnLimit;
my $tags_alias = $objs->Join(
TYPE => 'LEFT',
ALIAS1 => 'main',
FIELD1 => 'id',
TABLE2 => 'Tags',
FIELD2 => 'Object',
);
ok($tags_alias, "joined tags table");
$objs->OrderBy( ALIAS => $tags_alias, FIELD => 'Name', ORDER => $direction );
ok($objs->First, 'ok, we have at least one result');
$objs->GotoFirstItem;
my ($order_ok, $last) = (1, $direction eq 'ASC'? '-': 'zzzz');
while ( my $obj = $objs->Next ) {
my $tmp;
if ( $direction eq 'ASC' ) {
$tmp = (substr($last, 0, 1) cmp substr($obj->Name, 0, 1));
} else {
$tmp = -(substr($last, -1, 1) cmp substr($obj->Name, -1, 1));
}
if ( $tmp > 0 ) {
$order_ok = 0; last;
}
$last = $obj->Name;
}
ok($order_ok, "$direction order is correct") or do {
diag "Wrong $direction query: ". $objs->BuildSelectQuery;
$objs->GotoFirstItem;
while ( my $obj = $objs->Next ) {
diag($obj->id .":". $obj->Name);
}
}
}
cleanup_schema( 'TestApp', $handle );
}} # SKIP, foreach blocks
1;
package TestApp;
sub schema_mysql { [
"CREATE TEMPORARY TABLE Objects (
id integer AUTO_INCREMENT,
Name varchar(36),
PRIMARY KEY (id)
)",
"CREATE TEMPORARY TABLE Tags (
id integer AUTO_INCREMENT,
Object integer NOT NULL,
Name varchar(36),
PRIMARY KEY (id)
)",
] }
sub schema_pg { [
"CREATE TEMPORARY TABLE Objects (
id serial PRIMARY KEY,
Name varchar(36)
)",
"CREATE TEMPORARY TABLE Tags (
id serial PRIMARY KEY,
Object integer NOT NULL,
Name varchar(36)
)",
]}
sub schema_sqlite {[
"CREATE TABLE Objects (
id integer primary key,
Name varchar(36)
)",
"CREATE TABLE Tags (
id integer primary key,
Object integer NOT NULL,
Name varchar(36)
)",
]}
sub schema_oracle { [
"CREATE SEQUENCE Objects_seq",
"CREATE TABLE Objects (
id integer CONSTRAINT Objects_Key PRIMARY KEY,
Name varchar(36)
)",
"CREATE SEQUENCE Tags_seq",
"CREATE TABLE Tags (
id integer CONSTRAINT Tags_Key PRIMARY KEY,
Object integer NOT NULL,
Name varchar(36)
)",
] }
sub cleanup_schema_oracle { [
"DROP SEQUENCE Objects_seq",
"DROP TABLE Objects",
"DROP SEQUENCE Tags_seq",
"DROP TABLE Tags",
] }
1;
package TestApp::Object;
use base $ENV{SB_TEST_CACHABLE}?
qw/DBIx::SearchBuilder::Record::Cachable/:
qw/DBIx::SearchBuilder::Record/;
sub _Init {
my $self = shift;
my $handle = shift;
$self->Table('Objects');
$self->_Handle($handle);
}
sub _ClassAccessible {
{
id =>
{read => 1, type => 'int(11)' },
Name =>
{read => 1, write => 1, type => 'varchar(36)' },
}
}
1;
package TestApp::Objects;
use base qw/DBIx::SearchBuilder/;
sub _Init {
my $self = shift;
$self->SUPER::_Init( Handle => shift );
$self->Table('Objects');
}
sub NewItem
{
my $self = shift;
return TestApp::Object->new( $self->_Handle );
}
1;
package TestApp::Tag;
use base $ENV{SB_TEST_CACHABLE}?
qw/DBIx::SearchBuilder::Record::Cachable/:
qw/DBIx::SearchBuilder::Record/;
sub _Init {
my $self = shift;
my $handle = shift;
$self->Table('Tags');
$self->_Handle($handle);
}
sub _ClassAccessible {
{
id =>
{read => 1, type => 'int(11)' },
Object =>
{read => 1, type => 'int(11)' },
Name =>
{read => 1, write => 1, type => 'varchar(36)' },
}
}
1;
package TestApp::Tags;
# use TestApp::User;
use base qw/DBIx::SearchBuilder/;
sub _Init {
my $self = shift;
$self->SUPER::_Init( Handle => shift );
$self->Table('Tags');
}
sub NewItem
{
my $self = shift;
return TestApp::Tag->new( $self->_Handle );
}
1;