Skip Menu |
 

This queue is for tickets about the accessors CPAN distribution.

Report information
The Basics
Id: 73138
Status: open
Priority: 0/
Queue: accessors

People
Owner: Nobody in particular
Requestors: SREZIC [...] cpan.org
Cc:
AdminCc:

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

Attachments


Subject: Prohibit "class accessors"?
MIME-Version: 1.0
X-Mailer: MIME-tools 5.427 (Entity 5.427)
X-RT-Original-Encoding: utf-8
Content-Type: multipart/mixed; boundary="----------=_1323452610-6889-217"
Content-Length: 0
Content-Type: text/plain; charset="UTF-8"
Content-Disposition: inline
Content-Transfer-Encoding: binary
Content-Length: 514
Download (untitled) / with headers
text/plain 514b
Currently it is possible to define some kind of "class accessors" with accessors.pm. See the following script: #!/usr/bin/perl use strict; use warnings; { package Foo; use accessors qw(bla); } Foo->bla(2); print Foo->bla, "\n"; # or my $object = 'Foo'; # an accident! print $object->bla, "\n"; # does not die! __END__ I wonder if such a use should be forbidden. If you think it should be forbidden, then you can apply the attached patch (which has also additional test cases). Regards, Slaven
Subject: accessors-strict-refs.patch
MIME-Version: 1.0
Content-Type: text/x-diff; name="accessors-strict-refs.patch"
X-Mailer: MIME-tools 5.427 (Entity 5.427)
Content-Disposition: inline; filename="accessors-strict-refs.patch"
Content-Transfer-Encoding: binary
Content-Length: 5090
diff --git c/lib/accessors.pm w/lib/accessors.pm index 203ee72..9b0fdf0 100644 --- c/lib/accessors.pm +++ w/lib/accessors.pm @@ -68,12 +68,13 @@ sub create_accessor { $property = "-$property"; # set/get is slightly faster if we eval instead of using a closure + anon # sub, but the difference is marginal (~5%), and this uses less memory... - no strict 'refs'; - *{$accessor} = sub { + my $sub = sub { (@_ > 1) ? ($_[0]->{$property} = $_[1], return $_[0]) : $_[0]->{$property}; }; + no strict 'refs'; + *{$accessor} = $sub; } sub isa_valid_name { diff --git c/lib/accessors/classic.pm w/lib/accessors/classic.pm index add9025..0c105b8 100644 --- c/lib/accessors/classic.pm +++ w/lib/accessors/classic.pm @@ -31,10 +31,11 @@ sub create_accessor { my ($class, $accessor, $property) = @_; # set/get is slightly faster if we eval instead of using a closure + anon # sub, but the difference is marginal (~5%), and this uses less memory... - no strict 'refs'; - *{$accessor} = sub { + my $sub = sub { (@_ > 1) ? $_[0]->{$property} = $_[1] : $_[0]->{$property}; - } + }; + no strict 'refs'; + *{$accessor} = $sub; } 1; diff --git c/lib/accessors/ro.pm w/lib/accessors/ro.pm index 8ca1bfb..369f86f 100755 --- c/lib/accessors/ro.pm +++ w/lib/accessors/ro.pm @@ -37,8 +37,9 @@ sub create_accessor { my ($class, $accessor, $property) = @_; # get is slightly faster if we eval instead of using a closure + anon # sub, but the difference is marginal (~5%), and this uses less memory... + my $sub = sub { return $_[0]->{$property} }; no strict 'refs'; - *{$accessor} = sub { return $_[0]->{$property} }; + *{$accessor} = $sub; } 1; diff --git c/t/02__chaining.t w/t/02__chaining.t index fd10b25..f9935a4 100644 --- c/t/02__chaining.t +++ w/t/02__chaining.t @@ -7,7 +7,7 @@ use strict; use warnings; -use Test::More tests => 12; +use Test::More tests => 13; use Carp; BEGIN { use_ok( "accessors::chained" ) }; @@ -22,6 +22,12 @@ is( $foo->bar( 'set' )->baz( 2 ), $foo, 'set foo->bar->baz' ); is( $foo->bar, 'set', 'get foo->bar' ); is( $foo->baz, '2', 'get foo->baz' ); +eval { + my $class = 'Foo'; + $class->bar( 'set' )->baz( 2 ); +}; +isnt( $@, '', 'class accessor is an error' ); + SKIP: { skip '$ENV{BENCHMARK_ACCESSORS} not set', 6 unless ($ENV{BENCHMARK_ACCESSORS}); eval "use Benchmark qw( timestr countit )"; # ya never know... diff --git c/t/03__classic.t w/t/03__classic.t index 7396af0..93ecfa1 100644 --- c/t/03__classic.t +++ w/t/03__classic.t @@ -7,7 +7,7 @@ use strict; use warnings; -use Test::More tests => 12; +use Test::More tests => 13; use Carp; BEGIN { use_ok( "accessors::classic" ) }; @@ -22,6 +22,13 @@ is( $foo->bar( 'set' ), 'set', 'set foo->bar' ); is( $foo->baz( 2 ), 2, 'set foo->baz' ); is( $foo->bar, 'set', 'get foo->bar' ); +eval { + my $class = 'Foo'; + $class->bar( 'set' ); + $class->bar; +}; +isnt( $@, '', 'class accessor is an error' ); + SKIP: { skip '$ENV{BENCHMARK_ACCESSORS} not set', 6 unless ($ENV{BENCHMARK_ACCESSORS}); eval "use Benchmark qw( timestr countit )"; # ya never know... diff --git c/t/05__default.t w/t/05__default.t index fad10aa..75993d5 100644 --- c/t/05__default.t +++ w/t/05__default.t @@ -7,7 +7,7 @@ use strict; use warnings; -use Test::More tests => 6; +use Test::More tests => 7; use Carp; BEGIN { use_ok( "accessors" ) }; @@ -21,5 +21,12 @@ ok( $foo->bar( 1 ), 'set default' ); is( $foo->bar, 1 , 'get default' ); ok( !$foo->baz, 'get default'); +eval { + my $class = 'Foo'; + $class->bar( 1 ); + $class->bar; +}; +isnt( $@, '', 'class accessor is an error' ); + package Foo; use accessors qw( bar baz ); diff --git c/t/06__rw.t w/t/06__rw.t index ea77cc0..3b37170 100644 --- c/t/06__rw.t +++ w/t/06__rw.t @@ -7,7 +7,7 @@ use strict; use warnings; -use Test::More tests => 6; +use Test::More tests => 7; use Carp; BEGIN { use_ok( "accessors::rw" ) }; @@ -22,6 +22,13 @@ is( $foo->bar( 'set' ), 'set', 'set foo->bar' ); is( $foo->baz( 2 ), 2, 'set foo->baz' ); is( $foo->bar, 'set', 'get foo->bar' ); +eval { + my $class = 'Foo'; + $class->bar( 1 ); + $class->bar; +}; +isnt( $@, '', 'class accessor is an error' ); + # no sense benchmarking this as it inherits from accessors::classic. package Foo; diff --git c/t/07__ro.t w/t/07__ro.t index dc43390..133910a 100644 --- c/t/07__ro.t +++ w/t/07__ro.t @@ -7,7 +7,7 @@ use strict; use warnings; -use Test::More tests => 13; +use Test::More tests => 14; use Carp; BEGIN { use_ok( "accessors::ro" ) }; @@ -24,6 +24,12 @@ is( $foo->baz, undef, 'get foo->baz' ); $foo->{baz} = 'set'; is( $foo->baz, 'set', 'get foo->baz' ); +eval { + my $class = 'Foo'; + $class->bar; +}; +isnt( $@, '', 'class accessor is an error' ); + SKIP: { skip '$ENV{BENCHMARK_ACCESSORS} not set', 6 unless ($ENV{BENCHMARK_ACCESSORS}); eval "use Benchmark qw( timestr countit )"; # ya never know...
MIME-Version: 1.0
X-Mailer: MIME-tools 5.427 (Entity 5.427)
Content-Disposition: inline
Content-Type: text/plain; charset="UTF-8"
Message-ID: <rt-3.8.HEAD-14881-1327419014-1194.73138-0-0 [...] rt.cpan.org>
Content-Transfer-Encoding: binary
X-RT-Original-Encoding: utf-8
Content-Length: 1939
Download (untitled) / with headers
text/plain 1.8k
Hi Slaven, On Fri Dec 09 12:43:31 2011, SREZIC wrote: Show quoted text
> Currently it is possible to define some kind of "class accessors" with > accessors.pm. See the following script: [snip!]
Thanks, I agree it's a good idea to block this and also a bug -- I never intended for people to create random hashes in the accessors:: namespace! I've benchmarked your patch vs current module several times, and have seen no big performance hit (see below). My only other concerns: 1. The error message isn't great: Can't use string ("Foo") as a HASH ref while "strict refs" in use at lib/accessors.pm line 72. Ideally it'd say something like: accessors::$class can't set a property ($property) on a class ($class): use an instance instead at $caller_info So: what's the performance cost of adding in some error checking, and is it worth it? If not, the docs need to be updated to mention the above error in the event that this release breaks someones' unintentional class-accessor usage. 2. 'no' is compile-time... I wonder if it will revert to original behaviour (ie: apply to the whole block) in an older version of Perl? CPAN testers should catch this, if so we can throw another block around it. Cheers, -Steve ----------------- Performance testing ----------------- t/01__basic.t ... Patched: ok 8 - generates 38836 accessors/sec (> 100) Current: ok 7 - generates 38836 accessors/sec (> 100) t/03__classic.t ... Patched: ok 8 - generates 38836 accessors/sec (> 100) Current: ok 7 - generates 38836 accessors/sec (> 100) t/07__ro.t ........ Patched 2 runs: ok 9 - generates 35101 accessors/sec (> 100) Patched 3rd run: ok 9 - generates 34439 accessors/sec (> 100) Patched 4th run: ok 9 - generates 38027 accessors/sec (> 100) Current 3 runs: ok 8 - generates 35790 accessors/sec (> 100) Current 4th run: ok 8 - generates 39680 accessors/sec (> 100) Difference is small, so I'd say not worth investigating further.


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.