Added our own accessor system (ripped from C::A) and a bunch more compat code

diff --git a/lib/DBIx/Class/AccessorGroup.pm b/lib/DBIx/Class/AccessorGroup.pm
new file mode 100644 (file)
index 0000000..51dd7bc
--- /dev/null
+++ b/lib/DBIx/Class/AccessorGroup.pm
@@ -0,0 +1,110 @@
+package DBIx::Class::AccessorGroup;
+
+sub mk_group_accessors {
+    my($self, $group, @fields) = @_;
+
+    $self->_mk_group_accessors('make_group_accessor', $group, @fields);
+}
+
+
+{
+    no strict 'refs';
+
+    sub _mk_group_accessors {
+        my($self, $maker, $group, @fields) = @_;
+        my $class = ref $self || $self;
+
+        # So we don't have to do lots of lookups inside the loop.
+        $maker = $self->can($maker) unless ref $maker;
+
+        foreach my $field (@fields) {
+            if( $field eq 'DESTROY' ) {
+                require Carp;
+                &Carp::carp("Having a data accessor named DESTROY  in ".
+                             "'$class' is unwise.");
+            }
+
+            my $accessor = $self->$maker($group, $field);
+            my $alias = "_${field}_accessor";
+
+            *{$class."\:\:$field"}  = $accessor
+              unless defined &{$class."\:\:$field"};
+
+            *{$class."\:\:$alias"}  = $accessor
+              unless defined &{$class."\:\:$alias"};
+        }
+    }
+}
+
+sub mk_group_ro_accessors {
+    my($self, $group, @fields) = @_;
+
+    $self->_mk_group_accessors('make_group_ro_accessor', $group, @fields);
+}
+
+sub mk_group_wo_accessors {
+    my($self, $group, @fields) = @_;
+
+    $self->_mk_group_accessors('make_group_wo_accessor', $group, @fields);
+}
+
+sub make_group_accessor {
+    my ($class, $group, $field) = @_;
+
+    my $set = "set_$group";
+    my $get = "get_$group";
+
+    # Build a closure around $field.
+    return sub {
+        my $self = shift;
+
+        if(@_) {
+            return $self->set($field, @_);
+        }
+        else {
+            return $self->get($field);
+        }
+    };
+}
+
+sub make_group_ro_accessor {
+    my($class, $group, $field) = @_;
+
+    my $get = "get_$group";
+
+    return sub {
+        my $self = shift;
+
+        if(@_) {
+            my $caller = caller;
+            require Carp;
+            Carp::croak("'$caller' cannot alter the value of '$field' on ".
+                        "objects of class '$class'");
+        }
+        else {
+            return $self->get($field);
+        }
+    };
+}
+
+sub make_group_wo_accessor {
+    my($class, $group, $field) = @_;
+
+    my $set = "set_$group";
+
+    return sub {
+        my $self = shift;
+
+        unless (@_) {
+            my $caller = caller;
+            require Carp;
+            Carp::croak("'$caller' cannot access the value of '$field' on ".
+                        "objects of class '$class'");
+        }
+        else {
+            return $self->set($field, @_);
+        }
+    };
+}
+
+1;

diff --git a/lib/DBIx/Class/CDBICompat/AttributeAPI.pm b/lib/DBIx/Class/CDBICompat/AttributeAPI.pm
new file mode 100644 (file)
index 0000000..8dee47f
--- /dev/null
+++ b/lib/DBIx/Class/CDBICompat/AttributeAPI.pm
@@ -0,0 +1,33 @@
+package DBIx::Class::CDBICompat::AttributeAPI;
+
+sub _attrs {
+  my ($self, @atts) = @_;
+  return @{$self->{_column_data}}{@atts};
+}
+
+*_attr = \&_attrs;
+
+sub _attribute_store {
+  my $self   = shift;
+  my $vals   = @_ == 1 ? shift: {@_};
+  my (@cols) = keys %$vals;
+  @{$self->{_column_data}}{@cols} = @{$vals}{@cols};
+}
+
+sub _attribute_set {
+  my $self   = shift;
+  my $vals   = @_ == 1 ? shift: {@_};
+  $self->set_column($_, $vals->{$_}) for keys %{$vals};
+}
+
+sub _attribute_delete {
+  my ($self, $attr) = @_;
+  delete $self->{_column_data}{$attr};
+}
+
+sub _attribute_exists {
+  my ($self, $attr) = @_;
+  exists $self->{_column_data}{$attr};
+}
+
+1;

diff --git a/lib/DBIx/Class/CDBICompat/GetSet.pm b/lib/DBIx/Class/CDBICompat/GetSet.pm
new file mode 100644 (file)
index 0000000..a748c55
--- /dev/null
+++ b/lib/DBIx/Class/CDBICompat/GetSet.pm
@@ -0,0 +1,18 @@
+package DBIx::Class::CDBICompat::GetSet;
+
+#use base qw/Class::Accessor/;
+
+sub get {
+  my ($self, @cols) = @_;
+  if (@cols > 1) {
+    return map { $self->get_column($_) } @cols;
+  } else {
+    return $self->get_column($_[1]);
+  }
+}
+
+sub set {
+  return shift->set_column(@_);
+}
+
+1;

diff --git a/lib/DBIx/Class/CDBICompat/LazyLoading.pm b/lib/DBIx/Class/CDBICompat/LazyLoading.pm
new file mode 100644 (file)
index 0000000..ed61535
--- /dev/null
+++ b/lib/DBIx/Class/CDBICompat/LazyLoading.pm
@@ -0,0 +1,36 @@
+package DBIx::Class::CDBICompat::LazyLoading;
+
+use strict;
+use warnings;
+
+sub _select_columns {
+  return shift->columns('Essential');
+}
+
+sub get_column {
+  my ($self, $col) = @_;
+  if ((ref $self) && (!exists $self->{'_column_data'}{$col})
+    && $self->{'_in_database'}) {
+    $self->_flesh(grep { exists $self->_column_groups->{$_}{$col}
+                           && $_ ne 'All' }
+                   keys %{ $self->_column_groups || {} });
+  }
+  $self->NEXT::get_column(@_[1..$#_]);
+}
+
+sub _flesh {
+  my ($self, @groups) = @_;
+  my %want;
+  $want{$_} = 1 for map { keys %{$self->_column_groups->{$_}} } @groups;
+  if (my @want = grep { !exists $self->{'_column_data'}{$_} } keys %want) {
+    my $sth = $self->_get_sth('select', \@want, $self->_table_name,
+                                $self->_ident_cond); 
+    $sth->execute($self->_ident_values);
+    my @val = $sth->fetchrow_array;
+    foreach my $w (@want) {
+      $self->{'_column_data'}{$w} = shift @val;
+    }
+  }
+}
+
+1;

diff --git a/lib/DBIx/Class/CDBICompat/Triggers.pm b/lib/DBIx/Class/CDBICompat/Triggers.pm
new file mode 100644 (file)
index 0000000..21826f9
--- /dev/null
+++ b/lib/DBIx/Class/CDBICompat/Triggers.pm
@@ -0,0 +1,31 @@
+package DBIx::Class::CDBICompat::Triggers;
+
+use Class::Trigger;
+
+sub insert {
+  my $self = shift;
+  $self->call_trigger('before_create');
+  $self->NEXT::insert(@_);
+  $self->call_trigger('after_create');
+  return $self;
+}
+
+sub update {
+  my $self = shift;
+  $self->call_trigger('before_update');
+  my @to_update = keys %{$self->{_dirty_columns} || {}};
+  return -1 unless @to_update;
+  $self->NEXT::update(@_);
+  $self->call_trigger('after_update');
+  return $self;
+}
+
+sub delete {
+  my $self = shift;
+  $self->call_trigger('before_delete') if ref $self;
+  $self->NEXT::delete(@_);
+  $self->call_trigger('after_delete') if ref $self;
+  return $self;
+}
+
+1;