Imported a couple extra modules, added retrieve_all

diff --git a/lib/DBIx/Class/CDBICompat/Convenience.pm b/lib/DBIx/Class/CDBICompat/Convenience.pm
new file mode 100644 (file)
index 0000000..f0f98cd
--- /dev/null
+++ b/lib/DBIx/Class/CDBICompat/Convenience.pm
@@ -0,0 +1,35 @@
+package DBIx::Class::CDBICompat::Convenience;
+
+use strict;
+use warnings;
+
+sub find_or_create {
+  my $class    = shift;
+  my $hash     = ref $_[0] eq "HASH" ? shift: {@_};
+  my ($exists) = $class->search($hash);
+  return defined($exists) ? $exists : $class->create($hash);
+}
+
+sub id {
+  my ($self) = @_;
+  die "Can't call id() as a class method" unless ref $self;
+  my @pk = $self->_ident_value;
+  return (wantarray ? @pk : $pk[0]);
+}
+
+#sub insert {
+#  my $self = shift;
+#  $self->NEXT::insert(@_);
+#  my @pk = keys %{ $self->_primaries };
+#  if ((@pk == 1) && (!$self->{_column_data}{$pk[0]})) {
+#    $self->{_column_data}{$pk[0]} = $self->_get_dbh->last_insert_id;
+#  }
+#  return $self;
+#}
+
+sub retrieve_all {
+  my ($class) = @_;
+  return $class->search( { 1 => 1 } );
+}
+
+1;

diff --git a/lib/DBIx/Class/CDBICompat/ImaDBI.pm b/lib/DBIx/Class/CDBICompat/ImaDBI.pm
new file mode 100644 (file)
index 0000000..37495af
--- /dev/null
+++ b/lib/DBIx/Class/CDBICompat/ImaDBI.pm
@@ -0,0 +1,23 @@
+package DBIx::Class::CDBICompat::ImaDBI;
+
+use strict;
+use warnings;
+
+use NEXT;
+
+sub db_Main {
+  return $_[0]->_get_dbh;
+}
+
+sub _dbi_connect {
+  my ($class, @info) = @_;
+  $info[3] = { %{ $info[3] || {}} };
+  $info[3]->{RootClass} = 'DBIx::ContextualFetch';
+  return $class->NEXT::_dbi_connect(@info);
+}
+
+sub __driver {
+  return $_[0]->_get_dbh->{Driver}->{Name};
+}
+
+1;

diff --git a/lib/DBIx/Class/PK.pm b/lib/DBIx/Class/PK.pm
new file mode 100644 (file)
index 0000000..a2f5564
--- /dev/null
+++ b/lib/DBIx/Class/PK.pm
@@ -0,0 +1,45 @@
+package DBIx::Class::PK;
+
+use strict;
+use warnings;
+
+use base qw/Class::Data::Inheritable DBIx::Class::SQL/;
+
+__PACKAGE__->mk_classdata('_primaries' => {});
+
+sub _ident_cond {
+  my ($class) = @_;
+  return join(" AND ", map { "$_ = ?" } keys %{$class->_primaries});
+}
+
+sub _ident_values {
+  my ($self) = @_;
+  return (map { $self->{_column_data}{$_} } keys %{$self->_primaries});
+}
+
+sub set_primary {
+  my ($class, @cols) = @_;
+  my %pri;
+  $pri{$_} = {} for @cols;
+  $class->_primaries(\%pri);
+}
+
+sub retrieve {
+  my ($class, @vals) = @_;
+  my @pk = keys %{$class->_primaries};
+  die "Can't retrieve unless primary columns are defined" unless @pk;
+  my $query;
+  if (ref $vals[0] eq 'HASH') {
+    $query = $vals[0];
+  } elsif (@pk == 1 && @vals == 1) {
+    return ($class->retrieve_from_sql($class->_ident_cond, $vals[0]))[0];
+  } else {
+    $query = {@vals};
+  }
+  die "Can't retrieve unless all primary keys are specified"
+    unless (keys %$query >= @pk); # If we check 'em we run afoul of uc/lc
+                                  # column names etc. Not sure what to do yet
+  return ($class->search($query))[0];
+}
+
+1;