Test::DataLoader::MySQL - Load testdata into MySQL database

  my $data = Test::DataLoader::MySQL->new($dbh);
  $data->add('foo', #table name
             1,     # data id
             {# data_href: column => value
                 id => 1, 
                 name => 'aaa',
             },
             ['id']); # primary keys
  $data->add('foo', 2,
             {
                 id => 2,
                 name => 'bbb',
             },
             ['id']);
  $data->load('foo', 1); #load data into database
  # ... tests using database
  $data->clear;# when finished

  $data->add('foo', 1,
           {
               name => 'aaa',
           },
           ['id']);
  my $keys = $data->load('foo', 1);#load data and get auto_increment
  is( $keys->{id}, 2); # get key value(generated by auto_increment)
  # ... tests using database
  $data->clear;# when finished

  # data.pm
  my $data = Test::DataLoader::MySQL->init(); # use init(not new)
  $data->add('foo', 1,
             {
                id => 1,
                name => 'aaa',
             },
             ['id']);
  # in your testcode
  my $data = Test::DataLoader::MySQL->new($dbh);
  $data->load('foo', 1);
  # ... tests using database
  $data->clear;# when finished

  #$dbh = DBI->connect(...);

  my $data = Test::DataLoader::MySQL->new($dbh); # loaded data is deleted when $data is DESTROYed
  # or
  my $data = Test::DataLoader::MySQL->new($dbh, Keep => 1); # loaded data is remain
  # or
  my $data = Test::DataLoader::MySQL->new($dbh, DeleteBeforeInsert => 1); # delete data which has same keys before load

  $data->add('foo',  # table_name
              1,     # data_id, 
              {      # data which you want to load into database. specified by hash_ref
                 id => 1,
                 name => 'aaa',
              },
              ['id'] #key(s), specified by array_ref, this is important.
              );

 $data->load('foo', 1);

 $data->add('foo', 1, { id=>1, name=>'aaa' }); #registered name is 'aaa'
 $data->load('foo', 1, { name=>'bbb' });       #but loaded name is 'bbb' because option href is specified.

 my $key = $data->load('foo', 1);
 my $id = $key->{id};

 $data->load_direct('foo', { id=>1, name=>'aaa' }, ['id']);

 my $key = $data->load_direct('foo', { id=>1, name=>'aaa' }, ['id']);

 $data->add('foo', 1, { id=>1, name=>'aaa' }, ['id']);
 my $key = $data->load('foo', 1);

 $data->load_file('data.pm');

 my $data = Test::DataLoader::MySQL->init();
 #$data->add(...

  $data->do_select('foo', "id=1");

package Test::DataLoader::MySQL;
use strict;
use warnings;
use DBI;
use DBD::mysql;
use Carp;
use base qw(Exporter);
our $VERSION = '0.1.0';
use 5.008;

my $singleton; #instance object is shared for reading data from external file.
END {#delete data if test code is abort
    if (defined $singleton &&  @{ $singleton->{loaded} } ) {
        $singleton->clear;
    }
}

sub new {
    my $class = shift;
    my ($dbh, %options) = @_;
    my $self = defined $singleton ? $singleton : {};

    $self = {
        dbh => $dbh,
        loaded   => [],
        keynames => undef,#keys set in  set_keys()
        Keep               => !!$options{Keep},
        DeleteBeforeInsert => !!$options{DeleteBeforeInsert},
    };

    bless $self, $class;
    $singleton = $self;
    return $self;
}

sub add {
    my $self = shift;
    my ($table_name, $data_id, $data_href, $key_aref) = @_;

    carp "already exists $table_name : $data_id" if ( exists $self->{data} &&
                                                      exists $self->{data}->{$table_name}->{$data_id} );
    $self->{data}->{$table_name}->{$data_id} = { data => $data_href, key => $key_aref };
}

sub load {
    my $self = shift;
    my ($table_name, $data_id, $option_href) = @_;

    my %data = $self->_data_with_option($table_name, $data_id, $option_href);
    my $keynames_aref = $self->_get_keys($table_name, $data_id);

    return $self->_load($table_name, $keynames_aref, %data);
}

sub _get_keys {
    my $self = shift;
    my ($table_name, $data_id) = @_;
    my $keynames_aref = $self->{data}->{$table_name}->{$data_id}->{key};
    if ( $self->_aref_is_empty($keynames_aref) ) {
        $keynames_aref = $self->{keynames}->{$table_name};
    }
    return $keynames_aref;
}

sub _data_with_option {
    my $self = shift;
    my ($table_name, $data_id, $option_href) = @_;
    my %data = %{$self->_data($table_name, $data_id)};

    if ( defined $option_href ) {
        for my $key ( keys %{$option_href} ) {
            $data{$key} = $option_href->{$key};
        }
    }
    return %data;
}

sub load_direct {
    my $self = shift;
    my ($table_name, $data_href, $keynames_aref) = @_;
    my %data = %{ $data_href };
    if ( $self->_aref_is_empty($keynames_aref) ) {
        $keynames_aref = $self->{keynames}->{$table_name};
    }

    return $self->_load($table_name, $keynames_aref, %data);
}

sub _load {
    my $self = shift;
    my ($table_name, $keynames_aref, %data) = @_;

    croak "primary keys are not defined\n" if ( $self->_aref_is_empty($keynames_aref) );
    if ( $self->{DeleteBeforeInsert} && $self->_data_for_key_exists($keynames_aref, %data) ) {
        $self->_delete($table_name, \%data, $keynames_aref);
    }
    $self->_do_insert($table_name, %data);
    my $keys = $self->_primary_keys($keynames_aref, \%data);
    $self->{dbh}->do('commit');

    push @{$self->{loaded}}, [$table_name, \%data, $keynames_aref];

    return $keys;

}

sub _aref_is_empty {
    my $self = shift;
    my ($keynames_aref) = @_;
    return !defined $keynames_aref || !@{ $keynames_aref };
}

sub _data_for_key_exists {
    my $self = shift;
    my ($keynames_aref, %data) = @_;
    for my $key ( @{ $keynames_aref } ) {
        return 0 if ( !exists $data{$key} );
    }
    return 1;
}



sub _do_insert {
    my $self = shift;
    my ($table_name, %data) = @_;
    my $dbh = $self->{dbh};
    my $sth = $dbh->prepare($self->_insert_sql($table_name, %data)) || croak $dbh->errstr;
    my $i=1;
    for my $column ( sort keys %data ) {
        $sth->bind_param($i++, $data{$column});
    }
    $sth->execute() || croak $dbh->errstr;
    $sth->finish;
}

sub load_file {
    my $self = shift;
    my ( $filename ) = @_;
    require $filename;
    croak("can't read $filename") if ( $@ );
}

sub init {
    my $class = shift;
    my $self = {};
    if ( defined $singleton ) {
        $self = $singleton;
    }
    else {
        bless $self, $class;
        $singleton = $self;
    }
    return $self;
}

sub set_keys {
    my $self = shift;
    my($table_name, $keynames_aref) = @_;
    $self->{keynames}->{$table_name} = $keynames_aref;
}

sub _primary_keys {
    my $self = shift;
    my ($keynames_aref, $data_href) = @_;

    my $result;
    for my $key ( @{ $keynames_aref } ) {
        if ( !defined $data_href->{$key} ) { #for auto_increment
            $data_href->{$key} = $self->_last_insert_id() || undef; #if LAST_INSERT_ID returns '0' its not auto_increment
        }
        $result->{$key} = $data_href->{$key}

    }
    return $result;
}

sub _last_insert_id {
    my $self = shift;

    my $dbh = $self->{dbh};
    my $sth = $dbh->prepare("select LAST_INSERT_ID() from dual") || croak $dbh->errstr;
    $sth->execute() || croak $dbh->errstr;
    if ( my @id = $sth->fetchrow_array ) {
        return $id[0];
    }
    return;
}

sub do_select {
    my $self = shift;
    my ($table, $condition) = @_;
    my $dbh = $self->{dbh};
    croak( "Error: condition undefined" ) if !defined $condition;

    my $sth = $dbh->prepare("select * from $table where $condition");
    $sth->execute();

    my @result;
    while( my $item = $sth->fetchrow_hashref ) {
        push @result, $item;
    }
    $sth->finish();

    return @result if wantarray;
    return $result[0];
}

sub _insert_sql {
    my $self = shift;
    my ($table_name, %data) = @_;
    my $sql = sprintf("insert into %s set ", $table_name);
    $sql .= join(',', map { "$_=?" } sort keys %data);
    return $sql;
}

sub _data {
    my $self = shift;
    my ($table_name, $data_id) = @_;
    croak "$table_name not found"               if ( !exists $self->{data}->{$table_name} );
    croak "$data_id for $table_name not found"  if ( !exists $self->{data}->{$table_name}->{$data_id} );
    return $self->{data}->{$table_name}->{$data_id}->{data};
}


sub DESTROY {
    my $self = shift;
    if ( @{ $self->{loaded} } ) {
        carp "clear was not called in $0";
        $self->clear;
    }

}

sub clear {
    my $self = shift;
    my $dbh = $self->{dbh};
    if ( $self->{Keep} || !defined $dbh ) {
        $self->{loaded} = [];
        return;
    }

    for my $loaded ( reverse @{ $self->{loaded} } ) {
        $self->_delete_loaded($loaded);
    }
    $dbh->do('commit');
    $self->{loaded} = [];
}

sub _delete_loaded {
    my $self = shift;
    my ($loaded) = @_;

    my( $table_name, $data_href, $keynames_aref ) = @{ $loaded };
    $self->_delete($table_name, $data_href, $keynames_aref);
}

sub _delete {
    my $self = shift;
    my ($table_name, $data_href, $keynames_aref) = @_;
    my $dbh = $self->{dbh};
    my %data = %{ $data_href };
    my @keys = @{ $keynames_aref };
    my $condition = join(' And ', map { 
        defined $data{$_} ? "$_=?" : "$_ IS NULL"
    } @keys);
    my $sth = $dbh->prepare("delete from $table_name where $condition");
    my $i=1;
    for my $key ( @keys ) {
        $sth->bind_param($i++, $data{$key});
    }
    $sth->execute() || croak $dbh->errstr;
}

1;
__END__