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 => 66;

my $total = scalar(@AvailableDrivers) * TESTS_PER_DRIVER;
plan tests => $total;

foreach my $d ( @AvailableDrivers ) {
SKIP: {
	unless( has_schema( 'TestApp::Address', $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::Address', $handle );
	isa_ok($ret,'DBI::st', "Inserted the schema. got a statement handle back");

	my $rec = TestApp::Address->new($handle);
	isa_ok($rec, 'DBIx::SearchBuilder::Record');

# Handle->Fields
        is_deeply(
            [$handle->Fields('Address')],
            [qw(id name phone employeeid)],
            "listed all columns in the table"
        );
        is_deeply(
            [$handle->Fields('Some')],
            [],
            "no table -> no fields"
        );

# _Accessible testings
	is( $rec->_Accessible('id' => 'read'), 1, 'id is accessible for read' );
	is( $rec->_Accessible('id' => 'write'), undef, 'id is not accessible for write' );
	is( $rec->_Accessible('id'), undef, "any field is not accessible in undefined mode" );
	is( $rec->_Accessible('unexpected_field' => 'read'), undef, "field doesn't exist and can't be accessible for read" );
	is_deeply( [sort($rec->ReadableAttributes)], [qw(EmployeeId Name Phone id)], 'readable attributes' );
	is_deeply( [sort($rec->WritableAttributes)], [qw(EmployeeId Name Phone)], 'writable attributes' );

	can_ok($rec,'Create');

	my ($id) = $rec->Create( Name => 'Jesse', Phone => '617 124 567');
	ok($id,"Created record ". $id);
	ok($rec->Load($id), "Loaded the record");


	is($rec->id, $id, "The record has its id");
	is ($rec->Name, 'Jesse', "The record's name is Jesse");

	my ($val, $msg) = $rec->SetName('Obra');
	ok($val, $msg) ;
	is($rec->Name, 'Obra', "We did actually change the name");

# Validate immutability of the field id
	($val, $msg) = $rec->Setid( $rec->id + 1 );
	ok(!$val, $msg);
	is($msg, 'Immutable field', 'id is immutable field');
	is($rec->id, $id, "The record still has its id");

# Check some non existant field
	ok( !eval{ $rec->SomeUnexpectedField }, "The record has no 'SomeUnexpectedField'");
	{
		# test produce DBI warning
		local $SIG{__WARN__} = sub {return};
		is( $rec->_Value( 'SomeUnexpectedField' ), undef, "The record has no 'SomeUnexpectedField'");
	}
	($val, $msg) = $rec->SetSomeUnexpectedField( 'foo' );
	ok(!$val, $msg);
	is($msg, 'Nonexistant field?', "Field doesn't exist");
	($val, $msg) = $rec->_Set('SomeUnexpectedField', 'foo');
	ok(!$val, "$msg");


# Validate truncation on update

	($val,$msg) = $rec->SetName('1234567890123456789012345678901234567890');
	ok($val, $msg);
	is($rec->Name, '12345678901234', "Truncated on update");
	$val = $rec->TruncateValue(Phone => '12345678901234567890');
	is($val, '123456789012345678', 'truncate by length attribute');


# Test unicode truncation:
	my $univalue = "這是個測試";
	($val,$msg) = $rec->SetName($univalue.$univalue);
	ok($val, $msg) ;
	is($rec->Name, '這是個測');



# make sure we do _not_ truncate things which should not be truncated
	($val,$msg) = $rec->SetEmployeeId('1234567890');
	ok($val, $msg) ;
	is($rec->EmployeeId, '1234567890', "Did not truncate id on create");

# make sure we do truncation on create
	my $newrec = TestApp::Address->new($handle);
	my $newid = $newrec->Create( Name => '1234567890123456789012345678901234567890',
	                             EmployeeId => '1234567890' );

	$newrec->Load($newid);

	ok ($newid, "Created a new record");
	is($newrec->Name, '12345678901234', "Truncated on create");
	is($newrec->EmployeeId, '1234567890', "Did not truncate id on create");

# no prefetch feature and _LoadFromSQL sub checks
	$newrec = TestApp::Address->new($handle);
	($val, $msg) = $newrec->_LoadFromSQL('SELECT id FROM Address WHERE id = ?', $newid);
	is($val, 1, 'found object');
	is($newrec->Name, '12345678901234', "autoloaded not prefetched field");
	is($newrec->EmployeeId, '1234567890', "autoloaded not prefetched field");

# _LoadFromSQL and missing PK
	$newrec = TestApp::Address->new($handle);
	($val, $msg) = $newrec->_LoadFromSQL('SELECT Name FROM Address WHERE Name = ?', '12345678901234');
	is($val, 0, "didn't find object");
	is($msg, "Missing a primary key?", "reason is missing PK");

# _LoadFromSQL and not existant row
	$newrec = TestApp::Address->new($handle);
	($val, $msg) = $newrec->_LoadFromSQL('SELECT id FROM Address WHERE id = ?', 0);
	is($val, 0, "didn't find object");
	is($msg, "Couldn't find row", "reason is wrong id");

# _LoadFromSQL and wrong SQL
	$newrec = TestApp::Address->new($handle);
	{
		local $SIG{__WARN__} = sub{return};
		($val, $msg) = $newrec->_LoadFromSQL('SELECT ...');
	}
	is($val, 0, "didn't find object");
	like($msg, qr/^Couldn't execute query/, "reason is bad SQL");

# test Load* methods
	$newrec = TestApp::Address->new($handle);
	$newrec->Load();
	is( $newrec->id, undef, "can't load record with undef id");

	$newrec = TestApp::Address->new($handle);
	$newrec->LoadByCol( Name => '12345678901234' );
	is( $newrec->id, $newid, "load record by 'Name' column value");

# LoadByCol with operator
	$newrec = TestApp::Address->new($handle);
	$newrec->LoadByCol( Name => { value => '%45678%',
				      operator => 'LIKE' } );
	is( $newrec->id, $newid, "load record by 'Name' with LIKE");

# LoadByPrimaryKeys
	$newrec = TestApp::Address->new($handle);
	($val, $msg) = $newrec->LoadByPrimaryKeys( id => $newid );
	ok( $val, "load record by PK");
	is( $newrec->id, $newid, "loaded correct record");
	$newrec = TestApp::Address->new($handle);
	($val, $msg) = $newrec->LoadByPrimaryKeys( {id => $newid} );
	ok( $val, "load record by PK");
	is( $newrec->id, $newid, "loaded correct record" );
	$newrec = TestApp::Address->new($handle);
	($val, $msg) = $newrec->LoadByPrimaryKeys( Phone => 'some' );
	ok( !$val, "couldn't load, missing PK field");
	is( $msg, "Missing PK field: 'id'", "right error message" );

# LoadByCols and empty or NULL values
	$rec = TestApp::Address->new($handle);
	$id = $rec->Create( Name => 'Obra', Phone => undef );
	ok( $id, "new record");
	$rec = TestApp::Address->new($handle);
	$rec->LoadByCols( Name => 'Obra', Phone => undef, EmployeeId => '' );
    is( $rec->id, $id, "loaded record by empty value" );

# __Set error paths
	$rec = TestApp::Address->new($handle);
	$rec->Load( $id );
	$val = $rec->SetName( 'Obra' );
	isa_ok( $val, 'Class::ReturnValue', "couldn't set same value, error returned");
	is( ($val->as_array)[1], "That is already the current value", "correct error message" );
	is( $rec->Name, 'Obra', "old value is still there");
	$val = $rec->SetName( 'invalid' );
	isa_ok( $val, 'Class::ReturnValue', "couldn't set invalid value, error returned");
	is( ($val->as_array)[1], 'Illegal value for Name', "correct error message" );
	is( $rec->Name, 'Obra', "old value is still there");
	( $val, $msg ) = $rec->SetName();
    ok( $val, $msg );
	is( $rec->Name, undef, "no value means null");

# deletes
	$newrec = TestApp::Address->new($handle);
	$newrec->Load( $newid );
	is( $newrec->Delete, 1, 'successfuly delete record');
	$newrec = TestApp::Address->new($handle);
	$newrec->Load( $newid );
	is( $newrec->id, undef, "record doesn't exist any more");

	cleanup_schema( 'TestApp::Address', $handle );
}} # SKIP, foreach blocks

1;



package TestApp::Address;

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('Address');
    $self->_Handle($handle);
}

sub ValidateName
{
	my ($self, $value) = @_;
    return 1 unless defined $value;
	return 0 if $value =~ /invalid/i;
	return 1;
}

sub _ClassAccessible {

    {   
        
        id =>
        {read => 1, type => 'int(11)', default => ''}, 
        Name => 
        {read => 1, write => 1, type => 'varchar(14)', default => ''},
        Phone => 
        {read => 1, write => 1, type => 'varchar(18)', length => 18, default => ''},
        EmployeeId => 
        {read => 1, write => 1, type => 'int(8)', default => ''},

}

}

sub schema_mysql {
<<EOF;
CREATE TEMPORARY TABLE Address (
        id integer AUTO_INCREMENT,
        Name varchar(36),
        Phone varchar(18),
        EmployeeId int(8),
  	PRIMARY KEY (id))
EOF

}

sub schema_pg {
<<EOF;
CREATE TEMPORARY TABLE Address (
        id serial PRIMARY KEY,
        Name varchar,
        Phone varchar,
        EmployeeId integer
)
EOF

}

sub schema_sqlite {

<<EOF;
CREATE TABLE Address (
        id  integer primary key,
        Name varchar(36),
        Phone varchar(18),
        EmployeeId int(8))
EOF

}

sub schema_oracle { [
    "CREATE SEQUENCE Address_seq",
    "CREATE TABLE Address (
        id integer CONSTRAINT Address_Key PRIMARY KEY,
        Name varchar(36),
        Phone varchar(18),
        EmployeeId integer
    )",
] }

sub cleanup_schema_oracle { [
    "DROP SEQUENCE Address_seq",
    "DROP TABLE Address", 
] }

1;