Skip to content
Draft
Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
26 commits
Select commit Hold shift + click to select a range
5c33eec
accept prepared statement in terms array
jamadam Sep 7, 2025
445454d
accept prepared statement in select list
jamadam Sep 10, 2025
f5464a7
use models after check_driver
jamadam Sep 10, 2025
f7bd7d4
accept prepared statement in from clause
jamadam Sep 10, 2025
d2f906f
subquery alias should be set to select_map
jamadam Sep 11, 2025
8ff74a5
select_map_reverse is not needed for subquery
jamadam Sep 11, 2025
2191c0d
set select_map for subquery without alias to silence uuv
jamadam Sep 11, 2025
b47fb2f
fix uuv again
jamadam Sep 11, 2025
f1688e1
cleanup test
jamadam Sep 16, 2025
cbadb9c
silence uuv
jamadam Sep 18, 2025
e031cfb
do not aggricate bind array twice
jamadam Sep 18, 2025
9780fed
subquery in select list must have an alias for later access
jamadam Sep 18, 2025
e85a913
temporally remove subquery alias for WHERE, so the query may be reusable
jamadam Sep 18, 2025
71ad5e2
test that SQL actually works with DBI
jamadam Sep 18, 2025
af77ab5
add tests for bind aggregation on statement reuse
jamadam Sep 18, 2025
3ab7a82
use modeuls after check_driver
jamadam Sep 18, 2025
536bd34
use done_testing
jamadam Sep 18, 2025
380249c
do not use LIMIT with IN operator in test because mysql doesnt suppor…
jamadam Sep 18, 2025
a5e173a
fix test for mysql
jamadam Sep 18, 2025
10c8634
fix test for sqlite
jamadam Sep 18, 2025
f59d139
revert uuv fix for ommitted alias
jamadam Sep 19, 2025
dedf234
add_select now accepts subquery with alias
jamadam Sep 19, 2025
8ad033e
fix add_having on subquery alias
jamadam Sep 19, 2025
178b921
search method now accepts prepared statements
jamadam Sep 19, 2025
ccdc561
add a test dependency
jamadam Sep 19, 2025
cae68ff
rename bind concatinated flat
jamadam Sep 19, 2025
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions cpanfile
Original file line number Diff line number Diff line change
Expand Up @@ -22,6 +22,7 @@ on develop => sub {

on test => sub {
requires 'version';
requires 'Tie::IxHash';
};

feature 'test_sqlite', 'Test SQLite' => sub {
Expand Down
25 changes: 16 additions & 9 deletions lib/Data/ObjectDriver/Driver/DBI.pm
Original file line number Diff line number Diff line change
Expand Up @@ -12,6 +12,7 @@ use Data::ObjectDriver::Errors;
use Data::ObjectDriver::SQL;
use Data::ObjectDriver::Driver::DBD;
use Data::ObjectDriver::Iterator;
use Scalar::Util 'blessed';

my $ForkSafe = _is_fork_safe();
my %Handles;
Expand Down Expand Up @@ -172,14 +173,20 @@ sub prepare_fetch {

sub fetch {
my $driver = shift;
my($rec, $class, $orig_terms, $orig_args) = @_;
my ($rec, $class, $terms_or_stmt, $orig_args) = @_;
my ($sql, $stmt);

if ($Data::ObjectDriver::RESTRICT_IO) {
use Data::Dumper;
die "Attempted DBI I/O while in restricted mode: fetch() " . Dumper($orig_terms, $orig_args);
}
if (blessed($terms_or_stmt) && $terms_or_stmt->isa('Data::ObjectDriver::SQL')) {
$sql = $terms_or_stmt->as_sql;
$stmt = $terms_or_stmt;
} else {
if ($Data::ObjectDriver::RESTRICT_IO) {
use Data::Dumper;
die "Attempted DBI I/O while in restricted mode: fetch() " . Dumper($terms_or_stmt, $orig_args);
}

my ($sql, $bind, $stmt) = $driver->prepare_fetch($class, $orig_terms, $orig_args);
($sql, undef, $stmt) = $driver->prepare_fetch($class, $terms_or_stmt, $orig_args);
}

my @bind;
my $map = $stmt->select_map;
Expand Down Expand Up @@ -218,11 +225,11 @@ sub load_object_from_rec {
}

sub search {
my($driver) = shift;
my($class, $terms, $args) = @_;
my ($driver) = shift;
my ($class, $terms_or_stmt, $args) = @_;

my $rec = {};
my $sth = $driver->fetch($rec, $class, $terms, $args);
my $sth = $driver->fetch($rec, $class, $terms_or_stmt, $args);

my $iter = sub {
## This is kind of a hack--we need $driver to stay in scope,
Expand Down
78 changes: 67 additions & 11 deletions lib/Data/ObjectDriver/SQL.pm
Original file line number Diff line number Diff line change
Expand Up @@ -3,14 +3,15 @@
package Data::ObjectDriver::SQL;
use strict;
use warnings;
use Scalar::Util 'blessed';

use base qw( Class::Accessor::Fast );

__PACKAGE__->mk_accessors(qw(
select distinct select_map select_map_reverse
from joins where bind limit offset group order
having where_values column_mutator index_hint
comment
comment as is_bind_contatinated
));

sub new {
Expand All @@ -33,10 +34,17 @@ sub new {
sub add_select {
my $stmt = shift;
my($term, $col) = @_;
$col ||= $term;
push @{ $stmt->select }, $term;
$stmt->select_map->{$term} = $col;
$stmt->select_map_reverse->{$col} = $term;
if (blessed($term) && $term->isa('Data::ObjectDriver::SQL')) {
my $alias = $col || $term->as;
die 'Sub-query requires an alias by setting $stmt->as(...)' unless $alias;
$stmt->select_map->{$term} = $alias;
$stmt->select_map_reverse->{$alias} = $term;
} else {
$col ||= $term;
$stmt->select_map->{$term} = $col;
$stmt->select_map_reverse->{$col} = $term;
}
}

sub add_join {
Expand All @@ -60,12 +68,25 @@ sub add_index_hint {
sub as_sql {
my $stmt = shift;
my $sql = '';
my @bind_for_select;

if (@{ $stmt->select }) {
$sql .= 'SELECT ';
$sql .= 'DISTINCT ' if $stmt->distinct;
my $select_map = $stmt->select_map;
$sql .= join(', ', map {
my $alias = $stmt->select_map->{$_};
$alias && /(?:^|\.)\Q$alias\E$/ ? $_ : "$_ $alias";
my $col = $_;
my $alias = $select_map->{$col};
if (blessed($col) && $col->isa('Data::ObjectDriver::SQL')) {
push @bind_for_select, @{ $col->{bind} };
$col->as_subquery($alias);
} else {
if ($alias) {
/(?:^|\.)\Q$alias\E$/ ? $col : "$col $alias";
} else {
$col;
}
}
} @{ $stmt->select }) . "\n";
}
$sql .= 'FROM ';
Expand All @@ -91,8 +112,18 @@ sub as_sql {
$sql .= ', ' if @from;
}

my @bind_for_from;

if (@from) {
$sql .= join ', ', map { $stmt->_add_index_hint($_) } @from;
$sql .= join ', ', map {
my $from = $_;
if (blessed($from) && $from->isa('Data::ObjectDriver::SQL')) {
push @bind_for_from, @{$from->{bind}};
$from->as_subquery;
} else {
$stmt->_add_index_hint($from);
}
} @from;
}

$sql .= "\n";
Expand All @@ -107,9 +138,25 @@ sub as_sql {
if ($comment && $comment =~ /([ 0-9a-zA-Z.:;()_#&,]+)/) {
$sql .= "-- $1" if $1;
}

unless ($stmt->is_bind_contatinated) {
@{ $stmt->{bind} } = (@bind_for_select, @bind_for_from, @{ $stmt->{bind} });
$stmt->is_bind_contatinated(1);
}

return $sql;
}

sub as_subquery {
my ($stmt, $alias) = @_;
my $subquery = '(' . $stmt->as_sql . ')';
$alias ||= $stmt->as;
if ($alias) {
$subquery .= ' AS ' . $alias;
}
$subquery;
}

sub as_limit {
my $stmt = shift;
my $n = $stmt->limit or
Expand Down Expand Up @@ -231,7 +278,11 @@ sub add_having {
# Carp::croak("Invalid/unsafe column name $col") unless $col =~ /^[\w\.]+$/;

if (my $orig = $stmt->select_map_reverse->{$col}) {
$col = $orig;
if (blessed($orig) && $orig->isa('Data::ObjectDriver::SQL')) {
# do nothins
} else {
$col = $orig;
}
}

my($term, $bind) = $stmt->_mk_term($col, $val);
Expand Down Expand Up @@ -281,12 +332,17 @@ sub _mk_term {
$term = "$c $op ? AND ?";
push @bind, @{$val->{value}};
} else {
if (ref $val->{value} eq 'SCALAR') {
$term = "$c $val->{op} " . ${$val->{value}};
my $value = $val->{value};
if (ref $value eq 'SCALAR') {
$term = "$c $val->{op} " . $$value;
} elsif (blessed($value) && $value->isa('Data::ObjectDriver::SQL')) {
local $value->{as} = undef;
$term = "$c $val->{op} ". $value->as_subquery;
push @bind, @{$value->{bind}};
} else {
$term = "$c $val->{op} ?";
$term .= $stmt->as_escape($val->{escape}) if $val->{escape} && $op =~ /^(?:NOT\s+)?I?LIKE$/;
push @bind, $val->{value};
push @bind, $value;
}
}
} elsif (ref($val) eq 'SCALAR') {
Expand Down
Loading
Loading