From: Matt S Trout Date: Sat, 16 Oct 2010 01:15:58 +0000 (+0100) Subject: factor construction of simple expressions out into ExprHelpers.pm X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=12e6eab8ff2e8bab91319d401dd2e984a5e781e5;p=dbsrgits%2FData-Query.git factor construction of simple expressions out into ExprHelpers.pm --- diff --git a/lib/Data/Query/ExprBuilder.pm b/lib/Data/Query/ExprBuilder.pm index ee30702..0c8ee7b 100644 --- a/lib/Data/Query/ExprBuilder.pm +++ b/lib/Data/Query/ExprBuilder.pm @@ -1,8 +1,8 @@ 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 @@ -10,11 +10,7 @@ use overload ( 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)), @@ -23,23 +19,16 @@ use overload ( 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] - ] - }, + ) }); } } diff --git a/lib/Data/Query/ExprHelpers.pm b/lib/Data/Query/ExprHelpers.pm new file mode 100644 index 0000000..1ba349e --- /dev/null +++ b/lib/Data/Query/ExprHelpers.pm @@ -0,0 +1,27 @@ +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; diff --git a/lib/Data/Query/Renderer/SQL/Naive.pm b/lib/Data/Query/Renderer/SQL/Naive.pm index f44fb54..cbfc1e9 100644 --- a/lib/Data/Query/Renderer/SQL/Naive.pm +++ b/lib/Data/Query/Renderer/SQL/Naive.pm @@ -78,16 +78,18 @@ sub _render_value { [ '?', $_[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 { @@ -125,11 +127,11 @@ sub _handle_op_type_flatten { } 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;