The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# iterator testing - DBIx::Recordset and Class::DBI iterators
# 
# uses the mysql 'test' database, if available
#

use strict;
use Test::More;
use HTML::Tabulate;
use Data::Dumper;
use FindBin qw($Bin);

plan skip_all => '$ENV{HTML_TABULATE_TEST_DSN} not set - skipping db iterator tests'
  unless $ENV{HTML_TABULATE_TEST_DSN};
plan skip_all => 'DBI not installed'
  unless eval { require DBI };

# Load result strings
my %result = ();
my $test = "$Bin/t10";
die "missing data dir $test" unless -d $test;
opendir my $datadir, $test or die "can't open directory $test";
for (readdir $datadir) {
  next if m/^\./;
  open my $fh, "<$test/$_" or die "can't read $test/$_";
  { 
    local $/ = undef;
    $result{$_} = <$fh>;
  }
  close $fh;
}
close $datadir;

my $t = HTML::Tabulate->new({
  fields => [ qw(emp_id emp_name emp_title emp_birth_dt) ],
  table => { border => 0, class => 'table' },
  thtr => { class => 'thtr' },
  tr => { class => 'tr' },
  labels => 1,
  null => '-',
  trim => 1,
});

my $dbh;
SKIP: {
  my $db_tests = 2;

  # Setup test data
  ok($dbh = DBI->connect($ENV{HTML_TABULATE_TEST_DSN}, $ENV{HTML_TABULATE_TEST_USER}, $ENV{HTML_TABULATE_TEST_PASS}), 
    "connected to db '$ENV{HTML_TABULATE_TEST_DSN}' ok");
  ok($dbh->do("drop table if exists emp_tabulate"), 'drop table emp_tabulate ok');
  ok($dbh->do(qq(
    create table emp_tabulate (
      emp_id integer unsigned auto_increment primary key,
      emp_name varchar(255),
      emp_title varchar(255),
      emp_birth_dt date
    )
  )), 'create table emp_tabulate ok');
  ok(eval {
    $dbh->do(qq(
      insert into emp_tabulate values(123, 'Fred Flintstone', 'CEO', '1971-04-30')
    ));
    $dbh->do(qq(
      insert into emp_tabulate values(456, 'Barney Rubble', 'Lackey', '1975-08-04')
    ));
    $dbh->do(qq(
      insert into emp_tabulate values(789, 'Dino  ', 'Pet', null)
    ));
  }, 'emp_tabulate inserts ok');

  # DBIx::Recordset
  SKIP: {
    eval { require DBIx::Recordset };
    skip "DBIx::Recordset not installed", $db_tests if $@;

    my $set = eval { DBIx::Recordset->SetupObject({
      '!DataSource' => $dbh,
      '!Table' => 'emp_tabulate',
      '!PrimKey' => 'emp_id',
    }) };
    skip "DBIx::Recordset employee retrieve failed", $db_tests if $@;
    $set->Select;

    # Render1
    my $table = $t->render($set);
#   print $table, "\n";
    is ($table, $result{render1}, "DBIx::Recordset render1 okay");

    # Render2 (across)
    $table = $t->render($set, { style => 'across' });
#   print $table, "\n";
    is ($table, $result{render2}, "DBIx::Recordset render2 okay");
  }

  SKIP: {
    # Class::DBI setup
    eval { require Class::DBI } or skip "Class::DBI not installed", $db_tests;
    # Define a temp Class::DBI Employee class
    eval qq(
      package Employee;
      use base 'Class::DBI';
      __PACKAGE__->table('emp_tabulate');
      __PACKAGE__->columns(Essential => qw(emp_id emp_name emp_title emp_birth_dt));
    );
    { 
      no warnings;
      *Employee::db_Main = sub { $dbh };
    }
  
    package main;
    my $iter = eval { Employee->retrieve_all };
    skip "Class::DBI employee retrieve failed: $@", $db_tests if $@;
 
    # Render1
    my $table = $t->render($iter);
#   print $table, "\n";
    is ($table, $result{render1}, "Class::DBI render1 okay");

    # Render2 (across)
    $table = $t->render($iter, { style => 'across' });
#   print $table, "\n";
    is ($table, $result{render2}, "Class::DBI render2 okay");
  }

  SKIP: {
    # DBIx::Class setup
    eval { require DBIx::Class } or skip "DBIx::Class not installed", $db_tests;
    eval { require DBIx::Class::Schema::Loader } or skip "DBIx::Class::Schema::Loader not installed", $db_tests;
    DBIx::Class::Schema::Loader::make_schema_at('HTML::Tabulate::Schema', { debug => 0 },
      [ $ENV{HTML_TABULATE_TEST_DSN}, $ENV{HTML_TABULATE_TEST_USER}, $ENV{HTML_TABULATE_TEST_PASS} ])
      or skip "Cannot create temp DBIx::Class Schema from database", $db_tests;
  
    my $schema = eval { HTML::Tabulate::Schema->connect(sub { $dbh }) }
      or skip("DBIx::Class schema connect failed: $@", $db_tests);
    my $iter = $schema->resultset('EmpTabulate')
      or skip("DBIx::Class employee iterator setup failed: $@", $db_tests);
 
    # Render1
    my $table = $t->render($iter);
#   print $table, "\n";
    is ($table, $result{render1}, "DBIx::Class render1 okay");

    # Render2 (across)
    $table = $t->render($iter, { style => 'across' });
#   print $table, "\n";
    is ($table, $result{render2}, "DBIx::Class render2 okay");
  }

  eval { $dbh->do("drop table if exists emp_tabulate") };
}

$dbh->disconnect if ref $dbh;

# Code iterators
$t = HTML::Tabulate->new({ labels => 1, trim => 1, null => '-' });
my @data = ( 
  [ '123', 'Fred Flintstone', 'CEO' ], 
  [ '456', 'Barney Rubble', 'Lackey' ],
  [ '789', 'Wilma Flintstone   ', 'CFO' ], 
  [ '777', 'Betty Rubble', '' ], 
);
my $iterator = sub {
  return shift @data;
};
my $table = $t->render($iterator, { fields => [ qw(emp_id emp_name emp_title) ] });
is($table, $result{render3}, "code iterator ok (arrayrefs)");

$t = HTML::Tabulate->new({ labels => 1, trim => 1, null => '-' });
@data = ( 
  { emp_id => '123', emp_name => 'Fred Flintstone',     emp_title => 'CEO' }, 
  { emp_id => '456', emp_name => 'Barney Rubble',       emp_title => 'Lackey' },
  { emp_id => '789', emp_name => 'Wilma Flintstone   ', emp_title => 'CFO' }, 
  { emp_id => '777', emp_name => 'Betty Rubble' }, 
);
$iterator = sub {
  return shift @data;
};
$table = $t->render($iterator);
is($table, $result{render3}, "code iterator ok (hashrefs, derived fields)");

done_testing;