[SCM] Debian packaging of libclass-dbi-lite-perl branch, master, updated. debian/1.022-1-2-g91451e1

Onur Aslan onuraslan at gmail.com
Mon Oct 31 08:36:29 UTC 2011


The following commit has been merged in the master branch:
commit 91451e1875c42a295d1260738a8caaadb2babc80
Author: Onur Aslan <onuraslan at gmail.com>
Date:   Mon Oct 31 11:29:53 2011 +0200

    importing upstream

diff --git a/Changes b/Changes
index 17ea067..106de14 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,11 @@
 Revision history for Perl extension Class::DBI::Lite.
 
+1.023   2011-10-27
+  - Now if you want to override the default 'getter' or 'setter' behavior for a
+    field in your objects, you can do so by defining _set_foo( $self, $val ) or
+    _get_foo( $self ).
+  - Thanks Eric for the idea!  ehayes.inflection++
+
 1.022   2011-09-19
   - POD change from app::* to App::db::* namespace.
 
diff --git a/META.yml b/META.yml
index 26223fc..297214d 100644
--- a/META.yml
+++ b/META.yml
@@ -1,6 +1,6 @@
 --- #YAML:1.0
 name:                Class-DBI-Lite
-version:             1.022
+version:             1.023
 abstract:            Lightweight ORM for Perl
 license:             Perl
 author:              
diff --git a/lib/Class/DBI/Lite.pm b/lib/Class/DBI/Lite.pm
index 481c3b0..77e8aa9 100644
--- a/lib/Class/DBI/Lite.pm
+++ b/lib/Class/DBI/Lite.pm
@@ -18,7 +18,7 @@ use overload
   bool      => sub { eval { $_[0]->id } },
   fallback  => 1;
 
-our $VERSION = '1.022';
+our $VERSION = '1.023';
 our $meta;
 
 our %DBI_OPTIONS = (
@@ -158,13 +158,10 @@ sub _init_meta
   # Install the column accessors:
   foreach my $col ( grep { $_ ne $pk } $class->columns )
   {
-    *{"$class\::$col"} = sub {
-      my $s = shift;
-      
-      exists($s->{$col}) or $s->_flesh_out;
-      if( @_ )
-      {
-        my $newval = shift;
+    my $setter = "_set_$col";
+    my $getter = "_get_$col";
+    *{"$class\::$setter"} = sub {
+      my ($s, $newval) = @_;
         no warnings 'uninitialized';
         return $newval if $newval eq $s->{$col};
         $s->_call_triggers( "before_set_$col", $s->{$col}, $newval );
@@ -172,11 +169,16 @@ sub _init_meta
           oldval => $s->{$col}
         };
         return $s->{$col} = $newval;
-      }
-      else
-      {
-        return $s->{$col};
-      }# end if()
+    };
+    *{"$class\::$getter"} = sub {
+      shift->{$col};
+    };
+    
+    *{"$class\::$col"} = sub {
+      my $s = shift;
+      
+      exists($s->{$col}) or $s->_flesh_out;
+      @_ ? $s->$setter( @_ ) : $s->$getter( @_ );
     };
   }# end foreach()
 }# end _init_meta()
@@ -1885,6 +1887,15 @@ To save those changes to the database you must call C<update>:
 
 =back
 
+=head2 Overriding Setters and Getters
+
+The accessors/mutators ("setters" and "getters") can be individually overridden
+within your entity class by implementing C<_set_foo($self, $value)> or
+C<_get_foo($self)> methods.
+
+B<NOTE:> In practice this may be more useful for the C<_get_*> methods, as the C<_set_*>
+methods are usually best left to triggers.
+
 =head2 id
 
 Always returns the value of the object's primary column.
diff --git a/t/testdb b/t/testdb
index 0d0e366..dddd626 100644
Binary files a/t/testdb and b/t/testdb differ

-- 
Debian packaging of libclass-dbi-lite-perl



More information about the Pkg-perl-cvs-commits mailing list