Take Another Look Moose

Its re-think things day here in the Moose-Pen

Well I eally do not like this part;

 container => [
              {first_name=>'Bill',id=>"",last_name =>'Bloggings'},
              {first_name=>'Jane',id=>"",last_name =>'Doe'},
              {first_name=>'John',id=>"",last_name =>'Doe'},
              {first_name=>'Joe' ,id=>"",last_name =>'Blow'},
              ],
of my tests from yesterday. Remembering to stick in that 'id' in the values to be inserted will take away from utility of my API. Needless to say that sending an empty value for an create/insert is confusing at the least and downright disturbing to some. Therefor I will have to make this revised test;

{
        caption  => 'use identity option',
        key      => 'elements',
        elements => [
            { name => 'id',
              identity =>{'DBI::db'=>{DBM  => {
                            name => 'NEXTVAL',
                            view => 'products_seq'}
                }} 
            },
            { name => 'first_name', },
            { name => 'last_name', },
        ],
        create => {
            container => {
                last_name  => 'Bloggings',
                first_name => 'Bill',
            },
            sql =>
              "INSERT INTO Products ( id, first_name, last_name ) VALUES( products_seq.NEXTVAL, ?, ? )",
            params => [ 'Bill', 'Bloggings' ]
        },
    },
work instead.

The first thing I kneed to know is if there in an 'identity' element present on the DAD. I could just wait until I am processing in the DAD like I am now but it is best to know of such things early therefore I am going to set this at the Database::Accessor level.

My first act was to move the 'has_identity' attribute out of the Driver::DBI and add it to the 'Database::Accessor::Roles::Driver' role so it will be present in all DAD whether they will use it or not.

has has_identity => (
    is      => 'ro',
    isa     => 'Bool',
    default => 0,
);
Now I was thinking that I could use a Moose trigger on the 'identity' attribute of an 'Element' class like this;

has 'identity' => (
            is    => 'rw',
            isa   => 'HashRef',
            trigger=>'&_has_identity'
        );

sub _has_identity {
my ( $self, $new, $old) = @_;


However that is not going to do me much good as '99.99'% of the time I populate my attribute from either a 'default' or more rarely a 'builder'. As close read of the Moose manual will reveal this;

“However, triggers are not called when an attribute is populated from a default or builder.”
On to something else then. I do do an iteration over all my 'elements' with the 'get_dad_elements' sub and I can just tuck it on near the end of that sub but to get that to work I need a flag that I can use in that sub;

    has _has_identity => (
        is          => 'rw',
        isa         => 'Bool',
        default     => 0,
        traits      => ['MooseX::MetaDescription::Meta::Trait'],
        description => { not_in_DAD => 1 }
    );
and in the sub;

 private_method get_dad_elements => sub {
        my $self = shift;
        my ($action,$opt) = @_;
++      $self->_has_identity(0);
…
            push( @allowed, $element );
++          if ( ref($element) eq 'Database::Accessor::Element' and $element->identity()){
++              if ($self->_has_identity()){
++                  die " Database::Accessor->"
++                      . lc($action)
++                      . " More than one element has the 'identity'
++ attribute set. Please check your elements!";
++              }
++              else {                    
++                  $self->_has_identity(1);
++              }
++          }
        }
        return \@allowed;
    };
While I am here I also added in a 'die' so you can have only one 'identity' attribute set. Next I have to pass that down to the DAD like this;

        my $dad = $driver->new(
            {
                view               => $self->view,
                elements           => $self->get_dad_elements($action,$opt),
                conditions         => [@{$self->conditions},@{$self->dynamic_conditions}],
                links              => [@{$self->links},@{$self->dynamic_links}],
                gather             => $gather,
                sorts              => [@{ $self->sorts }  ,@{ $self->dynamic_sorts   }],
                da_compose_only    => $self->da_compose_only,
                da_no_effect       => $self->da_no_effect,
                da_warning         => $self->da_warning,
                da_raise_error_off => $self->da_raise_error_off,
                da_suppress_view_name=> $self->da_suppress_view_name,
++              has_identity         => $self->_has_identity
            }
        );
I don't even have to add in a new test for this as my '31_elements.t' test case should cover this addition automatically.

Onto the Driver::DBI next.

The first thing I did was back out my code changes from the other day as I want to take a different approach. I started with this

    if ($self->has_identity() ){
       my @ientity = grep ({ref($_) eq 'Database::Accessor::Element' and $_->identity},@{$self->elements()});
…
then I realized why not just rename that 'has_identity' to the 'identity_index' and kill two birds with one stone. I will spare you the code change for that and start right back where I left off in Driver::DBI. My first new patch goes into the '_insert' sub

if ($self->identity_index() ne undef ){
       my $field = $self->elements()->[$self->identity_index()];
       my $identity = $field->identity();
       if (exists(
            $identity->{ $self->DB_Class }->{ $self->dbh()->{Driver}->{Name} }
        )){
            my $new_field = Database::Accessor::Element->new($identity->{ $self->DB_Class }->{ $self->dbh()->{Driver}->{Name}} );
            unshift(@field_sql,$self->_field_sql($new_field,1));
       }
    } 
and that produces this SQL;

INSERT INTO Products ( products_seq.NEXTVAL, first_name, last_name ) VALUES( ?, ? )
which is sort of the opposite of what I want but a good start; All I needed to do was adjust it a little like this;

++  my @params =  @{ $self->params() };
    if ($self->identity_index() ne undef ){
       my $field = $self->elements()->[$self->identity_index()];
       my $identity = $field->identity();
       if (exists(
            $identity->{ $self->DB_Class }->{ $self->dbh()->{Driver}->{Name} }
        )){
            my $new_field = Database::Accessor::Element->new($identity->{ $self->DB_Class }->{ $self->dbh()->{Driver}->{Name}} );
++          unshift(@params,$new_field);
--          unshift(@field_sql,$self->_field_sql($field,1));
++          unshift(@field_sql,$self->_field_sql($field));
            
       }
    } 
…
and then the 'map' to use that new '@params';

my $values_clause = Database::Accessor::Driver::DBI::SQL::VALUES
      . join(
        " ",
        Database::Accessor::Driver::DBI::SQL::OPEN_PARENS,
        join(
            ", ",
            map( {  
                    (ref($_) eq 'Database::Accessor::Param' 
                    or ref($_) eq 'ARRAY')
                    ? Database::Accessor::Driver::DBI::SQL::PARAM
                    : $self->_field_sql( $_, 1 )
--                } @{$self->params() )
++                } @params )
        ),
        Database::Accessor::Driver::DBI::SQL::CLOSE_PARENS
      );
and now I get

...
ok 11 - use identity option create SQL correct
ok 12 - use identity option create params correct
ok 13 - use identity option with exe array create SQL correct
ok 14 - use identity option with exe array create params correct
Something new for tomorrow I geuss.

_MG_0852a.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