Index: trunk/t/32-partitioned.t
===================================================================
--- trunk/t/32-partitioned.t (revision 4)
+++ trunk/t/32-partitioned.t (revision 4)
@@ -0,0 +1,97 @@
+# $Id$
+
+use strict;
+
+use lib 't/lib';
+
+use Recipe;
+use Ingredient;
+use Test::More tests => 46;
+
+my($tmp, $iter);
+
+my $recipe = Recipe->new;
+$recipe->title('Banana Milkshake');
+ok($recipe->save, 'Object saved successfully');
+ok($recipe->id, 'Recipe has an ID');
+ok($recipe->cluster_id, 'Recipe assigned to a cluster');
+is($recipe->title, 'Banana Milkshake', 'Title is Banana Milkshake');
+
+$tmp = Recipe->lookup($recipe->id);
+is(ref $tmp, 'Recipe', 'lookup gave us a recipe');
+is($tmp->title, 'Banana Milkshake', 'Title is Banana Milkshake');
+
+my @recipes = Recipe->search;
+is(scalar @recipes, 1, 'Got one recipe back from search');
+is($recipes[0]->title, 'Banana Milkshake', 'Title is Banana Milkshake');
+
+$iter = Recipe->search;
+ok($iter, 'Got an iterator object');
+$tmp = $iter->();
+ok(!$iter->(), 'Iterator gave us only one recipe');
+is(ref $tmp, 'Recipe', 'Iterator gave us a recipe');
+is($tmp->title, 'Banana Milkshake', 'Title is Banana Milkshake');
+
+my $ingredient = Ingredient->new;
+$ingredient->recipe_id($recipe->id);
+$ingredient->name('Vanilla Ice Cream');
+$ingredient->quantity(1);
+ok($ingredient->save, 'Ingredient saved successfully');
+ok($ingredient->id, 'Ingredient has an ID');
+is($ingredient->id, 1, 'ID is 1');
+is($ingredient->name, 'Vanilla Ice Cream', 'Name is Vanilla Ice Cream');
+
+$tmp = Ingredient->lookup([ $recipe->id, $ingredient->id ]);
+is(ref $tmp, 'Ingredient', 'lookup gave us an ingredient');
+is($tmp->name, 'Vanilla Ice Cream', 'Name is Vanilla Ice Cream');
+
+my @ingredients = Ingredient->search({ recipe_id => $recipe->id });
+is(scalar @ingredients, 1, 'Got one ingredient back from search');
+is($ingredients[0]->name, 'Vanilla Ice Cream', 'Name is Vanilla Ice Cream');
+
+$iter = Ingredient->search({ recipe_id => $recipe->id });
+ok($iter, 'Got an iterator object');
+$tmp = $iter->();
+ok(!$iter->(), 'Iterator gave us only one ingredient');
+is(ref $tmp, 'Ingredient', 'Iterator gave us an ingredient');
+is($tmp->name, 'Vanilla Ice Cream', 'Name is Vanilla Ice Cream');
+
+my $ingredient2 = Ingredient->new;
+$ingredient2->recipe_id($recipe->id);
+$ingredient2->name('Bananas');
+$ingredient2->quantity(5);
+ok($ingredient2->save, 'Ingredient saved successfully');
+ok($ingredient2->id, 'Ingredient has an ID');
+is($ingredient2->id, 2, 'ID is 2');
+is($ingredient2->name, 'Bananas', 'Name is Bananas');
+
+@ingredients = Ingredient->search({ recipe_id => $recipe->id, quantity => 5 });
+is(scalar @ingredients, 1, 'Got one ingredient back from search');
+is($ingredients[0]->id, $ingredient2->id, 'ID is for the Bananas object');
+is($ingredients[0]->name, 'Bananas', 'Name is Bananas');
+
+my $recipe2 = Recipe->new;
+$recipe2->title('Chocolate Chip Cookies');
+ok($recipe2->save, 'Object saved successfully');
+ok($recipe2->id, 'Recipe has an ID');
+ok($recipe2->cluster_id, 'Recipe assigned to a cluster');
+is($recipe2->title, 'Chocolate Chip Cookies', 'Title is Chocolate Chip Cookies');
+
+my $ingredient3 = Ingredient->new;
+$ingredient3->recipe_id($recipe2->id);
+$ingredient3->name('Chocolate Chips');
+$ingredient3->quantity(100);
+ok($ingredient3->save, 'Ingredient saved successfully');
+ok($ingredient3->id, 'Ingredient has an ID');
+is($ingredient3->id, 1, 'ID is 1');
+is($ingredient3->name, 'Chocolate Chips', 'Name is Chocolate Chips');
+
+$tmp = Ingredient->lookup([ $recipe2->id, 1 ]);
+is(ref $tmp, 'Ingredient', 'lookup gave us an ingredient');
+is($tmp->name, 'Chocolate Chips', 'Name is Chocolate Chips');
+
+ok($ingredient->remove, 'Ingredient removed successfully');
+ok($ingredient2->remove, 'Ingredient removed successfully');
+ok($ingredient3->remove, 'Ingredient removed successfully');
+ok($recipe->remove, 'Recipe removed successfully');
+ok($recipe2->remove, 'Recipe removed successfully');
Index: trunk/t/lib/Recipe.pm
===================================================================
--- trunk/t/lib/Recipe.pm (revision 4)
+++ trunk/t/lib/Recipe.pm (revision 4)
@@ -0,0 +1,26 @@
+# $Id$
+
+package Recipe;
+use strict;
+use base qw( Data::ObjectDriver::BaseObject );
+
+use Data::ObjectDriver::Driver::DBI;
+
+__PACKAGE__->install_properties({
+    columns => [ 'id', 'cluster_id', 'title' ],
+    datasource => 'recipes',
+    primary_key => 'id',
+    driver => Data::ObjectDriver::Driver::DBI->new(
+        dsn      => 'dbi:mysql:database=global',
+        username => 'btrott',
+    ),
+});
+
+sub insert {
+    my $obj = shift;
+## xxx Choose a cluster for this recipe.
+    $obj->cluster_id(int(rand 2) + 1);
+    $obj->SUPER::insert(@_);
+}
+
+1;
Index: trunk/t/lib/Ingredient.pm
===================================================================
--- trunk/t/lib/Ingredient.pm (revision 4)
+++ trunk/t/lib/Ingredient.pm (revision 4)
@@ -0,0 +1,63 @@
+# $Id$
+
+package Ingredient;
+use strict;
+use base qw( Data::ObjectDriver::BaseObject );
+
+use Carp ();
+use Data::ObjectDriver::Driver::Partition;
+use Data::ObjectDriver::Driver::DBI;
+use Data::ObjectDriver::Driver::Memcached;
+
+our %IDs;
+
+__PACKAGE__->install_properties({
+    columns => [ 'id', 'recipe_id', 'name', 'quantity' ],
+    datasource => 'ingredients',
+    primary_key => [ 'recipe_id', 'id' ],
+    driver      => Data::ObjectDriver::Driver::Partition->new(
+        get_driver   => \&get_driver,
+        pk_generator => \&generate_pk,
+    ),
+});
+
+=pod
+
+    driver => Data::ObjectDriver::Driver::Memcached->new(
+        cache    => Cache::Memcached->new({
+            servers => [ 'admin.sfo.sixapart.com:11211' ],
+            debug   => 1,
+        }),
+        fallback => Data::ObjectDriver::Driver::Partition->new(
+            get_driver  => \&get_driver,
+        ),
+    ),
+
+=cut
+
+sub get_driver {
+    my($terms) = @_;
+    my $recipe;
+    if (ref($terms) eq 'HASH') {
+        my $recipe_id = $terms->{recipe_id}
+            or Carp::croak("recipe_id is required");
+        $recipe = Recipe->lookup($recipe_id);
+    } elsif (ref($terms) eq 'ARRAY') {
+        ## With a multiple-column primary key, the $id is an array ref, where
+        ## the first column is the recipe_id.
+        $recipe = Recipe->lookup($terms->[0]);
+    }
+    Data::ObjectDriver::Driver::DBI->new(
+        dsn      => 'dbi:mysql:database=cluster' . $recipe->cluster_id,
+        username => 'btrott',
+        pk_generator => \&generate_pk,
+    );
+}
+
+sub generate_pk {
+    my($obj) = @_;
+    $obj->id(++$IDs{$obj->recipe_id});
+    1;
+}
+
+1;
Index: trunk/t/00-compile.t
===================================================================
--- trunk/t/00-compile.t (revision 4)
+++ trunk/t/00-compile.t (revision 4)
@@ -0,0 +1,6 @@
+# $Id$
+
+use strict;
+use Test::More tests => 1;
+
+use_ok('Data::ObjectDriver');
Index: trunk/lib/Data/ObjectDriver/Driver/Memcached.pm
===================================================================
--- trunk/lib/Data/ObjectDriver/Driver/Memcached.pm (revision 4)
+++ trunk/lib/Data/ObjectDriver/Driver/Memcached.pm (revision 4)
@@ -0,0 +1,80 @@
+# $Id$
+
+package Data::ObjectDriver::Driver::Memcached;
+use strict;
+use base qw( Data::ObjectDriver Class::Accessor::Fast );
+
+use Cache::Memcached;
+use Carp ();
+
+__PACKAGE__->mk_accessors(qw( cache fallback ));
+
+sub init {
+    my $driver = shift;
+    $driver->SUPER::init(@_);
+    my %param = @_;
+    $driver->cache($param{cache})
+        or Carp::croak("cache is required");
+    $driver->fallback($param{fallback})
+        or Carp::croak("fallback is required");
+    $driver;
+}
+
+sub lookup {
+    my $driver = shift;
+    my($class, $id) = @_;
+    my $key = $driver->_cache_key($class, $id);
+    my $cache = $driver->cache;
+    my $obj = $cache->get($key);
+    unless ($obj) {
+        $obj = $driver->fallback->lookup($class, $id);
+        $driver->cache->add($key, $obj->clone) if $obj;
+    }
+    $obj;
+}
+
+sub lookup_multi {
+    my $driver = shift;
+    my($class, @ids) = @_;
+    my @keys = map $driver->_cache_key($class, $_), @ids;
+    $driver->cache->get_multi(@ids);
+}
+
+sub update {
+    my $driver = shift;
+    my($obj) = @_;
+    my $clone = $obj->clone;
+    my $cache = $driver->cache;
+    my $key = $driver->_cache_key(ref($obj), $obj->primary_key);
+    if ($cache->get($key)) {
+        $cache->replace($key, $clone);
+    } else {
+        $cache->set($key, $clone);
+    }
+    $driver->fallback->update($obj);
+}
+
+sub remove {
+    my $driver = shift;
+    my($obj) = @_;
+    $driver->cache->delete($driver->_cache_key(ref($obj), $obj->primary_key));
+    $driver->fallback->remove($obj);
+}
+
+sub search       { shift->_call_fallback('search',      @_) }
+sub insert       { shift->_call_fallback('insert',      @_) }
+sub exists       { shift->_call_fallback('exists',      @_) }
+
+sub _call_fallback {
+    my $driver = shift;
+    my($meth, @args) = @_;
+    $driver->fallback->$meth(@args);
+}
+
+sub _cache_key {
+    my $driver = shift;
+    my($class, $id) = @_;
+    join ':', $class, ref($id) eq 'ARRAY' ? @$id : $id;
+}
+
+1;
Index: trunk/lib/Data/ObjectDriver/Driver/Partition.pm
===================================================================
--- trunk/lib/Data/ObjectDriver/Driver/Partition.pm (revision 4)
+++ trunk/lib/Data/ObjectDriver/Driver/Partition.pm (revision 4)
@@ -0,0 +1,46 @@
+# $Id$
+
+package Data::ObjectDriver::Driver::Partition;
+use strict;
+use base qw( Data::ObjectDriver Class::Accessor::Fast );
+
+__PACKAGE__->mk_accessors(qw( get_driver ));
+
+sub init {
+    my $driver = shift;
+    $driver->SUPER::init(@_);
+    my %param = @_;
+    $driver->get_driver($param{get_driver});
+    $driver;
+}
+
+sub lookup {
+    my $driver = shift;
+    my($class, $id) = @_;
+    $driver->get_driver->($id)->lookup($class, $id);
+}
+
+sub lookup_multi {
+    my $driver = shift;
+    my($class, @ids) = @_;
+    $driver->get_driver->(@ids)->lookup_multi($class, @ids);
+}
+
+sub exists { shift->_exec_partitioned('exists', @_) }
+sub insert { shift->_exec_partitioned('insert', @_) }
+sub update { shift->_exec_partitioned('update', @_) }
+sub remove { shift->_exec_partitioned('remove', @_) }
+
+sub search {
+    my $driver = shift;
+    my($class, $terms, $args) = @_;
+    $driver->get_driver->($terms)->search($class, $terms, $args);
+}
+
+sub _exec_partitioned {
+    my $driver = shift;
+    my($meth, $obj) = @_;
+    $driver->get_driver->($obj->primary_key)->$meth($obj);
+}
+
+1;
Index: trunk/lib/Data/ObjectDriver/Driver/DBI.pm
===================================================================
--- trunk/lib/Data/ObjectDriver/Driver/DBI.pm (revision 4)
+++ trunk/lib/Data/ObjectDriver/Driver/DBI.pm (revision 4)
@@ -0,0 +1,567 @@
+# $Id$
+
+package Data::ObjectDriver::Driver::DBI;
+use strict;
+use base qw( Data::ObjectDriver Class::Accessor::Fast );
+
+use DBI;
+
+__PACKAGE__->mk_accessors(qw( dsn username password dbh ));
+
+sub init {
+    my $driver = shift;
+    my %param = @_;
+    for my $key (keys %param) {
+        $driver->$key($param{$key});
+    }
+    ## Rebless the driver into the DSN-specific subclass (e.g. "mysql").
+    my($type) = lc($driver->dsn) =~ /^dbi:(\w*)/;
+    my $class = __PACKAGE__ . '::' . $type;
+    eval "use $class";
+    die $@ if $@;
+    bless $driver, $class;
+    $driver;
+}
+
+# Base methods, override in driver
+sub generate_pk {
+    my $driver = shift;
+    if (my $generator = $driver->pk_generator) {
+        return $generator->(@_);
+    }
+}
+sub fetch_id { undef }
+sub offset_implemented { 1 }
+
+# map to true DB column, for databases that can't store long identifiers :(
+sub db_column_name {
+    my ($driver, $table, $column) = @_; 
+    return $column;
+}
+
+# Override in DB Driver to pass correct attributes to bind_param call
+sub bind_param_attributes { return undef }
+
+# set to 1 during development to get sql statements in the error log
+use constant SQLDEBUG => 0;
+
+sub rw_handle {
+    my $driver = shift;
+    my $db = shift || 'main';
+    my $dbh = $driver->dbh;
+    unless ($dbh) {
+        $dbh = $driver->init_db($db) or die $driver->errstr;
+        $driver->dbh($dbh);
+    }
+    $dbh;
+}
+*r_handle = \&rw_handle;
+
+sub search {
+    my $driver = shift;
+    my($class, $terms, $args) = @_;
+
+    my $stmt = $driver->prepare_statement($class, $terms, $args);
+    my $tbl = $class->datasource;
+    my(%rec, @bind, @cols);
+    my $cols = $class->column_names;
+
+    my $primary_key = $class->properties->{primary_key};
+    for my $col (@$cols) {
+        if ($args->{fetchonly}) {
+            next unless $args->{fetchonly}{$col};
+        }
+        my $dbcol  = $driver->db_column_name($tbl, $col);
+        push @cols, $dbcol;
+        push @bind, \$rec{$col};
+    }
+    my $tmp = "SELECT ";
+    $tmp .= "DISTINCT " if $args->{join} && $args->{join}[3]{unique};
+   
+    $tmp .= join(', ', @cols) . "\n";
+    my $sql = $tmp . mk_sql($stmt);
+    my $dbh = $driver->r_handle($class->properties->{db});
+    warn $sql if (SQLDEBUG);
+    my $sth = $dbh->prepare_cached($sql);
+    $sth->execute(@{ $stmt->{bind} });
+    $sth->bind_columns(undef, @bind);
+
+    # need to slurp 'offset' rows for DBs that cannot do it themselves
+    if (!$driver->offset_implemented && $args->{offset}) {
+        for (1..$args->{offset}) {
+            $sth->fetch;
+        }
+    }
+
+    my $iter = sub {
+        unless ($sth->fetch) {
+            $sth->finish;
+            return;
+        }
+        my $obj;
+        $obj = $class->new;
+        $obj->set_values(\%rec);
+        $obj->is_loaded(1);
+        $obj;
+    };
+    
+    if (wantarray) {
+        my @objs;
+        while (my $obj = $iter->()) {
+            push @objs, $obj;
+        }
+        return @objs;
+    } else {
+        return $iter;
+    }
+}
+
+sub lookup {
+    my $driver = shift;
+    my($class, $id) = @_;
+
+    my $stmt = $driver->prepare_statement($class, $id);
+    my $tbl = $class->datasource;
+    my(%rec, @bind, @cols);
+    my $cols = $class->column_names;
+    for my $col (@$cols) {
+        my $dbcol  = $driver->db_column_name($tbl, $col);
+        push @cols, $col;
+        push @bind, \$rec{$col};
+    }
+    my $tmp = "SELECT ";
+    $tmp .= join(', ', @cols) . "\n";
+    my $sql = $tmp . mk_sql($stmt);
+    warn $sql if (SQLDEBUG);
+    my $dbh = $driver->r_handle($class->properties->{db});
+    my $sth = $dbh->prepare($sql) or return;
+    $sth->execute(@{ $stmt->{bind} }) or return;
+    $sth->bind_columns(undef, @bind);
+    my @objs;
+    while ($sth->fetch) {
+        my $obj = $class->new;
+        $obj->set_values(\%rec);
+        $obj->is_loaded(1);
+        unless (wantarray) {
+            $sth->finish();
+            return $obj;
+        }
+        push @objs, $obj;
+    }
+    $sth->finish;
+    @objs;
+}
+
+sub select_one {
+    my $driver = shift;
+    my($dbh, $sql, $bind) = @_;
+    my $sth = $dbh->prepare_cached($sql);
+    $sth->execute(@$bind);
+    $sth->bind_columns(undef, \my($val));
+    $sth->fetch or return;
+    $sth->finish;
+    $val;
+}
+
+sub count {
+    my $driver = shift;
+    my($class, $terms, $args) = @_;
+    my $stmt = $driver->prepare_statement($class, $terms, $args);
+    ## Remove any order by clauses, because they will cause errors in
+    ## some drivers (and they're not necessary)
+    delete $stmt->{order};
+    my $sql = "SELECT COUNT(*)\n" . mk_sql($stmt);
+    warn $sql if (SQLDEBUG);
+    my $count = $driver->select_one(
+        $driver->r_handle($class->properties->{db}), $sql, $stmt->{bind}
+    );
+    $count;
+}
+
+sub data_exists {
+    my $driver = shift;
+    my($class, $terms, $args) = @_;
+
+    # add a limit 1 to select only one row
+    $args ||= {};
+    $args->{limit} = 1;
+
+    my $stmt = $driver->prepare_statement($class, $terms, $args);
+    ## Remove any order by clauses, because they will cause errors in
+    ## some drivers (and they're not necessary)
+    delete $stmt->{order};
+    my $sql = "SELECT 1\n" . mk_sql($stmt);
+    warn $sql if (SQLDEBUG);
+    my $exists = $driver->select_one(
+        $driver->r_handle($class->properties->{db}), $sql, $stmt->{bind}
+    );
+    $exists;
+}
+
+sub min {
+    my $driver = shift;
+    my($class, $terms, $args) = @_;
+    my $stmt = $driver->prepare_statement($class, $terms, $args);
+    ## Remove any order by clauses, because they will cause errors in
+    ## some drivers (and they're not necessary)
+    delete $stmt->{order};
+    my $field = $class->datasource . '_' . $args->{min_col};
+    my $sql = "SELECT MIN($field)\n" . mk_sql($stmt);
+    warn $sql if (SQLDEBUG);
+    my $min = $driver->select_one(
+        $driver->r_handle($class->properties->{db}), $sql, $stmt->{bind}
+    );
+    $min || undef;
+}
+
+sub sum {
+    my $driver = shift;
+    my($class, $terms, $args) = @_;
+    my $stmt = $driver->prepare_statement($class, $terms, $args);
+    ## Remove any order by clauses, because they will cause errors in
+    ## some drivers (and they're not necessary)
+    delete $stmt->{order};
+    my $field = $class->datasource . '_' . $args->{sum_col};
+    my $sql = "SELECT SUM($field)\n" . mk_sql($stmt);
+    warn $sql if (SQLDEBUG);
+    my $sum = $driver->select_one(
+        $driver->r_handle($class->properties->{db}), $sql, $stmt->{bind}
+    );
+    $sum || 0;
+}
+
+sub exists {
+    my $driver = shift;
+    my($obj) = @_;
+    return unless $obj->id;
+    my $tbl = $obj->datasource;
+    my $sql = "SELECT 1 FROM $tbl WHERE id = ?";
+    my $dbh = $driver->r_handle($obj->properties->{db});
+    warn $sql if (SQLDEBUG);
+    my $sth = $dbh->prepare_cached($sql) or return;
+    $sth->execute($obj->id) or return;
+    my $exists = $sth->fetch;
+    $sth->finish;
+    $exists;
+}
+
+sub insert {
+    my $driver = shift;
+    my($obj) = @_;
+    my $cols = $obj->column_names;
+    unless ($obj->has_primary_key) {
+        ## If we don't already have a primary key assigned for this object, we
+        ## may need to generate one (depending on the underlying DB
+        ## driver). If the driver gives us a new ID, we insert that into
+        ## the new record; otherwise, we assume that the DB is using an
+        ## auto-increment column of some sort, so we don't specify an ID
+        ## at all.
+        my $generated = $driver->generate_pk($obj);
+        unless ($generated) {
+            my $pk = $obj->properties->{primary_key};
+            $pk = [ $pk ] unless ref($pk) eq 'ARRAY';
+            my %pk = map { $_ => 1 } @$pk;
+            $cols = [ grep !$pk{$_} || defined $obj->$_(), @$cols ];
+        }
+    }
+    my $tbl = $obj->datasource;
+    my $sql = "INSERT INTO $tbl\n";
+    $sql .= '(' . join(', ', map $driver->db_column_name($tbl, $_), @$cols) . ')' . "\n" .
+            'VALUES (' . join(', ', ('?') x @$cols) . ')' . "\n";
+    my $dbh = $driver->rw_handle($obj->properties->{db});
+    warn $sql if (SQLDEBUG);
+    my $sth = $dbh->prepare_cached($sql);
+    my $i = 1;
+    my $col_defs = $obj->properties->{column_defs};
+    for my $col (@$cols) {
+        my $val = $obj->column($col);
+        my $type = $col_defs->{$col} || 'char';
+        my $attr = $driver->bind_param_attributes($type);
+        $sth->bind_param($i++, $val, $attr);
+    }
+    $sth->execute;
+    $sth->finish;
+
+    ## Now, if we didn't have an object ID, we need to grab the
+    ## newly-assigned ID.
+    unless ($obj->has_primary_key) {
+        $obj->id($driver->fetch_id($sth));
+    }
+    1;
+}
+
+sub update {
+    my $driver = shift;
+    my($obj) = @_;
+    my $cols = $obj->column_names;
+    my $pk = $obj->properties->{primary_key};
+    $pk = [ $pk ] unless ref($pk) eq 'ARRAY';
+    my %pk = map { $_ => 1 } @$pk;
+    $cols = [ grep !$pk{$_}, @$cols ];
+    my $tbl = $obj->datasource;
+    my $sql = "UPDATE $tbl SET\n";
+    $sql .= join(', ', map $driver->db_column_name($tbl, $_) . " = ?", @$cols) . "\n";
+    my $stmt = $driver->prepare_statement(ref($obj), $obj->primary_key);
+    $sql .= mk_sql_where($stmt);
+    
+    my $dbh = $driver->rw_handle($obj->properties->{db});
+    warn $sql if (SQLDEBUG);
+    my $sth = $dbh->prepare_cached($sql);
+    my $i = 1;
+    my $col_defs = $obj->properties->{column_defs};
+    for my $col (@$cols) {
+        my $val = $obj->column($col);
+        my $type = $col_defs->{$col} || 'char';
+        my $attr = $driver->bind_param_attributes($type);
+        $sth->bind_param($i++, $val, $attr);
+    }
+
+    ## Bind the primary key value(s).
+    for my $val (@{ $stmt->{bind} }) {
+        $sth->bind_param($i++, $val);
+    }
+
+    $sth->execute;
+    $sth->finish;
+    1;
+}
+
+sub remove {
+    my $driver = shift;
+    my($obj) = @_;
+    return unless $obj->has_primary_key;
+    my $tbl = $obj->datasource;
+    my $sql = "DELETE FROM $tbl\n";
+    my $stmt = $driver->prepare_statement(ref($obj), $obj->primary_key);
+    $sql .= mk_sql_where($stmt);
+    my $dbh = $driver->rw_handle($obj->properties->{db});
+    warn $sql if (SQLDEBUG);
+    my $sth = $dbh->prepare_cached($sql);
+    $sth->execute(@{ $stmt->{bind} });
+    $sth->finish;
+    1;
+}
+
+sub commit {
+    my $driver = shift;
+    if (my $dbh = $driver->dbh) {
+        $dbh->commit;
+    }
+    1;
+}
+
+sub rollback {
+    my $driver = shift;
+    if (my $dbh = $driver->dbh) {
+        $dbh->rollback;
+    }
+    1;
+}
+
+sub DESTROY {
+    if (my $dbh = shift->dbh) {
+        $dbh->disconnect if $dbh;
+    }
+}
+
+our %Filters;
+sub install_filters {
+    my($class, $filters) = @_[1, 2];
+    push @{ $Filters{$class} }, @$filters;
+}
+sub clear_filters {
+    %Filters = ();
+}
+
+sub prepare_statement {
+    my $driver = shift;
+    my($class, $terms, $args) = @_;
+    my $stmt = { bind => [] };
+
+    my $tbl = $class->datasource;
+    my $tbl_name = $tbl;
+
+    if (my $join = $args->{join}) {
+        my($j_class, $j_col, $j_terms, $j_args) = @$join;
+        my $j_tbl = $j_class->datasource;
+        my $j_tbl_name = $j_tbl;
+
+        $stmt->{from} = [ $tbl_name, $j_tbl_name ];
+        $driver->_update_statement($j_class, $j_terms, $j_args, $stmt);
+        push @{ $stmt->{where} }, "${tbl}_id = ${j_tbl}_$j_col";
+
+        ## We are doing a join, but some args and terms may have been
+        ## specified for the "outer" piece of the join--for example, if
+        ## we are doing a join of entry and comments where we end up with
+        ## entries, sorted by the created_on date in the entry table, or
+        ## filtered by author ID. In that case the sort or author ID will
+        ## be specified in the spec for the Entry load, not for the join
+        ## load.
+        $driver->_update_statement($class, $terms, $args, $stmt);
+
+        if ($j_args->{unique} && $j_args->{'sort'}) {
+            ## If it's a distinct with sorting, we need to create
+            ## a subselect to select the proper set of rows.
+            my $cols = $class->column_names;
+            $stmt->{from} = [
+                '(SELECT ' .
+                    join(', ', map "${tbl}_$_", @$cols) .
+                    ", ${j_tbl}_$j_args->{'sort'}\n" .
+                 mk_sql($stmt) .
+                ') t '
+            ];
+            delete $stmt->{where};
+            delete $stmt->{order};
+        }
+
+        ## If there's a LIMIT inside of the join arguments, promote it out
+        ## to the outer level statement, to be handled below.
+        if (my $n = $j_args->{limit}) {
+            $args->{limit} = $n;
+        }
+    } else {
+        $stmt->{from} = [ $tbl_name ];
+        $driver->_update_statement($class, $terms, $args, $stmt);
+    }
+    $stmt->{limit} = $args->{limit};
+    $stmt->{offset} = $args->{offset};
+    unless ($stmt->{is_primary_key}) {
+        my @filters = (@{ $args->{filters} || [] }, @{ $Filters{$class} || [] });
+        for my $filter (@filters) {
+            $filter->{object_class} = $class;
+            $filter->modify_sql($stmt);
+        }
+    }
+    $stmt;
+}
+
+sub mk_sql {
+    my($stmt) = @_;
+    my $sql = 'FROM ';
+    if (my $join = $stmt->{join}) {
+        ## If there's an actual JOIN statement, assume it's for joining with
+        ## the main datasource for the object we're loading. So shift that
+        ## off of the FROM list, and write the JOIN statement and condition.
+        $sql .= shift(@{ $stmt->{from} }) . ' ' .
+                uc($join->{type}) . ' JOIN ' . $join->{table} . ' ON ' .
+                $join->{condition};
+        $sql .= ', ' if @{ $stmt->{from} };
+    }
+    $sql .= join(', ', @{ $stmt->{from} }) . "\n";
+    $sql .= mk_sql_where($stmt);
+    if (my $order = $stmt->{order}) {
+        $sql .= 'ORDER BY ' . $order->{column} . ' ' . $order->{desc} . "\n";
+    }
+    if (my $n = $stmt->{limit}) {
+        $n =~ s/\D//g;   ## Get rid of any non-numerics.
+        $sql .= sprintf "LIMIT %d%s\n", $n,
+            ($stmt->{offset} ? " OFFSET $stmt->{offset}" : "");
+    }
+    $sql;
+}
+
+sub mk_sql_where {
+    my($stmt) = @_;
+    $stmt->{where} && @{ $stmt->{where} } ?
+        'WHERE ' . join(' AND ', @{ $stmt->{where} }) . "\n" :
+        '';
+}
+
+sub _update_statement {
+    my $driver = shift;
+    my($class, $terms, $args, $stmt) = @_;
+    my $col_defs = $class->properties->{column_defs};
+    my $tbl = $class->datasource;
+    if (defined($terms)) {
+        if (!ref($terms) || ref($terms) eq 'ARRAY') {
+            ## $terms is the value for the primary key, so we wipe out
+            ## any previous where and bind settings, if present.
+            $stmt->{is_primary_key} = 1;
+            $stmt->{where} = [];
+            $stmt->{bind} = [];
+            my $pk = $class->properties->{primary_key};
+            $pk = [ $pk ] unless ref($pk) eq 'ARRAY';
+            $terms = [ $terms ] unless ref($terms) eq 'ARRAY';
+            my $i = 0;
+            for my $col (@$pk) {
+                push @{ $stmt->{where} }, $col . ' = ?';
+                push @{ $stmt->{bind} }, $terms->[$i++];
+            }
+            return;
+        }
+        for my $col (keys %$terms) {
+            die "Invalid/unsafe column name $col" if $col =~ /\W/;
+            my $term = '';
+            my $col_type = $col_defs->{$col} || 'char';
+            if (ref($terms->{$col}) eq 'ARRAY') {
+                if ( ($args->{range} && $args->{range}{$col}) ||
+                     ($args->{range_incl} && $args->{range_incl}{$col}) ) {
+                    my($start, $end) = @{ $terms->{$col} };
+                    if ($start) {
+                        $term = $args->{range_incl}
+                          ? "$col >= ?"
+                          : "$col > ?";
+                        push @{ $stmt->{bind} }, $start;
+                    }
+                    $term .= " and " if $start && $end;
+                    if ($end) {
+                        $term .= $args->{range_incl}
+                          ? "$col <= ?"
+                          : "$col < ?";
+                        push @{ $stmt->{bind} }, $end;
+                    }
+                } else {
+                    # add multiple where clauses
+                    # my $op = $args->{and_ops}{$col} ? 'AND' : 'OR';
+                    my $op = 'OR'; 
+                    $term = join " $op ", map { "$col = ?" } @{ $terms->{$col}};
+                    foreach (@{ $terms->{$col} }) {
+                        push @{ $stmt->{bind} }, $_;
+                    }
+                }
+            } else {
+                my $op;
+                my $column = $col;
+
+                $op = '=';
+                $op = '<>'          if ($args->{not} && $args->{not}{$col});
+                $op = 'LIKE'        if ($args->{like} && $args->{like}{$col});
+                $op = 'IS NULL'     if ($args->{null} && $args->{null}{$col});
+        $op = 'IS NOT NULL' if ($args->{not_null} && $args->{not_null}{$col});
+
+                # if transform is supplied modify the column (UPPER, LOWER, etc.)
+                if ($args->{transform} && $args->{transform}{$col}) {
+                   $column = $args->{transform}{$col} . "($column)";
+                }
+                
+        $term = "$column $op";
+
+        # Unless this is a NULL/NOT NULL query, add a value placeholder
+        unless (($args->{null} and $args->{null}->{$col}) or
+            ($args->{not_null} and $args->{not_null}->{$col})) {
+            $term .= ' ?';
+            push @{ $stmt->{bind} }, $terms->{$col};
+        }
+            }
+            push @{ $stmt->{where} }, "($term)";
+        }
+    }
+    if (my $sv = $args->{start_val}) {
+        my $col = $args->{sort} || $driver->primary_key;
+        my $col_type = $col_defs->{$col} || 'char';
+        my $cmp = $args->{direction} eq 'descend' ? '<' : '>';
+        push @{ $stmt->{where} }, "($col $cmp ?)";
+        push @{ $stmt->{bind} }, $sv;
+    }
+    if ($args->{'sort'} || $args->{direction}) {
+        my $order = $args->{'sort'} || 'id';
+        my $dir = $args->{direction} &&
+                  $args->{direction} eq 'descend' ? 'DESC' : 'ASC';
+        $stmt->{order} = {
+            column => join('_', $tbl, $order),
+            desc   => $dir,
+        };
+    }
+}
+
+1;
Index: trunk/lib/Data/ObjectDriver/Driver/DBI/mysql.pm
===================================================================
--- trunk/lib/Data/ObjectDriver/Driver/DBI/mysql.pm (revision 4)
+++ trunk/lib/Data/ObjectDriver/Driver/DBI/mysql.pm (revision 4)
@@ -0,0 +1,30 @@
+# $Id$
+
+package Data::ObjectDriver::Driver::DBI::mysql;
+use strict;
+use base qw( Data::ObjectDriver::Driver::DBI );
+
+use Carp qw( croak );
+
+sub fetch_id { $_[1]->{mysql_insertid} || $_[1]->{insertid} }
+
+sub init_db {
+    my $driver = shift;
+    my $dbh;
+    eval {
+        local $SIG{ALRM} = sub { die "alarm\n" };
+        $dbh = DBI->connect($driver->dsn, $driver->username, $driver->password,
+            { RaiseError => 1, PrintError => 0, AutoCommit => 1 })
+            or Carp::croak("Connection error: " . $DBI::errstr);
+        alarm 0;
+    };
+    if ($@) {
+        Carp::croak(@$ eq "alarm\n" ? "Connection timeout" : $@);
+    }
+    $dbh;
+}
+
+sub commit   { 1 }
+sub rollback { 1 }
+
+1;
Index: trunk/lib/Data/ObjectDriver/BaseObject.pm
===================================================================
--- trunk/lib/Data/ObjectDriver/BaseObject.pm (revision 4)
+++ trunk/lib/Data/ObjectDriver/BaseObject.pm (revision 4)
@@ -0,0 +1,142 @@
+# $Id$
+
+package Data::ObjectDriver::BaseObject;
+use strict;
+
+=pod
+
+=over 4
+
+=item * serves as a base class for all object classes
+
+=item * proxies retrieve/save/etc methods to the driver
+
+=back
+
+=cut
+
+sub install_properties {
+    my $class = shift;
+    no strict 'refs';
+    my($props) = @_;
+    *{"${class}::__properties"} = sub { $props };
+    $props;
+}
+
+sub properties {
+    my $this = shift;
+    my $class = ref($this) || $this;
+    $class->__properties;
+}
+
+sub new { bless {}, shift }
+
+sub primary_key {
+    my $obj = shift;
+    my $pk = $obj->properties->{primary_key};
+    $pk = [ $pk ] unless ref($pk) eq 'ARRAY';
+    my @val = map $obj->$_(), @$pk;
+    @val == 1 ? $val[0] : \@val;
+}
+
+sub has_primary_key {
+    my $obj = shift;
+    my $val = $obj->primary_key;
+    $val = [ $val ] unless ref($val) eq 'ARRAY';
+    for my $v (@$val) {
+        return 0 unless defined $v;
+    }
+    1;
+}
+
+sub datasource { $_[0]->properties->{datasource} }
+
+sub columns_of_type {
+    my $obj = shift;
+    my($type) = @_;
+    my $props = $obj->properties;
+    my $cols = $props->{columns};
+    my $col_defs = $props->{column_defs};
+    my @cols;
+    for my $col (@$cols) {
+        push @cols, $col if $col_defs->{$col} && $col_defs->{$col} eq $type;
+    }
+    \@cols;
+}
+
+sub set_values {
+    my $obj = shift;
+    my($values) = @_;
+    my @cols = @{ $obj->column_names };
+    for my $col (@cols) {
+        next unless exists $values->{$col};
+        $obj->column($col, $values->{$col});
+    }
+}
+
+sub clone {
+    my $obj = shift;
+    my $clone = ref($obj)->new();
+    $clone->set_values($obj->column_values);
+    $clone;
+}
+
+sub column_names {
+    my $obj = shift;
+    my $props = $obj->properties;
+    my @cols = @{ $props->{columns} };
+    push @cols, qw( created_on modified_on )
+        if $props->{audit};
+    \@cols;
+}
+
+sub column_values { $_[0]->{'column_values'} }
+
+sub column {
+    my $obj = shift;
+    my $col = shift or return;
+    $obj->{column_values}->{$col} = shift if @_;
+    $obj->{column_values}->{$col};
+}
+
+sub exists {
+    my $obj = shift;
+    return 0 unless $obj->has_primary_key;
+    $obj->_proxy('exists', @_);
+}
+
+sub save {
+    my $obj = shift;
+    if ($obj->exists) {
+        return $obj->update;
+    } else {
+        return $obj->insert;
+    }
+}
+
+sub lookup          { shift->_proxy('lookup',       @_) }
+sub lookup_multi    { shift->_proxy('lookup_multi', @_) }
+sub search          { shift->_proxy('search',       @_) }
+sub remove          { shift->_proxy('remove',       @_) }
+sub update          { shift->_proxy('update',       @_) }
+sub insert          { shift->_proxy('insert',       @_) }
+
+sub _proxy {
+    my $obj = shift;
+    my($meth, @args) = @_;
+    $obj->properties->{driver}->$meth($obj, @args);
+}
+
+our $AUTOLOAD;
+sub AUTOLOAD {
+    my $obj = $_[0];
+    (my $col = $AUTOLOAD) =~ s!.+::!!;
+    no strict 'refs';
+    die "Cannot find method '$col' for class '$obj'" unless ref $obj;
+    *$AUTOLOAD = sub {
+        shift()->column($col, @_);
+    };
+    goto &$AUTOLOAD;
+}
+
+1;
Index: trunk/lib/Data/ObjectDriver.pm
===================================================================
--- trunk/lib/Data/ObjectDriver.pm (revision 4)
+++ trunk/lib/Data/ObjectDriver.pm (revision 4)
@@ -0,0 +1,47 @@
+# $Id$
+
+package Data::ObjectDriver;
+use strict;
+use base qw( Class::Accessor::Fast );
+
+__PACKAGE__->mk_accessors(qw( pk_generator ));
+
+## TODO:
+## refactoring the DBI.pm code
+##      - ability to define column => database for each value
+##      - plugin interface for doing things like audit
+##      - multiple column primary keys
+##      - SQL generation code belongs elsewhere
+## test suite
+## dbh needs to stay around at least as long as sth in iterator
+## Memcached::search should fetchonly the IDs, then fetch objects from cache
+## multiple column primary keys should allow passing in object,
+##  and transparently getting correct column value based on pk column
+## add in-memory cache driver (per Apache request)
+## refactor Memcached.pm into generic Cache.pm, with Memcached.pm override
+## add in DBM.pm
+## add in ObjectDriver filters
+
+sub new {
+    my $class = shift;
+    my $driver = bless {}, $class;
+    $driver->init(@_);
+    $driver;
+}
+
+sub init {
+    my $driver = shift;
+    my %param = @_;
+    $driver->pk_generator($param{pk_generator});
+    $driver;
+}
+
+sub lookup;
+sub lookup_multi;
+sub exists;
+sub insert;
+sub update;
+sub remove;
+sub search;
+
+1;
Index: trunk/Makefile.PL
===================================================================
--- trunk/Makefile.PL (revision 4)
+++ trunk/Makefile.PL (revision 4)
@@ -0,0 +1,22 @@
+# $Id$
+
+use inc::Module::Install;
+
+name('Data-ObjectDriver');
+abstract('');
+author('Six Apart <cpan@sixapart.com>');
+version_from('lib/Data/ObjectDriver.pm');
+license('perl');
+no_index(directory => 't');
+sign(1);
+
+include('ExtUtils::AutoInstall');
+
+requires('DBI');
+requires('Class::Accessor::Fast');
+requires('Cache::Memcached');
+
+auto_include();
+auto_install();
+
+&WriteAll;
Index: trunk/Changes
===================================================================
--- trunk/Changes (revision 4)
+++ trunk/Changes (revision 4)
@@ -0,0 +1,6 @@
+# $Id$
+
+Revision history for Data::ObjectDriver
+
+0.01  2005.07.01
+    - Initial distribution.
Index: trunk/Build.PL
===================================================================
--- trunk/Build.PL (revision 4)
+++ trunk/Build.PL (revision 4)
@@ -0,0 +1,3 @@
+# $Id$
+
+require 'Makefile.PL';
Index: trunk/MANIFEST.SKIP
===================================================================
--- trunk/MANIFEST.SKIP (revision 4)
+++ trunk/MANIFEST.SKIP (revision 4)
@@ -0,0 +1,12 @@
+^_build
+^Build$
+\bCVS\b
+~$
+\.bak$
+^MANIFEST\.SKIP$
+^Makefile$
+\.old$
+^blib
+^pm_to_blib$
+\.tar\.gz$
+\.svn
Index: trunk/README
===================================================================
--- trunk/README (revision 4)
+++ trunk/README (revision 4)
@@ -0,0 +1,29 @@
+$Id$
+
+This is Data::ObjectDriver, providing a simple and generic abstraction
+to databases (DBI and otherwise), along with support for partitioning and
+caching.
+
+PREREQUISITES
+
+    * DBI
+    * Class::Accessor::Fast
+    * Cache::Memcached
+
+INSTALLATION
+
+Data::ObjectDriver installation is straightforward. If your CPAN shell
+is set up, you should just be able to do
+
+    % perl -MCPAN -e 'install Data::ObjectDriver'
+
+Download it, unpack it, then build it as per the usual:
+
+    % perl Makefile.PL
+    % make && make test
+
+Then install it:
+
+    % make install
+
+Six Apart / cpan@sixapart.com