byterock

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.