r44420 - in /trunk/libclass-accessor-perl: Changes MANIFEST META.yml README debian/changelog debian/control examples/benchmark lib/Class/Accessor.pm lib/Class/Accessor/Fast.pm lib/Class/Accessor/Faster.pm t/antlers.t
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Sun Sep 20 17:23:36 UTC 2009
Author: jawnsy-guest
Date: Sun Sep 20 17:23:28 2009
New Revision: 44420
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=44420
Log:
* New upstream release
+ Adds a Moose-like interface, including the "has" keyword
* Standards-Version 3.8.3 (no changes)
Added:
trunk/libclass-accessor-perl/t/antlers.t
- copied unchanged from r44419, branches/upstream/libclass-accessor-perl/current/t/antlers.t
Modified:
trunk/libclass-accessor-perl/Changes
trunk/libclass-accessor-perl/MANIFEST
trunk/libclass-accessor-perl/META.yml
trunk/libclass-accessor-perl/README
trunk/libclass-accessor-perl/debian/changelog
trunk/libclass-accessor-perl/debian/control
trunk/libclass-accessor-perl/examples/benchmark
trunk/libclass-accessor-perl/lib/Class/Accessor.pm
trunk/libclass-accessor-perl/lib/Class/Accessor/Fast.pm
trunk/libclass-accessor-perl/lib/Class/Accessor/Faster.pm
Modified: trunk/libclass-accessor-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-accessor-perl/Changes?rev=44420&op=diff
==============================================================================
--- trunk/libclass-accessor-perl/Changes (original)
+++ trunk/libclass-accessor-perl/Changes Sun Sep 20 17:23:28 2009
@@ -1,3 +1,6 @@
+0.34 Sat Sep 12 21:50:26 JST 2009
+ - add a Moose-like interface: I can haz "has"
+
0.33 Tue May 5 00:15:09 JST 2009
- small cleanups to fix RT#45592 and RT#43493
Modified: trunk/libclass-accessor-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-accessor-perl/MANIFEST?rev=44420&op=diff
==============================================================================
--- trunk/libclass-accessor-perl/MANIFEST (original)
+++ trunk/libclass-accessor-perl/MANIFEST Sun Sep 20 17:23:28 2009
@@ -10,6 +10,7 @@
README
t/accessors.t
t/aliases.t
+t/antlers.t
t/bestpractice.t
t/croak.t
t/getset.t
Modified: trunk/libclass-accessor-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-accessor-perl/META.yml?rev=44420&op=diff
==============================================================================
--- trunk/libclass-accessor-perl/META.yml (original)
+++ trunk/libclass-accessor-perl/META.yml Sun Sep 20 17:23:28 2009
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Class-Accessor
-version: 0.33
+version: 0.34
abstract: ~
license: perl
author:
Modified: trunk/libclass-accessor-perl/README
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-accessor-perl/README?rev=44420&op=diff
==============================================================================
--- trunk/libclass-accessor-perl/README (original)
+++ trunk/libclass-accessor-perl/README Sun Sep 20 17:23:28 2009
@@ -25,23 +25,17 @@
Done. My::Class now has simple foo(), bar() and car() accessors defined.
-BENCHMARKS
+ If you prefer a Moose-like interface you can do this instead:
- accessors:
- Rate Basic Fast Faster Direct
- Basic 367589/s -- -51% -55% -89%
- Fast 747964/s 103% -- -9% -77%
- Faster 819199/s 123% 10% -- -75%
- Direct 3245887/s 783% 334% 296% --
+ package My::Class;
+ use Class::Accessor "moose-like";
+ has foo => ( is => "rw" );
+ has bar => ( is => "rw" );
+ has car => ( is => "rw" );
- mutators:
- Rate Acc Fast Faster Direct
- Acc 265564/s -- -54% -63% -91%
- Fast 573439/s 116% -- -21% -80%
- Faster 724710/s 173% 26% -- -75%
- Direct 2860979/s 977% 399% 295% --
+ Done, again.
-AUTHORS
+AUTHOR
Copyright 2009 Marty Pauley <marty+perl at kasei.com>
@@ -49,7 +43,3 @@
under the same terms as Perl itself. That means either (a) the GNU
General Public License or (b) the Artistic License.
-ORIGINAL AUTHOR
-
- Michael G Schwern <schwern at pobox.com>
-
Modified: trunk/libclass-accessor-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-accessor-perl/debian/changelog?rev=44420&op=diff
==============================================================================
--- trunk/libclass-accessor-perl/debian/changelog (original)
+++ trunk/libclass-accessor-perl/debian/changelog Sun Sep 20 17:23:28 2009
@@ -1,8 +1,11 @@
-libclass-accessor-perl (0.33-2) UNRELEASED; urgency=low
+libclass-accessor-perl (0.34-1) UNRELEASED; urgency=low
+ [ Jonathan Yu ]
+ * New upstream release
+ + Adds a Moose-like interface, including the "has" keyword
* Added myself to Uploaders and Copyright
* Cleaned up description in control
- * Standards-Version 3.8.2 (no changes)
+ * Standards-Version 3.8.3 (no changes)
* Quilt patch no longer necessary, was fixed upstream (Closes: #538636)
See also: the CPAN RT#29582 (remove quilt dependency)
* Use shorter debhelper rules format
@@ -18,7 +21,7 @@
[ Ryan Niebur ]
* Update jawnsy's email address
- -- Ryan Niebur <ryanryan52 at gmail.com> Tue, 01 Sep 2009 21:18:19 -0700
+ -- Jonathan Yu <jawnsy at cpan.org> Sun, 20 Sep 2009 09:22:44 -0400
libclass-accessor-perl (0.33-1) unstable; urgency=low
Modified: trunk/libclass-accessor-perl/debian/control
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-accessor-perl/debian/control?rev=44420&op=diff
==============================================================================
--- trunk/libclass-accessor-perl/debian/control (original)
+++ trunk/libclass-accessor-perl/debian/control Sun Sep 20 17:23:28 2009
@@ -1,24 +1,22 @@
Source: libclass-accessor-perl
Section: perl
Priority: optional
+Build-Depends: debhelper (>= 7)
+Build-Depends-Indep: perl, libsub-name-perl
Maintainer: Debian Perl Group <pkg-perl-maintainers at lists.alioth.debian.org>
Uploaders: Krzysztof Krzyżaniak (eloy) <eloy at debian.org>,
gregor herrmann <gregoa at debian.org>, Jonathan Yu <jawnsy at cpan.org>
-Build-Depends: debhelper (>= 7)
-Build-Depends-Indep: perl, libsub-name-perl
-Standards-Version: 3.8.2
+Standards-Version: 3.8.3
Homepage: http://search.cpan.org/dist/Class-Accessor/
Vcs-Svn: svn://svn.debian.org/pkg-perl/trunk/libclass-accessor-perl/
Vcs-Browser: http://svn.debian.org/viewsvn/pkg-perl/trunk/libclass-accessor-perl/
Package: libclass-accessor-perl
Architecture: all
-Depends: ${misc:Depends}, perl (>= 5.6.1-7), libsub-name-perl
-Description: Automated accessor generator
+Depends: ${misc:Depends}, ${perl:Depends}, libsub-name-perl
+Description: Perl module that automatically generates accessors
Class::Accessor automagically generates accessor/mutator methods for your
- class.
- .
- Most of the time, writing accessors is an exercise in cutting and pasting.
- If you make your module a subclass of Class::Accessor and declare your
- accessor fields with mk_accessors() then you will find yourself with a set
- of automatically generated accessors which can even be customized.
+ class. Most of the time, writing accessors is an exercise in cutting and
+ pasting. If you make your module a subclass of Class::Accessor and declare
+ your accessor fields with mk_accessors() then you will find yourself with a
+ set of automatically generated accessors which can even be customized.
Modified: trunk/libclass-accessor-perl/examples/benchmark
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-accessor-perl/examples/benchmark?rev=44420&op=diff
==============================================================================
--- trunk/libclass-accessor-perl/examples/benchmark (original)
+++ trunk/libclass-accessor-perl/examples/benchmark Sun Sep 20 17:23:28 2009
@@ -10,50 +10,43 @@
package Bench::Direct;
use base qw(Bench::Base);
-package Bench::Class::Accessor;
-use base qw(Class::Accessor);
-__PACKAGE__->mk_accessors(qw(test));
+package Bench::Normal;
+use Class::Accessor "moose-like";
+has test => (is => "rw");
+package Bench::Fast;
+use Class::Accessor::Fast "moose-like";
+has test => (is => "rw");
-package Bench::Class::Accessor::Fast;
-use base qw(Class::Accessor::Fast);
-__PACKAGE__->mk_accessors(qw(test));
+package Bench::Faster;
+use Class::Accessor::Faster "antlers";
+has test => (is => "rw");
-package Bench::Class::Accessor::Faster;
-use base qw(Class::Accessor::Faster);
-__PACKAGE__->mk_accessors(qw(test));
+package Bench::Moose;
+use Moose;
+has test => (is => "rw");
-my %init = ( test => 23 );
-my $ca = Bench::Class::Accessor->new(\%init);
-my $fast = Bench::Class::Accessor::Fast->new(\%init);
-my $faster = Bench::Class::Accessor::Faster->new(\%init);
-my $direct = Bench::Direct->new;
-
-my $foo;
-my $control = 42;
-
+package Bench::Mouse;
+use Mouse;
+has test => (is => "rw");
package main;
+use strict;
use Benchmark 'cmpthese';
-use strict;
+
+my $tmp;
+my $direct = Bench::Direct->new({ test => 23 });
+my %accessor = ( Direct => sub { $tmp = $direct->{test}; } );
+my %mutator = ( Direct => sub { $direct->{test} = 42; } );
+for my $p (qw/Normal Fast Faster Moose Mouse/) {
+ my $o = "Bench::$p"->new({ test => 23 });
+ $accessor{$p} = sub { $tmp = $o->test; };
+ $mutator{$p} = sub { $o->test(42); };
+}
print "accessors:\n";
-cmpthese( -1,
- {
- 'Basic' => sub { $foo = $ca->test; },
- 'Fast' => sub { $foo = $fast->test; },
- 'Faster' => sub { $foo = $faster->test; },
- 'Direct' => sub { $foo = $direct->{test}; }
- }
- );
+cmpthese( -10, \%accessor );
+print "\n";
+print "mutators:\n";
+cmpthese( -10, \%mutator );
-print "mutators:\n";
-cmpthese( -1,
- {
- 'Acc' => sub { $ca->test(42); },
- 'Fast' => sub { $fast->test(42); },
- 'Faster' => sub { $faster->test(42); },
- 'Direct' => sub { $direct->{test} = 42; }
- }
- );
-
Modified: trunk/libclass-accessor-perl/lib/Class/Accessor.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-accessor-perl/lib/Class/Accessor.pm?rev=44420&op=diff
==============================================================================
--- trunk/libclass-accessor-perl/lib/Class/Accessor.pm (original)
+++ trunk/libclass-accessor-perl/lib/Class/Accessor.pm Sun Sep 20 17:23:28 2009
@@ -1,127 +1,7 @@
package Class::Accessor;
require 5.00502;
use strict;
-$Class::Accessor::VERSION = '0.33';
-
-=head1 NAME
-
- Class::Accessor - Automated accessor generation
-
-=head1 SYNOPSIS
-
- package Foo;
- use base qw(Class::Accessor);
- Foo->follow_best_practice;
- Foo->mk_accessors(qw(name role salary));
-
- # Meanwhile, in a nearby piece of code!
- # Class::Accessor provides new().
- my $mp = Foo->new({ name => "Marty", role => "JAPH" });
-
- my $job = $mp->role; # gets $mp->{role}
- $mp->salary(400000); # sets $mp->{salary} = 400000 # I wish
-
- # like my @info = @{$mp}{qw(name role)}
- my @info = $mp->get(qw(name role));
-
- # $mp->{salary} = 400000
- $mp->set('salary', 400000);
-
-
-=head1 DESCRIPTION
-
-This module automagically generates accessors/mutators for your class.
-
-Most of the time, writing accessors is an exercise in cutting and
-pasting. You usually wind up with a series of methods like this:
-
- sub name {
- my $self = shift;
- if(@_) {
- $self->{name} = $_[0];
- }
- return $self->{name};
- }
-
- sub salary {
- my $self = shift;
- if(@_) {
- $self->{salary} = $_[0];
- }
- return $self->{salary};
- }
-
- # etc...
-
-One for each piece of data in your object. While some will be unique,
-doing value checks and special storage tricks, most will simply be
-exercises in repetition. Not only is it Bad Style to have a bunch of
-repetitious code, but it's also simply not lazy, which is the real
-tragedy.
-
-If you make your module a subclass of Class::Accessor and declare your
-accessor fields with mk_accessors() then you'll find yourself with a
-set of automatically generated accessors which can even be
-customized!
-
-The basic set up is very simple:
-
- package Foo;
- use base qw(Class::Accessor);
- Foo->mk_accessors( qw(far bar car) );
-
-Done. Foo now has simple far(), bar() and car() accessors
-defined.
-
-Alternatively, if you want to follow Damian's I<best practice> guidelines
-you can use:
-
- package Foo;
- use base qw(Class::Accessor);
- Foo->follow_best_practice;
- Foo->mk_accessors( qw(far bar car) );
-
-B<Note:> you must call C<follow_best_practice> before calling C<mk_accessors>.
-
-=head2 What Makes This Different?
-
-What makes this module special compared to all the other method
-generating modules (L<"SEE ALSO">)? By overriding the get() and set()
-methods you can alter the behavior of the accessors class-wide. Also,
-the accessors are implemented as closures which should cost a bit less
-memory than most other solutions which generate a new method for each
-accessor.
-
-
-=head1 METHODS
-
-=head2 new
-
- my $obj = Foo->new;
- my $obj = $other_obj->new;
-
- my $obj = Foo->new(\%fields);
- my $obj = $other_obj->new(\%fields);
-
-Class::Accessor provides a basic constructor. It generates a
-hash-based object and can be called as either a class method or an
-object method.
-
-It takes an optional %fields hash which is used to initialize the
-object (handy if you use read-only accessors). The fields of the hash
-correspond to the names of your accessors, so...
-
- package Foo;
- use base qw(Class::Accessor);
- Foo->mk_accessors('foo');
-
- my $obj = Foo->new({ foo => 42 });
- print $obj->foo; # 42
-
-however %fields can contain anything, new() will shove them all into
-your object. Don't like it? Override it.
-
-=cut
+$Class::Accessor::VERSION = '0.34';
sub new {
my($proto, $fields) = @_;
@@ -133,23 +13,6 @@
bless {%$fields}, $class;
}
-=head2 mk_accessors
-
- __PACKAGE__->mk_accessors(@fields);
-
-This creates accessor/mutator methods for each named field given in
- at fields. Foreach field in @fields it will generate two accessors.
-One called "field()" and the other called "_field_accessor()". For
-example:
-
- # Generates foo(), _foo_accessor(), bar() and _bar_accessor().
- __PACKAGE__->mk_accessors(qw(foo bar));
-
-See L<CAVEATS AND TRICKS/"Overriding autogenerated accessors">
-for details.
-
-=cut
-
sub mk_accessors {
my($self, @fields) = @_;
@@ -162,6 +25,28 @@
{
no strict 'refs';
+
+ sub import {
+ my ($class, @what) = @_;
+ my $caller = caller;
+ for (@what) {
+ if (/^(?:antlers|moose-?like)$/i) {
+ *{"${caller}::has"} = sub {
+ my ($f, %args) = @_;
+ $caller->_mk_accessors(($args{is}||"rw"), $f);
+ };
+ *{"${caller}::extends"} = sub {
+ @{"${caller}::ISA"} = @_;
+ unless (grep $_->can("_mk_accessors"), @_) {
+ push @{"${caller}::ISA"}, $class;
+ }
+ };
+ # we'll use their @ISA as a default, in case it happens to be
+ # set already
+ &{"${caller}::extends"}(@{"${caller}::ISA"});
+ }
+ }
+ }
sub follow_best_practice {
my($self) = @_;
@@ -223,7 +108,291 @@
}
-
+sub mk_ro_accessors {
+ my($self, @fields) = @_;
+
+ $self->_mk_accessors('ro', @fields);
+}
+
+sub mk_wo_accessors {
+ my($self, @fields) = @_;
+
+ $self->_mk_accessors('wo', @fields);
+}
+
+sub best_practice_accessor_name_for {
+ my ($class, $field) = @_;
+ return "get_$field";
+}
+
+sub best_practice_mutator_name_for {
+ my ($class, $field) = @_;
+ return "set_$field";
+}
+
+sub accessor_name_for {
+ my ($class, $field) = @_;
+ return $field;
+}
+
+sub mutator_name_for {
+ my ($class, $field) = @_;
+ return $field;
+}
+
+sub set {
+ my($self, $key) = splice(@_, 0, 2);
+
+ if(@_ == 1) {
+ $self->{$key} = $_[0];
+ }
+ elsif(@_ > 1) {
+ $self->{$key} = [@_];
+ }
+ else {
+ $self->_croak("Wrong number of arguments received");
+ }
+}
+
+sub get {
+ my $self = shift;
+
+ if(@_ == 1) {
+ return $self->{$_[0]};
+ }
+ elsif( @_ > 1 ) {
+ return @{$self}{@_};
+ }
+ else {
+ $self->_croak("Wrong number of arguments received");
+ }
+}
+
+sub make_accessor {
+ my ($class, $field) = @_;
+
+ return sub {
+ my $self = shift;
+
+ if(@_) {
+ return $self->set($field, @_);
+ } else {
+ return $self->get($field);
+ }
+ };
+}
+
+sub make_ro_accessor {
+ my($class, $field) = @_;
+
+ return sub {
+ my $self = shift;
+
+ if (@_) {
+ my $caller = caller;
+ $self->_croak("'$caller' cannot alter the value of '$field' on objects of class '$class'");
+ }
+ else {
+ return $self->get($field);
+ }
+ };
+}
+
+sub make_wo_accessor {
+ my($class, $field) = @_;
+
+ return sub {
+ my $self = shift;
+
+ unless (@_) {
+ my $caller = caller;
+ $self->_croak("'$caller' cannot access the value of '$field' on objects of class '$class'");
+ }
+ else {
+ return $self->set($field, @_);
+ }
+ };
+}
+
+
+use Carp ();
+
+sub _carp {
+ my ($self, $msg) = @_;
+ Carp::carp($msg || $self);
+ return;
+}
+
+sub _croak {
+ my ($self, $msg) = @_;
+ Carp::croak($msg || $self);
+ return;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+ Class::Accessor - Automated accessor generation
+
+=head1 SYNOPSIS
+
+ package Foo;
+ use base qw(Class::Accessor);
+ Foo->follow_best_practice;
+ Foo->mk_accessors(qw(name role salary));
+
+ # or if you prefer a Moose-like interface...
+
+ package Foo;
+ use Class::Accessor "antlers";
+ has name => ( is => "rw", isa => "Str" );
+ has role => ( is => "rw", isa => "Str" );
+ has salary => ( is => "rw", isa => "Num" );
+
+ # Meanwhile, in a nearby piece of code!
+ # Class::Accessor provides new().
+ my $mp = Foo->new({ name => "Marty", role => "JAPH" });
+
+ my $job = $mp->role; # gets $mp->{role}
+ $mp->salary(400000); # sets $mp->{salary} = 400000 # I wish
+
+ # like my @info = @{$mp}{qw(name role)}
+ my @info = $mp->get(qw(name role));
+
+ # $mp->{salary} = 400000
+ $mp->set('salary', 400000);
+
+
+=head1 DESCRIPTION
+
+This module automagically generates accessors/mutators for your class.
+
+Most of the time, writing accessors is an exercise in cutting and
+pasting. You usually wind up with a series of methods like this:
+
+ sub name {
+ my $self = shift;
+ if(@_) {
+ $self->{name} = $_[0];
+ }
+ return $self->{name};
+ }
+
+ sub salary {
+ my $self = shift;
+ if(@_) {
+ $self->{salary} = $_[0];
+ }
+ return $self->{salary};
+ }
+
+ # etc...
+
+One for each piece of data in your object. While some will be unique,
+doing value checks and special storage tricks, most will simply be
+exercises in repetition. Not only is it Bad Style to have a bunch of
+repetitious code, but it's also simply not lazy, which is the real
+tragedy.
+
+If you make your module a subclass of Class::Accessor and declare your
+accessor fields with mk_accessors() then you'll find yourself with a
+set of automatically generated accessors which can even be
+customized!
+
+The basic set up is very simple:
+
+ package Foo;
+ use base qw(Class::Accessor);
+ Foo->mk_accessors( qw(far bar car) );
+
+Done. Foo now has simple far(), bar() and car() accessors
+defined.
+
+Alternatively, if you want to follow Damian's I<best practice> guidelines
+you can use:
+
+ package Foo;
+ use base qw(Class::Accessor);
+ Foo->follow_best_practice;
+ Foo->mk_accessors( qw(far bar car) );
+
+B<Note:> you must call C<follow_best_practice> before calling C<mk_accessors>.
+
+=head2 Moose-like
+
+By popular demand we now have a simple Moose-like interface. You can now do:
+
+ package Foo;
+ use Class::Accessor "antlers";
+ has far => ( is => "rw" );
+ has bar => ( is => "rw" );
+ has car => ( is => "rw" );
+
+Currently only the C<is> attribute is supported.
+
+=head1 CONSTRUCTOR
+
+Class::Accessor provides a basic constructor, C<new>. It generates a
+hash-based object and can be called as either a class method or an
+object method.
+
+=head2 new
+
+ my $obj = Foo->new;
+ my $obj = $other_obj->new;
+
+ my $obj = Foo->new(\%fields);
+ my $obj = $other_obj->new(\%fields);
+
+It takes an optional %fields hash which is used to initialize the
+object (handy if you use read-only accessors). The fields of the hash
+correspond to the names of your accessors, so...
+
+ package Foo;
+ use base qw(Class::Accessor);
+ Foo->mk_accessors('foo');
+
+ my $obj = Foo->new({ foo => 42 });
+ print $obj->foo; # 42
+
+however %fields can contain anything, new() will shove them all into
+your object.
+
+=head1 MAKING ACCESSORS
+
+=head2 follow_best_practice
+
+In Damian's Perl Best Practices book he recommends separate get and set methods
+with the prefix set_ and get_ to make it explicit what you intend to do. If you
+want to create those accessor methods instead of the default ones, call:
+
+ __PACKAGE__->follow_best_practice
+
+B<before> you call any of the accessor-making methods.
+
+=head2 accessor_name_for / mutator_name_for
+
+You may have your own crazy ideas for the names of the accessors, so you can
+make those happen by overriding C<accessor_name_for> and C<mutator_name_for> in
+your subclass. (I copied that idea from Class::DBI.)
+
+=head2 mk_accessors
+
+ __PACKAGE__->mk_accessors(@fields);
+
+This creates accessor/mutator methods for each named field given in
+ at fields. Foreach field in @fields it will generate two accessors.
+One called "field()" and the other called "_field_accessor()". For
+example:
+
+ # Generates foo(), _foo_accessor(), bar() and _bar_accessor().
+ __PACKAGE__->mk_accessors(qw(foo bar));
+
+See L<CAVEATS AND TRICKS/"Overriding autogenerated accessors">
+for details.
=head2 mk_ro_accessors
@@ -243,14 +412,6 @@
$foo->foo(42); # BOOM! Naughty you.
-=cut
-
-sub mk_ro_accessors {
- my($self, @fields) = @_;
-
- $self->_mk_accessors('ro', @fields);
-}
-
=head2 mk_wo_accessors
__PACKAGE__->mk_wo_accessors(@write_only_fields);
@@ -271,13 +432,34 @@
$foo->foo(42); # OK. Sets $self->{foo} = 42
print $foo->foo; # BOOM! Can't read from this accessor.
-=cut
-
-sub mk_wo_accessors {
- my($self, @fields) = @_;
-
- $self->_mk_accessors('wo', @fields);
-}
+=head1 Moose!
+
+If you prefer a Moose-like interface to create accessors, you can use C<has> by
+importing this module like this:
+
+ use Class::Accessor "antlers";
+
+or
+
+ use Class::Accessor "moose-like";
+
+Then you can declare accessors like this:
+
+ has alpha => ( is => "rw", isa => "Str" );
+ has beta => ( is => "ro", isa => "Str" );
+ has gamma => ( is => "wo", isa => "Str" );
+
+Currently only the C<is> attribute is supported. And our C<is> also supports
+the "wo" value to make a write-only accessor.
+
+If you are using the Moose-like interface then you should use the C<extends>
+rather than tweaking your C<@ISA> directly. Basically, replace
+
+ @ISA = qw/Foo Bar/;
+
+with
+
+ extends(qw/Foo Bar/);
=head1 DETAILS
@@ -300,44 +482,6 @@
Class::Accessor provides default get() and set() methods which
your class can override. They're detailed later.
-=head2 follow_best_practice
-
-In Damian's Perl Best Practices book he recommends separate get and set methods
-with the prefix set_ and get_ to make it explicit what you intend to do. If you
-want to create those accessor methods instead of the default ones, call:
-
- __PACKAGE__->follow_best_practice
-
-B<before> you call mk_accessors.
-
-=head2 accessor_name_for / mutator_name_for
-
-You may have your own crazy ideas for the names of the accessors, so you can
-make those happen by overriding C<accessor_name_for> and C<mutator_name_for> in
-your subclass. (I copied that idea from Class::DBI.)
-
-=cut
-
-sub best_practice_accessor_name_for {
- my ($class, $field) = @_;
- return "get_$field";
-}
-
-sub best_practice_mutator_name_for {
- my ($class, $field) = @_;
- return "set_$field";
-}
-
-sub accessor_name_for {
- my ($class, $field) = @_;
- return $field;
-}
-
-sub mutator_name_for {
- my ($class, $field) = @_;
- return $field;
-}
-
=head2 Modifying the behavior of the accessor
Rather than actually modifying the accessor itself, it is much more
@@ -355,22 +499,6 @@
override this method to change how data is stored by your accessors.
-=cut
-
-sub set {
- my($self, $key) = splice(@_, 0, 2);
-
- if(@_ == 1) {
- $self->{$key} = $_[0];
- }
- elsif(@_ > 1) {
- $self->{$key} = [@_];
- }
- else {
- $self->_croak("Wrong number of arguments received");
- }
-}
-
=head2 get
$value = $obj->get($key);
@@ -380,22 +508,6 @@
override this method to change how it is retreived.
-=cut
-
-sub get {
- my $self = shift;
-
- if(@_ == 1) {
- return $self->{$_[0]};
- }
- elsif( @_ > 1 ) {
- return @{$self}{@_};
- }
- else {
- $self->_croak("Wrong number of arguments received");
- }
-}
-
=head2 make_accessor
$accessor = __PACKAGE__->make_accessor($field);
@@ -406,24 +518,6 @@
If you wish to change the behavior of your accessors, try overriding
get() and set() before you start mucking with make_accessor().
-=cut
-
-sub make_accessor {
- my ($class, $field) = @_;
-
- # Build a closure around $field.
- return sub {
- my $self = shift;
-
- if(@_) {
- return $self->set($field, @_);
- }
- else {
- return $self->get($field);
- }
- };
-}
-
=head2 make_ro_accessor
$read_only_accessor = __PACKAGE__->make_ro_accessor($field);
@@ -433,24 +527,6 @@
Override get() to change the behavior of your accessors.
-=cut
-
-sub make_ro_accessor {
- my($class, $field) = @_;
-
- return sub {
- my $self = shift;
-
- if (@_) {
- my $caller = caller;
- $self->_croak("'$caller' cannot alter the value of '$field' on objects of class '$class'");
- }
- else {
- return $self->get($field);
- }
- };
-}
-
=head2 make_wo_accessor
$read_only_accessor = __PACKAGE__->make_wo_accessor($field);
@@ -459,46 +535,12 @@
(mutator) for the given $field. It only calls set().
Override set() to change the behavior of your accessors.
-
-=cut
-
-sub make_wo_accessor {
- my($class, $field) = @_;
-
- return sub {
- my $self = shift;
-
- unless (@_) {
- my $caller = caller;
- $self->_croak("'$caller' cannot access the value of '$field' on objects of class '$class'");
- }
- else {
- return $self->set($field, @_);
- }
- };
-}
=head1 EXCEPTIONS
If something goes wrong Class::Accessor will warn or die by calling Carp::carp
or Carp::croak. If you don't like this you can override _carp() and _croak() in
your subclass and do whatever else you want.
-
-=cut
-
-use Carp ();
-
-sub _carp {
- my ($self, $msg) = @_;
- Carp::carp($msg || $self);
- return;
-}
-
-sub _croak {
- my ($self, $msg) = @_;
- Carp::croak($msg || $self);
- return;
-}
=head1 EFFICIENCY
@@ -670,7 +712,7 @@
=head1 AUTHORS
-Copyright 2007 Marty Pauley <marty+perl at kasei.com>
+Copyright 2009 Marty Pauley <marty+perl at kasei.com>
This program is free software; you can redistribute it and/or modify it under
the same terms as Perl itself. That means either (a) the GNU General Public
@@ -686,17 +728,17 @@
Tels, for his big feature request/bug report.
+Various presenters at YAPC::Asia 2009 for criticising the non-Moose interface.
=head1 SEE ALSO
-L<Class::Accessor::Fast>
+See L<Class::Accessor::Fast> and L<Class::Accessor::Faster> if speed is more
+important than flexibility.
These are some modules which do similar things in different ways
L<Class::Struct>, L<Class::Methodmaker>, L<Class::Generate>,
-L<Class::Class>, L<Class::Contract>
-
-L<Class::DBI> for an example of this module in use.
+L<Class::Class>, L<Class::Contract>, L<Moose>, L<Mouse>
+
+See L<Class::DBI> for an example of this module in use.
=cut
-
-1;
Modified: trunk/libclass-accessor-perl/lib/Class/Accessor/Fast.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-accessor-perl/lib/Class/Accessor/Fast.pm?rev=44420&op=diff
==============================================================================
--- trunk/libclass-accessor-perl/lib/Class/Accessor/Fast.pm (original)
+++ trunk/libclass-accessor-perl/lib/Class/Accessor/Fast.pm Sun Sep 20 17:23:28 2009
@@ -1,43 +1,14 @@
package Class::Accessor::Fast;
use base 'Class::Accessor';
use strict;
-$Class::Accessor::Fast::VERSION = '0.33';
-
-=head1 NAME
-
-Class::Accessor::Fast - Faster, but less expandable, accessors
-
-=head1 SYNOPSIS
-
- package Foo;
- use base qw(Class::Accessor::Fast);
-
- # The rest is the same as Class::Accessor but without set() and get().
-
-=head1 DESCRIPTION
-
-This is a faster but less expandable version of Class::Accessor.
-Class::Accessor's generated accessors require two method calls to accompish
-their task (one for the accessor, another for get() or set()).
-Class::Accessor::Fast eliminates calling set()/get() and does the access itself,
-resulting in a somewhat faster accessor.
-
-The downside is that you can't easily alter the behavior of your
-accessors, nor can your subclasses. Of course, should you need this
-later, you can always swap out Class::Accessor::Fast for
-Class::Accessor.
-
-Read the documentation for Class::Accessor for more info.
-
-=cut
+$Class::Accessor::Fast::VERSION = '0.34';
sub make_accessor {
my($class, $field) = @_;
return sub {
- return $_[0]->{$field} if @_ == 1;
- return $_[0]->{$field} = $_[1] if @_ == 2;
- return (shift)->{$field} = \@_;
+ return $_[0]->{$field} if scalar(@_) == 1;
+ return $_[0]->{$field} = scalar(@_) == 2 ? $_[1] : [@_[1..$#_]];
};
}
@@ -69,6 +40,36 @@
}
+1;
+
+__END__
+
+=head1 NAME
+
+Class::Accessor::Fast - Faster, but less expandable, accessors
+
+=head1 SYNOPSIS
+
+ package Foo;
+ use base qw(Class::Accessor::Fast);
+
+ # The rest is the same as Class::Accessor but without set() and get().
+
+=head1 DESCRIPTION
+
+This is a faster but less expandable version of Class::Accessor.
+Class::Accessor's generated accessors require two method calls to accompish
+their task (one for the accessor, another for get() or set()).
+Class::Accessor::Fast eliminates calling set()/get() and does the access itself,
+resulting in a somewhat faster accessor.
+
+The downside is that you can't easily alter the behavior of your
+accessors, nor can your subclasses. Of course, should you need this
+later, you can always swap out Class::Accessor::Fast for
+Class::Accessor.
+
+Read the documentation for Class::Accessor for more info.
+
=head1 EFFICIENCY
L<Class::Accessor/EFFICIENCY> for an efficiency comparison.
@@ -90,5 +91,3 @@
L<Class::Accessor>
=cut
-
-1;
Modified: trunk/libclass-accessor-perl/lib/Class/Accessor/Faster.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-accessor-perl/lib/Class/Accessor/Faster.pm?rev=44420&op=diff
==============================================================================
--- trunk/libclass-accessor-perl/lib/Class/Accessor/Faster.pm (original)
+++ trunk/libclass-accessor-perl/lib/Class/Accessor/Faster.pm Sun Sep 20 17:23:28 2009
@@ -1,32 +1,7 @@
package Class::Accessor::Faster;
use base 'Class::Accessor';
use strict;
-$Class::Accessor::Faster::VERSION = '0.33';
-
-=head1 NAME
-
-Class::Accessor::Faster - Even faster, but less expandable, accessors
-
-=head1 SYNOPSIS
-
- package Foo;
- use base qw(Class::Accessor::Faster);
-
-=head1 DESCRIPTION
-
-This is a faster but less expandable version of Class::Accessor::Fast.
-
-Class::Accessor's generated accessors require two method calls to accompish
-their task (one for the accessor, another for get() or set()).
-
-Class::Accessor::Fast eliminates calling set()/get() and does the access itself,
-resulting in a somewhat faster accessor.
-
-Class::Accessor::Faster uses an array reference underneath to be faster.
-
-Read the documentation for Class::Accessor for more info.
-
-=cut
+$Class::Accessor::Faster::VERSION = '0.34';
my %slot;
sub _slot {
@@ -55,12 +30,10 @@
my($class, $field) = @_;
my $n = $class->_slot($field);
return sub {
- return $_[0]->[$n] if @_ == 1;
- return $_[0]->[$n] = $_[1] if @_ == 2;
- return (shift)->[$n] = \@_;
+ return $_[0]->[$n] if scalar(@_) == 1;
+ return $_[0]->[$n] = scalar(@_) == 2 ? $_[1] : [@_[1..$#_]];
};
}
-
sub make_ro_accessor {
my($class, $field) = @_;
@@ -71,7 +44,6 @@
$_[0]->_croak("'$caller' cannot alter the value of '$field' on objects of class '$class'");
};
}
-
sub make_wo_accessor {
my($class, $field) = @_;
@@ -87,6 +59,32 @@
};
}
+1;
+
+__END__
+
+=head1 NAME
+
+Class::Accessor::Faster - Even faster, but less expandable, accessors
+
+=head1 SYNOPSIS
+
+ package Foo;
+ use base qw(Class::Accessor::Faster);
+
+=head1 DESCRIPTION
+
+This is a faster but less expandable version of Class::Accessor::Fast.
+
+Class::Accessor's generated accessors require two method calls to accompish
+their task (one for the accessor, another for get() or set()).
+
+Class::Accessor::Fast eliminates calling set()/get() and does the access itself,
+resulting in a somewhat faster accessor.
+
+Class::Accessor::Faster uses an array reference underneath to be faster.
+
+Read the documentation for Class::Accessor for more info.
=head1 AUTHORS
@@ -101,5 +99,3 @@
L<Class::Accessor>
=cut
-
-1;
More information about the Pkg-perl-cvs-commits
mailing list