The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package DBIDM_Test;

use strict;
use warnings;
use DBIx::DataModel;
use SQL::Abstract::Test import => [qw/is_same_sql_bind/];
use Test::More;
use DBI;
use DBD::Mock 1.39;

use Exporter  qw/import/;
our @EXPORT_OK = qw/sqlLike die_ok HR_connect $dbh/;


# define "HR" schema with a few tables and associations
DBIx::DataModel->Schema(HR => {  # HR=Human Resources
  no_update_columns            => {d_modif => 1, user_id => 1},
  sql_no_inner_after_left_join => 1,
})
->Table(Employee   => T_Employee   => qw/emp_id/, {
    no_update_columns => {last_login => 1},
  })
->Table(Department => T_Department => qw/dpt_id/)
->Table(Activity   => T_Activity   => qw/act_id/)
->Composition([qw/Employee   employee   1 /],
              [qw/Activity   activities * /])
->Association([qw/Department department 1 /],
              [qw/Activity   activities * /])
;


# open a connection to a mock database
our $dbh = DBI->connect('DBI:Mock:', '', '', {RaiseError => 1, AutoCommit => 1});


# closure on the $dbh : testing the generated SQL.
# takes a list of SQL regex and bind params, and a test msg; checks
# if those match with the DBD::Mock history.
sub sqlLike { # closure on $dbh
              # TODO : fix line number, should report the caller's line
  my $msg = pop @_;

  for (my $hist_index = -(@_ / 2); $hist_index < 0; $hist_index++) {
    my ($sql, $bind)  = (shift, shift);
    my $hist = $dbh->{mock_all_history}[$hist_index];

    is_same_sql_bind($hist->statement, $hist->bound_params,
                     $sql,             $bind, "$msg [$hist_index]");
  }
  $dbh->{mock_clear_history} = 1;
}



sub HR_connect {HR->dbh($dbh)};


# die_ok : succeeds if the supplied coderef dies with an exception
sub die_ok(&) {
  my $code=shift;
  eval {$code->()};
  my $err = $@;
  $err =~ s/ at .*//;
  ok($err, $err);
}

1;