1 package Data::Query::Renderer::Perl;
3 sub intersperse { my $i = shift; my @i = map +($_, $i), @_; pop @i; @i }
5 use Data::Query::Constants qw(DQ_IDENTIFIER);
9 is => 'ro', builder => '_build_simple_ops'
12 sub _build_simple_ops {
14 (map +($_ => 'binop'), qw(== > < >= <= != eq ne gt lt ge le and or)),
15 (map +($_ => 'funop'), qw(not ! defined)),
22 $self->_flatten_structure($self->_render(@_))
25 sub _flatten_structure {
26 my ($self, $struct) = @_;
32 elsif ($r eq 'ARRAY') {
33 my ($sql, @b) = @{$self->_flatten_structure($_)};
37 elsif ($r eq 'HASH') { push @bind, $_; () }
38 else { die "_flatten_structure can't handle ref type $r for $_" }
41 ($p[$_], (($p[$_+1]||',') eq ',') ? () : (' '))
49 $_[0]->${\"_render_${\(lc($_[1]->{type})||'broken')}"}($_[1]);
54 require Data::Dumper::Concise;
55 die "Broken DQ entry: ".Data::Dumper::Concise::Dumper($dq);
58 sub _render_identifier {
61 join '->', '$_', @{$dq->{elements}}
69 sub _operator_type { 'Perl' }
71 sub _render_operator {
73 my $op = $dq->{operator};
74 unless (exists $op->{$self->_operator_type}) {
75 $op->{$self->_operator_type} = $self->_convert_op($dq);
77 my $op_name = $op->{$self->_operator_type};
78 if (my $op_type = $self->{simple_ops}{$op_name}) {
79 return $self->${\"_handle_op_type_${op_type}"}($op_name, $dq);
81 die "Unsure how to handle ${op_name}";
85 sub _convert_op { die "No op conversion to perl yet" }
87 sub _handle_op_type_binop {
88 my ($self, $op_name, $dq) = @_;
89 die "${op_name} registered as binary op but args contain "
90 .scalar(@{$dq->{args}})." entries"
91 unless @{$dq->{args}} == 2;
94 $self->_render($dq->{args}[0]),
96 $self->_render($dq->{args}[1]),
101 sub _handle_op_type_funop {
102 my ($self, $op_name, $dq) = @_;
103 $self->_handle_funcall($op_name, $dq->{args});
106 sub _handle_op_type_apply {
107 my ($self, $op_name, $dq) = @_;
108 my ($func, @args) = @{$dq->{args}};
109 die "Function name must be identifier"
110 unless $func->{type} eq DQ_IDENTIFIER;
111 if (@{$func->{elements}} > 1) {
112 die "Not decided how to handle multi-part function identifiers yet";
114 $self->_handle_funcall($func->{elements}[0], \@args);
117 sub _handle_funcall {
118 my ($self, $fun, $args) = @_;
121 intersperse(',', map $self->_render($_), @$args),