r45225 - in /branches/upstream/libmouse-perl/current: ./ author/ lib/ lib/Mouse/ lib/Mouse/Meta/ lib/Mouse/Meta/Method/ t/990_deprecated/

jawnsy-guest at users.alioth.debian.org jawnsy-guest at users.alioth.debian.org
Fri Oct 2 12:43:07 UTC 2009


Author: jawnsy-guest
Date: Fri Oct  2 12:42:58 2009
New Revision: 45225

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=45225
Log:
[svn-upgrade] Integrating new upstream version, libmouse-perl (0.37)

Added:
    branches/upstream/libmouse-perl/current/author/test-externals.pl   (with props)
Modified:
    branches/upstream/libmouse-perl/current/Changes
    branches/upstream/libmouse-perl/current/MANIFEST
    branches/upstream/libmouse-perl/current/MANIFEST.SKIP
    branches/upstream/libmouse-perl/current/META.yml
    branches/upstream/libmouse-perl/current/lib/Mouse.pm
    branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Attribute.pm
    branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Method/Constructor.pm
    branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Module.pm
    branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Role.pm
    branches/upstream/libmouse-perl/current/lib/Mouse/Role.pm
    branches/upstream/libmouse-perl/current/lib/Mouse/Spec.pm
    branches/upstream/libmouse-perl/current/lib/Mouse/Tiny.pm
    branches/upstream/libmouse-perl/current/lib/Mouse/Util.pm
    branches/upstream/libmouse-perl/current/t/990_deprecated/044-attribute-metaclass.t

Modified: branches/upstream/libmouse-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/Changes?rev=45225&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/Changes (original)
+++ branches/upstream/libmouse-perl/current/Changes Fri Oct  2 12:42:58 2009
@@ -1,4 +1,11 @@
 Revision history for Mouse
+
+0.37 Mon Sep 28 10:48:27 2009
+    * Ensure backward compatibility by author/test-externa.pl (gfx)
+
+    * Change the algorithm of has_method() for backward compatibility (gfx)
+
+    * $ENV{MOUSE_VERBOSE}=1 for Moose-compatible warnings (gfx)
 
 0.36 Sun Sep 27 16:53:06 2009
     * Fix an issue that breaks backward compatibility (gfx)

Modified: branches/upstream/libmouse-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/MANIFEST?rev=45225&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/MANIFEST (original)
+++ branches/upstream/libmouse-perl/current/MANIFEST Fri Oct  2 12:42:58 2009
@@ -2,6 +2,7 @@
 author/generate-mouse-tiny.pl
 author/he-profile.pl
 author/munge-tests-for-moose.pl
+author/test-externals.pl
 benchmarks/basic.pl
 benchmarks/modifiers.pl
 Changes

Modified: branches/upstream/libmouse-perl/current/MANIFEST.SKIP
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/MANIFEST.SKIP?rev=45225&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/MANIFEST.SKIP (original)
+++ branches/upstream/libmouse-perl/current/MANIFEST.SKIP Fri Oct  2 12:42:58 2009
@@ -44,3 +44,4 @@
 \.out$
 
 author/benchmarks
+author/externals

Modified: branches/upstream/libmouse-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/META.yml?rev=45225&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/META.yml (original)
+++ branches/upstream/libmouse-perl/current/META.yml Fri Oct  2 12:42:58 2009
@@ -1,7 +1,7 @@
 ---
 abstract: 'Moose minus the antlers'
 author:
-  - 'Shawn M Moore, C<< <sartak at gmail.com> >>'
+  - 'Shawn M Moore, <sartak at gmail.com>'
 build_requires:
   ExtUtils::MakeMaker: 6.42
   Test::Exception: 0.27
@@ -25,4 +25,4 @@
   perl: 5.6.2
 resources:
   license: http://dev.perl.org/licenses/
-version: 0.36
+version: 0.37

Added: branches/upstream/libmouse-perl/current/author/test-externals.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/author/test-externals.pl?rev=45225&op=file
==============================================================================
--- branches/upstream/libmouse-perl/current/author/test-externals.pl (added)
+++ branches/upstream/libmouse-perl/current/author/test-externals.pl Fri Oct  2 12:42:58 2009
@@ -1,0 +1,39 @@
+#!perl -w
+use strict;
+use FindBin qw($Bin);
+use autodie;
+
+my %dist = (
+    'HTTP-Engine' => q{git://github.com/http-engine/HTTP-Engine.git},
+    'Ark'         => q{git://github.com/typester/ark-perl.git},
+
+#    'Any-Moose'   => q{git://github.com/sartak/any-moose.git}, # has no Makefile.PL :(
+);
+
+my $distdir = 'externals';
+
+chdir $Bin;
+mkdir $distdir if not -e $distdir;
+
+$ENV{ANY_MOOSE} = 'Mouse';
+
+while(my($name, $repo) = each %dist){
+    chdir "$Bin/$distdir";
+
+    print "Go $name ($repo)\n";
+
+    if(!(-e "$name")){
+        system "git clone $repo $name";
+        chdir $name;
+    }
+    else{
+        chdir $name;
+        system "git pull";
+    }
+
+    print "$^X Makefile.PL\n";
+    system("$^X Makefile.PL");
+
+    print "make test\n";
+    system "make test";
+}

Propchange: branches/upstream/libmouse-perl/current/author/test-externals.pl
------------------------------------------------------------------------------
    svn:executable = *

Modified: branches/upstream/libmouse-perl/current/lib/Mouse.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/lib/Mouse.pm?rev=45225&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/lib/Mouse.pm (original)
+++ branches/upstream/libmouse-perl/current/lib/Mouse.pm Fri Oct  2 12:42:58 2009
@@ -4,14 +4,14 @@
 use strict;
 use warnings;
 
-our $VERSION = '0.36';
+our $VERSION = '0.37';
 
 use Exporter;
 
 use Carp 'confess';
 use Scalar::Util 'blessed';
 
-use Mouse::Util qw(load_class is_class_loaded not_supported);
+use Mouse::Util qw(load_class is_class_loaded get_code_package not_supported);
 
 use Mouse::Meta::Module;
 use Mouse::Meta::Class;
@@ -190,7 +190,7 @@
         my $code;
         if(exists $is_removable{$keyword}
             && ($code = $caller->can($keyword))
-            && (Mouse::Util::get_code_info($code))[0] eq __PACKAGE__){
+            && get_code_package($code) eq __PACKAGE__){
 
             delete $stash->{$keyword};
         }
@@ -454,9 +454,9 @@
 
 =head1 AUTHORS
 
-Shawn M Moore, C<< <sartak at gmail.com> >>
-
-Yuval Kogman, C<< <nothingmuch at woobling.org> >>
+Shawn M Moore, E<lt>sartak at gmail.comE<gt>
+
+Yuval Kogman, E<lt>nothingmuch at woobling.orgE<gt>
 
 tokuhirom
 
@@ -464,7 +464,7 @@
 
 wu-lee
 
-Goro Fuji (gfx) C<< <gfuji at cpan.org> >>
+Goro Fuji (gfx) E<lt>gfuji at cpan.orgE<gt>
 
 with plenty of code borrowed from L<Class::MOP> and L<Moose>
 

Modified: branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Attribute.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Attribute.pm?rev=45225&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Attribute.pm (original)
+++ branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Attribute.pm Fri Oct  2 12:42:58 2009
@@ -31,8 +31,12 @@
     my $can_be_required = defined( $args->{init_arg} );
 
     if(exists $args->{builder}){
+        # XXX:
+        # Moose refuses a CODE ref builder, but Mouse doesn't for backward compatibility
+        # This feature will be changed in a future. (gfx)
         $class->throw_error('builder must be a defined scalar value which is a method name')
-            if ref $args->{builder} || !(defined $args->{builder});
+            #if ref $args->{builder} || !defined $args->{builder};
+            if !defined $args->{builder};
 
         $can_be_required++;
     }

Modified: branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Method/Constructor.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Method/Constructor.pm?rev=45225&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Method/Constructor.pm (original)
+++ branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Method/Constructor.pm Fri Oct  2 12:42:58 2009
@@ -182,6 +182,7 @@
     my @code;
     for my $class ($metaclass->linearized_isa) {
         no strict 'refs';
+        no warnings 'once';
 
         if (*{ $class . '::BUILD' }{CODE}) {
             unshift  @code, qq{${class}::BUILD(\$instance, \$args);};

Modified: branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Module.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Module.pm?rev=45225&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Module.pm (original)
+++ branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Module.pm Fri Oct  2 12:42:58 2009
@@ -5,7 +5,7 @@
 use Carp ();
 use Scalar::Util qw/blessed weaken/;
 
-use Mouse::Util qw/:meta get_code_info not_supported load_class/;
+use Mouse::Util qw/:meta get_code_package not_supported load_class/;
 
 {
     my %METACLASS_CACHE;
@@ -97,13 +97,17 @@
     *{ $pkg . '::' . $name } = $code;
 }
 
-sub _code_is_mine { # taken from Class::MOP::Class
-    my ( $self, $code ) = @_;
-
-    my ( $code_package, $code_name ) = get_code_info($code);
-
-    return $code_package && $code_package eq $self->{package}
-        || ( $code_package eq 'constant' && $code_name eq '__ANON__' );
+# XXX: for backward compatibility
+my %foreign = map{ $_ => undef } qw(
+    Mouse Mouse::Role Mouse::Util Mouse::Util::TypeConstraints
+    Carp Scalar::Util
+);
+sub _code_is_mine{
+    my($self, $code) = @_;
+
+    my $package = get_code_package($code);
+
+    return !exists $foreign{$package};
 }
 
 sub has_method {
@@ -111,7 +115,7 @@
 
     return 1 if $self->{methods}->{$method_name};
 
-    my $code = $self->{package}->can($method_name);
+    my $code = do{ no strict 'refs'; *{$self->{package} . '::' . $method_name}{CODE} };
 
     return $code && $self->_code_is_mine($code);
 }

Modified: branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Role.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Role.pm?rev=45225&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Role.pm (original)
+++ branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Role.pm Fri Oct  2 12:42:58 2009
@@ -2,7 +2,7 @@
 use strict;
 use warnings;
 
-use Mouse::Util qw(:meta not_supported english_list);
+use Mouse::Util qw(:meta not_supported english_list get_code_info);
 use Mouse::Meta::Module;
 our @ISA = qw(Mouse::Meta::Module);
 

Modified: branches/upstream/libmouse-perl/current/lib/Mouse/Role.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/lib/Mouse/Role.pm?rev=45225&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/lib/Mouse/Role.pm (original)
+++ branches/upstream/libmouse-perl/current/lib/Mouse/Role.pm Fri Oct  2 12:42:58 2009
@@ -7,7 +7,7 @@
 use Carp 'confess';
 use Scalar::Util 'blessed';
 
-use Mouse::Util qw(load_class not_supported);
+use Mouse::Util qw(load_class get_code_package not_supported);
 use Mouse ();
 
 our @ISA = qw(Exporter);
@@ -150,7 +150,7 @@
         my $code;
         if(exists $is_removable{$keyword}
             && ($code = $caller->can($keyword))
-            && (Mouse::Util::get_code_info($code))[0] eq __PACKAGE__){
+            && get_code_package($code) eq __PACKAGE__){
 
             delete $stash->{$keyword};
         }

Modified: branches/upstream/libmouse-perl/current/lib/Mouse/Spec.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/lib/Mouse/Spec.pm?rev=45225&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/lib/Mouse/Spec.pm (original)
+++ branches/upstream/libmouse-perl/current/lib/Mouse/Spec.pm Fri Oct  2 12:42:58 2009
@@ -2,7 +2,7 @@
 use strict;
 use warnings;
 
-our $VERSION = '0.36';
+our $VERSION = '0.37';
 
 our $MouseVersion = $VERSION;
 our $MooseVersion = '0.90';

Modified: branches/upstream/libmouse-perl/current/lib/Mouse/Tiny.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/lib/Mouse/Tiny.pm?rev=45225&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/lib/Mouse/Tiny.pm (original)
+++ branches/upstream/libmouse-perl/current/lib/Mouse/Tiny.pm Fri Oct  2 12:42:58 2009
@@ -8,15 +8,15 @@
 $INC{'Mouse.pm'} = __FILE__;
 $INC{'Mouse/Object.pm'} = __FILE__;
 $INC{'Mouse/Role.pm'} = __FILE__;
+$INC{'Mouse/Util.pm'} = __FILE__;
+$INC{'Mouse/TypeRegistry.pm'} = __FILE__;
 $INC{'Mouse/Spec.pm'} = __FILE__;
-$INC{'Mouse/TypeRegistry.pm'} = __FILE__;
-$INC{'Mouse/Util.pm'} = __FILE__;
 $INC{'Mouse/Meta/Attribute.pm'} = __FILE__;
 $INC{'Mouse/Meta/Class.pm'} = __FILE__;
+$INC{'Mouse/Meta/Role.pm'} = __FILE__;
+$INC{'Mouse/Meta/TypeConstraint.pm'} = __FILE__;
 $INC{'Mouse/Meta/Method.pm'} = __FILE__;
 $INC{'Mouse/Meta/Module.pm'} = __FILE__;
-$INC{'Mouse/Meta/Role.pm'} = __FILE__;
-$INC{'Mouse/Meta/TypeConstraint.pm'} = __FILE__;
 $INC{'Mouse/Meta/Method/Accessor.pm'} = __FILE__;
 $INC{'Mouse/Meta/Method/Constructor.pm'} = __FILE__;
 $INC{'Mouse/Meta/Method/Destructor.pm'} = __FILE__;
@@ -32,6 +32,7 @@
 use Exporter;
 
 use Carp qw(confess);
+use B ();
 
 use constant _MOUSE_VERBOSE => !!$ENV{MOUSE_VERBOSE};
 
@@ -48,6 +49,8 @@
 
     get_linear_isa
     get_code_info
+
+    get_code_package
 
     not_supported
 
@@ -126,8 +129,6 @@
         my ($coderef) = @_;
         ref($coderef) or return;
 
-        require B;
-
         my $cv = B::svref_2object($coderef);
         $cv->isa('B::CV') or return;
 
@@ -135,6 +136,18 @@
         $gv->isa('B::GV') or return;
 
         return ($gv->STASH->NAME, $gv->NAME);
+    }
+
+    sub get_code_package{
+        my($coderef) = @_;
+
+        my $cv = B::svref_2object($coderef);
+        $cv->isa('B::CV') or return '';
+
+        my $gv = $cv->GV;
+        $gv->isa('B::GV') or return '';
+
+        return $gv->STASH->NAME;
     }
 }
 
@@ -346,14 +359,14 @@
 use strict;
 use warnings;
 
-our $VERSION = '0.36';
+our $VERSION = '0.37';
 
 use Exporter;
 
 use Carp 'confess';
 use Scalar::Util 'blessed';
 
-BEGIN { Mouse::Util->import(qw(load_class is_class_loaded not_supported)) }
+BEGIN { Mouse::Util->import(qw(load_class is_class_loaded get_code_package not_supported)) }
 
 BEGIN { Mouse::Util::TypeConstraints->import(()) }
 
@@ -527,7 +540,7 @@
         my $code;
         if(exists $is_removable{$keyword}
             && ($code = $caller->can($keyword))
-            && (Mouse::Util::get_code_info($code))[0] eq __PACKAGE__){
+            && get_code_package($code) eq __PACKAGE__){
 
             delete $stash->{$keyword};
         }
@@ -564,8 +577,12 @@
     my $can_be_required = defined( $args->{init_arg} );
 
     if(exists $args->{builder}){
+        # XXX:
+        # Moose refuses a CODE ref builder, but Mouse doesn't for backward compatibility
+        # This feature will be changed in a future. (gfx)
         $class->throw_error('builder must be a defined scalar value which is a method name')
-            if ref $args->{builder} || !(defined $args->{builder});
+            #if ref $args->{builder} || !defined $args->{builder};
+            if !defined $args->{builder};
 
         $can_be_required++;
     }
@@ -1737,6 +1754,7 @@
     my @code;
     for my $class ($metaclass->linearized_isa) {
         no strict 'refs';
+        no warnings 'once';
 
         if (*{ $class . '::BUILD' }{CODE}) {
             unshift  @code, qq{${class}::BUILD(\$instance, \$args);};
@@ -1787,7 +1805,7 @@
 use Carp ();
 use Scalar::Util qw/blessed weaken/;
 
-BEGIN { Mouse::Util->import(qw/:meta get_code_info not_supported load_class/) }
+BEGIN { Mouse::Util->import(qw/:meta get_code_package not_supported load_class/) }
 
 {
     my %METACLASS_CACHE;
@@ -1879,13 +1897,17 @@
     *{ $pkg . '::' . $name } = $code;
 }
 
-sub _code_is_mine { # taken from Class::MOP::Class
-    my ( $self, $code ) = @_;
-
-    my ( $code_package, $code_name ) = get_code_info($code);
-
-    return $code_package && $code_package eq $self->{package}
-        || ( $code_package eq 'constant' && $code_name eq '__ANON__' );
+# XXX: for backward compatibility
+my %foreign = map{ $_ => undef } qw(
+    Mouse Mouse::Role Mouse::Util Mouse::Util::TypeConstraints
+    Carp Scalar::Util
+);
+sub _code_is_mine{
+    my($self, $code) = @_;
+
+    my $package = get_code_package($code);
+
+    return !exists $foreign{$package};
 }
 
 sub has_method {
@@ -1893,7 +1915,7 @@
 
     return 1 if $self->{methods}->{$method_name};
 
-    my $code = $self->{package}->can($method_name);
+    my $code = do{ no strict 'refs'; *{$self->{package} . '::' . $method_name}{CODE} };
 
     return $code && $self->_code_is_mine($code);
 }
@@ -2080,7 +2102,7 @@
 use strict;
 use warnings;
 
-BEGIN { Mouse::Util->import(qw(:meta not_supported english_list)) }
+BEGIN { Mouse::Util->import(qw(:meta not_supported english_list get_code_info)) }
 our @ISA = qw(Mouse::Meta::Module);
 
 sub method_metaclass(){ 'Mouse::Meta::Role::Method' } # required for get_method()
@@ -2659,7 +2681,7 @@
 use Carp 'confess';
 use Scalar::Util 'blessed';
 
-BEGIN { Mouse::Util->import(qw(load_class not_supported)) }
+BEGIN { Mouse::Util->import(qw(load_class get_code_package not_supported)) }
 BEGIN { Mouse->import(()) }
 
 our @ISA = qw(Exporter);
@@ -2802,7 +2824,7 @@
         my $code;
         if(exists $is_removable{$keyword}
             && ($code = $caller->can($keyword))
-            && (Mouse::Util::get_code_info($code))[0] eq __PACKAGE__){
+            && get_code_package($code) eq __PACKAGE__){
 
             delete $stash->{$keyword};
         }
@@ -2814,7 +2836,7 @@
 use strict;
 use warnings;
 
-our $VERSION = '0.36';
+our $VERSION = '0.37';
 
 our $MouseVersion = $VERSION;
 our $MooseVersion = '0.90';

Modified: branches/upstream/libmouse-perl/current/lib/Mouse/Util.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/lib/Mouse/Util.pm?rev=45225&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/lib/Mouse/Util.pm (original)
+++ branches/upstream/libmouse-perl/current/lib/Mouse/Util.pm Fri Oct  2 12:42:58 2009
@@ -5,6 +5,7 @@
 use Exporter;
 
 use Carp qw(confess);
+use B ();
 
 use constant _MOUSE_VERBOSE => !!$ENV{MOUSE_VERBOSE};
 
@@ -21,6 +22,8 @@
 
     get_linear_isa
     get_code_info
+
+    get_code_package
 
     not_supported
 
@@ -99,8 +102,6 @@
         my ($coderef) = @_;
         ref($coderef) or return;
 
-        require B;
-
         my $cv = B::svref_2object($coderef);
         $cv->isa('B::CV') or return;
 
@@ -108,6 +109,18 @@
         $gv->isa('B::GV') or return;
 
         return ($gv->STASH->NAME, $gv->NAME);
+    }
+
+    sub get_code_package{
+        my($coderef) = @_;
+
+        my $cv = B::svref_2object($coderef);
+        $cv->isa('B::CV') or return '';
+
+        my $gv = $cv->GV;
+        $gv->isa('B::GV') or return '';
+
+        return $gv->STASH->NAME;
     }
 }
 
@@ -337,7 +350,7 @@
 
 =head2 Class::MOP
 
-=head2 C<< is_class_loaded(ClassName) -> Bool >>
+=head3 C<< is_class_loaded(ClassName) -> Bool >>
 
 Returns whether C<ClassName> is actually loaded or not. It uses a heuristic which
 involves checking for the existence of C<$VERSION>, C<@ISA>, and any

Modified: branches/upstream/libmouse-perl/current/t/990_deprecated/044-attribute-metaclass.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/t/990_deprecated/044-attribute-metaclass.t?rev=45225&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/t/990_deprecated/044-attribute-metaclass.t (original)
+++ branches/upstream/libmouse-perl/current/t/990_deprecated/044-attribute-metaclass.t Fri Oct  2 12:42:58 2009
@@ -31,6 +31,15 @@
         return $attr;
     };
 
+    around 'canonicalize_args' => sub {
+        my ($next, $self, $name, %args) = @_;
+
+        %args = $next->($self, $name, %args);
+        $args{is}  = 'rw'  unless exists $args{is};
+
+        return %args;
+    };
+
     package # hide me from search.cpan.org
         Mouse::Meta::Attribute::Custom::Number;
     sub register_implementation { 'MouseX::AttributeHelpers::Number' }
@@ -40,9 +49,8 @@
     package Klass;
     use Mouse;
 
-    has 'i' => (
+    has 'number' => (
         metaclass => 'Number',
-        is => 'rw',
         isa => 'Int',
         provides => {
             'add' => 'add_number'
@@ -50,8 +58,8 @@
     );
 };
 
-can_ok 'Klass', 'add_number';
-my $k = Klass->new(i=>3);
+can_ok 'Klass', 'add_number', 'number';
+my $k = Klass->new(number => 3);
 $k->add_number(4);
-is $k->i, 7;
+is $k->number, 7;
 




More information about the Pkg-perl-cvs-commits mailing list