view release on metacpan or  search on metacpan

lib/Data/Differences.pm  view on Meta::CPAN

	# a structure that cannot be dissected any further : return it.

	return $self;
    }
}


sub filter_array
{
    my $self = shift;

    my $is_empty = 1;

    foreach my $entry (@$self)
    {
	#t see comments below on ->filter_hash().
	#t perhaps this needs protection with an additional check, not sure.

	if (defined $entry)
	{
	    if ($entry->filter())
	    {
		$is_empty = 0;
	    }
	}
    }

    if ($is_empty)
    {
	@$self = ();
    }

    return $self;
}


sub filter_hash
{
    my $self = shift;

    my $is_empty = 1;

    foreach my $key (keys %$self)
    {
	#t
	#t The first if condition is bogus I guess,
	#t commented out but perhaps
	#t it is right for certain scenarios, unresolved.
	#t The rest of the TODO comments is about the
	#t commented out condition only.
	#t
	#t we can get here with a reference to an empty hash.
	#t without the eval below, we get the perl error
	#t 'Not a SCALAR reference'.  I simply added the
	#t eval {} statement to allow to continue the other
	#t developments.  I inspected via the debugger the
	#t correctness of the software under test,
	#t I am not sure of the correctness of the testing
	#t software.  Given the fact that this eval {} statement
	#t also hides a number of warnings, I suspect so far
	#t unforeseen scenarios that might popup as bugs of
	#t the testing software.

	eval
	{
#  	    if (defined ${$self->{$key}})
	    if (defined $self->{$key})
	    {
		if ($self->{$key}->filter())
		{
		    $is_empty = 0;
		}
	    }
	};
    }

    if ($is_empty)
    {
	%$self = ();
    }

    return $self;
}


sub filter_scalar
{
    my $self = shift;

    if (defined $$self)
    {
	return 1;
    }
    else
    {
	return undef;
    }
}


#
# new()
#
# Create a new structure from the given data structure.
#
# The given data structure must be compliant with the common
# conventions for this data structure, whatever they may be.  They
# still need complete definition.
#
# Currently the differences structure only deals with new data (to be
# added to existing data), it does not deal with data to be removed.
#

sub new
{
    my $proto = shift;

    my $class = ref $proto || $proto;

    my $differences = shift;