package Data::Query::ExprBuilder;
use strictures 1;
-use Data::Query::Constants qw(DQ_OPERATOR DQ_VALUE);
use Scalar::Util ();
+use Data::Query::ExprHelpers qw(perl_scalar_value perl_operator);
use overload (
# unary operators
my $op = $_;
$op => sub {
Data::Query::ExprBuilder->new({
- expr => {
- type => DQ_OPERATOR,
- operator => { Perl => $op },
- args => [ $_[0]->{expr} ]
- }
+ expr => perl_operator($op => $_[0]->{expr})
});
}
} qw(! neg)),
my ($overload, $as) = ref($_) ? @$_ : ($_, $_);
$overload => sub {
Data::Query::ExprBuilder->new({
- expr => {
- type => DQ_OPERATOR,
- operator => { Perl => $as },
- args => [
+ expr => perl_operator(
+ $as,
map {
(Scalar::Util::blessed($_)
&& $_->isa('Data::Query::ExprBuilder'))
? $_->{expr}
- : {
- type => DQ_VALUE,
- subtype => { Perl => 'Scalar' },
- value => $_
- }
+ : perl_scalar_value($_)
# we're called with ($left, $right, 0) or ($right, $left, 1)
} $_[2] ? @_[1,0] : @_[0,1]
- ]
- },
+ )
});
}
}
--- /dev/null
+package Data::Query::ExprHelpers;
+
+use strictures 1;
+use Data::Query::Constants qw(DQ_VALUE DQ_OPERATOR);
+
+use base qw(Exporter);
+
+our @EXPORT_OK = qw(perl_scalar_value perl_operator);
+
+sub perl_scalar_value {
+ +{
+ type => DQ_VALUE,
+ subtype => { Perl => 'Scalar' },
+ value => $_[0]
+ }
+}
+
+sub perl_operator {
+ my ($op, @args) = @_;
+ +{
+ type => DQ_OPERATOR,
+ operator => { Perl => $op },
+ args => \@args
+ }
+}
+
+1;
[ '?', $_[1] ];
}
+sub _operator_type { 'SQL.Naive' }
+
sub _render_operator {
my ($self, $dq) = @_;
my $op = $dq->{operator};
- unless (exists $op->{'SQL.Naive'}) {
- $op->{'SQL.Naive'} = $self->_convert_op($dq);
+ unless (exists $op->{$self->_operator_type}) {
+ $op->{$self->_operator_type} = $self->_convert_op($dq);
}
- if (my $op_type = $self->{simple_ops}{my $op_name = $op->{'SQL.Naive'}}) {
+ if (my $op_type = $self->{simple_ops}{my $op_name = $op->{$self->_operator_type}}) {
return $self->${\"_handle_op_type_${op_type}"}($op_name, $dq);
}
- die "Couldn't render operator ".$op->{'SQL.Naive'};
+ die "Couldn't render operator ".$op->{$self->_operator_type};
}
sub _handle_op_type_binop {
}
my $op = $arg->{operator};
- unless (exists $op->{'SQL.Naive'}) {
- $op->{'SQL.Naive'} = $self->_convert_op($arg);
+ unless (exists $op->{$self->_operator_type}) {
+ $op->{$self->_operator_type} = $self->_convert_op($arg);
}
- if ($op->{'SQL.Naive'} eq $op_name) {
+ if ($op->{$self->_operator_type} eq $op_name) {
unshift @argq, @{$arg->{args}};
} else {
push @arg_final, $arg;