t/sql.t

   1 use strictures 1;
   2 use Test::More qw(no_plan);
   3
   4 use Devel::Dwarn;
   5 use Data::Query::Renderer::SQL::Naive;
   6 use Data::Query::ExprHelpers qw(perl_scalar_value);
   7
   8 BEGIN { require 't/expr.include' }
   9
  10 my $rend = Data::Query::Renderer::SQL::Naive->new({ quote_chars => [ "'" ] });
  11
  12 sub expr_sql_is (&;@) {
  13   my $sub = shift;
  14   @_
  15     ? is_deeply($rend->render(_mk_expr($sub)), @_)
  16     : ::Dwarn($rend->render(_mk_expr($sub)));
  17 }
  18
  19 expr_sql_is { $_->foo }
  20   [ 'foo' ],
  21   "Simple identifier -> SQL";
  22
  23 expr_sql_is { $_->group }
  24   [ q{'group'} ],
  25   "Simple identifier needing quoting -> SQL";
  26
  27 expr_sql_is { $_->foo->group }
  28   [ q{foo.'group'} ],
  29   "Complex identifier -> SQL";
  30
  31 expr_sql_is { $_->foo == 1 }
  32   [
  33     "foo = ?",
  34     {
  35       subtype => {
  36         Perl => "Scalar"
  37       },
  38       type => "Value",
  39       value => 1
  40     }
  41   ],
  42   "Simple expression -> SQL";
  43
  44 expr_sql_is { ($_->foo == 1) & ($_->bar eq "foo") }
  45   [
  46     "( foo = ? AND bar = ? )",
  47     {
  48       subtype => {
  49         Perl => "Scalar"
  50       },
  51       type => "Value",
  52       value => 1
  53     },
  54     {
  55       subtype => {
  56         Perl => "Scalar"
  57       },
  58       type => "Value",
  59       value => "foo"
  60     }
  61   ],
  62   "Compound expression -> SQL";
  63
  64
  65 expr_sql_is { ($_->foo == 1) & ($_->bar eq "foo") & ($_->baz > 3) }
  66   [
  67     "( foo = ? AND bar = ? AND baz > ? )",
  68     {
  69       subtype => {
  70         Perl => "Scalar"
  71       },
  72       type => "Value",
  73       value => 1
  74     },
  75     {
  76       subtype => {
  77         Perl => "Scalar"
  78       },
  79       type => "Value",
  80       value => "foo"
  81     },
  82     {
  83       subtype => {
  84         Perl => "Scalar"
  85       },
  86       type => "Value",
  87       value => 3
  88     }
  89   ],
  90   "Flatten expression ok";
  91
  92 expr_sql_is { !$_->foo }
  93   [ "NOT foo" ],
  94   "Unary expression ok";
  95
  96 expr_sql_is { SELECT { $_->foo } }
  97   [ "SELECT foo" ],
  98   "Simple identifier";
  99
 100 expr_sql_is { SELECT { $_->foo, 1 } }
 101   # the extra space here is a little icky but Naive's _flatten_structure
 102   # will need rewriting to fix it - commit bits available if you do it first
 103   [ "SELECT foo , ?", perl_scalar_value(1) ],
 104   "Identifier and literal";