File Coverage

blib/lib/Data/Reconciliation.pm

Criterion	Covered	Total	%
statement	102	108	94.4
branch	12	20	60.0
condition	1	3	33.3
subroutine	14	14	100.0
pod	8	8	100.0
total	137	153	89.5

##======================================================================
## Authors:
##    [e-mail]
##    [e-mail]
##======================================================================
## Copyright (c) 2001, Siemens Financial Services. All rights reserved.
## This library is free software; you can redistribute it and/or modify
## it under the same terms as Perl itself.
##======================================================================
## $Log:$
##======================================================================

package Data::Reconciliation;

require 5.005_62;
use strict;
use warnings;

use Data::Table;
use Carp;

use Data::Reconciliation::Rule;

require Exporter;

our $VERSION = '0.07';

sub new {
    my $class = shift;
    my $source1 = shift;
    my $source2 = shift;
    my %prms = @_;

    croak 'Sources must be of type Data::Table'
	if (! eval {$source1->isa('Data::Table')}) ||
	    (! eval {$source2->isa('Data::Table')});

    my @rules;
    if (exists $prms{-rules}) {
	@rules = @{$prms{-rules}};

	croak 'Invalid Data::Reconciliation::Rule'
	    if grep(! eval {$_->isa('Data::Reconciliation::Rule')},
		    @rules);

    } else {
	my $r = new Data::Reconciliation::Rule;
	$r->identification([0], undef, [0], undef);

	my $col_nb = 0;
	foreach ($source1->header) {
	    $r->add_comparison([++$col_nb], undef, [$col_nb], undef, undef);
	}
	push @rules, $r;
    }

    return bless {'srcs' => [$source1, $source2],
		  'rules' => \@rules,
		  #'result-store' => $result_store
	      }, $class;
}

sub build_signatures {
    my $this    = shift;
    my $rule_nb = shift;

    croak 'usage: $r->build_signatures();'
	if ! defined $rule_nb;

    croak 'invalid rule nb'
	if $rule_nb >= @{$this->{'rules'}};

    for my $src_nb (0 .. 1) {
	my %signature;
	my $rule = $this->{'rules'}->[$rule_nb];
	my $src = $this->{'srcs'}->[$src_nb];
	    for(my $i = 0 ; $i < $src->nofRow ; $i++) {
		push @{$signature{$rule->signature($src_nb, $src->rowRef($i))}}, $i;
	    }
	$this->{'signatures'}->[$src_nb] = \%signature;
    }
}

sub signatures {
    my $this = shift;
    return ([], []) if ! defined $this->{'signatures'};
    return @{$this->{'signatures'}};
}

sub duplicate_signatures {
    my $this = shift;
    my @results;
    foreach my $src_nb (0..1) {
	my $signature = $this->{'signatures'}->[$src_nb];
	$results[$src_nb] = {
	    map {
		($_ => $signature->{$_})
		} grep(1 < @{$signature->{$_}}, keys %$signature)
	}
    }
    return @results;
}

sub _delete {
    my $this = shift;
    my @signs = @_;
    my @results = ({},{});
    foreach my $src_nb (0..1) {

	my $signs = $signs[$src_nb];
	next if @$signs == 0;

	my $src = $this->{'srcs'}->[$src_nb];
	my $signature = $this->{'signatures'}->[$src_nb];

	%{$results[$src_nb]} = map { ($_ => delete $signature->{$_}) } @$signs;
    }
    return @results;
}

sub delete_dup_signatures {
    my $this = shift;
    return $this->_delete(map {[keys %$_]} $this->duplicate_signatures);
}

sub widow_signatures {
    my $this = shift;
    my @results = ({},{});
    foreach my $src_nb (0..1) {

	my $sign = $this->{'signatures'}->[$src_nb];
	my $sign_other_src = $this->{'signatures'}->[ $src_nb == 0 ? 1 : 0 ];
	my $result = $results[$src_nb];

	%$result = map {($_ =>$sign->{$_})}
	            grep(! exists $sign_other_src->{$_}, keys %$sign);

#  	foreach my $sign (keys %$sign) {
#  	    push @$result, ($sign => $sign->{$sign})
#  		if ! exists $sign_other_src->{$sign};
#  	}
    }
    return @results;
}

sub delete_wid_signatures {
    my $this = shift;
    return $this->_delete(map {[keys %$_]} $this->widow_signatures);
}

sub reconciliate {
    my $this = shift;
    my $rule_nb = shift;

    croak 'usage: $r->reconciliate();'
	if ! defined $rule_nb;

    croak 'invalid rule nb'
	if $rule_nb >= @{$this->{'rules'}};

    my $rule = $this->{'rules'}->[$rule_nb];
    my @results;

    my $sign_1 = $this->{'signatures'}->[0];
    my $src_1  = $this->{'srcs'}->[0];
    my $sign_2 = $this->{'signatures'}->[1];
    my $src_2  = $this->{'srcs'}->[1];

    foreach my $signature (keys %$sign_1) {

	(my $idx1) = @{$sign_1->{$signature}};
	(my $idx2) = @{$sign_2->{$signature}};

	my $rec1 = [ $src_1->row($idx1) ];
	my $rec2 = [ $src_2->row($idx2) ];

	push @results, map {
#	    if ($mode eq 'all') {
		[$signature, [$idx1, $idx2], $rule, $_];
#  	    } elsif ($mode eq 'ok') {
#  		$_ ? () : [$key, $rule, $_];
#  	    } else {
#  		$_ ? [$key, $rule, $_] : ();
#  	    }
	} $rule->compare($rec1, $rec2);

    }

    return @results;
}

1;
__END__