+++ /dev/null
-
-package Moose::Meta::Attribute::Native::MethodProvider::Counter;
-use Moose::Role;
-
-our $VERSION = '1.14';
-$VERSION = eval $VERSION;
-our $AUTHORITY = 'cpan:STEVAN';
-
-sub reset : method {
- my ( $attr, $reader, $writer ) = @_;
- return sub { $writer->( $_[0], $attr->default( $_[0] ) ) };
-}
-
-sub set : method {
- my ( $attr, $reader, $writer, $value ) = @_;
- return sub { $writer->( $_[0], $_[1] ) };
-}
-
-sub inc {
- my ( $attr, $reader, $writer ) = @_;
- return sub {
- $writer->( $_[0],
- $reader->( $_[0] ) + ( defined( $_[1] ) ? $_[1] : 1 ) );
- };
-}
-
-sub dec {
- my ( $attr, $reader, $writer ) = @_;
- return sub {
- $writer->( $_[0],
- $reader->( $_[0] ) - ( defined( $_[1] ) ? $_[1] : 1 ) );
- };
-}
-
-1;
-
-__END__
-
-=pod
-
-=head1 NAME
-
-Moose::Meta::Attribute::Native::MethodProvider::Counter - role providing method generators for Counter trait
-
-=head1 DESCRIPTION
-
-This is a role which provides the method generators for
-L<Moose::Meta::Attribute::Native::Trait::Counter>. Please check there for
-documentation on what methods are provided.
-
-=head1 METHODS
-
-=over 4
-
-=item B<meta>
-
-=back
-
-=head1 BUGS
-
-See L<Moose/BUGS> for details on reporting bugs.
-
-=head1 AUTHOR
-
-Stevan Little E<lt>stevan@iinteractive.comE<gt>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright 2007-2009 by Infinity Interactive, Inc.
-
-L<http://www.iinteractive.com>
-
-This library is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
-
-=cut
# XXX - bridge code
( ( $accessor_class && $accessor_class->can('new') )
|| exists $method_constructors->{$name} )
- || confess "$name is an unsupported method type";
+ || confess "$name is an unsupported method type - $accessor_class";
}
}
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
-use Moose::Meta::Attribute::Native::MethodProvider::Counter;
+use Moose::Meta::Method::Accessor::Native::Counter::dec;
+use Moose::Meta::Method::Accessor::Native::Counter::inc;
+use Moose::Meta::Method::Accessor::Native::Counter::reset;
+use Moose::Meta::Method::Accessor::Native::Counter::set;
-with 'Moose::Meta::Attribute::Native::Trait';
-
-has 'method_provider' => (
- is => 'ro',
- isa => 'ClassName',
- predicate => 'has_method_provider',
- default => 'Moose::Meta::Attribute::Native::MethodProvider::Counter',
-);
+with 'Moose::Meta::Attribute::Native::Trait' =>
+ { -excludes => ['_root_types'] };
sub _default_default { 0 }
sub _default_is { 'ro' }
sub _helper_type { 'Num' }
+sub _native_type { 'Counter' }
+sub _root_types { 'Num', 'Int' }
no Moose::Role;
--- /dev/null
+package Moose::Meta::Method::Accessor::Native::Counter::Writer;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.13';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
+use base 'Moose::Meta::Method::Accessor::Native::Writer';
+
+sub _new_value {'$_[0]'}
+
+sub _constraint_must_be_checked {
+ my $self = shift;
+
+ my $attr = $self->associated_attribute;
+
+ return $attr->has_type_constraint
+ && ( $attr->type_constraint->name =~ /^(?:Num|Int)$/
+ || ( $attr->should_coerce && $attr->type_constraint->has_coercion ) );
+}
+
+sub _inline_check_coercion {
+ my ( $self, $value ) = @_;
+
+ my $attr = $self->associated_attribute;
+
+ return ''
+ unless $attr->should_coerce && $attr->type_constraint->has_coercion;
+
+ # We want to break the aliasing in @_ in case the coercion tries to make a
+ # destructive change to an array member.
+ return "$value = $attr->type_constraint->coerce($value);";
+}
+
+1;
--- /dev/null
+package Moose::Meta::Method::Accessor::Native::Counter::dec;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.13';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
+use base 'Moose::Meta::Method::Accessor::Native::Writer';
+
+sub _minimum_arguments {0}
+sub _maximum_arguments {1}
+
+sub _potential_value {
+ my ( $self, $slot_access ) = @_;
+
+ return "$slot_access - ( defined \$_[0] ? \$_[0] : 1 );";
+}
+
+sub _inline_optimized_set_new_value {
+ my ( $self, $inv, $new, $slot_access ) = @_;
+
+ return "$slot_access -= defined \$_[0] ? \$_[0] : 1;";
+}
+
+1;
--- /dev/null
+package Moose::Meta::Method::Accessor::Native::Counter::inc;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.13';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
+use base 'Moose::Meta::Method::Accessor::Native::Writer';
+
+sub _minimum_arguments { 0 }
+sub _maximum_arguments { 1 }
+
+sub _potential_value {
+ my ( $self, $slot_access ) = @_;
+
+ return "$slot_access + ( defined \$_[0] ? \$_[0] : 1 );";
+}
+
+sub _inline_optimized_set_new_value {
+ my ( $self, $inv, $new, $slot_access ) = @_;
+
+ return "$slot_access += defined \$_[0] ? \$_[0] : 1;";
+}
+
+1;
--- /dev/null
+package Moose::Meta::Method::Accessor::Native::Counter::reset;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.13';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
+use base 'Moose::Meta::Method::Accessor::Native::Writer';
+
+sub _minimum_arguments { 0 }
+sub _maximum_arguments { 0 }
+
+sub _potential_value {
+ my ( $self, $slot_access ) = @_;
+
+ return "\$attr->default(\$self)"
+}
+
+sub _inline_optimized_set_new_value {
+ my ( $self, $inv, $new, $slot_access ) = @_;
+
+ return "$slot_access = \$attr->default(\$self);";
+}
+
+1;
--- /dev/null
+package Moose::Meta::Method::Accessor::Native::Counter::set;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.13';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
+use base 'Moose::Meta::Method::Accessor::Native::Writer';
+
+sub _minimum_arguments {1}
+sub _maximum_arguments {1}
+
+sub _potential_value {'$_[0]'}
+
+sub _inline_optimized_set_new_value {
+ my ( $self, $inv, $new, $slot_access ) = @_;
+
+ return "$slot_access = \$_[0];";
+}
+
+1;