DQ_IDENTIFIER DQ_OPERATOR DQ_VALUE DQ_LITERAL DQ_JOIN DQ_SELECT DQ_ORDER
DQ_WHERE DQ_DELETE DQ_UPDATE DQ_INSERT
);
-use Data::Query::ExprHelpers qw(perl_scalar_value);
+use Data::Query::ExprHelpers;
use Moo;
+use namespace::clean;
has renderer_will_quote => (
is => 'ro'
);
has lower_case => (
- is => 'ro'
+ is => 'ro'
);
has default_logic => (
my ($self, $literal) = @_;
my @bind;
($literal, @bind) = @$literal if ref($literal) eq 'ARRAY';
- +{
- type => DQ_LITERAL,
- subtype => 'SQL',
- literal => $literal,
- (@bind ? (values => [ $self->_bind_to_dq(@bind) ]) : ()),
- };
+ Literal('SQL', $literal, [ $self->_bind_to_dq(@bind) ]);
}
sub _bind_to_dq {
my ($self, $ident) = @_;
$self->_assert_pass_injection_guard($ident)
unless $self->renderer_will_quote;
- $self->_maybe_convert_dq({
- type => DQ_IDENTIFIER,
- elements => [ split /\Q${\$self->identifier_sep}/, $ident ],
- });
+ $self->_maybe_convert_dq(Identifier(split /\Q${\$self->identifier_sep}/, $ident));
}
sub _maybe_convert_dq {
my ($self, $dq) = @_;
if (my $c = $self->{where_convert}) {
- +{
- type => DQ_OPERATOR,
- operator => { 'SQL.Naive' => 'apply' },
- args => [
- { type => DQ_IDENTIFIER, elements => [ $self->_sqlcase($c) ] },
- $dq
- ]
- };
+ Operator({ 'SQL.Naive' => 'apply' }, [
+ { type => DQ_IDENTIFIER, elements => [ $self->_sqlcase($c) ] },
+ $dq
+ ]
+ );
} else {
$dq;
}
sub _op_to_dq {
my ($self, $op, @args) = @_;
$self->_assert_pass_injection_guard($op);
- +{
- type => DQ_OPERATOR,
- operator => { 'SQL.Naive' => $op },
- args => \@args
- };
+ Operator({ 'SQL.Naive' => $op }, \@args);
}
sub _assert_pass_injection_guard {
(ref($r_source) eq 'ARRAY' ? @$r_source : $r_source),
];
}
- +{
- type => DQ_INSERT,
- target => $self->_table_to_dq($table),
- (@names ? (names => [ map $self->_ident_to_dq($_), @names ]) : ()),
- values => [ \@values ],
- ($returning ? (returning => $returning) : ()),
- };
+ Insert(
+ (@names ? ([ map $self->_ident_to_dq($_), @names ]) : undef),
+ [ \@values ],
+ $self->_table_to_dq($table),
+ ($returning ? ($returning) : undef),
+ );
}
sub _mutation_rhs_to_dq {
push @set, [ $self->_ident_to_dq($k), $self->_mutation_rhs_to_dq($v) ];
}
- return +{
- type => DQ_UPDATE,
- target => $self->_table_to_dq($table),
- set => \@set,
- where => $self->_where_to_dq($where),
- };
+ Update(
+ \@set,
+ $self->_where_to_dq($where),
+ $self->_table_to_dq($table),
+ );
}
sub _source_to_dq {
my $source_dq = $self->_table_to_dq($table);
if (my $where_dq = $self->_where_to_dq($where)) {
- $source_dq = {
- type => DQ_WHERE,
- from => $source_dq,
- where => $where_dq,
- };
+ $source_dq = Where($where_dq, $source_dq);
}
$source_dq;
$fields ||= '*';
- return +{
- type => DQ_SELECT,
- select => $self->_select_field_list_to_dq($fields),
- from => $from_dq,
- };
+ Select(
+ $self->_select_field_list_to_dq($fields),
+ $from_dq,
+ );
}
sub _select_field_list_to_dq {
sub _delete_to_dq {
my ($self, $table, $where) = @_;
- +{
- type => DQ_DELETE,
- target => $self->_table_to_dq($table),
- where => $self->_where_to_dq($where),
- }
+ Delete(
+ $self->_where_to_dq($where),
+ $self->_table_to_dq($table),
+ );
}
sub _where_to_dq {
return undef unless defined($where);
+ # if we're given a simple string assume it's a literal
+ return $self->_literal_to_dq($where) if !ref($where);
+
# turn the convert misfeature on - only used in WHERE clauses
local $self->{where_convert} = $self->convert;
map +{ $k => $_ }, @$v
], $logic);
} elsif (ref($v) eq 'SCALAR' or (ref($v) eq 'REF' and ref($$v) eq 'ARRAY')) {
- return +{
- type => DQ_LITERAL,
- subtype => 'SQL',
- parts => [ $self->_ident_to_dq($k), $self->_literal_to_dq($$v) ]
- };
+ return Literal('SQL', [ $self->_ident_to_dq($k), $self->_literal_to_dq($$v) ]);
}
my ($op, $rhs) = do {
if (ref($v) eq 'HASH') {
return unless $arg;
- my $dq = {
- type => DQ_ORDER,
- ($dir ? (direction => $dir) : ()),
- ($from ? (from => $from) : ()),
- };
+ my $dq = Order(
+ undef,
+ (defined($dir) ? (!!($dir =~ /desc/i)) : undef),
+ ($from ? ($from) : undef),
+ );
if (!ref($arg)) {
$dq->{by} = $self->_ident_to_dq($arg);
} elsif (ref($arg) eq 'REF' and ref($$arg) eq 'ARRAY') {
$dq->{by} = $self->_literal_to_dq($$arg);
} elsif (ref($arg) eq 'SCALAR') {
- $dq->{by} = $self->_literal_to_dq($$arg);
+
+ # < mst> right, but if it doesn't match that, it goes "ok, right, not sure,
+ # totally leaving this untouched as a literal"
+ # < mst> so I -think- it's relatively robust
+ # < ribasushi> right, it's relatively safe then
+ # < ribasushi> is this regex centralized?
+ # < mst> it only exists in _order_by_to_dq in SQL::Abstract::Converter
+ # < mst> it only exists because you were kind enough to support new
+ # dbihacks crack combined with old literal order_by crack
+ # < ribasushi> heh :)
+
+ if (my ($ident, $dir) = $$arg =~ /^(\w+)(?:\s+(desc|asc))?$/i) {
+ $dq->{by} = $self->_ident_to_dq($ident);
+ $dq->{reverse} = 1 if $dir and lc($dir) eq 'desc';
+ } else {
+ $dq->{by} = $self->_literal_to_dq($$arg);
+ }
} elsif (ref($arg) eq 'HASH') {
my ($key, $val, @rest) = %$arg;
die "Empty FROM list" unless my @f = @$from;
my $dq = $self->_table_to_dq(shift @f);
while (my $x = shift @f) {
- $dq = {
- type => DQ_JOIN,
- join => [ $dq, $self->_table_to_dq($x) ]
- };
+ $dq = Join(
+ $dq,
+ $self->_table_to_dq($x),
+ );
}
$dq;
} elsif (ref($from) eq 'SCALAR' or (ref($from) eq 'REF')) {
projects / dbsrgits/SQL-Abstract.git / blobdiff