Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
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,27 +173,33 @@ 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);
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);
if (blessed($terms_or_stmt) && $terms_or_stmt->isa('Data::ObjectDriver::SQL')) {
$sql = $terms_or_stmt->as_sql;
$stmt = $terms_or_stmt;
} else {
($sql, undef, $stmt) = $driver->prepare_fetch($class, $terms_or_stmt, $orig_args);
}

my @bind;
my @columns;
my $map = $stmt->select_map;
for my $col (@{ $stmt->select }) {
push @bind, \$rec->{ $map->{$col} };
push @columns, \$rec->{ $map->{$col} };
}

my $dbh = $driver->r_handle($class->properties->{db});
$driver->start_query($sql, $stmt->{bind});

my $sth = $orig_args->{no_cached_prepare} ? $dbh->prepare($sql) : $driver->_prepare_cached($dbh, $sql);
$sth->execute(@{ $stmt->{bind} });
$sth->bind_columns(undef, @bind);
$sth->bind_columns(undef, @columns);

# need to slurp 'offset' rows for DBs that cannot do it themselves
if (!$driver->dbd->offset_implemented && $orig_args->{offset}) {
Expand All @@ -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
76 changes: 65 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
));

sub new {
Expand All @@ -33,10 +34,16 @@ 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 || $term->as_sql;
$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 +67,26 @@ 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->{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,19 @@ 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->{bind}} = ();
$from->as_subquery;
} else {
$stmt->_add_index_hint($from);
}
} @from;
}

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

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

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 +276,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 +330,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