X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Flib%2FTest%2FSQL%2FAbstract%2FUtil.pm;fp=t%2Flib%2FTest%2FSQL%2FAbstract%2FUtil.pm;h=4455c299fa75baa507e120f95939d34bb8538a8f;hb=96bbece0b664b9225ef1f94a5224f5d5bcee4207;hp=0000000000000000000000000000000000000000;hpb=627dcb628879019141978e2211c56044fbd205c6;p=dbsrgits%2FSQL-Abstract-2.0-ish.git

diff --git a/t/lib/Test/SQL/Abstract/Util.pm b/t/lib/Test/SQL/Abstract/Util.pm
new file mode 100644
index 0000000..4455c29
--- /dev/null
+++ b/t/lib/Test/SQL/Abstract/Util.pm
@@ -0,0 +1,90 @@
+package Test::SQL::Abstract::Util;
+
+use strict;
+use warnings;
+
+use Sub::Exporter -setup => {
+  exports => [qw/
+    mk_name
+    mk_value
+    mk_alias
+    field_op_value
+  /],
+  groups => [
+    dumper_sort => sub {
+
+      require Data::Dumper;
+      my $Dump = Data::Dumper->can('Dump');
+
+      no warnings 'redefine';
+
+      *Data::Dumper::Dump = sub {
+        local $Data::Dumper::Sortkeys = sub {
+          my $hash = $_[0];
+          my @keys = sort {
+            my $a_minus = substr($a,0,1) eq '-';
+            my $b_minus = substr($b,0,1) eq '-';
+
+            return $a cmp $b if $a_minus || $b_minus;
+
+            return -1 if $a eq 'op';
+            return  1 if $b eq 'op';
+            return $a cmp $b;
+          } keys %$hash;
+
+          return \@keys;
+        };
+        return $Dump->(@_);
+      };
+      return {};
+    }
+  ],
+};
+
+sub mk_alias {
+  return {
+    -type => 'alias',
+    ident => shift,
+    as    => shift,
+  };
+}
+
+sub mk_name {
+  my ($field) = shift;
+  $field = ref $field eq 'HASH'
+         ? $field
+         : ref $field eq 'ARRAY'
+         ? { -type => 'identifier', elements => $field }
+         : { -type => 'identifier', elements => [$field,@_] };
+  return $field;
+}
+
+sub mk_value {
+  return { -type => 'value', value => $_[0] }
+}
+
+
+sub field_op_value {
+  my ($field, $op, $value) = @_;
+
+  $field = ref $field eq 'HASH'
+         ? $field
+         : mk_name($field);
+
+  my @value = ref $value eq 'HASH'
+            ? $value
+            : ref $value eq 'ARRAY'
+            ? @$value
+            : mk_value($value);
+
+  return {
+    -type => 'expr',
+    op => $op,
+    args => [
+      $field,
+      @value
+    ]
+  };
+}
+
+1;