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 Test::More tests => 284;

BEGIN 
{
  require 't/test-lib.pl';
  use_ok('Rose::DB::Object');
  use_ok('Rose::DB::Object::Manager');
  use_ok('Rose::DateTime::Util');
}

use Rose::DateTime::Util qw(parse_date);

our(%Have, $Did_Setup, %Temp);

#
# Setup
#

SETUP:
{
  package MyObject;

  our @ISA = qw(Rose::DB::Object);

  MyObject->meta->table('Rose_db_object_test');

  MyObject->meta->columns
  (
    id       => { primary_key => 1, not_null => 1 },
    name     => { type => 'varchar', length => 32, on_set => sub { die "foo" },
                  on_get => [  sub { die "bar" }, sub { die "baz" } ] },
    code     => { type => 'varchar', length => 32 },
    start    => { type => 'date', default => '12/24/1980' },
    ended    => { type => 'scalar', default => '11/22/2003' },
    date_created => { type => 'timestamp' },
  );

  foreach my $column (MyObject->meta->columns)
  {
    $column->add_auto_method_types(qw(get set));
    $column->method_name('get' => 'xget_' . $column->name);
    $column->method_name('set' => 'xset_' . $column->name);
  }

  my $column = MyObject->meta->column('name');

  foreach my $event (qw(on_set on_get on_load on_save inflate deflate))
  {
    $column->add_trigger($event => sub { die "foo" })  unless($event eq 'on_set');

    unless($event eq 'on_get')
    {
      $column->add_trigger($event => sub { die "bar" });
      $column->add_trigger($event => sub { die "baz" });
    }
  }

  $column->delete_triggers('on_set');

  Test::More::ok(!defined $column->triggers('on_set'), 'delete_triggers 1');
  Test::More::ok(defined $column->triggers('on_get'), 'delete_triggers 2');

  $column->delete_triggers;

  my $i = 2;

  foreach my $event (qw(on_set on_get on_load on_save inflate deflate))
  {
    $i++;
    Test::More::ok(!defined $column->triggers($event), "delete_triggers $i");
  }

  # 0: die
  $column->add_trigger(event => 'on_get', 
                       name  => 'die',
                       code  => sub { die "blah" });

  # 1: die, dyn
  $column->add_trigger(event => 'on_get', 
                       code => sub { $Temp{'get'}{'name'} = shift->name });

  # XXX: This relies on knowledge of how generate_trigger_name() works
  my $dyn_name = "dyntrig_${$}_19"; 

  # 0: warn, die, dyn
  $column->add_trigger(event => 'on_get', 
                       name  => 'warn',
                       code  => sub { warn "boo" },
                       position => 'first');

  Test::More::is($column->trigger_index('on_get', 'warn'), 0, 'trigger_index 1');
  Test::More::is($column->trigger_index('on_get', 'die'), 1, 'trigger_index 2');
  Test::More::is($column->trigger_index('on_get', $dyn_name), 2, 'trigger_index 3');

  $column->delete_trigger(event => 'on_get',
                          name  => 'die');

  Test::More::is($column->trigger_index('on_get', 'warn'), 0, 'trigger_index 4');
  Test::More::is($column->trigger_index('on_get', $dyn_name), 1, 'trigger_index 5');

  $column->delete_trigger(event => 'on_get',
                          name  => 'warn');

  Test::More::is($column->trigger_index('on_get', $dyn_name), 0, 'trigger_index 6');

  my $indexes = $column->trigger_indexes('on_get');
  Test::More::is(keys %$indexes, 1, 'trigger_indexes 1');
  my $triggers = $column->triggers('on_get');
  Test::More::is(scalar @$triggers, 1, 'triggers 1');

  $column->add_trigger(event => 'on_set', 
                       code => sub { $Temp{'set'}{'name'} = shift->name });

  $column->add_trigger(on_load => sub { $Temp{'on_load'}{'name'} = shift->name });
  $column->add_trigger(on_save => sub { $Temp{'on_save'}{'name'} = shift->name });

  $column->add_trigger(inflate => sub {no warnings 'uninitialized';  $Temp{'inflate'}{'name'} = shift->name });
  $column->add_trigger(deflate => sub { no warnings 'uninitialized'; $Temp{'deflate'}{'name'} = uc $_[1] });

  $column = MyObject->meta->column('code');

  $column->add_trigger(inflate => sub { no warnings 'uninitialized'; lc $_[1] });
  $column->add_trigger(deflate => sub { no warnings 'uninitialized'; uc $_[1] });

  $column = MyObject->meta->column('start');

  $column->add_trigger(inflate => sub { ref $_[1] ? $_[1]->add(days => 1) : $_[1] });
  $column->add_trigger(deflate => sub 
  { 
    if(ref $_[1])
    {
      $_[1]->subtract(days => 1);
      return $_[0]->db->format_date($_[1]);
    }

    return $_[1];
  });

  $column->add_trigger(on_set => sub { shift->name('start set') });
  $column->add_trigger(on_get => sub { shift->name('start get') });

  $column = MyObject->meta->column('ended');

  $column->add_trigger(inflate => sub
  {
    # Handle older MySQL version of timestamp values
    if(defined $_[1])
    {
      $_[1] =~ s/^(\d{4})(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)$/$1-$2-$3 $2:$5:$6/;
    }

    defined $_[1] ? (Rose::DateTime::Util::parse_date($_[1]) || $_[0]->db->parse_date($_[1])) : undef 
  });

  $column->add_trigger(deflate => sub 
  {
    defined $_[1] ? $_[0]->db->format_date(Rose::DateTime::Util::parse_date($_[1]) || 
                                           $_[0]->db->parse_date($_[1])) : undef 
  });

  # Test built-in triggers

  # 0: die
  $column->add_builtin_trigger(event => 'on_get', 
                               name  => 'die',
                               code  => sub { die "blah" });

  # 1: die, dyn
  $column->add_builtin_trigger(event => 'on_get', 
                               code => sub { $Temp{'bi'}{'get'}{'name'} = shift->name });

  # This relies on knowledge of how generate_trigger_name() works
  $dyn_name = "dyntrig_${$}_33"; 

  # 0: warn, die, dyn
  $column->add_builtin_trigger(event => 'on_get', 
                               name  => 'warn',
                               code  => sub { warn "boo" },
                               position => 'first');

  Test::More::is($column->builtin_trigger_index('on_get', 'warn'), 0, 'builtin_trigger_index 1');
  Test::More::is($column->builtin_trigger_index('on_get', 'die'), 1, 'builtin_trigger_index 2');
  Test::More::is($column->builtin_trigger_index('on_get', $dyn_name), 2, 'builtin_trigger_index 3');

  $column->delete_builtin_trigger(event => 'on_get',
                                  name  => 'die');

  Test::More::is($column->builtin_trigger_index('on_get', 'warn'), 0, 'builtin_trigger_index 4');
  Test::More::is($column->builtin_trigger_index('on_get', $dyn_name), 1, 'builtin_trigger_index 5');

  $column->delete_builtin_trigger(event => 'on_get',
                                  name  => 'warn');

  Test::More::is($column->builtin_trigger_index('on_get', $dyn_name), 0, 'builtin_trigger_index 6');

  $indexes = $column->builtin_trigger_indexes('on_get');
  Test::More::is(keys %$indexes, 1, 'builtin_trigger_indexes 1');

  $triggers = $column->builtin_triggers('on_get');
  Test::More::is(scalar @$triggers, 1, 'builtin_triggers 1');

  $column->add_builtin_trigger(event => 'on_set', 
                       code => sub { $Temp{'bi'}{'set'}{'name'} = shift->name });

  $column->add_builtin_trigger(on_load => sub { $Temp{'bi'}{'on_load'}{'name'} = shift->name });
  $column->add_builtin_trigger(on_save => sub { $Temp{'bi'}{'on_save'}{'name'} = shift->name });

  $column->add_builtin_trigger(inflate => sub { $Temp{'bi'}{'inflate'}{'name'} = shift->name });
  $column->add_builtin_trigger(deflate => sub { $Temp{'bi'}{'deflate'}{'name'} = uc $_[1] });

  $column->delete_builtin_triggers;

  $i = 0;

  foreach my $event (qw(on_set on_get on_load on_save inflate deflate))
  {
    $i++;
    $indexes = $column->builtin_trigger_indexes($event);
    Test::More::is(keys %$indexes, 0, "delete_builtin_triggers $i");

    $i++;
    $triggers = $column->builtin_triggers($event);
    Test::More::ok(!defined $triggers, "delete_builtin_triggers $i");
  }
}

#
# Tests
#

my @dbs = qw(mysql pg pg_with_schema informix sqlite);
eval { require List::Util };
@dbs = List::Util::shuffle(@dbs)  unless($@);
#@dbs = qw(informix sqlite mysql pg_with_schema  pg);

foreach my $db_type (@dbs)
{
  SKIP:
  {
    skip("$db_type tests", 49)  unless($Have{$db_type});
  }

  next  unless($Have{$db_type});

  Rose::DB->default_type($db_type);

  unless($Did_Setup++)
  {
    MyObject->meta->initialize;
  }

  ##
  ## Run tests
  ##

  %Temp = ();

  #
  # name
  #

  my $o = MyObject->new;

  is($o->name('Fred'), 'Fred', "on_set return 1 - $db_type");
  is($Temp{'set'}{'name'}, 'Fred', "on_set 1 - $db_type");
  is(keys %Temp, 1, "on_set 2 - $db_type");
  %Temp = ();

  is($o->xset_name('Fred'), 'Fred', "on_set return 2 - $db_type");
  is($Temp{'set'}{'name'}, 'Fred', "on_set 3 - $db_type");
  is(keys %Temp, 1, "on_set 4 - $db_type");
  %Temp = ();

  my $name = $o->xget_name;
  is($Temp{'get'}{'name'}, 'Fred', "on_get 1 - $db_type");
  is($Temp{'inflate'}{'name'}, 'Fred', "on_get 2 - $db_type");
  is(keys %Temp, 2, "on_get 3 - $db_type");
  %Temp = ();

  $name = $o->name;
  is($Temp{'get'}{'name'}, 'Fred', "on_get 4 - $db_type");
  is(keys %Temp, 1, "on_get 5 - $db_type");
  %Temp = ();

  $name = $o->xget_name;
  is($Temp{'get'}{'name'}, 'Fred', "on_get 6 - $db_type");
  is(keys %Temp, 1, "on_get 7 - $db_type");
  %Temp = ();

  #local $Rose::DB::Object::Debug = 1;

  $o->save;
  is($Temp{'on_save'}{'name'}, 'FRED', "on_save 1 - $db_type");
  is($Temp{'deflate'}{'name'}, 'FRED', "on_save 2 - $db_type");
  is(keys %Temp, 2, "on_save 3 - $db_type");
  %Temp = ();

  $o->load;
  is($Temp{'on_load'}{'name'}, 'FRED', "on_load 1 - $db_type");
  is(keys %Temp, 1, "on_load 2 - $db_type");
  %Temp = ();

  is($o->name, 'FRED', "deflate 1 - $db_type");
  is($Temp{'get'}{'name'}, 'FRED', "on_get 8 - $db_type");
  is($Temp{'inflate'}{'name'}, 'FRED', "on_get 9 - $db_type");
  is(keys %Temp, 2, "on_get 10 - $db_type");
  %Temp = ();

  $o->name('Fred');
  is($Temp{'set'}{'name'}, 'Fred', "on_set 5 - $db_type");
  is(keys %Temp, 1, "on_set 6 - $db_type");
  %Temp = ();

  MyObject->meta->column('name')->add_trigger(
    event => 'inflate',
    name  => 'lc_inflate',
    code  => sub { $Temp{'lc_inflate'}{'name'} = lc shift->name });

  is($o->name, 'fred', "inflate 1 - $db_type");
  is($Temp{'get'}{'name'}, 'fred', "inflate 2 - $db_type");
  is($Temp{'inflate'}{'name'}, 'Fred', "inflate 3 - $db_type");
  is($Temp{'lc_inflate'}{'name'}, 'fred', "inflate 4 - $db_type");
  is(keys %Temp, 3, "inflate 5 - $db_type");
  %Temp = ();

  $o = MyObject->new();
  $o->meta->add_unique_keys('name');
  $o->name('FRED');
  $o->load(speculative => 1);
  isnt($Temp{'on_save'}{'name'}, 'FRED', "on_load/on_save mix - $db_type");

  #
  # code
  #

  $o = MyObject->new(name => 'foo', code => 'Abc');

  is($o->code, 'abc', "inflate/deflate 1 - $db_type");

  $o->save;

  my $sth = $o->db->dbh->prepare(
    'SELECT code FROM ' . $o->meta->fq_table_sql($o->db) . ' WHERE id = ?');

  $sth->execute($o->id);
  my $code = $sth->fetchrow_array;
  $sth->finish;

  is($code, 'ABC', "inflate/deflate 2 - $db_type");

  is($o->code, 'abc', "inflate/deflate 3 - $db_type");
  is($o->xget_code, 'abc', "inflate/deflate 4 - $db_type");

  #
  # start
  #

  $o->start('2002-10-20');
  is($o->name, 'start set',  "start 1 - $db_type");

  $o->save;

  is($o->name, 'start set',  "start 2 - $db_type");

  $sth = $o->db->dbh->prepare(
    'SELECT start FROM ' . $o->meta->fq_table_sql($o->db) . ' WHERE id = ?');

  $sth->execute($o->id);
  my $start = $sth->fetchrow_array;
  $sth->finish;

  $start = parse_date($start);

  is($start->ymd, '2002-10-19', "start 3 - $db_type");

  is($o->start->ymd, '2002-10-20', "start 4 - $db_type");
  is($o->name, 'start get',  "start 5 - $db_type");

  $o->load;

  is($o->start->ymd, '2002-10-20', "start 6 - $db_type");

  $start = $o->start(truncate => 'month');
  is($start->ymd, '2002-10-01', "start 7 - $db_type");

  $start = $o->start(format => '%B %E %Y');
  is($start, 'October 20th 2002', "start 8 - $db_type");

  #
  # ended
  #

  $o = MyObject->new;

  is($o->ended->ymd, '2003-11-22', "ended 1 - $db_type");
  $o->ended('1999-09-10');

  is($o->ended->ymd, '1999-09-10', "ended 2 - $db_type");

  $o->save;

  $o = MyObject->new(id => $o->id);
  $o->load;

  is($o->ended->ymd, '1999-09-10', "ended 3 - $db_type");

  $o->ended('2/3/2004');
  is($o->ended->ymd, '2004-02-03', "ended 4 - $db_type");

  $o->ended(DateTime->new(year => 1980, month => 5, day => 20));
  is($o->ended->ymd, '1980-05-20', "ended 5 - $db_type");

  $o->meta->column('ended')->disable_triggers;
  $o->ended('2/13/2004');
  is($o->ended, '2/13/2004', "disable_triggers - $db_type");

  $o->meta->column('ended')->enable_triggers;
  $o->ended('2/3/2003');
  is($o->ended->ymd, '2003-02-03', "enable_triggers - $db_type");

  #
  # Clean-up
  #

  MyObject->meta->column('name')->delete_trigger(event => 'inflate',
                                                 name  => 'lc_inflate');
}

BEGIN
{
  our %Have;

  #
  # PostgreSQL
  #

  my $dbh;

  eval 
  {
    $dbh = Rose::DB->new('pg_admin')->retain_dbh()
      or die Rose::DB->error;
  };

  if(!$@ && $dbh)
  {
    $Have{'pg'} = 1;
    $Have{'pg_with_schema'} = 1;

    # Drop existing tables and create schema, ignoring errors
    {
      local $dbh->{'RaiseError'} = 0;
      local $dbh->{'PrintError'} = 0;
      $dbh->do('DROP TABLE Rose_db_object_test CASCADE');
      $dbh->do('DROP TABLE Rose_db_object_private.Rose_db_object_test CASCADE');
      $dbh->do('DROP SCHEMA Rose_db_object_private CASCADE');
      $dbh->do('CREATE SCHEMA Rose_db_object_private');
    }

    $dbh->do(<<"EOF");
CREATE TABLE Rose_db_object_test
(
  id             SERIAL NOT NULL PRIMARY KEY,
  name           VARCHAR(32) NOT NULL,
  code           VARCHAR(32),
  start          DATE NOT NULL DEFAULT '1980-12-24',
  ended          TIMESTAMP,
  date_created   TIMESTAMP
)
EOF

    $dbh->do(<<"EOF");
CREATE TABLE Rose_db_object_private.Rose_db_object_test
(
  id             SERIAL NOT NULL PRIMARY KEY,
  name           VARCHAR(32) NOT NULL,
  code           VARCHAR(32),
  start          DATE NOT NULL DEFAULT '1980-12-24',
  ended          TIMESTAMP,
  date_created   TIMESTAMP
)
EOF

    $dbh->disconnect;
  }

  #
  # MySQL
  #

  eval 
  {
    my $db = Rose::DB->new('mysql_admin');
    $dbh = $db->retain_dbh or die Rose::DB->error;

    # Drop existing tables, ignoring errors
    {
      local $dbh->{'RaiseError'} = 0;
      local $dbh->{'PrintError'} = 0;
      $dbh->do('DROP TABLE Rose_db_object_test CASCADE');
    }
  };

  if(!$@ && $dbh)
  {
    $Have{'mysql'} = 1;

    $dbh->do(<<"EOF");
CREATE TABLE Rose_db_object_test
(
  id             INT UNSIGNED AUTO_INCREMENT PRIMARY KEY,
  name           VARCHAR(32) NOT NULL,
  code           VARCHAR(32),
  start          DATE NOT NULL DEFAULT '1980-12-24',
  ended          TIMESTAMP,
  date_created   TIMESTAMP
)
EOF

    $dbh->disconnect;
  }

  #
  # Informix
  #

  eval
  {
    $dbh = Rose::DB->new('informix_admin')->retain_dbh()
      or die Rose::DB->error;
  };

  if(!$@ && $dbh)
  {
    $Have{'informix'} = 1;

    # Drop existing tables, ignoring errors
    {
      local $dbh->{'RaiseError'} = 0;
      local $dbh->{'PrintError'} = 0;
      $dbh->do('DROP TABLE Rose_db_object_test CASCADE');
    }

    $dbh->do(<<"EOF");
CREATE TABLE Rose_db_object_test
(
  id             SERIAL NOT NULL PRIMARY KEY,
  name           VARCHAR(32) NOT NULL,
  code           VARCHAR(32),
  start          DATE DEFAULT '12/24/1980' NOT NULL,
  ended          DATE,
  date_created   DATETIME YEAR TO SECOND
)
EOF

    $dbh->disconnect;
  }

  #
  # SQLite
  #

  eval
  {
    $dbh = Rose::DB->new('sqlite_admin')->retain_dbh()
      or die Rose::DB->error;
  };

  if(!$@ && $dbh)
  {
    $Have{'sqlite'} = 1;

    # Drop existing tables, ignoring errors
    {
      local $dbh->{'RaiseError'} = 0;
      local $dbh->{'PrintError'} = 0;
      $dbh->do('DROP TABLE Rose_db_object_test');
    }

    $dbh->do(<<"EOF");
CREATE TABLE Rose_db_object_test
(
  id             INTEGER PRIMARY KEY AUTOINCREMENT,
  name           VARCHAR(32) NOT NULL,
  code           VARCHAR(32),
  start          DATE DEFAULT '1980-12-24' NOT NULL,
  ended          DATE,
  date_created   DATETIME
)
EOF

    $dbh->disconnect;
  }
}

END
{
  # Delete test table

  if($Have{'pg'})
  {
    # PostgreSQL
    my $dbh = Rose::DB->new('pg_admin')->retain_dbh()
      or die Rose::DB->error;

    $dbh->do('DROP TABLE Rose_db_object_test CASCADE');
    $dbh->do('DROP TABLE Rose_db_object_private.Rose_db_object_test CASCADE');
    $dbh->do('DROP SCHEMA Rose_db_object_private CASCADE');

    $dbh->disconnect;
  }

  if($Have{'mysql'})
  {
    # MySQL
    my $dbh = Rose::DB->new('mysql_admin')->retain_dbh()
      or die Rose::DB->error;

    $dbh->do('DROP TABLE Rose_db_object_test CASCADE');

    $dbh->disconnect;
  }

  if($Have{'informix'})
  {
    # Informix
    my $dbh = Rose::DB->new('informix_admin')->retain_dbh()
      or die Rose::DB->error;

    $dbh->do('DROP TABLE Rose_db_object_test CASCADE');

    $dbh->disconnect;
  }

  if($Have{'sqlite'})
  {
    # Informix
    my $dbh = Rose::DB->new('sqlite_admin')->retain_dbh()
      or die Rose::DB->error;

    $dbh->do('DROP TABLE Rose_db_object_test');

    $dbh->disconnect;
  }
}