byterock

Its hold your head in shame smarty pants day here in the Moose pen.

So here I am with a little 'mea culpa' for yesterday post. I had what you would call a real newbie flaw to to that I should of caught right away.

Now it was not in the re-factoring or the implantation of the re-factoring that was all ok my problem was assuming that the coercion of my objects was not happening on a new. Of course it was so when I hit the test where I had an coercion error on new on a coerced object I was getting a double fail that would wash out my original fail.

The real problem is this code in my 'Types'

coerce 'Predicate', from 'HashRef',

  via { 

     my $object;

     eval {

         $object = Database::Accessor::Predicate->new( %{$_} ) ;

      };

      if ($@) {

            _one_error($_);

      }

      return $object;

  };

and it occurs when I have an error on a deeply nested attribute, such as the 'conditions' on the gather of this '$in_hash'

$in_hash = {

    view => { name => 'People' },

    elements => [ { name => 'first_name', }, { name => 'last_name', }, ],

    gather    => {

                elements => [

                    {

                        name => 'first_name',

                        view => 'People4'

                    },

                ],

                conditions => [

                    {

                        left_failx => {

                            name => 'last_name',

                            view => 'People7'

                        },

                        right             => { value => 'test' },

                        operator          => '=',

                        open_parentheses  => 1,

                        close_parentheses => 0,

                        condition         => 'AND',

                    },

                ]

            }

};

I will get an error header like this;

Database::Accessor Error:

The following Attribute is required: (conditions->left)

where I was expecting one like this

Database::Accessor new Error:

The following Attribute is required: (conditions->left)

what was happening was the coercion is happening in a nested item and therefore it dies they when it fires the '_one_error' and never gets to the '_one_error' sub in the 'around'

I found this out by chance as my test was just checking to see if '(conditions->left)' was present.

The main reason why I want this to work is when I do something like this;

$da->add_condition( {

            leftx => {

                name => 'last_name',

                view => 'People'

            },

            right             => { value => 'test' },

            operator          => '=',

            open_parentheses  => 1,

            close_parentheses => 0,

            condition         => 'AND',

        },);

I want to use the same function to handle both errors.

Well I spent the day today to see if I could weasel out of this this one.

I tried checking the caller in the coerce with little luck to see it there was something in the stack that would tell me is I am in a new or not. I did get something to work with as I found this in the call stack 'Class::MOP::Class:::around' however that only worked intermtitanly as the stack was different each time I made a call.

I then look twice at I think every MooseX out there and did not find one that could help me. I either had to do a major re-write using an object builder of some form or write even more code an try attribute coercion.

I then tried to add in flag to the '$in_hash' to tell anying using it that it was doing a new. No luck there as I did not fine an easy or quick way (apart from brute force iteration) to at the flag in all the correct places in what could be a very large nested data structure.

In desperation I tried using the 'Taint' module but soon gave that a miss as that is way of in hacker zone of programming.

I did finally come up with a rather ugly solution. A global (yuck) flag. Implemented like this;

use strict;


package Database::Accessor::Types;

our $NEW;

…

coerce 'Predicate', from 'HashRef',

  via { 

      my $object;

      if($NEW){

         $object = Database::Accessor::Predicate->new( %{$_} ) ;

      }

      else {

         eval {

             $object = Database::Accessor::Predicate->new( %{$_} ) ;

          };

          if ($@) {

            _one_error($_);

          }

      }

      return $object;

  };

  

sub _is_new {

    my ($new) = @_;

    $NEW = $new;

}

...

and in the 'around BUILDARGS' of Accessor.pm

 around BUILDARGS => sub {
        _is_new(1);
        my $orig  = shift;
        my $class = shift;
        my $ops   = shift(@_);

        

        my ($package, $filename, $line, $subroutine) = caller(3);

        if ( $ops->{retrieve_only} ) {

            $ops->{no_create}   = 1;

            $ops->{no_retrieve} = 0;

            $ops->{no_update}   = 1;

            $ops->{no_delete}   = 1;

        }

        my $instance;

        eval{ $instance = $class->$orig($ops)};

        if ($@) {            

            if (exists($ENV{'DA_ALL_ERRORS'}) and $ENV{'DA_ALL_ERRORS'} ){

                die $@;

            }

            else {

                 _one_error($ops,'new',$package, $filename, $line, $subroutine);

            }

         }

         else {

             _is_new(0);

             return $instance;

         }

    };

The above works as it shuts out eval when $NEW is 1 and I get the correct error report on a new and on an add.

Oh well live an learn. Still do not like it much there must be a better way to do it.

`