The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/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;