| Subject: | Make primary keys read-only |
Patch against 3.0.13 + my patch from #16154.
--- ../Class-DBI-ask/lib/Class/DBI.pm 2005-12-30 05:25:57.000000000 -0800
+++ lib/Class/DBI.pm 2005-12-30 06:05:18.000000000 -0800
@@ -328,6 +328,9 @@
sub _mk_column_accessors {
my $class = shift;
+
+ my %pks = map { $_ => 1 } $class->primary_columns;
+
foreach my $col (@_) {
my $default_accessor = $col->accessor;
@@ -337,8 +340,9 @@
my %method = ();
- if (($acc eq $mut) # if they are the same
- or ($mut eq $default_accessor)) { # or only the accessor was customized
+ if (!$pks{$col}
+ and (($acc eq $mut) # if they are the same
+ or ($mut eq $default_accessor))) { # or only the accessor was customized
%method = ('_' => $acc); # make the accessor the mutator too
$col->accessor($acc);
$col->mutator($acc);
@@ -356,7 +360,8 @@
my $name = $method{$type};
my $acc_type = "make${type}accessor";
my $accessor = $class->$acc_type($col->name_lc);
- $class->_make_method($_, $accessor) for ($name, "_${name}_accessor");
+ next if $pks{$col} and $type eq '_wo_';
+ $class->_make_method($_, $accessor) for ($name, "_${name}_accessor")
}
}
}
$ cat t/26-primary_key_ro.t
use strict;
use Test::More;
BEGIN {
eval "use DBD::SQLite";
plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 5);
}
use lib 't/testlib';
use Film;
my %info = (
Title => 'La Double Vie De Veronique',
Director => 'Kryzstof Kieslowski',
Rating => '18',
);
ok(my $ver = Film->insert({%info}), "Insert");
is($ver->id, 'La Double Vie De Veronique', 'id is title');
# should this croak too?
#ok(!$ver->id("foobar"), 'try changing id');
{
local *Film::_croak = sub {
my ($self, $msg, %info) = @_;
die %info ? bless \%info => "My::Error" : $msg;
};
eval {
$ver->Title("foobar");
$ver->update;
};
like($@, qr/^'main' cannot alter the value of 'title' on objects of class 'Film'/, 'got error
message');
is($ver->id, 'La Double Vie De Veronique', "id didn't change");
ok $ver->delete, "Delete";
}