Moose Does Case
Finally its Driver::DBI Case day in the Moose-Pen
Has it really been since August 15th that I have been mucking about with Case? I guess after almost two weeks I am glad to finally get into the DBI::Driver part of things. As usual to start (well recap really) lets look at this SQL;
SELECT ProductName,
CASE WHEN Price < 10 THEN 'under 10$'
WHEN Price >=10 AND Price <= 30 THEN '10~30'
WHEN Price >30 and Price <= 100 THEN '30~100'
ELSE 'Over 100' END AS price_group
FROM Products
which will translate into this hash ref using my Database::Accessor model language;
my $in_hash = {
da_compose_only => 1,
update_requires_condition => 0,
delete_requires_condition => 0,
view => { name => 'Products' },
elements =>[{whens=>[{ left => { name => 'Price', },
right => { value => '10' },
operator => '<',
statement=>{value=>'under 10$'}},
[{left => {name => 'Price'},
right => { value => '10' },
operator => '>=',
},
{ condition => 'and',
left => {name=>'Price'},
right => { value => '30' },
operator => '<=',
statement=>{value=>'10~30$'}}
],
[{left => {name => 'Price'},
right => { value => '30' },
operator => '>',
},
{ condition => 'and',
left => {name=>'Price'},
right => { value => '100' },
operator => '<=',
statement=>{value=>'30~100$'}}
],
{ statement=>{value=>'Over 100$'}},
],
alias=>'price_group'}]};
Now we just need a test to start;
my $tests = [
{
caption => 'Retrieve with case statement in elements',
retrieve => {
sql =>"SELECT CASE WHEN Price < ? THEN ? WHEN Price >=? AND Price <= ? THEN ? WHEN Price >? and Price <= ? THEN ? ELSE ? END AS price_group FROM Products",
params => [10,'under 10$',10,30,'10~30$',30,100,'30~100$','Over 100$']
},
}
];
so lots of params in there which I like to see for all those hard-coded points where someone may try an injection attack.
My fist task is to add in my constants into ''
use constant CASE =>'CASE';
use constant WHEN =>'WHEN';
use constant THEN =>'THEN';
use constant ELSE =>'ELSE';
use constant END_CASE =>'END';
One item of note is you cannot use 'END' as a constant as it is a reserved perl word hence my END_CASE constant, thanks Padre syntax checking for that one.
Now to add a little more interesting code and that is to add in the 'Database::Accessor::Case' to the 'if' statement in the '_field_sql' sub;
if (ref($element) eq "Database::Accessor::Case"){
my @whens = ();
foreach my $when (@{$element->whens()}){
if (ref($when) eq "Database::Accessor::Case::When"){
push(@whens,join(" ",Database::Accessor::Driver::DBI::SQL::WHEN
,$self->_field_sql($when,$use_view)
,Database::Accessor::Driver::DBI::SQL::THEN
,$self->_field_sql($when->statement(),0)));
}
else {
my $condition_sql;
my $statement;
foreach my $condition (@{$when}){
$condition_sql .= $condition->condition
if ($condition->condition);
$condition_sql .= $self->_field_sql($condition,0);
$statement = $condition->statement()
if ( $condition->statement());
}
push(@whens,join(" ",Database::Accessor::Driver::DBI::SQL::WHEN
,$condition_sql
,Database::Accessor::Driver::DBI::SQL::THEN
,$self->_field_sql($statement,0)));
}
}
return join(" ",Database::Accessor::Driver::DBI::SQL::CASE
,@whens
,Database::Accessor::Driver::DBI::SQL::END_CASE);
}
elsif (ref($element) eq "Database::Accessor::Case::When"){
return join(" ",$self->_field_sql($element->left(),0)
,$element->operator
,$self->_field_sql($element->right(),0));
}
In the above when I find a 'Case' class I then iterate over each of 'whens' that are in there which either be a single 'Case::When' or an 'Array ref' of them. In the first case I simply format the single condition when and then add it to the my @whens.
In the case of an array-ref I iterate over those 'whens' and collect up all the conditions as a string then add the formatted when to the @whens. This one I had to take into account the reverse polish notation and add the 'condition' first and as I a little lazy I just set the $statement on each iteration just to save me the bother of figuring out the statement attribute.
Finally I return by joining that @whens with the CASE and END constants.
I also added in a handler for the 'Case::When' that simply formats the left and right part of a when conditional.
So going to give the above a try;
Use of uninitialized value in concatenation (.) or string at D:\GitHub\database-accessor-driver-dbi\lib/Database/Accessor/Driver/DBI.pm line 519.
Can't call method "name" on an undefined value at D:\GitHub\database-accessor-driver-dbi\lib/Database/Accessor/Driver/DBI.pm line 517.
hmm after a little debugging I found what the problem was. The last item on a case is always (well should be anyway) just a 'When' with only the statement attribute set
bless( {
'statement' => bless( {
'value' => 'Over 100$'
}, 'Database::Accessor::Param' ),
'close_parentheses' => 0,
'condition' => undef,
'open_parentheses' => 0
}, 'Database::Accessor::Case::When' )
I forgot to account for that; I think this small patch should fix it;
if (ref($element) eq "Database::Accessor::Case"){
my @whens = ();
++ my $last = pop(@{$element->whens()});
...
return join(" ",Database::Accessor::Driver::DBI::SQL::CASE
,@whens
++ ,Database::Accessor::Driver::DBI::SQL::ELSE
++ ,$self->_field_sql($last->statement(),0)
,Database::Accessor::Driver::DBI::SQL::END_CASE);
and now I get
Expected--> SELECT CASE WHEN Price < ? THEN ? WHEN Price >=? AND Price <= ? THEN ? WHEN Price >? and Price <= ? THEN ? ELSE ? END AS price_group FROM Products
Generated-> SELECT CASE WHEN Price < ? THEN ? WHEN Price >= ?andPrice <= ? THEN ? WHEN Price > ?andPrice <= ? THEN ? ELSE ? END price_group FROM Products
Well not too bad and I have a post for tomorrow as well.
Long time Perl guy, a few CPAN mods allot of work on DBD::Oracle and a few YAPC presentations
Leave a comment