File Coverage

blib/lib/Data/Presenter/Combo/Intersect.pm

Criterion	Covered	Total	%
statement	41	41	100.0
branch	4	4	100.0
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	49	49	100.0

package Data::Presenter::Combo::Intersect;
#$Id: Intersect.pm 1218 2008-02-10 00:11:59Z jimk $
$VERSION = 1.03; # 02-10-2008
@ISA = qw(Data::Presenter::Combo);
use strict;
use warnings;
use Data::Dumper;

our %reserved_partial = (
    'fields'   => 1,
    'index'    => 1,
    'options'  => 1,
);

sub _merge_engine {
    my ($self, $mergeref) = @_;

    my %base                = %{${$mergeref}{base}};
    my %sec                 = %{${$mergeref}{secondary}};
    my %newbase             = %{${$mergeref}{newbase}};
    my %secneeded           = %{${$mergeref}{secfieldsneeded}};

    my %seenboth = ();

    # Work thru the entries in the base ...
    foreach my $i (keys %base) {
        # reserved entry qw| parameters | gets built here without any fuss
        # reserved entries qw| fields index options | get built in Combo.pm
        unless ($reserved_partial{$i}) {
            # and build up a look-up table %seenboth where each key is an entry
            # in the base found in BOTH base and sec
            # i.e., the intersection of base and sec
            foreach my $j (keys %sec) {
                if ($i eq $j) {
                    $seenboth{$i} = 1;
                    last;
                }
            }
        }
    }

    # Work thru the look-up table ...
    my $null = q{};
    foreach my $rec (keys %seenboth) {
        my (@basevalues, @secvalues);
        # 1.  Assign the values encountered first in base
        my @record = @{$base{$rec}};
        for (my $q=0; $q < scalar(@record); $q++) {
            $basevalues[$q] = $record[$q];
        }
        # 2.  Assign the values encountered first in sec
        # (%secneeded's keys are numbers:  field's subscripts in sec
        foreach my $i (sort {$a <=> $b} keys %secneeded) {
            push @secvalues, $sec{$rec}[$i];
        }
        $newbase{$rec} = [@basevalues, @secvalues];
    }
    return \%newbase;
    # Note:  This is actually newbase less the 'fields' and 'index' entries
}

1;

############################## DOCUMENTATION ##############################

=head1 NAME

Data::Presenter::Combo::Intersect

=head1 VERSION

This document refers to version 1.03 of Data::Presenter::Combo::Intersect, released February 10, 2008.

=head1 DESCRIPTION

This package is a subclass of, and inherits from, Data::Presenter::Combo.  Please see the Data::Presenter documentation to learn how to use Data::Presenter::Combo::Intersect.

=head1 AUTHOR

James E. Keenan ([e-mail]).

Creation date:  October 28, 2001.  Last modification date:  February 10, 2008.
Copyright (c) 2001-5 James E. Keenan.  United States.  All rights reserved.

All data presented in this documentation or in the sample files in the
archive accompanying this documentation are dummy copy.  The data was
entirely fabricated by the author for heuristic purposes.  Any resemblance
to any person, living or dead, is coincidental.

This is free software which you may distribute under the same terms as
Perl itself.

=cut