$sql = join " ", $self->_sqlcase('insert into'), $table, $sql;
if ($options->{returning}) {
- my ($s, @b) = $self->_insert_returning ($options);
+ my ($s, @b) = $self->_insert_returning($options);
$sql .= $s;
push @bind, @b;
}
if (@rest or not $op =~ /^\-(.+)/);
local $self->{_nested_func_lhs} = $k;
- my ($sql, @bind) = $self->_where_unary_op ($1, $arg);
+ my ($sql, @bind) = $self->_where_unary_op($1, $arg);
push @set, "$label = $sql";
push @all_bind, @bind;
}
if ($options->{returning}) {
- my ($returning_sql, @returning_bind) = $self->_update_returning ($options);
+ my ($returning_sql, @returning_bind) = $self->_update_returning($options);
$sql .= $returning_sql;
push @all_bind, @returning_bind;
}
my $sql = $self->_sqlcase('delete from') . " $table" . $where_sql;
if ($options->{returning}) {
- my ($returning_sql, @returning_bind) = $self->_delete_returning ($options);
+ my ($returning_sql, @returning_bind) = $self->_delete_returning($options);
$sql .= $returning_sql;
push @bind, @returning_bind;
}
$op =~ s/^not_/NOT /i;
$self->_debug("Unary OP(-$op) within hashref, recursing...");
- my ($s, @b) = $self->_where_unary_op ($op, $v);
+ my ($s, @b) = $self->_where_unary_op($op, $v);
# top level vs nested
# we assume that handled unary ops will take care of their ()s
# top level special ops are illegal in general
# this includes the -ident/-value ops (dual purpose unary and special)
puke "Illegal use of top-level '-$op'"
- if ! defined $self->{_nested_func_lhs} and List::Util::first {$op =~ $_->{regex}} @{$self->{special_ops}};
+ if ! defined $self->{_nested_func_lhs} and List::Util::first { $op =~ $_->{regex} } @{$self->{special_ops}};
- if (my $op_entry = List::Util::first {$op =~ $_->{regex}} @{$self->{unary_ops}}) {
+ if (my $op_entry = List::Util::first { $op =~ $_->{regex} } @{$self->{unary_ops}}) {
my $handler = $op_entry->{handler};
if (not ref $handler) {
belch 'Use of [and|or|nest]_N modifiers is deprecated and will be removed in SQLA v2.0. '
. "You probably wanted ...-and => [ -$op => COND1, -$op => COND2 ... ]";
}
- return $self->$handler ($op, $rhs);
+ return $self->$handler($op, $rhs);
}
elsif (ref $handler eq 'CODE') {
return $handler->($self, $op, $rhs);
$self->_assert_pass_injection_guard($op);
- my ($sql, @bind) = $self->_SWITCH_refkind ($rhs, {
+ my ($sql, @bind) = $self->_SWITCH_refkind($rhs, {
SCALAR => sub {
puke "Illegal use of top-level '-$op'"
unless defined $self->{_nested_func_lhs};
);
},
FALLBACK => sub {
- $self->_recurse_where ($rhs)
+ $self->_recurse_where($rhs)
},
});
- $sql = sprintf ('%s %s',
+ $sql = sprintf('%s %s',
$self->_sqlcase($op),
$sql,
);
},
HASHREF => sub {
- return ( $op =~ /^or/i )
- ? $self->_where_ARRAYREF( [ map { $_ => $v->{$_} } ( sort keys %$v ) ], $op )
+ return ($op =~ /^or/i)
+ ? $self->_where_ARRAYREF([ map { $_ => $v->{$_} } (sort keys %$v) ], $op)
: $self->_where_HASHREF($v);
},
},
FALLBACK => sub {
- $self->_recurse_where ($v);
+ $self->_recurse_where($v);
},
});
},
FALLBACK => sub {
- $self->_recurse_where ($v);
+ $self->_recurse_where($v);
},
});
}
my @bind =
- $self->_bindtype (
- ( defined $lhs ? $lhs : $self->{_nested_func_lhs} ),
+ $self->_bindtype(
+ (defined $lhs ? $lhs : $self->{_nested_func_lhs}),
$rhs,
)
;
sub _where_hashpair_ARRAYREF {
my ($self, $k, $v) = @_;
- if( @$v ) {
+ if (@$v) {
my @v = @$v; # need copy because of shift below
$self->_debug("ARRAY($k) means distribute over elements");
my ($sql, @bind);
# CASE: col-value logic modifiers
- if ( $orig_op =~ /^ \- (and|or) $/xi ) {
+ if ($orig_op =~ /^ \- (and|or) $/xi) {
($sql, @bind) = $self->_where_hashpair_HASHREF($k, $val, $1);
}
# CASE: special operators like -in or -between
- elsif ( my $special_op = List::Util::first {$op =~ $_->{regex}} @{$self->{special_ops}} ) {
+ elsif (my $special_op = List::Util::first { $op =~ $_->{regex} } @{$self->{special_ops}}) {
my $handler = $special_op->{handler};
if (! $handler) {
puke "No handler supplied for special operator $orig_op";
}
elsif (not ref $handler) {
- ($sql, @bind) = $self->$handler ($k, $op, $val);
+ ($sql, @bind) = $self->$handler($k, $op, $val);
}
elsif (ref $handler eq 'CODE') {
($sql, @bind) = $handler->($self, $k, $op, $val);
},
FALLBACK => sub { # CASE: col => {op/func => $stuff}
- ($sql, @bind) = $self->_where_unary_op ($op, $val);
+ ($sql, @bind) = $self->_where_unary_op($op, $val);
- $sql = join (' ',
+ $sql = join(' ',
$self->_convert($self->_quote($k)),
$self->{_nested_func_lhs} eq $k ? $sql : "($sql)", # top level vs nested
);
my @vals = @$vals; #always work on a copy
- if(@vals) {
+ if (@vals) {
$self->_debug(sprintf '%s means multiple elements: [ %s ]',
$vals,
- join (', ', map { defined $_ ? "'$_'" : 'NULL' } @vals ),
+ join(', ', map { defined $_ ? "'$_'" : 'NULL' } @vals ),
);
# see if the first element is an -and/-or op
my $logic;
- if (defined $vals[0] && $vals[0] =~ /^ - ( AND|OR ) $/ix) {
+ if (defined $vals[0] && $vals[0] =~ /^ - (AND|OR) $/ix) {
$logic = uc $1;
shift @vals;
}
and
(!$logic or $logic eq 'OR')
and
- ( $op =~ $self->{inequality_op} or $op =~ $self->{not_like_op} )
+ ($op =~ $self->{inequality_op} or $op =~ $self->{not_like_op})
) {
my $o = uc($op);
belch "A multi-element arrayref as an argument to the inequality op '$o' "
$self->_sqlcase($self->{cmp}),
$self->_convert('?');
my @bind = $self->_bindtype($k, $v);
- return ( $sql, @bind);
+ return ($sql, @bind);
}
my ($func, $arg, @rest) = %$val;
puke "Only simple { -func => arg } functions accepted as sub-arguments to BETWEEN"
if (@rest or $func !~ /^ \- (.+)/x);
- $self->_where_unary_op ($1 => $arg);
+ $self->_where_unary_op($1 => $arg);
},
FALLBACK => sub {
puke $invalid_args,
my ($func, $arg, @rest) = %$val;
puke "Only simple { -func => arg } functions accepted as sub-arguments to IN"
if (@rest or $func !~ /^ \- (.+)/x);
- $self->_where_unary_op ($1 => $arg);
+ $self->_where_unary_op($1 => $arg);
},
UNDEF => sub {
puke(
}
return (
- sprintf ('%s %s ( %s )',
+ sprintf('%s %s ( %s )',
$label,
$op,
- join (', ', @all_sql)
+ join(', ', @all_sql)
),
$self->_bindtype($k, @all_bind),
);
},
SCALARREF => sub { # literal SQL
- my $sql = $self->_open_outer_paren ($$vals);
+ my $sql = $self->_open_outer_paren($$vals);
return ("$label $op ( $sql )");
},
ARRAYREFREF => sub { # literal SQL with bind
my ($sql, @bind) = @$$vals;
$self->_assert_bindval_matches_bindtype(@bind);
- $sql = $self->_open_outer_paren ($sql);
+ $sql = $self->_open_outer_paren($sql);
return ("$label $op ( $sql )", @bind);
},
sub _open_outer_paren {
my ($self, $sql) = @_;
- while ( my ($inner) = $sql =~ /^ \s* \( (.*) \) \s* $/xs ) {
+ while (my ($inner) = $sql =~ /^ \s* \( (.*) \) \s* $/xs) {
# there are closing parens inside, need the heavy duty machinery
# to reevaluate the extraction starting from $sql (full reevaluation)
- if ( $inner =~ /\)/ ) {
+ if ($inner =~ /\)/) {
require Text::Balanced;
my (undef, $remainder) = do {
# idiotic design - writes to $@ but *DOES NOT* throw exceptions
local $@;
- Text::Balanced::extract_bracketed( $sql, '()', qr/\s*/ );
+ Text::Balanced::extract_bracketed($sql, '()', qr/\s*/);
};
# the entire expression needs to be a balanced bracketed thing
my ($self, $arg) = @_;
my (@sql, @bind);
- for my $c ($self->_order_by_chunks ($arg) ) {
- $self->_SWITCH_refkind ($c, {
+ for my $c ($self->_order_by_chunks($arg) ) {
+ $self->_SWITCH_refkind($c, {
SCALAR => sub { push @sql, $c },
ARRAYREF => sub { push @sql, shift @$c; push @bind, @$c },
});
}
my $sql = @sql
- ? sprintf ('%s %s',
+ ? sprintf('%s %s',
$self->_sqlcase(' order by'),
- join (', ', @sql)
+ join(', ', @sql)
)
: ''
;
return $self->_SWITCH_refkind($arg, {
ARRAYREF => sub {
- map { $self->_order_by_chunks ($_ ) } @$arg;
+ map { $self->_order_by_chunks($_ ) } @$arg;
},
ARRAYREFREF => sub {
return () unless $key;
- if ( @rest or not $key =~ /^-(desc|asc)/i ) {
+ if (@rest or not $key =~ /^-(desc|asc)/i) {
puke "hash passed to _order_by must have exactly one key (-desc or -asc)";
}
my $direction = $1;
my @ret;
- for my $c ($self->_order_by_chunks ($val)) {
+ for my $c ($self->_order_by_chunks($val)) {
my ($sql, @bind);
- $self->_SWITCH_refkind ($c, {
+ $self->_SWITCH_refkind($c, {
SCALAR => sub {
$sql = $c;
},
my $esc = $_[0]->{escape_char} || $r;
# parts containing * are naturally unquoted
- return join( $_[0]->{name_sep}||'', map
+ return join($_[0]->{name_sep}||'', map
+( $_ eq '*' ? $_ : do { (my $n = $_) =~ s/(\Q$esc\E|\Q$r\E)/$esc$1/g; $l . $n . $r } ),
( $_[0]->{name_sep} ? split (/\Q$_[0]->{name_sep}\E/, $_[1] ) : $_[1] )
);
unless ref $data eq 'HASH';
my @all_bind;
- foreach my $k ( sort keys %$data ) {
+ foreach my $k (sort keys %$data) {
my $v = $data->{$k};
$self->_SWITCH_refkind($v, {
ARRAYREF => sub {
When supplied with a method name, it is simply called on the
L<SQL::Abstract> object as:
- $self->$method_name ($field, $op, $arg)
+ $self->$method_name($field, $op, $arg)
Where:
When supplied with a method name, it is simply called on the
L<SQL::Abstract> object as:
- $self->$method_name ($op, $arg)
+ $self->$method_name($op, $arg)
Where:
for (1,2) {
my $chunk = shift @_;
- if ( ref $chunk eq 'REF' and ref $$chunk eq 'ARRAY' ) {
+ if (ref $chunk eq 'REF' and ref $$chunk eq 'ARRAY') {
my ($sql, @bind) = @$$chunk;
push @args, ($sql, \@bind);
}
}
sub diag_where{
- $tb->diag( "Search term:\n" . &dumper );
+ $tb->diag("Search term:\n" . &dumper);
}
sub _sql_differ_diag {
my $sql1 = shift || '';
my $sql2 = shift || '';
- $tb->${\( $tb->in_todo ? 'note' : 'diag')} (
+ $tb->${\($tb->in_todo ? 'note' : 'diag')} (
"SQL expressions differ\n"
." got: $sql1\n"
."want: $sql2\n"
sub _bind_differ_diag {
my ($bind_ref1, $bind_ref2) = @_;
- $tb->${\( $tb->in_todo ? 'note' : 'diag')} (
+ $tb->${\($tb->in_todo ? 'note' : 'diag')} (
"BIND values differ " . dumper({ got => $bind_ref1, want => $bind_ref2 })
);
}
my ($left, $right) = @_;
# one is defined the other not
- if ( (defined $left) xor (defined $right) ) {
- $sql_differ = sprintf ("[%s] != [%s]\n", map { defined $_ ? $sqlat->unparse ($_) : 'N/A' } ($left, $right) );
+ if ((defined $left) xor (defined $right)) {
+ $sql_differ = sprintf ("[%s] != [%s]\n", map { defined $_ ? $sqlat->unparse($_) : 'N/A' } ($left, $right) );
return 0;
}
# one is empty
if (@$left == 0 or @$right == 0) {
- $sql_differ = sprintf ("left: %s\nright: %s\n", map { @$_ ? $sqlat->unparse ($_) : 'N/A'} ($left, $right) );
+ $sql_differ = sprintf ("left: %s\nright: %s\n", map { @$_ ? $sqlat->unparse($_) : 'N/A'} ($left, $right) );
return 0;
}
# one is a list, the other is an op with a list
elsif (ref $left->[0] xor ref $right->[0]) {
$sql_differ = sprintf ("[%s] != [%s]\nleft: %s\nright: %s\n", map
- { ref $_ ? $sqlat->unparse ($_) : $_ }
+ { ref $_ ? $sqlat->unparse($_) : $_ }
($left->[0], $right->[0], $left, $right)
);
return 0;
if (! $sql_differ or $sql_differ !~ /left\:\s .+ right:\s/xs) {
$sql_differ ||= '';
$sql_differ .= "\n" unless $sql_differ =~ /\n\z/;
- $sql_differ .= sprintf ("left: %s\nright: %s\n", map { $sqlat->unparse ($_) } ($left, $right) );
+ $sql_differ .= sprintf ("left: %s\nright: %s\n", map { $sqlat->unparse($_) } ($left, $right) );
}
return 0;
}
else {
# unroll parenthesis if possible/allowed
- unless ( $parenthesis_significant ) {
+ unless ($parenthesis_significant) {
$sqlat->_parenthesis_unroll($_) for $left, $right;
}
$sqlat->_strip_asc_from_order_by($_) for $left, $right;
}
- if ( $left->[0] ne $right->[0] ) {
+ if ($left->[0] ne $right->[0]) {
$sql_differ = sprintf "OP [$left->[0]] != [$right->[0]] in\nleft: %s\nright: %s\n",
$sqlat->unparse($left),
$sqlat->unparse($right)
# if operators are identical, compare operands
else {
my $eq = _eq_sql($left->[1], $right->[1]);
- $sql_differ ||= sprintf ("left: %s\nright: %s\n", map { $sqlat->unparse ($_) } ($left, $right) ) if not $eq;
+ $sql_differ ||= sprintf ("left: %s\nright: %s\n", map { $sqlat->unparse($_) } ($left, $right) ) if not $eq;
return $eq;
}
}
projects / dbsrgits/SQL-Abstract.git / commitdiff