package Data::Query::ExprHelpers;
use strictures 1;
-use Data::Query::Constants qw(DQ_VALUE DQ_OPERATOR);
+use Data::Query::Constants;
use base qw(Exporter);
-our @EXPORT_OK = qw(perl_scalar_value perl_operator);
+our @EXPORT = qw(perl_scalar_value perl_operator Literal Identifier compose);
sub perl_scalar_value {
+{
- type => DQ_VALUE,
- subtype => { Perl => 'Scalar' },
- value => $_[0]
+ type => DQ_VALUE,
+ subtype => { Perl => 'Scalar' },
+ value => $_[0],
+ $_[1] ? (value_meta => $_[1]) : ()
}
}
}
}
+my %map = (
+ Join => [ qw(left right on outer) ],
+ Alias => [ qw(to from) ],
+ Operator => [ qw(operator args) ],
+ Select => [ qw(select from) ],
+ Where => [ qw(where from) ],
+ Order => [ qw(by reverse from) ],
+ Group => [ qw(by from) ],
+ Delete => [ qw(where target) ],
+ Update => [ qw(set where target) ],
+ Insert => [ qw(names values target returning) ],
+ Slice => [ qw(offset limit from) ],
+);
+
+sub Literal {
+ if (ref($_[0])) {
+ return +{
+ type => DQ_LITERAL,
+ parts => @{$_[0]},
+ };
+ }
+ return +{
+ type => DQ_LITERAL,
+ literal => $_[0],
+ ($_[1] ? (values => $_[1]) : ())
+ };
+}
+
+sub Identifier {
+ return +{
+ type => DQ_IDENTIFIER,
+ elements => [ @_ ],
+ };
+}
+
+foreach my $name (values %Data::Query::Constants::CONST) {
+ no strict 'refs';
+ my $sub = "is_${name}";
+ *$sub = sub {
+ my $dq = $_[0]||$_;
+ $dq->{type} eq $name
+ };
+ push @EXPORT, $sub;
+ if ($map{$name}) {
+ my @map = @{$map{$name}};
+ *$name = sub {
+ my $dq = { type => $name };
+ foreach (0..$#_) {
+ $dq->{$map[$_]} = $_[$_] if defined $_[$_];
+ }
+ return $dq;
+ };
+ push @EXPORT, $name;
+ }
+}
+
+sub compose (&@) {
+ my $code = shift;
+ require Scalar::Util;
+ my $type = Scalar::Util::reftype($code);
+ unless($type and $type eq 'CODE') {
+ require Carp;
+ Carp::croak("Not a subroutine reference");
+ }
+ no strict 'refs';
+
+ return shift unless @_ > 1;
+
+ use vars qw($a $b);
+
+ my $caller = caller;
+ local(*{$caller."::a"}) = \my $a;
+ local(*{$caller."::b"}) = \my $b;
+
+ $a = pop;
+ foreach (reverse @_) {
+ $b = $_;
+ $a = &{$code}();
+ }
+
+ $a;
+}
+
+
1;