byterock

Find and fix a bug day here in the Moose-Pen

The great thing is the new tests I added to fix up my subroutine covers as reported by Delve::Cover revealed that I may have two new bugs in Database::Accessor.

The two fails were;

…

not ok 92 - no_create flag error on create

ok 93 - no_retrieve flag error on retrieve

not ok 94 - no_update flag error on update

…

The test is fine as it is failing with the expected error message 'Attempt to use create with no_create flag on' with the error message 'No Create, Update or Delete with retrieve_only flag'.

I looked though the code and that error comes from here

 sub BUILD {

        my $self = shift;

        my $dad  = {};

        map( { $self->_loadDADClassesFromDir( $_, $dad ) }

          grep { -d $_ }

          map { File::Spec->catdir( $_, 'Database', 'Accessor', 'Driver' ) }

          @INC

        );

        if ( $self->retrieve_only == 1 ) {

            foreach my $flag (qw(no_create no_update no_delete)) {

                my $field = $self->meta->get_attribute($flag);

                $field->description->{message} =

                  "No Create, Update or Delete with retrieve_only flag on";

            }

        }

…

What is happening is that BUILD is firing only once in the '20_dad_load.t' test case when the 'Database::Accessor' is first instantiated and that happens with this call;

my $da =

  Database::Accessor->new( { retrieve_only => 1, view => { name => 'person' }, elements=>[{ name => 'street', view => 'person', }] } );

and of course once I do the above I am stuck with it.

Now I read back though my notes and I first though I would want the system to work in this way, so a Accessor can be locked down but in reality there is no need for this. A Nosy Parker could always find a way around this using DBI directly in a script.

My first attempt at a fix was to move that script into the 'around BUILDARGS' like this

        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;

++          $ops->{no_retrieve} = 0;

++          foreach my $flag (qw(no_create no_update no_delete)) {

++               $ops->{$flag}=1;

++              my $field = $class->meta->get_attribute($flag);

++              $field->description->{message} =

++                "No Create, Update or Delete with retrieve_only flag on";

++          }

++      }

Unfortunately that did not solve my problem as what I am changing is the 'meta' data on the 'Class'. In essence I am doing this

has no_create => (

        is          => 'ro',

        isa         => 'Bool',

        default     => 0,

        traits      => ['MooseX::MetaDescription::Meta::Trait'],

        description => {

--          message    => "Database::Accessor create  Error: Attempt to use create with no_create flag on!",

++          message    => "No Create, Update or Delete with retrieve_only flag on!"

              not_in_DAD => 1

        }

    );

only at run-time.

Ok I learned something new about Moose even at the late stage in the project. Once you mess with meta data it stays for all instances in a script.

There is a way around this with only a small adjustment of my code.

First I empty out take out the 'message' parts on the attribute;

has no_create => (

        is          => 'ro',

        isa         => 'Bool',

        default     => 0,

        traits      => ['MooseX::MetaDescription::Meta::Trait'],

        description => {

--        message    => "Database::Accessor create Error: Attempt to use create with no_create flag on!",

++        message    => "",

          not_in_DAD => 1

        }

    );

Next I will keep the code for this in the 'around' sub but this time I do this;

 foreach my $action (qw(create update delete)) {

            my $flag = "no_$action";

            my $message = $action

                          ." Error: Attempt to use "

                          . $action

                          ." with "

                          .$flag

                          ." flag on!";

            if ($ops->{retrieve_only}) {

                $message =$action

                          ." Error: No Create, Update or Delete with retrieve_only flag on";

                $ops->{$flag}=1;

                

            }

            my $field = $class->meta->get_attribute($flag);

            $field->description->{message} = $message;

        }

I just loop though the three actions then set up the default message, change the message if the 'retrieve_only' flag is on and then set the meta data key to the $message.

I give my test a go and get;

...

ok 91 - da_result_class has to be a valid Class in the path

ok 92 - no_create flag error on create

ok 93 - no_retrieve flag error on retrieve

ok 94 - no_update flag error on update

…

happy moose.