Bugfixes, optimisations

[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / AccessorGroup.pm

diff --git a/lib/DBIx/Class/AccessorGroup.pm b/lib/DBIx/Class/AccessorGroup.pm
index 51dd7bc..0625f01 100644 (file)
--- a/lib/DBIx/Class/AccessorGroup.pm
+++ b/lib/DBIx/Class/AccessorGroup.pm
@@ -1,5 +1,27 @@
 package DBIx::Class::AccessorGroup;
 
+use strict;
+use warnings;
+
+use NEXT;
+
+=head1 NAME 
+
+DBIx::Class::AccessorGroup -  Lets you build groups of accessors
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+This class lets you build groups of accessors that will call different
+getters and setters.
+
+=head1 METHODS
+
+=over 4
+
+=cut
+
 sub mk_group_accessors {
     my($self, $group, @fields) = @_;
 
@@ -9,6 +31,7 @@ sub mk_group_accessors {
 
 {
     no strict 'refs';
+    no warnings 'redefine';
 
     sub _mk_group_accessors {
         my($self, $maker, $group, @fields) = @_;
@@ -24,14 +47,20 @@ sub mk_group_accessors {
                              "'$class' is unwise.");
             }
 
+            my $name = $field;
+
+            ($name, $field) = @$field if ref $field;
+
             my $accessor = $self->$maker($group, $field);
-            my $alias = "_${field}_accessor";
+            my $alias = "_${name}_accessor";
 
-            *{$class."\:\:$field"}  = $accessor
-              unless defined &{$class."\:\:$field"};
+            #warn "$class $group $field $alias";
 
-            *{$class."\:\:$alias"}  = $accessor
-              unless defined &{$class."\:\:$alias"};
+            *{$class."\:\:$name"}  = $accessor;
+              #unless defined &{$class."\:\:$field"}
+
+            *{$class."\:\:$alias"}  = $accessor;
+              #unless defined &{$class."\:\:$alias"}
         }
     }
 }
@@ -59,10 +88,10 @@ sub make_group_accessor {
         my $self = shift;
 
         if(@_) {
-            return $self->set($field, @_);
+            return $self->$set($field, @_);
         }
         else {
-            return $self->get($field);
+            return $self->$get($field);
         }
     };
 }
@@ -82,7 +111,7 @@ sub make_group_ro_accessor {
                         "objects of class '$class'");
         }
         else {
-            return $self->get($field);
+            return $self->$get($field);
         }
     };
 }
@@ -102,9 +131,32 @@ sub make_group_wo_accessor {
                         "objects of class '$class'");
         }
         else {
-            return $self->set($field, @_);
+            return $self->$set($field, @_);
         }
     };
 }
 
+sub get_simple {
+  my ($self, $get) = @_;
+  return $self->{$get};
+}
+
+sub set_simple {
+  my ($self, $set, $val) = @_;
+  return $self->{$set} = $val;
+}
+
 1;
+
+=back
+
+=head1 AUTHORS
+
+Matt S. Trout <mst@shadowcatsystems.co.uk>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut
+