r27987 - in /trunk/libmoosex-emulate-class-accessor-fast-perl: Changes META.yml debian/changelog lib/MooseX/Emulate/Class/Accessor/Fast.pm t/getset.t

[eloy at users.alioth.debian.org]

Author: eloy
Date: Wed Dec 10 10:50:55 2008
New Revision: 27987

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=27987
Log:
new upstream version

Modified:
    trunk/libmoosex-emulate-class-accessor-fast-perl/Changes
    trunk/libmoosex-emulate-class-accessor-fast-perl/META.yml
    trunk/libmoosex-emulate-class-accessor-fast-perl/debian/changelog
    trunk/libmoosex-emulate-class-accessor-fast-perl/lib/MooseX/Emulate/Class/Accessor/Fast.pm
    trunk/libmoosex-emulate-class-accessor-fast-perl/t/getset.t

Modified: trunk/libmoosex-emulate-class-accessor-fast-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmoosex-emulate-class-accessor-fast-perl/Changes?rev=27987&op=diff
==============================================================================
--- trunk/libmoosex-emulate-class-accessor-fast-perl/Changes (original)
+++ trunk/libmoosex-emulate-class-accessor-fast-perl/Changes Wed Dec 10 10:50:55 2008
@@ -1,3 +1,6 @@
+0.00500    Dec 9, 2008
+          - make_accessor, make_ro_accessor, make_rw_accessor
+            - tests
 0.00400    Oct 28, 2008
            - Fix bug where a bad assumption was causing us to infinitely loop
              on badly-written code like Data::Page. (Reported by marcus)

Modified: trunk/libmoosex-emulate-class-accessor-fast-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmoosex-emulate-class-accessor-fast-perl/META.yml?rev=27987&op=diff
==============================================================================
--- trunk/libmoosex-emulate-class-accessor-fast-perl/META.yml (original)
+++ trunk/libmoosex-emulate-class-accessor-fast-perl/META.yml Wed Dec 10 10:50:55 2008
@@ -19,4 +19,4 @@
   Moose: 0.31
 resources:
   license: http://dev.perl.org/licenses/
-version: 0.00400
+version: 0.00500

Modified: trunk/libmoosex-emulate-class-accessor-fast-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmoosex-emulate-class-accessor-fast-perl/debian/changelog?rev=27987&op=diff
==============================================================================
--- trunk/libmoosex-emulate-class-accessor-fast-perl/debian/changelog (original)
+++ trunk/libmoosex-emulate-class-accessor-fast-perl/debian/changelog Wed Dec 10 10:50:55 2008
@@ -1,3 +1,9 @@
+libmoosex-emulate-class-accessor-fast-perl (0.00500-1) UNRELEASED; urgency=low
+
+  * New upstream release
+
+ -- Krzysztof Krzyżaniak (eloy) <eloy at debian.org>  Wed, 10 Dec 2008 11:50:03 +0100
+
 libmoosex-emulate-class-accessor-fast-perl (0.00400-1) unstable; urgency=low
 
   [ Krzysztof Krzyżaniak (eloy) <eloy at debian.org> ]

Modified: trunk/libmoosex-emulate-class-accessor-fast-perl/lib/MooseX/Emulate/Class/Accessor/Fast.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmoosex-emulate-class-accessor-fast-perl/lib/MooseX/Emulate/Class/Accessor/Fast.pm?rev=27987&op=diff
==============================================================================
--- trunk/libmoosex-emulate-class-accessor-fast-perl/lib/MooseX/Emulate/Class/Accessor/Fast.pm (original)
+++ trunk/libmoosex-emulate-class-accessor-fast-perl/lib/MooseX/Emulate/Class/Accessor/Fast.pm Wed Dec 10 10:50:55 2008
@@ -2,7 +2,7 @@
 
 use Moose::Role;
 
-our $VERSION = '0.00400';
+our $VERSION = '0.00500';
 
 =head1 NAME
 
@@ -226,6 +226,36 @@
   return @values;
 }
 
+sub make_accessor {
+  my($class, $field) = @_;
+  my $meta = $class->meta;
+  my $attr = $meta->find_attribute_by_name($field) || $meta->add_attribute($field); 
+  my $reader = $attr->get_read_method_ref;
+  my $writer = $attr->get_write_method_ref;
+  return sub {
+    my $self = shift;
+    return $reader->($self) unless @_;
+    return $writer->($self,(@_ > 1 ? [@_] : @_));
+  }
+}
+
+
+sub make_ro_accessor {
+  my($class, $field) = @_;
+  my $meta = $class->meta;
+  my $attr = $meta->find_attribute_by_name($field) || $meta->add_attribute($field); 
+  return $attr->get_read_method_ref;
+}
+
+
+sub make_wo_accessor {
+  my($class, $field) = @_;
+  my $meta = $class->meta;
+  my $attr = $meta->find_attribute_by_name($field) || $meta->add_attribute($field); 
+  return $attr->get_write_method_ref;
+}
+
+
 1;
 
 =head2 meta

Modified: trunk/libmoosex-emulate-class-accessor-fast-perl/t/getset.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmoosex-emulate-class-accessor-fast-perl/t/getset.t?rev=27987&op=diff
==============================================================================
--- trunk/libmoosex-emulate-class-accessor-fast-perl/t/getset.t (original)
+++ trunk/libmoosex-emulate-class-accessor-fast-perl/t/getset.t Wed Dec 10 10:50:55 2008
@@ -1,14 +1,30 @@
 #!perl
 use strict;
-use Test::More tests => 3;
+use Test::More tests => 9;
 
 require_ok("MooseX::Adopt::Class::Accessor::Fast");
+{
+  @Foo::ISA = qw(Class::Accessor::Fast);
+  Foo->mk_accessors(qw( foo ));
+  my $test = Foo->new({ foo => 49 });
+  is( $test->get('foo'), 49, "get initial foo");
+  $test->set('foo', 42);
+  is($test->get('foo'), 42, "get new foo");
+}
 
- at Foo::ISA = qw(Class::Accessor::Fast);
-Foo->mk_accessors(qw( foo ));
+{
+  @Bar::ISA = qw(Class::Accessor::Fast);
+  my $get_ref = Bar->make_ro_accessor('read');
+  my $set_ref = Bar->make_wo_accessor('write');
+  my $getset_ref = Bar->make_accessor('read_write');
 
-my $test = Foo->new({ foo => 49 });
+  ok(Bar->meta->has_attribute("read"),"has read");
+  ok(Bar->meta->has_attribute("write"),"has write");
+  ok(Bar->meta->has_attribute("read_write"),"has read_write");
 
-is( $test->get('foo'), 49, "get initial foo");
-$test->set('foo', 42);
-is($test->get('foo'), 42, "get new foo");
+  my $obj = Bar->new({read => 1, write => 2, read_write => 3});
+  is($get_ref->($obj), 1, "read get works");
+  is($getset_ref->($obj), 3, "read_write get works");
+  $getset_ref->($obj,2);
+  is($getset_ref->($obj), 2, "read_write set works");
+}