*{"${class}::search_${name}"} =
sub {
my ($class, @args) = @_;
- $class->sth_to_objects($class->$meth, \@args);
+ my $sth = $class->$meth;
+ $sth->execute(@args);
+ return $class->sth_to_objects($sth);
};
}
}
+sub sth_to_objects {
+ my ($class, $sth) = @_;
+ my @cols = $class->_select_columns;
+ my @ret;
+ while (my @row = $sth->fetchrow_array) {
+ push(@ret, $class->_row_to_object(\@cols,\@row));
+ }
+ return @ret;
+}
+
sub transform_sql {
my ($class, $sql, @args) = @_;
my $table = $class->_table_name;
my %want;
$want{$_} = 1 for map { keys %{$self->_column_groups->{$_}} } @groups;
if (my @want = grep { !exists $self->{'_column_data'}{$_} } keys %want) {
- my $sth = $self->storage->select($self->_table_name, \@want,
+ my $cursor = $self->storage->select($self->_table_name, \@want,
\$self->_ident_cond, { bind => [ $self->_ident_values ] });
#my $sth = $self->storage->select($self->_table_name, \@want,
# $self->ident_condition);
# Not sure why the first one works and this doesn't :(
- my @val = $sth->fetchrow_array;
+ my @val = $cursor->next;
#warn "Flesh: ".join(', ', @want, '=>', @val);
foreach my $w (@want) {
$self->{'_column_data'}{$w} = shift @val;
use strict;
use warnings;
+no warnings 'qw';
use base qw/DBIx::Class/;
Relationship::ProxyMethods
Relationship
InflateColumn
- SQL::OrderBy
+ #SQL::OrderBy
SQL::Abstract
PK
Table
use strict;
use warnings;
-use overload
- '0+' => 'count',
- fallback => 1;
sub new {
- my ($it_class, $db_class, $sth, $args, $cols, $attrs) = @_;
+ my ($it_class, $sth, $args, $attrs) = @_;
#use Data::Dumper; warn Dumper(@_);
$it_class = ref $it_class if ref $it_class;
- unless ($sth) {
- $attrs->{bind} = $args;
- $sth = $db_class->storage->select($db_class->_table_name,$cols,
- $attrs->{where},$attrs);
- }
my $new = {
- class => $db_class,
sth => $sth,
- cols => $cols,
args => $args,
pos => 0,
attrs => $attrs };
return bless ($new, $it_class);
}
-sub slice {
- my ($self, $min, $max) = @_;
- my $attrs = { %{ $self->{attrs} || {} } };
- $self->{class}->throw("Can't slice without where") unless $attrs->{where};
- $attrs->{offset} = $min;
- $attrs->{rows} = ($max ? ($max - $min + 1) : 1);
- my $slice = $self->new($self->{class}, undef, $self->{args},
- $self->{cols}, $attrs);
- return (wantarray ? $slice->all : $slice);
-}
-
sub next {
my ($self) = @_;
return if $self->{attrs}{rows}
unless ($self->{live_sth}) {
$self->{sth}->execute(@{$self->{args} || []});
if (my $offset = $self->{attrs}{offset}) {
- $self->{sth}->fetchrow_array for 1 .. $offset;
+ $self->{sth}->fetch for 1 .. $offset;
}
$self->{live_sth} = 1;
}
my @row = $self->{sth}->fetchrow_array;
- return unless (@row);
- $self->{pos}++;
- return $self->{class}->_row_to_object($self->{cols}, \@row);
-}
-
-sub count {
- my ($self) = @_;
- return $self->{attrs}{rows} if $self->{attrs}{rows};
- if (my $cond = $self->{attrs}->{where}) {
-#warn "Counting ".$$cond;
- return $self->{class}->count($cond, { bind => $self->{args} });
- } else {
- return scalar $_[0]->all; # So inefficient
- }
-}
-
-sub all {
- my ($self) = @_;
- $self->reset;
- my @all;
- while (my $obj = $self->next) {
- push(@all, $obj);
- }
- $self->reset;
- return @all;
+ $self->{pos}++ if @row;
+ return @row;
}
sub reset {
return $self;
}
-sub first {
- return $_[0]->reset->next;
-}
-
-sub delete_all {
- my ($self) = @_;
- $_->delete for $self->all;
- return 1;
-}
-
sub DESTROY {
my ($self) = @_;
$self->{sth}->finish if $self->{sth}->{Active};
my $ret = $class->NEXT::ACTUAL::add_relationship($rel => @rest);
my $rel_obj = $class->_relationships->{$rel};
if (my $acc_type = $rel_obj->{attrs}{accessor}) {
- $class->_add_relationship_accessor($rel => $acc_type);
+ $class->add_relationship_accessor($rel => $acc_type);
}
return $ret;
}
-sub _add_relationship_accessor {
+sub add_relationship_accessor {
my ($class, $rel, $acc_type) = @_;
my %meth;
if ($acc_type eq 'single') {
my ($class, $rel, @rest) = @_;
my $ret = $class->NEXT::ACTUAL::add_relationship($rel => @rest);
if (my $proxy_list = $class->_relationships->{$rel}->{attrs}{proxy}) {
- no strict 'refs';
- no warnings 'redefine';
- foreach my $proxy (ref $proxy_list ? @$proxy_list : $proxy_list) {
- *{"${class}::${proxy}"} =
- sub {
- my $self = shift;
- my $val = $self->$rel;
- if (@_ && !defined $val) {
- $val = $self->create_related($rel, { $proxy => $_[0] });
- @_ = ();
- }
- return ($val ? $val->$proxy(@_) : undef);
- }
- }
+ $class->proxy_to_related($rel,
+ (ref $proxy_list ? @$proxy_list : $proxy_list));
}
return $ret;
}
+sub proxy_to_related {
+ my ($class, $rel, @proxy) = @_;
+ no strict 'refs';
+ no warnings 'redefine';
+ foreach my $proxy (@proxy) {
+ *{"${class}::${proxy}"} =
+ sub {
+ my $self = shift;
+ my $val = $self->$rel;
+ if (@_ && !defined $val) {
+ $val = $self->create_related($rel, { $proxy => $_[0] });
+ @_ = ();
+ }
+ return ($val ? $val->$proxy(@_) : undef);
+ }
+ }
+}
+
1;
use strict;
use warnings;
use DBI;
+use SQL::Abstract;
+use DBIx::Class::Cursor;
use base qw/DBIx::Class/;
-__PACKAGE__->load_components(qw/SQL::Abstract SQL Exception AccessorGroup/);
+__PACKAGE__->load_components(qw/SQL SQL::Abstract Exception AccessorGroup/);
-__PACKAGE__->mk_group_accessors('simple' => qw/connect_info _dbh/);
+__PACKAGE__->mk_group_accessors('simple' =>
+ qw/connect_info _dbh sql_maker debug cursor/);
sub new {
- bless({}, ref $_[0] || $_[0]);
+ my $new = bless({}, ref $_[0] || $_[0]);
+ $new->sql_maker(new SQL::Abstract);
+ $new->cursor("DBIx::Class::Cursor");
+ #$new->debug(1);
+ return $new;
}
sub get_simple {
sub rollback { $_[0]->dbh->rollback; }
+sub _execute {
+ my ($self, $op, $extra_bind, $ident, @args) = @_;
+ my ($sql, @bind) = $self->sql_maker->$op($ident, @args);
+ warn "$sql: @bind" if $self->debug;
+ my $sth = $self->sth($sql);
+ unshift(@bind, @$extra_bind) if $extra_bind;
+ @bind = map { ref $_ ? ''.$_ : $_ } @bind;
+ my $rv = $sth->execute(@bind); # stringify args
+ return (wantarray ? ($rv, $sth, @bind) : $rv);
+}
+
sub insert {
my ($self, $ident, $to_insert) = @_;
- my $sql = $self->create_sql('insert', [ keys %{$to_insert} ], $ident, undef);
- my $sth = $self->sth($sql);
- $sth->execute(values %{$to_insert});
$self->throw( "Couldn't insert ".join(', ', map "$_ => $to_insert->{$_}", keys %$to_insert)." into ${ident}" )
- unless $sth->rows;
+ unless ($self->_execute('insert' => [], $ident, $to_insert) > 0);
return $to_insert;
}
sub update {
- my ($self, $ident, $to_update, $condition) = @_;
- my $attrs = { };
- my $set_sql = $self->_cond_resolve($to_update, $attrs, ',');
- $set_sql =~ s/^\(//;
- $set_sql =~ s/\)$//;
- my $cond_sql = $self->_cond_resolve($condition, $attrs);
- my $sql = $self->create_sql('update', $set_sql, $ident, $cond_sql);
- my $sth = $self->sth($sql);
- my $rows = $sth->execute( @{$attrs->{bind}||[]} );
- return $rows;
+ return shift->_execute('update' => [], @_);
}
sub delete {
- my ($self, $ident, $condition) = @_;
- my $attrs = { };
- my $cond_sql = $self->_cond_resolve($condition, $attrs);
- my $sql = $self->create_sql('delete', undef, $ident, $cond_sql);
- #warn "$sql ".join(', ',@{$attrs->{bind}||[]});
- my $sth = $self->sth($sql);
- return $sth->execute( @{$attrs->{bind}||[]} );
+ return shift->_execute('delete' => [], @_);
}
sub select {
my ($self, $ident, $select, $condition, $attrs) = @_;
- $attrs ||= { };
- #my $select_sql = $self->_cond_resolve($select, $attrs, ',');
- my $cond_sql = $self->_cond_resolve($condition, $attrs);
- 1 while $cond_sql =~ s/^\s*\(\s*(.*ORDER.*)\s*\)\s*$/$1/;
- my $sql = $self->create_sql('select', $select, $ident, $cond_sql);
- #warn $sql.' '.join(', ', @{$attrs->{bind}||[]});
- my $sth = $self->sth($sql);
- $sth->execute( @{$attrs->{bind}||[]} );
- return $sth;
+ my $order = $attrs->{order_by};
+ if (ref $condition eq 'SCALAR') {
+ $order = $1 if $$condition =~ s/ORDER BY (.*)$//i;
+ }
+ my ($rv, $sth, @bind) = $self->_execute('select', $attrs->{bind}, $ident, $select, $condition, $order);
+ return $self->cursor->new($sth, \@bind, $attrs);
}
sub sth {
use strict;
use warnings;
-use DBIx::Class::Cursor;
+use DBIx::Class::ResultSet;
use base qw/Class::Data::Inheritable/;
__PACKAGE__->mk_classdata('table_alias'); # FIXME: Doesn't actually do anything yet!
-__PACKAGE__->mk_classdata('_cursor_class' => 'DBIx::Class::Cursor');
+__PACKAGE__->mk_classdata('_resultset_class' => 'DBIx::Class::ResultSet');
-sub iterator_class { shift->_cursor_class(@_) }
+sub iterator_class { shift->_resultset_class(@_) }
=head1 NAME
my $attrs = (ref $vals[$#vals] eq 'HASH' ? pop(@vals) : {});
my @cols = $class->_select_columns($attrs);
#warn "@cols $cond @vals";
- return $class->sth_to_objects(undef, \@vals, \@cols, { where => \$cond });
+ return $class->cursor_to_resultset(undef, \@vals, \@cols, { where => \$cond, %$attrs });
}
=item count_from_sql
=cut
sub count_from_sql {
- my ($self, $cond, @vals) = @_;
+ my ($class, $cond, @vals) = @_;
$cond =~ s/^\s*WHERE//i;
my $attrs = (ref $vals[$#vals] eq 'HASH' ? pop(@vals) : {});
- my @cols = 'COUNT(*)';
$attrs->{bind} = [ @vals ];
- my $sth = $self->storage->select($self->_table_name,\@cols,\$cond, $attrs);
- #warn "$cond @vals";
- my ($count) = $sth->fetchrow_array;
- $sth->finish;
- return $count;
+ return $class->count($cond, $attrs);
}
=item count
if (@_ > 1 && ref $_[$#_] eq 'HASH') {
$attrs = { %{ pop(@_) } };
}
- my $query = ref $_[0] eq "HASH" || (@_ == 1) ? shift: {@_};
- my ($cond) = $class->_cond_resolve($query, $attrs);
- return $class->count_from_sql($cond, @{$attrs->{bind}||[]}, $attrs);
+ my $query = ref $_[0] eq "HASH" || (@_ == 1) ? shift: {@_};
+ my @cols = 'COUNT(*)';
+ my $cursor = $class->storage->select($class->_table_name, \@cols,
+ $query, $attrs);
+ return ($cursor->next)[0];
}
-=item sth_to_objects
-
- my @obj = $class->sth_to_objects($sth, \@bind, \@columns, $attrs);
- my $cursor = $class->sth_to_objects($sth, \@bind, \@columns, $attrs);
-
-=cut
-
-sub sth_to_objects {
+sub cursor_to_resultset {
my ($class, $sth, $args, $cols, $attrs) = @_;
- my @cols = ((ref $cols eq 'ARRAY') ? @$cols : @{$sth->{NAME_lc}} );
- my @args = map { ref $_ ? ''.$_ : $_ } @$args; # Stringify objects
- my $cursor_class = $class->_cursor_class;
- eval "use $cursor_class;";
- my $cursor = $cursor_class->new($class, $sth, \@args, \@cols, $attrs);
- return (wantarray ? $cursor->all : $cursor);
+ my $rs_class = $class->_resultset_class;
+ eval "use $rs_class;";
+ my $rs = $rs_class->new($class, $sth, $args, $cols, $attrs);
+ return (wantarray ? $rs->all : $rs);
}
sub _row_to_object { # WARNING: Destructive to @$row
$attrs = { %{ pop(@_) } };
}
my $query = ref $_[0] eq "HASH" ? shift: {@_};
- my ($cond, @param) = $class->_cond_resolve($query, $attrs);
- return $class->retrieve_from_sql($cond, @param, $attrs);
+ my @cols = $class->_select_columns;
+ return $class->cursor_to_resultset(undef, $attrs->{bind}, \@cols,
+ { where => $query, %$attrs });
}
=item search_like
if (@_ > 1 && ref $_[$#_] eq 'HASH') {
$attrs = pop(@_);
}
- return $class->search(@_, { %$attrs, cmp => 'LIKE' });
+ my $query = ref $_[0] eq "HASH" ? { %{shift()} }: {@_};
+ $query->{$_} = { 'like' => $query->{$_} } for keys %$query;
+ return $class->search($query, { %$attrs });
}
sub _select_columns {
# Iterators
#----------------------------------------------------------------------
-my $it_class = 'DBIx::Class::Cursor';
+my $it_class = 'DBIx::Class::ResultSet';
sub test_normal_iterator {
my $it = $film->actors;
use lib 't/testlib';
use Film;
-my $it_class = "DBIx::Class::Cursor";
+my $it_class = "DBIx::Class::ResultSet";
my @film = (
Film->create({ Title => 'Film 1' }),
projects / dbsrgits/DBIx-Class-Historic.git / commitdiff