Skip Menu |
 

This queue is for tickets about the Class-DBI CPAN distribution.

Report information
The Basics
Id: 16808
Status: new
Priority: 0/
Queue: Class-DBI

People
Owner: Nobody in particular
Requestors: ask [...] develooper.com
Cc:
AdminCc:

Bug Information
Severity: (no value)
Broken in: (no value)
Fixed in: (no value)



Subject: Make primary keys read-only
Download (untitled) / with headers
text/plain 2.4k
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"; }


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.