Added claco to contributors in POD

[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..4e42b27 100644 (file)
--- a/lib/DBIx/Class/AccessorGroup.pm
+++ b/lib/DBIx/Class/AccessorGroup.pm
@@ -1,5 +1,25 @@
 package DBIx::Class::AccessorGroup;
 
+use strict;
+use warnings;
+
+use Carp::Clan qw/^DBIx::Class/;
+
+=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
+
+=cut
+
 sub mk_group_accessors {
     my($self, $group, @fields) = @_;
 
@@ -9,6 +29,7 @@ sub mk_group_accessors {
 
 {
     no strict 'refs';
+    no warnings 'redefine';
 
     sub _mk_group_accessors {
         my($self, $maker, $group, @fields) = @_;
@@ -19,19 +40,24 @@ sub mk_group_accessors {
 
         foreach my $field (@fields) {
             if( $field eq 'DESTROY' ) {
-                require Carp;
-                &Carp::carp("Having a data accessor named DESTROY  in ".
+                carp("Having a data accessor named DESTROY  in ".
                              "'$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 +85,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);
         }
     };
 }
@@ -77,12 +103,11 @@ sub make_group_ro_accessor {
 
         if(@_) {
             my $caller = caller;
-            require Carp;
-            Carp::croak("'$caller' cannot alter the value of '$field' on ".
+            croak("'$caller' cannot alter the value of '$field' on ".
                         "objects of class '$class'");
         }
         else {
-            return $self->get($field);
+            return $self->$get($field);
         }
     };
 }
@@ -98,13 +123,55 @@ sub make_group_wo_accessor {
         unless (@_) {
             my $caller = caller;
             require Carp;
-            Carp::croak("'$caller' cannot access the value of '$field' on ".
+            croak("'$caller' cannot access the value of '$field' on ".
                         "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;
+}
+
+sub get_component_class {
+  my ($self, $get) = @_;
+  if (ref $self) {
+      return $self->{$get};
+  } else {
+      $get = "_$get";
+      return $self->can($get) ? $self->$get : undef;      
+  }
+}
+
+sub set_component_class {
+  my ($self, $set, $val) = @_;
+  eval "require $val";
+  if (ref $self) {
+      return $self->{$set} = $val;
+  } else {
+      $set = "_$set";
+      return $self->can($set) ? $self->$set($val) : $self->mk_classdata($set => $val);      
+  }  
+}
+
 1;
+
+=head1 AUTHORS
+
+Matt S. Trout <mst@shadowcatsystems.co.uk>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut
+