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 'all';
use lib qw( lib t/lib );
use Test::More 'no_plan';

use_ok('My::State');
use_ok('My::City');

# Check relationships:
can_ok( 'My::State',  'cities' );
can_ok( 'My::City',   'state' );

map { $_->delete } My::State->retrieve_all;
My::City->find_or_create(
  state_id  =>
    My::State->find_or_create(
      state_name => 'Colorado',
      state_abbr => 'CO'
    )->id,
  city_name => 'Denver',
);


# Object index on both the Class and an Object:
my @states = My::State->retrieve_all;
My::State->clear_object_index;
$states[0]->clear_object_index;


# Does the class have a column?:
ok(
  My::State->find_column('state_id'),
  'My::State has field state_id'
);
ok(
  ! My::State->find_column('lucky_charms'),
  'My::State does not have field lucky_charms'
);


# Fun with columns:
ok(
  scalar(My::State->columns),
  'Called columns on class'
);
ok(
  scalar($states[0]->columns),
  'Called columns on object'
);
ok(
  scalar(My::State->columns('All')),
  'Called columns(all) on class'
);
ok(
  scalar($states[0]->columns('All')),
  'Called columns(all) on object'
);
ok(
  scalar(My::State->columns('Primary')),
  'Called columns(primary) on class'
);
ok(
  scalar($states[0]->columns('Primary')),
  'Called columns(primary) on object'
);
ok(
  ! eval { My::State->columns('FooBar') },
  'Called columns(foobar) on class'
);
ok(
  ! eval { $states[0]->columns('FooBar') },
  'Called columns(foobar) on object'
);
ok(
  My::State->columns(All => My::State->columns),
  'Called columns(all => @cols) on class'
);
ok(
  $states[0]->columns(All => My::State->columns),
  'Called columns(all => @cols) on object'
);


# Call 'construct' as an object method:
ok(
  $states[0]->construct( $states[0] ),
  'Can call construct on an object'
);



# Call create on an object:
ok(
  My::State->create( %{$states[0]}, state_id => undef, ),
  'called create on a class'
);
ok(
  $states[0]->create( %{$states[0]}, state_id => undef, ),
  'called create on an object'
);


# Call update on the class - should fail:
eval { My::State->update };
ok(
  $@,
  'calling class->update dies'
);



# Call update when something hasn't been changed:
ok(
  $states[0]->update,
  'called update() on an unchanged object'
);
{
  # Mark it as changed, but nothing has changed:
  local $states[0]->{__Changed} = { };
  ok(
    $states[0]->update,
    'called update() on an unchanged object'
  );
}
{
  # Mark it as changed, but something strange is in the keys...
  local $states[0]->{__Changed} = 1;
  ok(
    $states[0]->update,
    'called update() on an unchanged object'
  );
}



# Call delete as a class method:
eval { My::State->delete };
ok(
  $@,
  'calling class->delete dies'
);


# discard changes:
{
  my $old_name = $states[0]->state_name;
  $states[0]->state_name( 'Foo' );
  ok(
    scalar(keys(%{ $states[0]->{__Changed} })),
    'the __Changed hashref is populated after making a field value change'
  );
  $states[0]->discard_changes;
  is(
    $states[0]->state_name => $old_name,
    'discard changes works'
  );
  ok(
    ! keys(%{ $states[0]->{__Changed} }),
    'the __Changed hashref is emptied after discard_changes'
  );
}


# fleshing out incomplete objects:
{
  My::State->clear_object_index;
  My::State->columns('Essential' => qw/
    state_id
  /);
  my $state = My::State->retrieve( 1 );
  ok(
    ! $state->{state_name},
    'state_name hash entry is blank'
  );
  ok(
    $state->state_name,
    'calling state_name fleshes out missing field data'
  );
  ok(
    $state->{state_name},
    'after method call, state_name hash entry is valid'
  );
  
  My::State->columns('Essential' => My::State->columns );
  is_deeply(
    [ My::State->columns('Essential') ],
    [ My::State->columns('All') ],
    'we have reset the Essential column group to include all fields'
  );
}


# Class: calling an invalid field or method:
{
  eval { My::State->foobar };
  like(
    $@,
    qr/Can't locate object method "foobar" via package "My::State"/i,
    'invalid class method call dies'
  );
}

# Object: calling an invalid field or method:
{
  eval { $states[0]->foobar };
  like(
    $@,
    qr/Can't locate object method "foobar" via package "My::State"/i,
    'invalid class method call dies'
  );
}



# DESTROY an object that has changes in it:
{
  my $warning;
  local $SIG{__WARN__} = sub {
    $warning = shift;
  };
  SCOPE: {
    my $state = My::State->retrieve( 1 );
    $state->state_name('Foo');
  };
  like $warning, qr/DESTROY'd without saving changes to state_name/,
    'Changing values without saving causes death';
}


# Deletion:
{
  my $test_state = My::State->create(
    state_name  => 'FooState',
    state_abbr  => 'FO',
  );
  ok( $test_state => 'Got FooState' );
  isa_ok( $test_state => 'My::State' );
  ok(  $test_state->id => 'id works' );
  ok( $test_state, 'bool overload before delete' );
  $test_state->delete;
  ok( ! $test_state, 'bool overload after delete' );
  isa_ok( $test_state, 'Class::DBI::Lite::Object::Has::Been::Deleted' );
}



# Misc properties - Class:
{
  is(
    My::State->schema,
    'DBI:SQLite:dbname=t/testdb'
  );
  is_deeply(
    My::State->dsn, 
    [
      'DBI:SQLite:dbname=t/testdb', '', ''
    ]
  );
  ok(
    ( ! My::State->triggers('before_create') ),
    'no triggers before_create'
  );
  is(
    scalar(My::State->triggers('after_delete')) => 0,
    'there is 1 after_delete trigger for My::State'
  );
}

# Misc properties - Object:
{
  is(
    $states[0]->schema,
    'DBI:SQLite:dbname=t/testdb'
  );
  is_deeply(
    $states[0]->dsn, 
    [
      'DBI:SQLite:dbname=t/testdb', '', ''
    ]
  );
  ok(
    ( ! $states[0]->triggers('before_create') ),
    'no triggers before_create'
  );
  is(
    scalar($states[0]->triggers('after_delete')) => 0,
    'there is 1 after_delete trigger for $states[0]'
  );
}



# Add the same trigger twice, make sure it is only called once:
{
  my $counter = 0;
  my $once = sub {
    $counter++;
  };
  My::State->add_trigger( before_update => $once );
  My::State->add_trigger( before_update => $once );
  my $old_name = $states[0]->state_name;
  $states[0]->state_name('FooState' . rand());
  $states[0]->update;
  is( $counter => 1, 'trigger was added twice but only called once' );
}




# Add a trigger that will cause any create actions to fail:
{
  my $failer = sub {
    die "TEST FAIL CREATE"
  };
  My::State->add_trigger( before_create => $failer );
  ok(
    ! eval { My::State->create( %{$states[0]}, state_id => undef ) },
    'cannot create because of failure'
  );
  like $@, qr/TEST FAIL CREATE/;
  $failer = sub { };
}



# Add a trigger that will cause any update actions to fail:
{
  my $failer = sub {
    die "TEST FAIL UPDATE"
  };
  My::State->add_trigger( before_update => $failer );
  $states[0]->state_name( 'Foo Updated' );
  ok(
    ! eval { $states[0]->update },
    'cannot update because of failure'
  );
  like $@, qr/TEST FAIL UPDATE/;
  $failer = sub { };
  $states[0]->discard_changes;
}



# Add a trigger that will cause any delete actions to fail:
{
  my $failer = sub {
    die "TEST FAIL DELETE"
  };
  My::State->add_trigger( before_delete => $failer );
  ok(
    ! eval { $states[0]->delete },
    'cannot delete because of failure'
  );
  like $@, qr/TEST FAIL DELETE/;
  $failer = sub { };
}




# search_where on an object:
{
  $states[0]->search_where( state_name => 'foo' );
  $states[0]->search_where({ state_name => 'foo' });
  $states[0]->search_where(
    { state_name => 'foo' },
    { order_by => 'state_name' }
  );
  $states[0]->search_where(
    { state_name => 'foo' },
    { order_by => 'state_name', limit => 1 },
  );
  $states[0]->search_where(
    { state_name => 'foo' },
    { order_by => 'state_name', limit => 1, offset => 0 },
  );
}


# count_search_where on an object:
{
  $states[0]->count_search_where( state_name => 'foo' );
  $states[0]->count_search_where({ state_name => 'foo' });
  $states[0]->count_search_where(
    { state_name => 'foo' },
    { order_by => 'state_name' }
  );
  $states[0]->count_search_where(
    { state_name => 'foo' },
    { order_by => 'state_name', limit => 1 },
  );
  $states[0]->count_search_where(
    { state_name => 'foo' },
    { order_by => 'state_name', limit => 1, offset => 0 },
  );
}



# search_where on a class:
{
  My::State->search_where( state_name => 'foo' );
  My::State->search_where({ state_name => 'foo' });
  My::State->search_where(
    { state_name => 'foo' },
    { order_by => 'state_name' }
  );
  My::State->search_where(
    { state_name => 'foo' },
    { order_by => 'state_name', limit => 1 },
  );
  My::State->search_where(
    { state_name => 'foo' },
    { order_by => 'state_name', limit => 1, offset => 0 },
  );
}


# count_search_where on a class:
{
  My::State->count_search_where( state_name => 'foo' );
  My::State->count_search_where({ state_name => 'foo' });
  My::State->count_search_where(
    { state_name => 'foo' },
    { order_by => 'state_name' }
  );
  My::State->count_search_where(
    { state_name => 'foo' },
    { order_by => 'state_name', limit => 1 },
  );
  My::State->count_search_where(
    { state_name => 'foo' },
    { order_by => 'state_name', limit => 1, offset => 0 },
  );
}



# dbi_commit when we're not in a transaction:
{
 eval { $states[0]->dbi_commit };
}


# has_many on an object:
{
  eval {
    $states[0]->has_many(
      cities  =>
        'My::City'  =>
          'state_id'
    );
  };
}


# has_a on an object:
{
  my ($city) = $states[0]->cities;
  eval {
    $city->has_a(
      state  =>
        'My::State'  =>
          'state_id'
    );
  };
}



# Call add_to_cities with a hashref:
{
  my ($city) = $states[0]->cities;
  my $new_city = $states[0]->add_to_cities(
    { %$city, city_id => undef }
  );
  ok( $new_city, 'got a new object' );
  isa_ok( $new_city => 'My::City' );
  is_deeply( $new_city->state, $states[0] );
  $new_city->delete;
}

# Call add_to_cities with a hash:
{
  my ($city) = $states[0]->cities;
  my $new_city = $states[0]->add_to_cities(
    %$city, city_id => undef
  );
  ok( $new_city, 'got a new object' );
  isa_ok( $new_city => 'My::City' );
  is_deeply( $new_city->state, $states[0] );
  $new_city->delete;
}

# Call add_to_cities with extra fields:
{
  my ($city) = $states[0]->cities;
  my $new_city = $states[0]->add_to_cities(
    %$city,
    foo => 'bar',
    baz => 'bux',
    city_id => $city->id,
    nonexist => undef,
  );
  ok( $new_city, 'got a new object' );
  isa_ok( $new_city => 'My::City' );
  is_deeply( $new_city->state, $states[0] );
  $new_city->delete;
}


# Try to set up a table that does not exist:
{
  eval {
    My::City->set_up_table('provinces')
  };
  like $@, qr/Table provinces doesn't exist or has no columns/i,
    'attempt to set up invalid table fails';
}


# Call reset on an iterator:
{
  my $iter = My::State->retrieve_all;
  $iter->reset;
  is( $iter->{idx} => 0, 'reset on an iterator sets its internal index to zero' );
}


# Simple accessor/mutators for the entity meta:
{
  is( My::State->_meta->table => 'states' );
  ok( scalar(My::State->_meta->triggers) );
  ok( My::State->_meta->has_a_rels );
  ok( My::State->_meta->has_many_rels );
}