add compose routine and refactor FetchFirst to functional style

[dbsrgits/Data-Query.git] / lib / Data / Query / ExprHelpers.pm

diff --git a/lib/Data/Query/ExprHelpers.pm b/lib/Data/Query/ExprHelpers.pm
index 6b2cbef..8c030d7 100644 (file)
--- a/lib/Data/Query/ExprHelpers.pm
+++ b/lib/Data/Query/ExprHelpers.pm
@@ -5,7 +5,7 @@ use Data::Query::Constants;
 
 use base qw(Exporter);
 
-our @EXPORT = qw(perl_scalar_value perl_operator Literal Identifier);
+our @EXPORT = qw(perl_scalar_value perl_operator Literal Identifier compose);
 
 sub perl_scalar_value {
   +{
@@ -81,4 +81,32 @@ foreach my $name (values %Data::Query::Constants::CONST) {
   }
 }
 
+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;