t/lib/Test/SQL/Abstract/Util.pm

   1 package Test::SQL::Abstract::Util;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Sub::Exporter -setup => {
   7   exports => [qw/
   8     mk_name
   9     mk_value
  10     mk_alias
  11     mk_expr
  12     field_op_value
  13   /],
  14   groups => [
  15     dumper_sort => sub {
  16
  17       require Data::Dumper;
  18       my $Dump = Data::Dumper->can('Dump');
  19
  20       no warnings 'redefine';
  21
  22       *Data::Dumper::Dump = sub {
  23         local $Data::Dumper::Sortkeys = sub {
  24           my $hash = $_[0];
  25           my @keys = sort {
  26             my $a_minus = substr($a,0,1) eq '-';
  27             my $b_minus = substr($b,0,1) eq '-';
  28
  29             return $a cmp $b if $a_minus || $b_minus;
  30
  31             return -1 if $a eq 'op';
  32             return  1 if $b eq 'op';
  33             return $a cmp $b;
  34           } keys %$hash;
  35
  36           return \@keys;
  37         };
  38         return $Dump->(@_);
  39       };
  40       return {};
  41     }
  42   ],
  43 };
  44
  45 sub mk_alias {
  46   return {
  47     -type => 'alias',
  48     ident => shift,
  49     as    => shift,
  50   };
  51 }
  52
  53 sub mk_name {
  54   my ($field) = shift;
  55   $field = ref $field eq 'HASH'
  56          ? $field
  57          : ref $field eq 'ARRAY'
  58          ? { -type => 'identifier', elements => $field }
  59          : { -type => 'identifier', elements => [$field,@_] };
  60   return $field;
  61 }
  62
  63 sub mk_value {
  64   return { -type => 'value', value => $_[0] }
  65 }
  66
  67 sub mk_expr {
  68   my ($op, @args) = @_;
  69
  70   return {
  71     -type => 'expr',
  72     op => $op,
  73     args => [@args]
  74   };
  75 }
  76
  77 sub field_op_value {
  78   my ($field, $op, $value) = @_;
  79
  80   $field = ref $field eq 'HASH'
  81          ? $field
  82          : mk_name($field);
  83
  84   my @value = ref $value eq 'HASH'
  85             ? $value
  86             : ref $value eq 'ARRAY'
  87             ? @$value
  88             : mk_value($value);
  89
  90   return {
  91     -type => 'expr',
  92     op => $op,
  93     args => [
  94       $field,
  95       @value
  96     ]
  97   };
  98 }
  99
 100 1;