[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