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