Baby Fancy Moose

Its get fancy day here in the Moose-Pen

Now that I have 'Functions' nicely working I am going to move on to the next logical field and that is an 'Expression'. In SQL (and 99.9% of other languages) an expression is just a predicate that can be evaluated. So an SQL like this

SELECT user.username, user.salary + 10 FROM users WHERE username='BOB'
In Database::Accessor I have an Expression class for this and it works 90% the same as the Function class I just finished. Thus this expression;

user.salary + 10
is expressed as the following attributes

          +------------+-------------+
          | Attribute  |  Value      |
          +------------+-------------+
          | expression | +           |
          +------------+-------------+
          | left       | user.salary |
          +------------+-------------+
          | right      | 10          |
          +------------+-------------+
in an Expression class and would look like this when used in a DA

         { expression => '+',
                left  => { name => 'salary' },
                right => { param =>10} }, }
As 'Expression' works mostly the same as 'Function' all I really have to do is give the 'Expression' class the 'Element' role and extend the coverage of the 'check_view' sub to include an 'expression' class;

 }
        else {
           return 
              if ((ref($element) ne "Database::Accessor::Function")
++            and
++               (ref($element) ne "Database::Accessor::Expresion"));
Then in Driver::DBI I just had to likewise extend the '_element_sql' sub;

 if (ref($element) eq "Database::Accessor::Expression"){
      my $left_sql = $self->_element_sql($element->left());
      my @right_sql;      
      if (ref($element->right()) ne "Array"){
         my $param = $element->right();
         $element->right([$param]);
      }
      foreach my $param (@{$element->right()}){
        push(@right_sql,$self->_element_sql($param));
      }        
      my $right_sql = join(',',@right_sql);
      return  Database::Accessor::Driver::DBI::SQL::OPEN_PARENS
             .join(" "
             ,$left_sql
             ,$element->expression
             ,$right_sql)
             .Database::Accessor::Driver::DBI::SQL::CLOSE_PARENS;
  
 }
  elsif (ref($element) eq "Database::Accessor::Function"){ 
and of course a new test;

$in_hash->{elements}->[1] = { expression => '+',
                                   left  => { name => 'salary' },
                                   right => { param =>10} };

my $da = Database::Accessor->new($in_hash);
$da->retrieve( $utils->connect() );
ok(
    $da->result()->query() eq
      "SELECT user.username, user.salary + ?, user.address FROM user WHERE user.username = ?",
      "Expression with 1 param binds SQL correct"
);
cmp_deeply(
           $da->result()->params,
           [10,'Bill'],
           "Expression params correct"
          );
and on my first run I get;

SELECT user.username, (.salary + ?), user.address FROM user WHERE user.username = ?
for my SQL. That missing table/view again on '.salary' so my recursion in my 'check_view' sub is a little off. This one took about three minutes to find out all I had was a typo in the 'check_view' sub;

--               (ref($element) ne "Database::Accessor::Expresion"));
++               (ref($element) ne "Database::Accessor::Expression"));
and on the next test I get;

ok 1 - Expression with 1 param binds SQL correct
ok 2 - Expression params correct
Next a test for expression in an expression with this;

$in_hash->{elements}->[1] = { expression => '+',
                                 left  => { name => 'salary' },
                                 right => { expression => '*',
                                                 left  => { name => 'bonus' },
                                                 right => { param=>.05 }} };
and that passed with the expected SQL of

SELECT user.username, (user.salary + (user.bonus * ?)), user.address FROM user WHERE user.username = ?
Now to get very fancy I am going to try a mix and match; A function with an expression say an SQL like this;

SELECT user.username, abs((user.bonus * ?)), user.address FROM user WHERE user.username = ?
My in hash would be;

$in_hash->{elements}->[1] = { function => 'abs',
                                 left  => { expression => '*',
                                                 left  => { name => 'bonus' },
                                                 right => { param=>-.05 }} };
I know off the top of my head I will have two problems; first the 'left' on a Comparator role only excepts 'Elements' and the 'right' is a 'Required' fields. So two quick changes to start;

        package 
           Database::Accessor::Roles::Comparators;
        use Moose::Role;
        use MooseX::Aliases;
        use namespace::autoclean;
        has left => (
            is       => 'rw',
--          isa      => 'Element|',
++          isa      => 'Element|Param|Function|Expression|ArrayRefofParams|ArrayRefofElements|ArrayRefofExpressions',
            required => 1,
            coerce   => 1,
        );
        has right => (
            is => 'rw',
            isa =>'Element|Param|Function|Expression|ArrayRefofParams|ArrayRefofElements|ArrayRefofExpressions',
--          required => 1,
            coerce   => 1,
        );
and when I run it I get

Attribute (name) is required at D:\GitHub\database-accessor\lib/Database/Accessor/Types.pm line 100
Hmm that is a very tricky one to debug. One cannot do the old trick of adding

   my ($package, $filename, $line) = caller;
   warn("package=$package, filename=$filename, line $line");
above line 100 in the Types.pm file, to see where the error orginates.

All that will come out of that is a walk up through the coercion methods in Types with ever more obtuse package, file and line values as you eventually get up into Moose Code where you will reach 'Moose::Base::Type' and then you can't go any further, unless you go into the source code of Moose.

Fortunately I knew this already, so I did not go down that path and I did find after a few well placed warns and the odd Dump I found this;

        bless({
               'left' => bless( {}, 'Database::Accessor::Param' ),
               'function' => 'abs',
               'close_parentheses' => 0,
               'open_parentheses' => 0
               }, 'Database::Accessor::Function' ),
The 'Function' class I was passing in had the left attribute as a Param not an Expression so there is some coercion funny business going on there, as the original error message suggested. After some playing about I finally found it in the Types role; Seems this call;

    coerce 'Param', from 'HashRef', via { 
       Database::Accessor::Param->new( %{$_} ) 
    };
is not correct and it should be the more generic

    coerce 'Param', from 'HashRef', via { 
      return  _element_coerce($_);
    }; 
to account for params that may be other types, After this small change I get the correct coercion;

        bless( {
               'left' => bless( {
                                 'left' => bless( {
                                                  'name' => 'bonus'
                                                  }, 'Database::Accessor::Element' ),
                                 'right' => bless( {
                                                  'value' => '-0.05'
                                                  }, 'Database::Accessor::Param' ),
                                 'expression' => '*',
                                 'close_parentheses' => 0,
                                 'open_parentheses' => 0
                                 }, 'Database::Accessor::Expression' ),
               'function' => 'abs',
               'close_parentheses' => 0,
               'open_parentheses' => 0
               }, 'Database::Accessor::Function' ),
but still the same error;

Attribute (name) is required at D:\GitHub\database-accessor\lib/Database/Accessor/Types.pm line 100
and some more debugging that led me to these lines

      if (ref($element->right()) ne "Array"){
         my $param = $element->right();
         $element->right([$param]);
      }
the problem is I did not take into account that now there may not be a 'right' value and that code above will add a blank '$param' and then the coercion will fail. So I changed my code to account for the empty 'right' case;

++ if ($element->right()){
        if (ref($element->right()) ne "Array"){
           my $param = $element->right();
           $element->right([$param]);
        }
        foreach my $param (@{$element->right()}){
          push(@right_sql,$self->_element_sql($param));
        }        
++ }
I ran my test again and my SQL was coming out;

SELECT user.username, abs((user.bonus * ?),), user.address FROM user WHERE user.username = ?
that 'abs((user.bonus * ?),)' is a little funky so I corrected for that by the only empty comma trick;

++  my $comma = "";
      if ($element->right()){
++        $comma = ",";
...
      return $element->function
             .Database::Accessor::Driver::DBI::SQL::OPEN_PARENS
             .$left_sql
–             .','
++             .$comma
             .$right_sql
             .Database::Accessor::Driver::DBI::SQL::CLOSE_PARENS;
and my test comes up perfect.

Well that is enough funky code for one day.

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