lib/Data/Query/ExprBuilder.pm

   1 package Data::Query::ExprBuilder;
   2
   3 use strictures 1;
   4 use Scalar::Util ();
   5 use Data::Query::ExprHelpers qw(perl_scalar_value perl_operator);
   6
   7 use overload (
   8   # unary operators
   9   (map {
  10     my $op = $_;
  11     $op => sub {
  12       Data::Query::ExprBuilder->new({
  13         expr => perl_operator($op => $_[0]->{expr})
  14       });
  15     }
  16   } qw(! neg)),
  17   # binary operators
  18   (map {
  19     my ($overload, $as) = ref($_) ? @$_ : ($_, $_);
  20     $overload => sub {
  21       Data::Query::ExprBuilder->new({
  22         expr => perl_operator(
  23            $as,
  24            map {
  25              (Scalar::Util::blessed($_)
  26              && $_->isa('Data::Query::ExprBuilder'))
  27                ? $_->{expr}
  28                : perl_scalar_value($_)
  29               # we're called with ($left, $right, 0) or ($right, $left, 1)
  30             } $_[2] ? @_[1,0] : @_[0,1]
  31           )
  32       });
  33     }
  34   }
  35     qw(+ - * / % ** << >> . < > == != lt le gt ge eq ne),
  36
  37     # since 'and' and 'or' aren't operators we borrow the bitwise ops
  38     [ '&' => 'and' ], [ '|' => 'or' ],
  39   ),
  40   # unsupported
  41   (map {
  42     my $op = $_;
  43     $op => sub { die "Can't use operator $op on a ".ref($_[0]) }
  44    } qw(<=> cmp x ^ ~)
  45   ),
  46   fallback => 1,
  47 );
  48
  49 sub new {
  50   bless({ %{$_[1]} }, (ref($_[0])||$_[0]));
  51 }
  52
  53 1;