From: Matt S Trout <mst@shadowcat.co.uk>
Date: Sat, 6 Aug 2005 18:01:28 +0000 (+0000)
Subject: - Storage/DBI.pm now uses Abstract internally
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=223b8fe3185dba976b275c120ba7a07c05c06644;p=dbsrgits%2FDBIx-Class-Historic.git

- Storage/DBI.pm now uses Abstract internally
- Storage returns Cursors, classes return Resultsets
---

diff --git a/lib/DBIx/Class/CDBICompat/ImaDBI.pm b/lib/DBIx/Class/CDBICompat/ImaDBI.pm
index 08a72d8..f659983 100644
--- a/lib/DBIx/Class/CDBICompat/ImaDBI.pm
+++ b/lib/DBIx/Class/CDBICompat/ImaDBI.pm
@@ -84,11 +84,23 @@ sub set_sql {
     *{"${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;
diff --git a/lib/DBIx/Class/CDBICompat/LazyLoading.pm b/lib/DBIx/Class/CDBICompat/LazyLoading.pm
index ea76d0c..8e2c2ae 100644
--- a/lib/DBIx/Class/CDBICompat/LazyLoading.pm
+++ b/lib/DBIx/Class/CDBICompat/LazyLoading.pm
@@ -24,12 +24,12 @@ sub _flesh {
   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;
diff --git a/lib/DBIx/Class/Core.pm b/lib/DBIx/Class/Core.pm
index 94e1b2a..6920c51 100644
--- a/lib/DBIx/Class/Core.pm
+++ b/lib/DBIx/Class/Core.pm
@@ -2,6 +2,7 @@ package DBIx::Class::Core;
 
 use strict;
 use warnings;
+no warnings 'qw';
 
 use base qw/DBIx::Class/;
 
@@ -11,7 +12,7 @@ __PACKAGE__->load_components(qw/
   Relationship::ProxyMethods
   Relationship
   InflateColumn
-  SQL::OrderBy
+  #SQL::OrderBy
   SQL::Abstract
   PK
   Table
diff --git a/lib/DBIx/Class/Cursor.pm b/lib/DBIx/Class/Cursor.pm
index 687c5a4..3cd5505 100644
--- a/lib/DBIx/Class/Cursor.pm
+++ b/lib/DBIx/Class/Cursor.pm
@@ -2,40 +2,19 @@ package DBIx::Class::Cursor;
 
 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}
@@ -43,36 +22,13 @@ sub next {
   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 {
@@ -83,16 +39,6 @@ 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};
diff --git a/lib/DBIx/Class/Relationship/Accessor.pm b/lib/DBIx/Class/Relationship/Accessor.pm
index 0c19ef1..12d8f8f 100644
--- a/lib/DBIx/Class/Relationship/Accessor.pm
+++ b/lib/DBIx/Class/Relationship/Accessor.pm
@@ -8,12 +8,12 @@ sub add_relationship {
   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') {
diff --git a/lib/DBIx/Class/Relationship/ProxyMethods.pm b/lib/DBIx/Class/Relationship/ProxyMethods.pm
index ede62a7..11a4e28 100644
--- a/lib/DBIx/Class/Relationship/ProxyMethods.pm
+++ b/lib/DBIx/Class/Relationship/ProxyMethods.pm
@@ -9,22 +9,28 @@ sub add_relationship {
   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;
diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index 623da44..d49d5c5 100644
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -3,15 +3,22 @@ package DBIx::Class::Storage::DBI;
 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 {
@@ -80,50 +87,40 @@ Issues a rollback again the current dbh
 
 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 {
diff --git a/lib/DBIx/Class/Table.pm b/lib/DBIx/Class/Table.pm
index 32a83fc..0123aef 100644
--- a/lib/DBIx/Class/Table.pm
+++ b/lib/DBIx/Class/Table.pm
@@ -3,7 +3,7 @@ package DBIx::Class::Table;
 use strict;
 use warnings;
 
-use DBIx::Class::Cursor;
+use DBIx::Class::ResultSet;
 
 use base qw/Class::Data::Inheritable/;
 
@@ -13,9 +13,9 @@ __PACKAGE__->mk_classdata('_table_name');
 
 __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 
 
@@ -261,7 +261,7 @@ sub retrieve_from_sql {
   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
@@ -271,16 +271,11 @@ sub retrieve_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
@@ -295,26 +290,19 @@ sub 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
@@ -340,8 +328,9 @@ sub search {
     $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
@@ -356,7 +345,9 @@ sub 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 {
diff --git a/t/cdbi-t/12-filter.t b/t/cdbi-t/12-filter.t
index 7132a54..ecaff02 100644
--- a/t/cdbi-t/12-filter.t
+++ b/t/cdbi-t/12-filter.t
@@ -93,7 +93,7 @@ is $@, '', "No errors";
 # Iterators
 #----------------------------------------------------------------------
 
-my $it_class = 'DBIx::Class::Cursor';
+my $it_class = 'DBIx::Class::ResultSet';
 
 sub test_normal_iterator {
 	my $it = $film->actors;
diff --git a/t/cdbi-t/21-iterator.t b/t/cdbi-t/21-iterator.t
index d029bab..2f34c11 100644
--- a/t/cdbi-t/21-iterator.t
+++ b/t/cdbi-t/21-iterator.t
@@ -9,7 +9,7 @@ BEGIN {
 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' }),