| Subject: | old accessor_name/mutator_name methods not working (rather than just being deprecated as announced) |
Since 3.0.7 (I think) accessor_name and mutator_name has simple been ignored. This patch
fixes it. I left the deprecation warnings commented out for now.
diff -rbupN Class-DBI-v3.0.14/lib/Class/DBI.pm Class-DBI-v3.0.14-ask/lib/Class/DBI.pm
--- Class-DBI-v3.0.14/lib/Class/DBI.pm 2006-01-16 02:25:27.000000000 -0800
+++ Class-DBI-v3.0.14-ask/lib/Class/DBI.pm 2006-02-02 23:07:37.000000000 -0800
@@ -59,10 +59,7 @@ sub _undefined_primary {
__PACKAGE__->mk_classdata('__hasa_rels' => {});
{
- my %deprecated = (
- accessor_name => 'accessor_name_for', # 3.0.7
- mutator_name => 'mutator_name_for', # 3.0.7
- );
+ my %deprecated = ();
no strict 'refs';
while (my ($old, $new) = each %deprecated) {
@@ -375,11 +372,17 @@ sub _make_method {
sub accessor_name_for {
my ($class, $column) = @_;
+ if ($class->can('accessor_name')) {
+ return $class->accessor_name($column);
+ }
return $column->accessor;
}
sub mutator_name_for {
my ($class, $column) = @_;
+ if ($class->can('mutator_name')) {
+ return $class->mutator_name($column);
+ }
return $column->mutator;
}
diff -rbupN Class-DBI-v3.0.14/t/27-mutator-old.t Class-DBI-v3.0.14-ask/t/27-mutator-
old.t
--- Class-DBI-v3.0.14/t/27-mutator-old.t 1969-12-31 16:00:00.000000000 -0800
+++ Class-DBI-v3.0.14-ask/t/27-mutator-old.t 2006-02-02 23:01:15.000000000 -0800
@@ -0,0 +1,45 @@
+use strict;
+use Test::More;
+
+BEGIN {
+ eval "use DBD::SQLite";
+ plan $@
+ ? (skip_all => 'needs DBD::SQLite for testing')
+ : (tests => 6);
+}
+
+INIT {
+ local $SIG{__WARN__} = sub {
+ like $_[0], qr/clashes with built-in method/, $_[0];
+ };
+ use lib 't/testlib';
+ require Film;
+}
+
+sub Film::accessor_name {
+ my ($class, $col) = @_;
+ return "sheep" if lc $col eq "numexplodingsheep";
+ return $col;
+}
+
+my $data = {
+ Title => 'Bad Taste',
+ Director => 'Peter Jackson',
+ Rating => 'R',
+};
+
+my $bt;
+eval {
+ my $data = $data;
+ $data->{sheep} = 1;
+ ok $bt = Film->insert($data), "Modified accessor - with
+accessor";
+ isa_ok $bt, "Film";
+};
+is $@, '', "No errors";
+
+eval {
+ ok $bt->sheep(2), 'Modified accessor, set';
+ ok $bt->update, 'Update';
+};
+is $@, '', "No errors";