Every Moose has a bad day.

Another sad day in the Moose-Pen

Not a good way to start another year of blogging as I was reviewing my tests and when I got into '47_dynamic_gathers.t' I was getting a duplication on the number of conditions on a gather which is not a good thing.

Somewhere in the last few days I really buggered something up.

Well after much hair pulling and debugging I finally stumbled into it. It seems I have added so many warns and comment out code over the past few days I was playing with subs that look like this;


sub _predicate_array_or_object {

my ( $class, $in ) = @_;

warn( "JPS 1 _predicate_array_or_object $class in=" . Dumper($in) );
my $objects = [];
foreach my $object ( @{$in} ) {
warn( "JPS 2 ref object" . Dumper($object) );
if ( ref($object) eq $class ) {
push( @{$objects}, $object );
}
elsif ( ref($object) eq "ARRAY" ) {
push(
@{$objects},
@{ _predicate_array_or_object( $class, $object ) }
);
}
else {
warn( "JPS 3 ref object" . ref($object) );
my $predicate = _create_instance( $class, { predicates => $object },4,$object);
warn( "JPS 4 ref object" . ref($object) );
push( @{$objects},$predicate);
# unless ($object) {
#warn( "JPS 5 ref object" . ref($object) );

# eval {

# };
# my ( $package, $filename, $line, $subroutine ) = caller(3);
# # #warn("$class $package, $filename, $line, $subroutine");
# $subroutine =~ s/Database::Accessor:://g;
# $class =~ s/Database::Accessor:://g;
# my $die =
# MooseX::Constructor::AllErrors::Error::Constructor->new(
# caller => [ $package, $filename, $line, $subroutine ], );
# $die->add_error(
# MooseX::Constructor::AllErrors::Error::Misc->new(
# {
# message => "Database::Accessor "
# . $subroutine
# . " Error:\n"
# . "You cannot add undef to dynamic_"
# . $class . "s! "
# }
# )
# );
# die $die;
# }
#warn("Error re$objectf is ".ref($@))
# if($@);

# unless ($hash) {

# eval {
# $object = Database::Accessor::Element->new( %{$hash} );
# };

# my ( $package, $filename, $line, $subroutine ) = caller(4);
# #warn(" $package, $filename, $line, $subroutine");
# $subroutine =~ s/Database::Accessor:://g;
# my $add = substr($subroutine,4,length($subroutine));
# # $class =~ s/Database::Accessor:://g;
# my $die =
# MooseX::Constructor::AllErrors::Error::Constructor->new(
# caller => [ $package, $filename, $line, $subroutine ], );
# $die->add_error(
# MooseX::Constructor::AllErrors::Error::Misc->new(
# {
# message => "Database::Accessor "
# . $subroutine
# . " Error:\n"
# . "You cannot add undef to dynamic_"
# . $add
# . "! "
# }
# )
# );
# die $die;
# }
# els
# if ( exists( $hash->{expression} ) ) {
# $hash->{expression} = uc( $hash->{expression} );
# $object = Database::Accessor::Expression->new( %{$hash} );
# }
# elsif ( exists( $hash->{function} ) ) {
# $hash->{function} = uc( $hash->{function} );
# $object = Database::Accessor::Function->new( %{$hash} );
# }
# elsif ( exists( $hash->{value} ) || exists( $hash->{param} ) ) {
# $object = Database::Accessor::Param->new( %{$hash} );
# }
# elsif ( exists( $hash->{ifs} ) ) {
# die "Attribute (ifs) does not pass the type constraint because:
# Validation failed for 'ArrayRefofThens' with less than 2 ifs"
# if ( exists( $hash->{ifs} )
# and ref( $hash->{ifs} ) eq 'ARRAY'
# and scalar( @{ $hash->{ifs} } < 2 ) );

# $object = Database::Accessor::If->new( %{$hash} );
# }
# else {

# #warn("JPS herre in_element_coerce $hash ".Dumper($hash));
# my ($package, $filename, $line, $subroutine ) = caller(3);
# #warn( "$hash first $package, $filename, $line, $subroutine");

# unless ($hash) {

# my ( $package, $filename, $line, $subroutine ) = caller(4);
# #warn(" $package, $filename, $line, $subroutine");
# $subroutine =~ s/Database::Accessor:://g;
# my $add = substr($subroutine,4,length($subroutine));
# # $class =~ s/Database::Accessor:://g;
# my $die =
# MooseX::Constructor::AllErrors::Error::Constructor->new(
# caller => [ $package, $filename, $line, $subroutine ], );
# $die->add_error(
# MooseX::Constructor::AllErrors::Error::Misc->new(
# {
# message => "Database::Accessor "
# . $subroutine
# . " Error:\n"
# . "You cannot add undef to dynamic_"
# . $add
# . "! "
# }
# )
# );
# die $die;
# }
# if ( exists( $hash->{left} ) or exists( $hash->{right} ) ) {
# my %copy = %{ Clone::clone($hash) };
# delete( $copy{left} );
# delete( $copy{right} );
# $LAST = \%copy;

# }
# # $object = Database::Accessor::Element->new( %{$hash} );
# _create_instance("Database::Accessor::Element",$hash,4,$hash);
# my ( $class, $ops,$caller,$raw )
# # };
# # if ($@) {
# # confess($@);
# # }
# # die ($@);
# }
push( @{$objects}, $class->new( { predicates => $object } ) );
}
}
return $objects;
}


Looks like I left in an extra push at the very bottom of the code a silly mistake but I guess that is why we write tests.

The cleaned up sub looks like this now;


sub _predicate_array_or_object {
my ( $class, $in ) = @_;
my $objects = [];
foreach my $object ( @{$in} ) {
if ( ref($object) eq $class ) {
push( @{$objects}, $object );
}
elsif ( ref($object) eq "ARRAY" ) {
push(
@{$objects},
@{ _predicate_array_or_object( $class, $object ) }
);
}
else {
my $predicate =
_create_instance( $class, { predicates => $object }, 4, $object );
push( @{$objects}, $predicate );
}
}
return $objects;
}

a little eisser on the eys and now my test passes.

I think is is time I did a major clean-up of the code and re-run my full suite. But that is for tomorrow.

ClC2UAb.jpg

Leave a comment

About byterock

user-pic Long time Perl guy, a few CPAN mods allot of work on DBD::Oracle and a few YAPC presentations