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);
10 is => 'ro', builder => '_build_simple_ops'
13 sub _build_simple_ops {
15 (map +($_ => 'binop'), qw(== > < >= <= != eq ne gt lt ge le and or)),
16 (map +($_ => 'funop'), qw(not ! defined)),
23 $self->_flatten_structure($self->_render(@_))
26 sub _flatten_structure {
27 my ($self, $struct) = @_;
33 elsif ($r eq 'ARRAY') {
34 my ($code, @b) = @{$self->_flatten_structure($_)};
38 elsif ($r eq 'HASH') { push @bind, $_; () }
39 else { die "_flatten_structure can't handle ref type $r for $_" }
42 ($p[$_], (($p[$_+1]||',') eq ',') ? () : (' '))
50 $_[0]->${\"_render_${\(lc($_[1]->{type})||'broken')}"}($_[1]);
55 require Data::Dumper::Concise;
56 die "Broken DQ entry: ".Data::Dumper::Concise::Dumper($dq);
59 sub _render_identifier {
62 join '->', '$_', @{$dq->{elements}}
70 sub _operator_type { 'Perl' }
72 sub _render_operator {
74 my $op = $dq->{operator};
75 unless (exists $op->{$self->_operator_type}) {
76 $op->{$self->_operator_type} = $self->_convert_op($dq);
78 my $op_name = $op->{$self->_operator_type};
79 if (my $op_type = $self->{simple_ops}{$op_name}) {
80 return $self->${\"_handle_op_type_${op_type}"}($op_name, $dq);
82 die "Unsure how to handle ${op_name}";
86 sub _convert_op { die "No op conversion to perl yet" }
88 sub _handle_op_type_binop {
89 my ($self, $op_name, $dq) = @_;
90 die "${op_name} registered as binary op but args contain "
91 .scalar(@{$dq->{args}})." entries"
92 unless @{$dq->{args}} == 2;
95 $self->_render($dq->{args}[0]),
97 $self->_render($dq->{args}[1]),
102 sub _handle_op_type_funop {
103 my ($self, $op_name, $dq) = @_;
104 $self->_handle_funcall($op_name, $dq->{args});
107 sub _handle_op_type_apply {
108 my ($self, $op_name, $dq) = @_;
109 my ($func, @args) = @{$dq->{args}};
110 die "Function name must be identifier"
111 unless $func->{type} eq DQ_IDENTIFIER;
112 if (@{$func->{elements}} > 1) {
113 die "Not decided how to handle multi-part function identifiers yet";
115 $self->_handle_funcall($func->{elements}[0], \@args);
118 sub _handle_funcall {
119 my ($self, $fun, $args) = @_;
122 intersperse(',', map $self->_render($_), @$args),