lib/Data/Query/ExprBuilder.pm

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