A Real Life Example

#!/usr/bin/perl -w

use strict;

use Test::More qw(no_plan);

use Catalyst::Logger::File;
use EEC::DataMatching::DB;
use EEC::DataMatching::Cache;

$EEC::DataMatching::Record::DEBUG = 1;

$ENV{DM_DBNAME}  ||= 'dm-test';
my $LOG_FILE = 'load.log';

my @TEST = (
#  Source    Module            Load file                     Correct processed details
  ['DIA',    'NewCitizens',    "Electoral.txt"             , "Electoral.correct"],
  ['LTSA',   'LTSA',           "Dlrchanges.txt"            , "Dlrchanges.correct"],
  ['MOT',    'Transport',      "Mvrchanges.txt"            , "Mvrchanges.correct"],
  ['MSB',    'SocialBenefits', "SWIFTT_Changed_Clients.txt", "SWIFTT_Changed_Clients.correct"],
  ['MSL',    'StudentLoans',   "SAL_Changed_Clients.txt"   , "SAL_Changed_Clients.correct"],
# ['Filter', 'NegativeFilter', "Filter.txt"                , ""],
);
my @FIELDS = qw(
 surname
 forenames
 dob

 dwelling
 flat_number
 house_number
 house_alpha
 street
 town_suburb
 city
 postcode       
 rural_delivery
);

unlink $LOG_FILE if -f $LOG_FILE;
my $logger = new Catalyst::Logger::File($LOG_FILE) or die;
my $db     = new EEC::DataMatching::DB(logger => $logger,
#                                      eec_cache => EEC::DataMatching::Cache->new($logger)
                                       ) or die;
my $match_count_sth = $db->dbh->prepare("SELECT count(*) FROM match WHERE source = ?");
my $test_sth        = $db->dbh->prepare("SELECT * FROM match WHERE source = ? ORDER BY row");

$db->clear;

foreach ( @TEST ) {
    my ($source, $module, $load_file, $correct_file) = @$_;
    print "$source <- $load_file\n";

    my $full_module = "EEC::DataMatching::Loader::$module";

    require_ok( $full_module ) or next;

    my $loader = $full_module->new( db => $db );
    $loader->load( file => $load_file );

    $match_count_sth->execute($source);
    my $num_loaded = $match_count_sth->fetchrow_array;
    unless ($num_loaded) {
        print "No records loaded from $load_file\n";
        next;
    }

    open CORRECT, $correct_file or die "Cannot open $correct_file: $!";
    my @correct = eval join('', <CORRECT>);
    die $@ if $@;
    use Data::Dumper;
#   die Dumper(\@correct) if $source eq 'LTSA';

    $test_sth->execute($source);
    while ( my $rec = $test_sth->fetchrow_hashref ) {
        my $row = $rec->{row};
        my $correct = shift @correct
          or fail("row $row"),
             diag( "No correct address in $correct_file" ),
             diag( dump_rec($rec) ),
             next;
        
        my $reject_reason = $rec->{reject_reason};
        if (my $correct_reject_reason = $correct->{reject_reason}) {
            like($reject_reason, qr/^$correct_reject_reason/,
               "row $row rejected $correct_reject_reason" )
              or diag ( $reject_reason || "Not rejected" );
            next;
        } else {
            ok(!$reject_reason, "row $row not rejected" )
              or diag ( "Rejected $reject_reason" );
        }

        my $mismatch = find_mismatch($rec, $correct);
        ok(!$mismatch, "row $row") 
          or diag ( "$mismatch mismatch for $rec->{surname} $rec->{forenames}" )
#         ,  diag ( dump_rec($rec) )
          ;

        TODO: {
            local $TODO = "Not finished";
        }
    }
}



sub find_mismatch {
    my ($rec1, $rec2) = @_;

    foreach (@FIELDS) {
        my ($v1, $v2) = ($rec1->{$_}, $rec2->{$_});
        $v1 = '' unless defined $v1;
        $v2 = '' unless defined $v2;

        return qq{$_ ("$v1" ne "$v2")} unless $v1 eq $v2;
    }

    return undef;
}

sub dump_rec {
    my $rec = shift or die;

    return sprintf "{%s},",
      join ", ",
        map { $rec->{$_} ? "$_ => ".qq("$rec->{$_}") : () } @FIELDS;
}