Baby Moose Break
It playing with update and container day here in the Moose-pen.
Now that I have the 'create' function working so well with execute_array I figured the next logical step would be to do 'update' function but I have one small problem. When I attempt to do this;
$container = [Test::User->new({username=>'Bill',address =>'ABC'}),
{username=>'Jane',address =>'DEF'},
Test::User->new({username=>'John',address =>'HIJ'}),
{username=>'Joe',address =>'KLM'},
];
$user->update( $utils->connect(),$container);
I will get this;
Usage: Database::Accessor->update( Class , Hash-Ref||Class, Hash-Ref); The $container parameter must be either a Hash-Ref or a Class at …
I guess early on I decided to exclude an array-ref from the container for an update. That was a little premature on my part as this code snippet;
my $sth = $dbh->prepare("UPDATE users SET users.address = ? where users.username=?");
$sth->bind_param_array(1, [ '456', '789', '101112' ]);
$sth->bind_param_array(2, [ '1', '2', '3' ]);
$sth->execute_array( { ArrayTupleStatus => \my @tuple_status } );
is perfectly valid perl DIB code.
Back to Accessor.pm I go again to make some more adjustments.
The good thing is can do a little re-factoring as both 'create' and 'update' have the same containers so I need just one function for both. In the end I came up with this;
sub _create_or_update {
my $self = shift;
my ( $action, $conn, $container, $opt ) = @_;
my $message =
"Usage: Database::Accessor->"
. lc($action)
. "( Class , Hash-Ref||Class||Array-Ref of [Hash-ref||Class], Hash-Ref); ";
if ( ref($container) eq "ARRAY" ) {
die $message .= "The \$container Arry-Ref cannot be empty"
if ( !scalar( @{$container} ) );
my @bad =
grep( !( ref($_) eq 'HASH' or blessed($_) ), @{$container} );
die $message
. " The \$container 'Array-Ref' must contain only Hash-refs or Classes"
if ( scalar(@bad) );
}
else {
die $message .=
"The \$container parameter must be either a Hash-Ref, a Class or an Array-ref of Hash-refs and or Classes"
if ( !( ref($container) eq 'HASH' or blessed($container) ) );
die $message .= "The \$container Hash-Ref cannot be empty"
if ( ref($container) eq 'HASH' and !keys( %{$container} ) );
}
$self->_all_elements_present( $message, $container )
if ( $self->all_elements_present );
return $self->_execute( $action, $conn, $container, $opt );
}
for the container function and I next had to re-refactored 'create' and 'update' subs to take advantage of it;
sub create {
my $self = shift;
my ( $conn, $container, $opt ) = @_;
die( $self->meta->get_attribute('no_create')->description->{message} )
if ( $self->no_create() );
return $self->_create_or_update( Database::Accessor::Constants::CREATE,
$conn, $container, $opt );
}
sub update {
my $self = shift;
my ( $conn, $container, $opt ) = @_;
die( $self->meta->get_attribute('no_update')->description->{message} )
if ( $self->no_update() );
$self->_need_condition( Database::Accessor::Constants::UPDATE,
$self->update_requires_condition()
);
return $self->_create_or_update( Database::Accessor::Constants::UPDATE,
$conn, $container, $opt );
}
Now the next step, after re-ran my tests and they all passed, was to do a little re-factoring in Driver::DBI. Frist I stripped out the container iteration code from the '_insert' sub into a new sub that both '_update' and '_create' could use and adjusted it for both;
sub _insert_update_container {
my $self = shift;
my ($action,$container) = @_;
my @field_sql = ();
if (ref($container) eq "ARRAY"){
my @fields = ();
$self->is_exe_array(1);
my $fields = $container->[0];
foreach my $key (sort(keys( %{$fields} )) ) {
my $field = $self->get_element_by_name( $key);
next
if(!$field);
push(@fields,$field);
if ($action eq Database::Accessor::Constants::UPDATE){
push(@field_sql,join(" ",
$self->_element_sql($field),
'=',
Database::Accessor::Driver::DBI::SQL::PARAM));
}
else {
push(@field_sql, $self->_element_sql($field));
}
$self->add_param([]);
}
foreach my $tuple (@{$container}){
my $index = 0;
foreach my $field (@fields){
my $param = Database::Accessor::Param->new({value=> $tuple->{$field->name()}});
push(@{$self->params->[$index]},$param);
$index++;
}
}
}
else {
foreach my $key ( sort(keys( %{$container} )) ) {
my $field = $self->get_element_by_name( $key);
next
if(!$field);
if ($action eq Database::Accessor::Constants::UPDATE){
push(@field_sql,join(" ",
$self->_element_sql($field),
'=',
$self->_element_sql(Database::Accessor::Param->new({value=> $container->{$key}}))));
}
else {
push(@field_sql, $self->_element_sql($field));
my $param = Database::Accessor::Param->new({value=> $container->{$key}});
$self->add_param($param);
}
}
}
return (@field_sql);
}
Now the only real problem I ran into was that I had to account for the fact that I could have either an array-ref or scalar in a param when doing the tuple transform for the 'results' 'param' attribute;
if ($self->is_exe_array()){
my $params = $self->params();
foreach my $tuple (@{$params}){
if (ref($tuple) eq "ARRAY"){
my @tuple = map({$_->value} @{$tuple} );
$result->add_param(\@tuple);
}
else {
$result->add_param($tuple->value);
}
}
}
and I with this simple addition to the test case
ok($user->update( $utils->connect(),$container),"update with present container");
it passed.
Now a little explanation of what is going on in the above. I have the same $container but I still have one condition in effect so the end SQL should be;
UPDATE user SET user.address = ?, user.username = ? WHERE user.username = ?
and looking at the bind params I have;
[ [ 'ABC', 'DEF', 'HIJ', 'KLM'],
[ 'Bill', 'Jane', 'John', 'Joe' ],
'user_new'
],
The neat thing is that DBI will take that last bind call
$sth->bind_param_array(3,'user_new');
and re-use that scalar for any of the other binds. In the end the SQL that is being executed would look like this;
UPDATE user SET user.address = 'ABC', user.username = 'Bill' WHERE user.username = 'user_new'
…
UPDATE user SET user.address = 'KLM', user.username = 'Joe' WHERE user.username = 'user_new'
It is so neat when things just work! Time for a break.
Long time Perl guy, a few CPAN mods allot of work on DBD::Oracle and a few YAPC presentations
Leave a comment