diff options
| author | Lorry Tar Creator <lorry-tar-importer@lorry> | 2015-06-06 17:50:16 +0000 |
|---|---|---|
| committer | Lorry Tar Creator <lorry-tar-importer@lorry> | 2015-06-06 17:50:16 +0000 |
| commit | 5ac2026f7eed78958d69d051e7a8e993dcf51205 (patch) | |
| tree | 298c3d2f08bdfe5689998b11892d72a897985be1 /lib/Moose/Meta/Method/Accessor | |
| download | Moose-tarball-master.tar.gz | |
Moose-2.1405HEADMoose-2.1405master
Diffstat (limited to 'lib/Moose/Meta/Method/Accessor')
76 files changed, 3162 insertions, 0 deletions
diff --git a/lib/Moose/Meta/Method/Accessor/Native.pm b/lib/Moose/Meta/Method/Accessor/Native.pm new file mode 100644 index 0000000..01a3fee --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native.pm @@ -0,0 +1,157 @@ +package Moose::Meta::Method::Accessor::Native; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Carp qw( confess ); +use Scalar::Util qw( blessed ); + +use Moose::Role; + +use Moose::Util 'throw_exception'; + +around new => sub { + my $orig = shift; + my $class = shift; + my %options = @_; + + $options{curried_arguments} = [] + unless exists $options{curried_arguments}; + + throw_exception( MustSupplyArrayRefAsCurriedArguments => params => \%options, + class_name => $class + ) + unless $options{curried_arguments} + && ref($options{curried_arguments}) eq 'ARRAY'; + + my $attr_context = $options{attribute}->definition_context; + my $desc = 'native delegation method '; + $desc .= $options{attribute}->associated_class->name; + $desc .= '::' . $options{name}; + $desc .= " ($options{delegate_to_method})"; + $desc .= " of attribute " . $options{attribute}->name; + $options{definition_context} = { + %{ $attr_context || {} }, + description => $desc, + }; + + $options{accessor_type} = 'native'; + + return $class->$orig(%options); +}; + +sub _new { + my $class = shift; + my $options = @_ == 1 ? $_[0] : {@_}; + + return bless $options, $class; +} + +sub root_types { (shift)->{'root_types'} } + +sub _initialize_body { + my $self = shift; + + $self->{'body'} = $self->_compile_code( [$self->_generate_method] ); + + return; +} + +sub _inline_curried_arguments { + my $self = shift; + + return unless @{ $self->curried_arguments }; + + return 'unshift @_, @curried;'; +} + +sub _inline_check_argument_count { + my $self = shift; + + my @code; + + if (my $min = $self->_minimum_arguments) { + push @code, ( + 'if (@_ < ' . $min . ') {', + $self->_inline_throw_exception( MethodExpectsMoreArgs => + 'method_name => "'.$self->delegate_to_method.'",'. + "minimum_args => ".$min, + ) . ';', + '}', + ); + } + + if (defined(my $max = $self->_maximum_arguments)) { + push @code, ( + 'if (@_ > ' . $max . ') {', + $self->_inline_throw_exception( MethodExpectsFewerArgs => + 'method_name => "'.$self->delegate_to_method.'",'. + 'maximum_args => '.$max, + ) . ';', + '}', + ); + } + + return @code; +} + +sub _inline_return_value { + my $self = shift; + my ($slot_access, $for_writer) = @_; + + return 'return ' . $self->_return_value($slot_access, $for_writer) . ';'; +} + +sub _minimum_arguments { 0 } +sub _maximum_arguments { undef } + +override _get_value => sub { + my $self = shift; + my ($instance) = @_; + + return $self->_slot_access_can_be_inlined + ? super() + : $instance . '->$reader'; +}; + +override _inline_store_value => sub { + my $self = shift; + my ($instance, $value) = @_; + + return $self->_slot_access_can_be_inlined + ? super() + : $instance . '->$writer(' . $value . ');'; +}; + +override _eval_environment => sub { + my $self = shift; + + my $env = super(); + + $env->{'@curried'} = $self->curried_arguments; + + return $env if $self->_slot_access_can_be_inlined; + + my $reader = $self->associated_attribute->get_read_method_ref; + $reader = $reader->body if blessed $reader; + + $env->{'$reader'} = \$reader; + + my $writer = $self->associated_attribute->get_write_method_ref; + $writer = $writer->body if blessed $writer; + + $env->{'$writer'} = \$writer; + + return $env; +}; + +sub _slot_access_can_be_inlined { + my $self = shift; + + return $self->is_inline && $self->_instance_is_inlinable; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Array.pm b/lib/Moose/Meta/Method/Accessor/Native/Array.pm new file mode 100644 index 0000000..d585648 --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Array.pm @@ -0,0 +1,28 @@ +package Moose::Meta::Method::Accessor::Native::Array; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Role; + +sub _inline_check_var_is_valid_index { + my $self = shift; + my ($var) = @_; + + return ( + 'if (!defined(' . $var . ') || ' . $var . ' !~ /^-?\d+$/) {', + $self->_inline_throw_exception( InvalidArgumentToMethod => + 'argument => '.$var.','. + 'method_name => "'.$self->delegate_to_method.'",'. + 'type_of_argument => "integer",'. + 'type => "Int",'. + 'argument_noun => "index"', + ) . ';', + '}', + ); +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Array/Writer.pm b/lib/Moose/Meta/Method/Accessor/Native/Array/Writer.pm new file mode 100644 index 0000000..e47d940 --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Array/Writer.pm @@ -0,0 +1,27 @@ +package Moose::Meta::Method::Accessor::Native::Array::Writer; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Writer', + 'Moose::Meta::Method::Accessor::Native::Array', + 'Moose::Meta::Method::Accessor::Native::Collection'; + +sub _inline_coerce_new_values { + my $self = shift; + $self->Moose::Meta::Method::Accessor::Native::Collection::_inline_coerce_new_values(@_); +} + +sub _new_members { '@_' } + +sub _copy_old_value { + my $self = shift; + my ($slot_access) = @_; + + return '[ @{(' . $slot_access . ')} ]'; +} + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Array/accessor.pm b/lib/Moose/Meta/Method/Accessor/Native/Array/accessor.pm new file mode 100644 index 0000000..62af0a5 --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Array/accessor.pm @@ -0,0 +1,56 @@ +package Moose::Meta::Method::Accessor::Native::Array::accessor; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Array::set', + 'Moose::Meta::Method::Accessor::Native::Array::get'; + +sub _inline_process_arguments { + my $self = shift; + $self->Moose::Meta::Method::Accessor::Native::Array::get::_inline_process_arguments(@_); +} + +sub _inline_check_arguments { + my $self = shift; + $self->Moose::Meta::Method::Accessor::Native::Array::get::_inline_check_arguments(@_); +} + +sub _return_value { + my $self = shift; + $self->Moose::Meta::Method::Accessor::Native::Array::get::_return_value(@_); +} + +sub _generate_method { + my $self = shift; + + my $inv = '$self'; + my $slot_access = $self->_get_value($inv); + + return ( + 'sub {', + 'my ' . $inv . ' = shift;', + $self->_inline_curried_arguments, + $self->_inline_check_lazy($inv, '$type_constraint', '$type_coercion', '$type_message'), + # get + 'if (@_ == 1) {', + $self->_inline_check_var_is_valid_index('$_[0]'), + $self->Moose::Meta::Method::Accessor::Native::Array::get::_inline_return_value($slot_access), + '}', + # set + 'else {', + $self->_inline_writer_core($inv, $slot_access), + '}', + '}', + ); +} + +sub _minimum_arguments { 1 } +sub _maximum_arguments { 2 } + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Array/clear.pm b/lib/Moose/Meta/Method/Accessor/Native/Array/clear.pm new file mode 100644 index 0000000..39913ff --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Array/clear.pm @@ -0,0 +1,28 @@ +package Moose::Meta::Method::Accessor::Native::Array::clear; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Array::Writer'; + +sub _maximum_arguments { 0 } + +sub _adds_members { 0 } + +sub _potential_value { '[]' } + +sub _inline_optimized_set_new_value { + my $self = shift; + my ($inv, $new, $slot_access) = @_; + + return $slot_access . ' = [];'; +} + +sub _return_value { '' } + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Array/count.pm b/lib/Moose/Meta/Method/Accessor/Native/Array/count.pm new file mode 100644 index 0000000..724db7a --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Array/count.pm @@ -0,0 +1,22 @@ +package Moose::Meta::Method::Accessor::Native::Array::count; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Reader'; + +sub _maximum_arguments { 0 } + +sub _return_value { + my $self = shift; + my ($slot_access) = @_; + + return 'scalar @{ (' . $slot_access . ') }'; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Array/delete.pm b/lib/Moose/Meta/Method/Accessor/Native/Array/delete.pm new file mode 100644 index 0000000..bf47e09 --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Array/delete.pm @@ -0,0 +1,50 @@ +package Moose::Meta::Method::Accessor::Native::Array::delete; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Array::Writer'; + +sub _minimum_arguments { 1 } + +sub _maximum_arguments { 1 } + +sub _inline_check_arguments { + my $self = shift; + + return $self->_inline_check_var_is_valid_index('$_[0]'); +} + +sub _adds_members { 0 } + +sub _potential_value { + my $self = shift; + my ($slot_access) = @_; + + return '(do { ' + . 'my @potential = @{ (' . $slot_access . ') }; ' + . '@return = splice @potential, $_[0], 1; ' + . '\@potential; ' + . '})'; +} + +sub _inline_optimized_set_new_value { + my $self = shift; + my ($inv, $new, $slot_access) = @_; + + return '@return = splice @{ (' . $slot_access . ') }, $_[0], 1;'; +} + +sub _return_value { + my $self = shift; + my ($slot_access) = @_; + + return '$return[0]'; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Array/elements.pm b/lib/Moose/Meta/Method/Accessor/Native/Array/elements.pm new file mode 100644 index 0000000..59dcc14 --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Array/elements.pm @@ -0,0 +1,22 @@ +package Moose::Meta::Method::Accessor::Native::Array::elements; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Reader'; + +sub _maximum_arguments { 0 } + +sub _return_value { + my $self = shift; + my ($slot_access) = @_; + + return '@{ (' . $slot_access . ') }'; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Array/first.pm b/lib/Moose/Meta/Method/Accessor/Native/Array/first.pm new file mode 100644 index 0000000..32059f8 --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Array/first.pm @@ -0,0 +1,42 @@ +package Moose::Meta::Method::Accessor::Native::Array::first; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use List::Util (); +use Params::Util (); + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Reader'; + +sub _minimum_arguments { 1 } + +sub _maximum_arguments { 1 } + +sub _inline_check_arguments { + my $self = shift; + + return ( + 'if (!Params::Util::_CODELIKE($_[0])) {', + $self->_inline_throw_exception( InvalidArgumentToMethod => + 'argument => $_[0],'. + 'method_name => "first",'. + 'type_of_argument => "code reference",'. + 'type => "CodeRef",', + ) . ';', + '}', + ); +} + +sub _return_value { + my $self = shift; + my ($slot_access) = @_; + + return '&List::Util::first($_[0], @{ (' . $slot_access . ') })'; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Array/first_index.pm b/lib/Moose/Meta/Method/Accessor/Native/Array/first_index.pm new file mode 100644 index 0000000..da22266 --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Array/first_index.pm @@ -0,0 +1,42 @@ +package Moose::Meta::Method::Accessor::Native::Array::first_index; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use List::MoreUtils (); +use Params::Util (); + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Reader'; + +sub _minimum_arguments { 1 } + +sub _maximum_arguments { 1 } + +sub _inline_check_arguments { + my $self = shift; + + return ( + 'if (!Params::Util::_CODELIKE($_[0])) {', + $self->_inline_throw_exception( InvalidArgumentToMethod => + 'argument => $_[0],'. + 'method_name => "first_index",'. + 'type_of_argument => "code reference",'. + 'type => "CodeRef",', + ) . ';', + '}', + ); +} + +sub _return_value { + my $self = shift; + my ($slot_access) = @_; + + return '&List::MoreUtils::first_index($_[0], @{ (' . $slot_access . ') })'; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Array/get.pm b/lib/Moose/Meta/Method/Accessor/Native/Array/get.pm new file mode 100644 index 0000000..3e88930 --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Array/get.pm @@ -0,0 +1,31 @@ +package Moose::Meta::Method::Accessor::Native::Array::get; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Class::MOP::MiniTrait; + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Reader', + 'Moose::Meta::Method::Accessor::Native::Array'; + +sub _minimum_arguments { 1 } + +sub _maximum_arguments { 1 } + +sub _inline_check_arguments { + my $self = shift; + + return $self->_inline_check_var_is_valid_index('$_[0]'); +} + +sub _return_value { + my $self = shift; + my ($slot_access) = @_; + + return $slot_access . '->[ $_[0] ]'; +} + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Array/grep.pm b/lib/Moose/Meta/Method/Accessor/Native/Array/grep.pm new file mode 100644 index 0000000..c750e5b --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Array/grep.pm @@ -0,0 +1,41 @@ +package Moose::Meta::Method::Accessor::Native::Array::grep; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Params::Util (); + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Reader'; + +sub _minimum_arguments { 1 } + +sub _maximum_arguments { 1 } + +sub _inline_check_arguments { + my $self = shift; + + return ( + 'if (!Params::Util::_CODELIKE($_[0])) {', + $self->_inline_throw_exception( InvalidArgumentToMethod => + 'argument => $_[0],'. + 'method_name => "grep",'. + 'type_of_argument => "code reference",'. + 'type => "CodeRef",', + ) . ';', + '}', + ); +} + +sub _return_value { + my $self = shift; + my ($slot_access) = @_; + + return 'grep { $_[0]->() } @{ (' . $slot_access . ') }'; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Array/insert.pm b/lib/Moose/Meta/Method/Accessor/Native/Array/insert.pm new file mode 100644 index 0000000..c085223 --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Array/insert.pm @@ -0,0 +1,58 @@ +package Moose::Meta::Method::Accessor::Native::Array::insert; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Array::Writer'; + +sub _minimum_arguments { 2 } + +sub _maximum_arguments { 2 } + +sub _adds_members { 1 } + +sub _potential_value { + my $self = shift; + my ($slot_access) = @_; + + return '(do { ' + . 'my @potential = @{ (' . $slot_access . ') }; ' + . 'splice @potential, $_[0], 0, $_[1]; ' + . '\@potential; ' + . '})'; +} + +# We need to override this because while @_ can be written to, we cannot write +# directly to $_[1]. +sub _inline_coerce_new_values { + my $self = shift; + + return unless $self->associated_attribute->should_coerce; + + return unless $self->_tc_member_type_can_coerce; + + return '@_ = ($_[0], $member_coercion->($_[1]));'; +}; + +sub _new_members { '$_[1]' } + +sub _inline_optimized_set_new_value { + my $self = shift; + my ($inv, $new, $slot_access) = @_; + + return 'splice @{ (' . $slot_access . ') }, $_[0], 0, $_[1];'; +} + +sub _return_value { + my $self = shift; + my ($slot_access) = @_; + + return $slot_access . '->[ $_[0] ]'; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Array/is_empty.pm b/lib/Moose/Meta/Method/Accessor/Native/Array/is_empty.pm new file mode 100644 index 0000000..c57c448 --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Array/is_empty.pm @@ -0,0 +1,22 @@ +package Moose::Meta::Method::Accessor::Native::Array::is_empty; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Reader'; + +sub _maximum_arguments { 0 } + +sub _return_value { + my $self = shift; + my ($slot_access) = @_; + + return '@{ (' . $slot_access . ') } ? 0 : 1'; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Array/join.pm b/lib/Moose/Meta/Method/Accessor/Native/Array/join.pm new file mode 100644 index 0000000..b06ae3b --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Array/join.pm @@ -0,0 +1,41 @@ +package Moose::Meta::Method::Accessor::Native::Array::join; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Util (); + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Reader'; + +sub _minimum_arguments { 1 } + +sub _maximum_arguments { 1 } + +sub _inline_check_arguments { + my $self = shift; + + return ( + 'if (!Moose::Util::_STRINGLIKE0($_[0])) {', + $self->_inline_throw_exception( InvalidArgumentToMethod => + 'argument => $_[0],'. + 'method_name => "join",'. + 'type_of_argument => "string",'. + 'type => "Str",', + ) . ';', + '}', + ); +} + +sub _return_value { + my $self = shift; + my ($slot_access) = @_; + + return 'join $_[0], @{ (' . $slot_access . ') }'; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Array/map.pm b/lib/Moose/Meta/Method/Accessor/Native/Array/map.pm new file mode 100644 index 0000000..59c6225 --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Array/map.pm @@ -0,0 +1,41 @@ +package Moose::Meta::Method::Accessor::Native::Array::map; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Params::Util (); + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Reader'; + +sub _minimum_arguments { 1 } + +sub _maximum_arguments { 1 } + +sub _inline_check_arguments { + my $self = shift; + + return ( + 'if (!Params::Util::_CODELIKE($_[0])) {', + $self->_inline_throw_exception( InvalidArgumentToMethod => + 'argument => $_[0],'. + 'method_name => "map",'. + 'type_of_argument => "code reference",'. + 'type => "CodeRef",', + ) . ';', + '}', + ); +} + +sub _return_value { + my $self = shift; + my ($slot_access) = @_; + + return 'map { $_[0]->() } @{ (' . $slot_access . ') }'; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Array/natatime.pm b/lib/Moose/Meta/Method/Accessor/Native/Array/natatime.pm new file mode 100644 index 0000000..e72815e --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Array/natatime.pm @@ -0,0 +1,65 @@ +package Moose::Meta::Method::Accessor::Native::Array::natatime; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use List::MoreUtils (); +use Params::Util (); + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Reader'; + +sub _minimum_arguments { 1 } + +sub _maximum_arguments { 2 } + +sub _inline_check_arguments { + my $self = shift; + + return ( + 'if (!defined($_[0]) || $_[0] !~ /^\d+$/) {', + $self->_inline_throw_exception( InvalidArgumentToMethod => + 'argument => $_[0],'. + 'method_name => "natatime",'. + 'type_of_argument => "integer",'. + 'type => "Int",'. + 'argument_noun => "n value"', + ) . ';', + '}', + 'if (@_ == 2 && !Params::Util::_CODELIKE($_[1])) {', + $self->_inline_throw_exception( InvalidArgumentToMethod => + 'argument => $_[1],'. + 'method_name => "natatime",'. + 'type_of_argument => "code reference",'. + 'type => "CodeRef",'. + 'ordinal => "second"', + ) . ';', + '}', + ); +} + +sub _inline_return_value { + my $self = shift; + my ($slot_access) = @_; + + return ( + 'my $iter = List::MoreUtils::natatime($_[0], @{ (' . $slot_access . ') });', + 'if ($_[1]) {', + 'while (my @vals = $iter->()) {', + '$_[1]->(@vals);', + '}', + '}', + 'else {', + 'return $iter;', + '}', + ); +} + +# Not called, but needed to satisfy the Reader role +sub _return_value { } + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Array/pop.pm b/lib/Moose/Meta/Method/Accessor/Native/Array/pop.pm new file mode 100644 index 0000000..a9df36f --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Array/pop.pm @@ -0,0 +1,47 @@ +package Moose::Meta::Method::Accessor::Native::Array::pop; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Array::Writer'; + +sub _maximum_arguments { 0 } + +sub _adds_members { 0 } + +sub _potential_value { + my $self = shift; + my ($slot_access) = @_; + + return '[ @{ (' . $slot_access . ') } > 1 ' + . '? @{ (' . $slot_access . ') }[0..$#{ (' . $slot_access . ') } - 1] ' + . ': () ]'; +} + +sub _inline_capture_return_value { + my $self = shift; + my ($slot_access) = @_; + + return 'my $old = ' . $slot_access . '->[-1];'; +} + +sub _inline_optimized_set_new_value { + my $self = shift; + my ($inv, $new, $slot_access) = @_; + + return 'pop @{ (' . $slot_access . ') };'; +} + +sub _return_value { + my $self = shift; + my ($slot_access) = @_; + + return '$old'; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Array/push.pm b/lib/Moose/Meta/Method/Accessor/Native/Array/push.pm new file mode 100644 index 0000000..eec4344 --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Array/push.pm @@ -0,0 +1,36 @@ +package Moose::Meta::Method::Accessor::Native::Array::push; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Array::Writer'; + +sub _adds_members { 1 } + +sub _potential_value { + my $self = shift; + my ($slot_access) = @_; + + return '[ @{ (' . $slot_access . ') }, @_ ]'; +} + +sub _inline_optimized_set_new_value { + my $self = shift; + my ($inv, $new, $slot_access) = @_; + + return 'push @{ (' . $slot_access . ') }, @_;'; +} + +sub _return_value { + my $self = shift; + my ($slot_access) = @_; + + return 'scalar @{ (' . $slot_access . ') }'; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Array/reduce.pm b/lib/Moose/Meta/Method/Accessor/Native/Array/reduce.pm new file mode 100644 index 0000000..12fd9c4 --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Array/reduce.pm @@ -0,0 +1,42 @@ +package Moose::Meta::Method::Accessor::Native::Array::reduce; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use List::Util (); +use Params::Util (); + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Reader'; + +sub _minimum_arguments { 1 } + +sub _maximum_arguments { 1 } + +sub _inline_check_arguments { + my $self = shift; + + return ( + 'if (!Params::Util::_CODELIKE($_[0])) {', + $self->_inline_throw_exception( InvalidArgumentToMethod => + 'argument => $_[0],'. + 'method_name => "reduce",'. + 'type_of_argument => "code reference",'. + 'type => "CodeRef",', + ) . ';', + '}', + ); +} + +sub _return_value { + my $self = shift; + my ($slot_access) = @_; + + return 'List::Util::reduce { $_[0]->($a, $b) } @{ (' . $slot_access . ') }'; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Array/set.pm b/lib/Moose/Meta/Method/Accessor/Native/Array/set.pm new file mode 100644 index 0000000..b487303 --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Array/set.pm @@ -0,0 +1,64 @@ +package Moose::Meta::Method::Accessor::Native::Array::set; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Array::Writer'; + +sub _minimum_arguments { 2 } + +sub _maximum_arguments { 2 } + +sub _inline_check_arguments { + my $self = shift; + + return $self->_inline_check_var_is_valid_index('$_[0]'); +} + +sub _adds_members { 1 } + +sub _potential_value { + my $self = shift; + my ($slot_access) = @_; + + return '(do { ' + . 'my @potential = @{ (' . $slot_access . ') }; ' + . '$potential[$_[0]] = $_[1]; ' + . '\@potential; ' + . '})'; +} + +# We need to override this because while @_ can be written to, we cannot write +# directly to $_[1]. +sub _inline_coerce_new_values { + my $self = shift; + + return unless $self->associated_attribute->should_coerce; + + return unless $self->_tc_member_type_can_coerce; + + return '@_ = ($_[0], $member_coercion->($_[1]));'; +}; + +sub _new_members { '$_[1]' } + +sub _inline_optimized_set_new_value { + my $self = shift; + my ($inv, $new, $slot_access) = @_; + + return $slot_access . '->[$_[0]] = $_[1];'; +} + +sub _return_value { + my $self = shift; + my ($slot_access) = @_; + + return $slot_access . '->[$_[0]]'; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Array/shallow_clone.pm b/lib/Moose/Meta/Method/Accessor/Native/Array/shallow_clone.pm new file mode 100644 index 0000000..f4dd6b4 --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Array/shallow_clone.pm @@ -0,0 +1,26 @@ +package Moose::Meta::Method::Accessor::Native::Array::shallow_clone; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Params::Util (); + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Reader'; + +sub _minimum_arguments { 0 } + +sub _maximum_arguments { 0 } + +sub _return_value { + my $self = shift; + my ($slot_access) = @_; + + return '[ @{ (' . $slot_access . ') } ]'; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Array/shift.pm b/lib/Moose/Meta/Method/Accessor/Native/Array/shift.pm new file mode 100644 index 0000000..f0c3057 --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Array/shift.pm @@ -0,0 +1,47 @@ +package Moose::Meta::Method::Accessor::Native::Array::shift; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Array::Writer'; + +sub _maximum_arguments { 0 } + +sub _adds_members { 0 } + +sub _potential_value { + my $self = shift; + my ($slot_access) = @_; + + return '[ @{ (' . $slot_access . ') } > 1 ' + . '? @{ (' . $slot_access . ') }[1..$#{ (' . $slot_access . ') }] ' + . ': () ]'; +} + +sub _inline_capture_return_value { + my $self = shift; + my ($slot_access) = @_; + + return 'my $old = ' . $slot_access . '->[0];'; +} + +sub _inline_optimized_set_new_value { + my $self = shift; + my ($inv, $new, $slot_access) = @_; + + return 'shift @{ (' . $slot_access . ') };'; +} + +sub _return_value { + my $self = shift; + my ($slot_access) = @_; + + return '$old'; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Array/shuffle.pm b/lib/Moose/Meta/Method/Accessor/Native/Array/shuffle.pm new file mode 100644 index 0000000..9e7a93e --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Array/shuffle.pm @@ -0,0 +1,24 @@ +package Moose::Meta::Method::Accessor::Native::Array::shuffle; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use List::Util (); + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Reader'; + +sub _maximum_arguments { 0 } + +sub _return_value { + my $self = shift; + my ($slot_access) = @_; + + return 'List::Util::shuffle @{ (' . $slot_access . ') }'; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Array/sort.pm b/lib/Moose/Meta/Method/Accessor/Native/Array/sort.pm new file mode 100644 index 0000000..a1b15a1 --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Array/sort.pm @@ -0,0 +1,44 @@ +package Moose::Meta::Method::Accessor::Native::Array::sort; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Params::Util (); + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Reader'; + +sub _maximum_arguments { 1 } + +sub _inline_check_arguments { + my $self = shift; + + return ( + 'if (@_ && !Params::Util::_CODELIKE($_[0])) {', + $self->_inline_throw_exception( InvalidArgumentToMethod => + 'argument => $_[0],'. + 'method_name => "sort",'. + 'type_of_argument => "code reference",'. + 'type => "CodeRef",', + ) . ';', + '}', + ); +} + +sub _return_value { + my $self = shift; + my ($slot_access) = @_; + + return + 'wantarray ? ( ' . + '$_[0] ' + . '? sort { $_[0]->($a, $b) } @{ (' . $slot_access . ') } ' + . ': sort @{ (' . $slot_access . ') }' + . ' ) : @{ (' . $slot_access . ') }'; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Array/sort_in_place.pm b/lib/Moose/Meta/Method/Accessor/Native/Array/sort_in_place.pm new file mode 100644 index 0000000..cfdb2c1 --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Array/sort_in_place.pm @@ -0,0 +1,45 @@ +package Moose::Meta::Method::Accessor::Native::Array::sort_in_place; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Params::Util (); + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Array::Writer'; + +sub _maximum_arguments { 1 } + +sub _inline_check_arguments { + my $self = shift; + + return ( + 'if (@_ && !Params::Util::_CODELIKE($_[0])) {', + $self->_inline_throw_exception( InvalidArgumentToMethod => + 'argument => $_[0],'. + 'method_name => "sort_in_place",'. + 'type_of_argument => "code reference",'. + 'type => "CodeRef",', + ) . ';', + '}', + ); +} + +sub _adds_members { 0 } + +sub _potential_value { + my $self = shift; + my ($slot_access) = @_; + + return '[ $_[0] ' + . '? sort { $_[0]->($a, $b) } @{ (' . $slot_access . ') } ' + . ': sort @{ (' . $slot_access . ') } ]'; +} + +sub _return_value { '' } + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Array/splice.pm b/lib/Moose/Meta/Method/Accessor/Native/Array/splice.pm new file mode 100644 index 0000000..8bbc6df --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Array/splice.pm @@ -0,0 +1,72 @@ +package Moose::Meta::Method::Accessor::Native::Array::splice; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Array::Writer'; + +sub _minimum_arguments { 1 } + +sub _adds_members { 1 } + +sub _inline_process_arguments { + return ( + 'my $idx = shift;', + 'my $len = @_ ? shift : undef;', + ); +} + +sub _inline_check_arguments { + my $self = shift; + + return ( + $self->_inline_check_var_is_valid_index('$idx'), + 'if (defined($len) && $len !~ /^-?\d+$/) {', + $self->_inline_throw_exception( InvalidArgumentToMethod => + 'argument => $len,'. + 'method_name => "splice",'. + 'type_of_argument => "integer",'. + 'type => "Int",'. + 'argument_noun => "length argument"', + ) . ';', + '}', + ); +} + +sub _potential_value { + my $self = shift; + my ($slot_access) = @_; + + return '(do { ' + . 'my @potential = @{ (' . $slot_access . ') }; ' + . '@return = defined $len ' + . '? (splice @potential, $idx, $len, @_) ' + . ': (splice @potential, $idx); ' + . '\@potential;' + . '})'; +} + +sub _inline_optimized_set_new_value { + my $self = shift; + my ($inv, $new, $slot_access) = @_; + + return ( + '@return = defined $len', + '? (splice @{ (' . $slot_access . ') }, $idx, $len, @_)', + ': (splice @{ (' . $slot_access . ') }, $idx);', + ); +} + +sub _return_value { + my $self = shift; + my ($slot_access) = @_; + + return 'wantarray ? @return : $return[-1]'; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Array/uniq.pm b/lib/Moose/Meta/Method/Accessor/Native/Array/uniq.pm new file mode 100644 index 0000000..535b802 --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Array/uniq.pm @@ -0,0 +1,24 @@ +package Moose::Meta::Method::Accessor::Native::Array::uniq; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use List::MoreUtils (); + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Reader'; + +sub _maximum_arguments { 0 } + +sub _return_value { + my $self = shift; + my ($slot_access) = @_; + + return 'List::MoreUtils::uniq @{ (' . $slot_access . ') }'; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Array/unshift.pm b/lib/Moose/Meta/Method/Accessor/Native/Array/unshift.pm new file mode 100644 index 0000000..4111671 --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Array/unshift.pm @@ -0,0 +1,36 @@ +package Moose::Meta::Method::Accessor::Native::Array::unshift; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Array::Writer'; + +sub _adds_members { 1 } + +sub _potential_value { + my $self = shift; + my ($slot_access) = @_; + + return '[ @_, @{ (' . $slot_access . ') } ]'; +} + +sub _inline_optimized_set_new_value { + my $self = shift; + my ($inv, $new, $slot_access) = @_; + + return 'unshift @{ (' . $slot_access . ') }, @_;'; +} + +sub _return_value { + my $self = shift; + my ($slot_access) = @_; + + return 'scalar @{ (' . $slot_access . ') }'; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Bool/not.pm b/lib/Moose/Meta/Method/Accessor/Native/Bool/not.pm new file mode 100644 index 0000000..60eb646 --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Bool/not.pm @@ -0,0 +1,20 @@ +package Moose::Meta::Method::Accessor::Native::Bool::not; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Reader'; + +sub _maximum_arguments { 0 } + +sub _return_value { + my $self = shift; + my ($slot_access) = @_; + + return '!' . $slot_access; +} + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Bool/set.pm b/lib/Moose/Meta/Method/Accessor/Native/Bool/set.pm new file mode 100644 index 0000000..725da20 --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Bool/set.pm @@ -0,0 +1,24 @@ +package Moose::Meta::Method::Accessor::Native::Bool::set; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Writer'; + +sub _maximum_arguments { 0 } + +sub _potential_value { 1 } + +sub _inline_optimized_set_new_value { + my $self = shift; + my ($inv, $new, $slot_access) = @_; + + return $slot_access . ' = 1;'; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Bool/toggle.pm b/lib/Moose/Meta/Method/Accessor/Native/Bool/toggle.pm new file mode 100644 index 0000000..663b1a2 --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Bool/toggle.pm @@ -0,0 +1,29 @@ +package Moose::Meta::Method::Accessor::Native::Bool::toggle; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Writer'; + +sub _maximum_arguments { 0 } + +sub _potential_value { + my $self = shift; + my ($slot_access) = @_; + + return $slot_access . ' ? 0 : 1'; +} + +sub _inline_optimized_set_new_value { + my $self = shift; + my ($inv, $new, $slot_access) = @_; + + return $slot_access . ' = ' . $slot_access . ' ? 0 : 1;'; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Bool/unset.pm b/lib/Moose/Meta/Method/Accessor/Native/Bool/unset.pm new file mode 100644 index 0000000..6c5c62b --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Bool/unset.pm @@ -0,0 +1,24 @@ +package Moose::Meta::Method::Accessor::Native::Bool::unset; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Writer'; + +sub _maximum_arguments { 0 } + +sub _potential_value { 0 } + +sub _inline_optimized_set_new_value { + my $self = shift; + my ($inv, $new, $slot_access) = @_; + + return $slot_access . ' = 0;'; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Code/execute.pm b/lib/Moose/Meta/Method/Accessor/Native/Code/execute.pm new file mode 100644 index 0000000..c74604f --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Code/execute.pm @@ -0,0 +1,20 @@ +package Moose::Meta::Method::Accessor::Native::Code::execute; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Reader'; + +sub _return_value { + my $self = shift; + my ($slot_access) = @_; + + return $slot_access . '->(@_)'; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Code/execute_method.pm b/lib/Moose/Meta/Method/Accessor/Native/Code/execute_method.pm new file mode 100644 index 0000000..b3d40b9 --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Code/execute_method.pm @@ -0,0 +1,20 @@ +package Moose::Meta::Method::Accessor::Native::Code::execute_method; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Reader'; + +sub _return_value { + my $self = shift; + my ($slot_access) = @_; + + return $slot_access . '->($self, @_)'; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Collection.pm b/lib/Moose/Meta/Method/Accessor/Native/Collection.pm new file mode 100644 index 0000000..67331d5 --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Collection.pm @@ -0,0 +1,167 @@ +package Moose::Meta::Method::Accessor::Native::Collection; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Role; + +requires qw( _adds_members ); + +sub _inline_coerce_new_values { + my $self = shift; + + return unless $self->associated_attribute->should_coerce; + + return unless $self->_tc_member_type_can_coerce; + + return ( + '(' . $self->_new_members . ') = map { $member_coercion->($_) }', + $self->_new_members . ';', + ); +} + +sub _tc_member_type_can_coerce { + my $self = shift; + + my $member_tc = $self->_tc_member_type; + + return $member_tc && $member_tc->has_coercion; +} + +sub _tc_member_type { + my $self = shift; + + my $tc = $self->associated_attribute->type_constraint; + while ($tc) { + return $tc->type_parameter + if $tc->can('type_parameter'); + $tc = $tc->parent; + } + + return; +} + +sub _writer_value_needs_copy { + my $self = shift; + + return $self->_constraint_must_be_checked + && !$self->_check_new_members_only; +} + +sub _inline_tc_code { + my $self = shift; + my ($value, $tc, $coercion, $message, $is_lazy) = @_; + + return unless $self->_constraint_must_be_checked; + + if ($self->_check_new_members_only) { + return unless $self->_adds_members; + + return $self->_inline_check_member_constraint($self->_new_members); + } + else { + return ( + $self->_inline_check_coercion($value, $tc, $coercion, $is_lazy), + $self->_inline_check_constraint($value, $tc, $message, $is_lazy), + ); + } +} + +sub _check_new_members_only { + my $self = shift; + + my $attr = $self->associated_attribute; + + my $tc = $attr->type_constraint; + + # If we have a coercion, we could come up with an entirely new value after + # coercing, so we need to check everything, + return 0 if $attr->should_coerce && $tc->has_coercion; + + # If the parent is our root type (ArrayRef, HashRef, etc), that means we + # can just check the new members of the collection, because we know that + # we will always be generating an appropriate collection type. + # + # However, if this type has its own constraint (it's Parameteriz_able_, + # not Paramet_erized_), we don't know what is being checked by the + # constraint, so we need to check the whole value, not just the members. + return 1 + if $self->_is_root_type( $tc->parent ) + && ( $tc->isa('Moose::Meta::TypeConstraint::Parameterized') + || $tc->isa('Specio::Constraint::Parameterized') ); + + return 0; +} + +sub _inline_check_member_constraint { + my $self = shift; + my ($new_value) = @_; + + my $attr_name = $self->associated_attribute->name; + + my $check + = $self->_tc_member_type->can_be_inlined + ? '! (' . $self->_tc_member_type->_inline_check('$new_val') . ')' + : ' !$member_tc->($new_val) '; + + return ( + 'for my $new_val (' . $new_value . ') {', + "if ($check) {", + 'my $msg = do { local $_ = $new_val; $member_message->($new_val) };'. + $self->_inline_throw_exception( ValidationFailedForInlineTypeConstraint => + "attribute_name => '".$attr_name."',". + 'type_constraint_message => $msg,'. + 'class_name => $class_name,'. + 'value => $new_val,'. + 'new_member => 1', + ) . ';', + '}', + '}', + ); +} + +sub _inline_get_old_value_for_trigger { + my $self = shift; + my ($instance, $old) = @_; + + my $attr = $self->associated_attribute; + return unless $attr->has_trigger; + + return ( + 'my ' . $old . ' = ' . $self->_has_value($instance), + '? ' . $self->_copy_old_value($self->_get_value($instance)), + ': ();', + ); +} + +around _eval_environment => sub { + my $orig = shift; + my $self = shift; + + my $env = $self->$orig(@_); + + my $member_tc = $self->_tc_member_type; + + return $env unless $member_tc; + + $env->{'$member_tc'} = \( $member_tc->_compiled_type_constraint ); + $env->{'$member_coercion'} = \( + $member_tc->coercion->_compiled_type_coercion + ) if $member_tc->has_coercion; + $env->{'$member_message'} = \( + $member_tc->has_message + ? $member_tc->message + : $member_tc->_default_message + ); + + my $tc_env = $member_tc->inline_environment(); + + $env = { %{$env}, %{$tc_env} }; + + return $env; +}; + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Counter/Writer.pm b/lib/Moose/Meta/Method/Accessor/Native/Counter/Writer.pm new file mode 100644 index 0000000..55ab4a7 --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Counter/Writer.pm @@ -0,0 +1,24 @@ +package Moose::Meta::Method::Accessor::Native::Counter::Writer; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Writer'; + +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) + ); +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Counter/dec.pm b/lib/Moose/Meta/Method/Accessor/Native/Counter/dec.pm new file mode 100644 index 0000000..3e61d59 --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Counter/dec.pm @@ -0,0 +1,30 @@ +package Moose::Meta::Method::Accessor::Native::Counter::dec; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Writer'; + +sub _minimum_arguments { 0 } +sub _maximum_arguments { 1 } + +sub _potential_value { + my $self = shift; + my ($slot_access) = @_; + + return $slot_access . ' - (defined $_[0] ? $_[0] : 1)'; +} + +sub _inline_optimized_set_new_value { + my $self = shift; + my ($inv, $new, $slot_access) = @_; + + return $slot_access . ' -= defined $_[0] ? $_[0] : 1;'; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Counter/inc.pm b/lib/Moose/Meta/Method/Accessor/Native/Counter/inc.pm new file mode 100644 index 0000000..1efeab8 --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Counter/inc.pm @@ -0,0 +1,30 @@ +package Moose::Meta::Method::Accessor::Native::Counter::inc; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Writer'; + +sub _minimum_arguments { 0 } +sub _maximum_arguments { 1 } + +sub _potential_value { + my $self = shift; + my ($slot_access) = @_; + + return $slot_access . ' + (defined $_[0] ? $_[0] : 1)'; +} + +sub _inline_optimized_set_new_value { + my $self = shift; + my ($inv, $new, $slot_access) = @_; + + return $slot_access . ' += defined $_[0] ? $_[0] : 1;'; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Counter/reset.pm b/lib/Moose/Meta/Method/Accessor/Native/Counter/reset.pm new file mode 100644 index 0000000..b62ac7b --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Counter/reset.pm @@ -0,0 +1,36 @@ +package Moose::Meta::Method::Accessor::Native::Counter::reset; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Writer'; + +sub _maximum_arguments { 0 } + +sub _potential_value { + my $self = shift; + my ($slot_access) = @_; + + my $attr = $self->associated_attribute; + + return '(do { ' + . join(' ', $attr->_inline_generate_default( + '$self', '$default_for_reset' + )) . ' ' + . '$default_for_reset; ' + . '})'; +} + +sub _inline_optimized_set_new_value { + my $self = shift; + my ($inv, $new, $slot_access) = @_; + + return $slot_access . ' = ' . $self->_potential_value . ';'; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Counter/set.pm b/lib/Moose/Meta/Method/Accessor/Native/Counter/set.pm new file mode 100644 index 0000000..671984c --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Counter/set.pm @@ -0,0 +1,25 @@ +package Moose::Meta::Method::Accessor::Native::Counter::set; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Role; + +with '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 = shift; + my ($inv, $new, $slot_access) = @_; + + return $slot_access . ' = $_[0];'; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Hash.pm b/lib/Moose/Meta/Method/Accessor/Native/Hash.pm new file mode 100644 index 0000000..721c5f5 --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Hash.pm @@ -0,0 +1,28 @@ +package Moose::Meta::Method::Accessor::Native::Hash; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Role; + +sub _inline_check_var_is_valid_key { + my $self = shift; + my ($var) = @_; + + return ( + 'if (!defined(' . $var . ')) {', + $self->_inline_throw_exception( InvalidArgumentToMethod => + 'argument => '.$var.','. + 'method_name => "'.$self->delegate_to_method.'",'. + 'type_of_argument => "defined value",'. + 'type => "Defined",'. + 'argument_noun => "key"', + ) . ';', + '}', + ); +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Hash/Writer.pm b/lib/Moose/Meta/Method/Accessor/Native/Hash/Writer.pm new file mode 100644 index 0000000..ccc3e1f --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Hash/Writer.pm @@ -0,0 +1,31 @@ +package Moose::Meta::Method::Accessor::Native::Hash::Writer; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Class::MOP::MiniTrait; + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Writer', + 'Moose::Meta::Method::Accessor::Native::Hash', + 'Moose::Meta::Method::Accessor::Native::Collection'; + +sub _inline_coerce_new_values { + my $self = shift; + $self->Moose::Meta::Method::Accessor::Native::Collection::_inline_coerce_new_values(@_); +} + +sub _new_values { '@values' } + +sub _copy_old_value { + my $self = shift; + my ($slot_access) = @_; + + return '{ %{ (' . $slot_access . ') } }'; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Hash/accessor.pm b/lib/Moose/Meta/Method/Accessor/Native/Hash/accessor.pm new file mode 100644 index 0000000..f4f978e --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Hash/accessor.pm @@ -0,0 +1,61 @@ +package Moose::Meta::Method::Accessor::Native::Hash::accessor; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Hash::set', + 'Moose::Meta::Method::Accessor::Native::Hash::get'; + +sub _inline_process_arguments { + my $self = shift; + $self->Moose::Meta::Method::Accessor::Native::Hash::set::_inline_process_arguments(@_); +} + +sub _inline_check_argument_count { + my $self = shift; + $self->Moose::Meta::Method::Accessor::Native::Hash::set::_inline_check_argument_count(@_); +} + +sub _inline_check_arguments { + my $self = shift; + $self->Moose::Meta::Method::Accessor::Native::Hash::set::_inline_check_arguments(@_); +} + +sub _return_value { + my $self = shift; + $self->Moose::Meta::Method::Accessor::Native::Hash::set::_return_value(@_); +} + +sub _generate_method { + my $self = shift; + + my $inv = '$self'; + my $slot_access = $self->_get_value($inv); + + return ( + 'sub {', + 'my ' . $inv . ' = shift;', + $self->_inline_curried_arguments, + $self->_inline_check_lazy($inv, '$type_constraint', '$type_coercion', '$type_message'), + # get + 'if (@_ == 1) {', + $self->_inline_check_var_is_valid_key('$_[0]'), + $slot_access . '->{$_[0]}', + '}', + # set + 'else {', + $self->_inline_writer_core($inv, $slot_access), + '}', + '}', + ); +} + +sub _minimum_arguments { 1 } +sub _maximum_arguments { 2 } + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Hash/clear.pm b/lib/Moose/Meta/Method/Accessor/Native/Hash/clear.pm new file mode 100644 index 0000000..751a443 --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Hash/clear.pm @@ -0,0 +1,28 @@ +package Moose::Meta::Method::Accessor::Native::Hash::clear; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Hash::Writer'; + +sub _maximum_arguments { 0 } + +sub _adds_members { 0 } + +sub _potential_value { '{}' } + +sub _inline_optimized_set_new_value { + my $self = shift; + my ($inv, $new, $slot_access) = @_; + + return $slot_access . ' = {};'; +} + +sub _return_value { '' } + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Hash/count.pm b/lib/Moose/Meta/Method/Accessor/Native/Hash/count.pm new file mode 100644 index 0000000..aca9116 --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Hash/count.pm @@ -0,0 +1,22 @@ +package Moose::Meta::Method::Accessor::Native::Hash::count; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Reader'; + +sub _maximum_arguments { 0 } + +sub _return_value { + my $self = shift; + my ($slot_access) = @_; + + return 'scalar keys %{ (' . $slot_access . ') }'; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Hash/defined.pm b/lib/Moose/Meta/Method/Accessor/Native/Hash/defined.pm new file mode 100644 index 0000000..0062918 --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Hash/defined.pm @@ -0,0 +1,31 @@ +package Moose::Meta::Method::Accessor::Native::Hash::defined; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Reader', + 'Moose::Meta::Method::Accessor::Native::Hash'; + +sub _minimum_arguments { 1 } + +sub _maximum_arguments { 1 } + +sub _inline_check_arguments { + my $self = shift; + + return $self->_inline_check_var_is_valid_key('$_[0]'); +} + +sub _return_value { + my $self = shift; + my ($slot_access) = @_; + + return 'defined ' . $slot_access . '->{ $_[0] }'; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Hash/delete.pm b/lib/Moose/Meta/Method/Accessor/Native/Hash/delete.pm new file mode 100644 index 0000000..1a6d706 --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Hash/delete.pm @@ -0,0 +1,40 @@ +package Moose::Meta::Method::Accessor::Native::Hash::delete; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Hash::Writer'; + +sub _adds_members { 0 } + +sub _potential_value { + my $self = shift; + my ($slot_access) = @_; + + return '(do { ' + . 'my %potential = %{ (' . $slot_access . ') }; ' + . '@return = delete @potential{@_}; ' + . '\%potential; ' + . '})'; +} + +sub _inline_optimized_set_new_value { + my $self = shift; + my ($inv, $new, $slot_access) = @_; + + return '@return = delete @{ (' . $slot_access . ') }{@_};'; +} + +sub _return_value { + my $self = shift; + my ($slot_access) = @_; + + return 'wantarray ? @return : $return[-1]'; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Hash/elements.pm b/lib/Moose/Meta/Method/Accessor/Native/Hash/elements.pm new file mode 100644 index 0000000..d1ba09d --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Hash/elements.pm @@ -0,0 +1,23 @@ +package Moose::Meta::Method::Accessor::Native::Hash::elements; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Reader'; + +sub _maximum_arguments { 0 } + +sub _return_value { + my $self = shift; + my ($slot_access) = @_; + + return 'map { $_, ' . $slot_access . '->{$_} } ' + . 'keys %{ (' . $slot_access . ') }'; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Hash/exists.pm b/lib/Moose/Meta/Method/Accessor/Native/Hash/exists.pm new file mode 100644 index 0000000..7ab09cc --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Hash/exists.pm @@ -0,0 +1,31 @@ +package Moose::Meta::Method::Accessor::Native::Hash::exists; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Reader', + 'Moose::Meta::Method::Accessor::Native::Hash'; + +sub _minimum_arguments { 1 } + +sub _maximum_arguments { 1 } + +sub _inline_check_arguments { + my $self = shift; + + return $self->_inline_check_var_is_valid_key('$_[0]'); +} + +sub _return_value { + my $self = shift; + my ($slot_access) = shift; + + return 'exists ' . $slot_access . '->{ $_[0] }'; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Hash/get.pm b/lib/Moose/Meta/Method/Accessor/Native/Hash/get.pm new file mode 100644 index 0000000..a91c8f8 --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Hash/get.pm @@ -0,0 +1,35 @@ +package Moose::Meta::Method::Accessor::Native::Hash::get; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Reader', + 'Moose::Meta::Method::Accessor::Native::Hash'; + +sub _minimum_arguments { 1 } + +sub _inline_check_arguments { + my $self = shift; + + return ( + 'for (@_) {', + $self->_inline_check_var_is_valid_key('$_'), + '}', + ); +} + +sub _return_value { + my $self = shift; + my ($slot_access) = @_; + + return '@_ > 1 ' + . '? @{ (' . $slot_access . ') }{@_} ' + . ': ' . $slot_access . '->{$_[0]}'; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Hash/is_empty.pm b/lib/Moose/Meta/Method/Accessor/Native/Hash/is_empty.pm new file mode 100644 index 0000000..7948927 --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Hash/is_empty.pm @@ -0,0 +1,22 @@ +package Moose::Meta::Method::Accessor::Native::Hash::is_empty; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Reader'; + +sub _maximum_arguments { 0 } + +sub _return_value { + my $self = shift; + my ($slot_access) = @_; + + return 'scalar keys %{ (' . $slot_access . ') } ? 0 : 1'; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Hash/keys.pm b/lib/Moose/Meta/Method/Accessor/Native/Hash/keys.pm new file mode 100644 index 0000000..439be94 --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Hash/keys.pm @@ -0,0 +1,22 @@ +package Moose::Meta::Method::Accessor::Native::Hash::keys; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Reader'; + +sub _maximum_arguments { 0 } + +sub _return_value { + my $self = shift; + my ($slot_access) = @_; + + return 'keys %{ (' . $slot_access . ') }'; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Hash/kv.pm b/lib/Moose/Meta/Method/Accessor/Native/Hash/kv.pm new file mode 100644 index 0000000..4bbb325 --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Hash/kv.pm @@ -0,0 +1,23 @@ +package Moose::Meta::Method::Accessor::Native::Hash::kv; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Reader'; + +sub _maximum_arguments { 0 } + +sub _return_value { + my $self = shift; + my ($slot_access) = @_; + + return 'map { [ $_, ' . $slot_access . '->{$_} ] } ' + . 'keys %{ (' . $slot_access . ') }'; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Hash/set.pm b/lib/Moose/Meta/Method/Accessor/Native/Hash/set.pm new file mode 100644 index 0000000..7d7a1fa --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Hash/set.pm @@ -0,0 +1,103 @@ +package Moose::Meta::Method::Accessor::Native::Hash::set; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use List::MoreUtils (); +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Hash::Writer'; + +sub _minimum_arguments { 2 } + +sub _maximum_arguments { undef } + +around _inline_check_argument_count => sub { + my $orig = shift; + my $self = shift; + + return ( + $self->$orig(@_), + 'if (@_ % 2) {', + $self->_inline_throw_exception( MustPassEvenNumberOfArguments => + "method_name => '".$self->delegate_to_method."',". + 'args => \@_', + ) . ';', + '}', + ); +}; + +sub _inline_process_arguments { + my $self = shift; + + return ( + 'my @keys_idx = grep { ! ($_ % 2) } 0..$#_;', + 'my @values_idx = grep { $_ % 2 } 0..$#_;', + ); +} + +sub _inline_check_arguments { + my $self = shift; + + return ( + 'for (@keys_idx) {', + 'if (!defined($_[$_])) {', + $self->_inline_throw_exception( UndefinedHashKeysPassedToMethod => + 'hash_keys => \@keys_idx,'. + "method_name => '".$self->delegate_to_method."'", + ) . ';', + '}', + '}', + ); +} + +sub _adds_members { 1 } + +# We need to override this because while @_ can be written to, we cannot write +# directly to $_[1]. +sub _inline_coerce_new_values { + my $self = shift; + + return unless $self->associated_attribute->should_coerce; + + return unless $self->_tc_member_type_can_coerce; + + # Is there a simpler way to do this? + return ( + 'my $iter = List::MoreUtils::natatime(2, @_);', + '@_ = ();', + 'while (my ($key, $val) = $iter->()) {', + 'push @_, $key, $member_coercion->($val);', + '}', + ); +}; + +sub _potential_value { + my $self = shift; + my ($slot_access) = @_; + + return '{ %{ (' . $slot_access . ') }, @_ }'; +} + +sub _new_members { '@_[ @values_idx ]' } + +sub _inline_optimized_set_new_value { + my $self = shift; + my ($inv, $new, $slot_access) = @_; + + return '@{ (' . $slot_access . ') }{ @_[@keys_idx] } = @_[@values_idx];'; +} + +sub _return_value { + my $self = shift; + my ($slot_access) = @_; + + return 'wantarray ' + . '? @{ (' . $slot_access . ') }{ @_[@keys_idx] } ' + . ': ' . $slot_access . '->{ $_[$keys_idx[0]] }'; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Hash/shallow_clone.pm b/lib/Moose/Meta/Method/Accessor/Native/Hash/shallow_clone.pm new file mode 100644 index 0000000..62b09cb --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Hash/shallow_clone.pm @@ -0,0 +1,26 @@ +package Moose::Meta::Method::Accessor::Native::Hash::shallow_clone; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Params::Util (); + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Reader'; + +sub _minimum_arguments { 0 } + +sub _maximum_arguments { 0 } + +sub _return_value { + my $self = shift; + my ($slot_access) = @_; + + return '{ %{ (' . $slot_access . ') } }'; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Hash/values.pm b/lib/Moose/Meta/Method/Accessor/Native/Hash/values.pm new file mode 100644 index 0000000..750ce76 --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Hash/values.pm @@ -0,0 +1,22 @@ +package Moose::Meta::Method::Accessor::Native::Hash::values; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Reader'; + +sub _maximum_arguments { 0 } + +sub _return_value { + my $self = shift; + my ($slot_access) = @_; + + return 'values %{ (' . $slot_access . ') }'; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Number/abs.pm b/lib/Moose/Meta/Method/Accessor/Native/Number/abs.pm new file mode 100644 index 0000000..987a89f --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Number/abs.pm @@ -0,0 +1,29 @@ +package Moose::Meta::Method::Accessor::Native::Number::abs; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Writer'; + +sub _maximum_arguments { 0 } + +sub _potential_value { + my $self = shift; + my ($slot_access) = @_; + + return 'abs(' . $slot_access . ')'; +} + +sub _inline_optimized_set_new_value { + my $self = shift; + my ($inv, $new, $slot_access) = @_; + + return $slot_access . ' = abs(' . $slot_access . ');'; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Number/add.pm b/lib/Moose/Meta/Method/Accessor/Native/Number/add.pm new file mode 100644 index 0000000..a7bd95c --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Number/add.pm @@ -0,0 +1,31 @@ +package Moose::Meta::Method::Accessor::Native::Number::add; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Writer'; + +sub _minimum_arguments { 1 } + +sub _maximum_arguments { 1 } + +sub _potential_value { + my $self = shift; + my ($slot_access) = @_; + + return $slot_access . ' + $_[0]'; +} + +sub _inline_optimized_set_new_value { + my $self = shift; + my ($inv, $new, $slot_access) = @_; + + return $slot_access . ' += $_[0];'; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Number/div.pm b/lib/Moose/Meta/Method/Accessor/Native/Number/div.pm new file mode 100644 index 0000000..e2037a2 --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Number/div.pm @@ -0,0 +1,31 @@ +package Moose::Meta::Method::Accessor::Native::Number::div; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Writer'; + +sub _minimum_arguments { 1 } + +sub _maximum_arguments { 1 } + +sub _potential_value { + my $self = shift; + my ($slot_access) = @_; + + return $slot_access . ' / $_[0]'; +} + +sub _inline_optimized_set_new_value { + my $self = shift; + my ($inv, $new, $slot_access) = @_; + + return $slot_access . ' /= $_[0];'; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Number/mod.pm b/lib/Moose/Meta/Method/Accessor/Native/Number/mod.pm new file mode 100644 index 0000000..80a3c2a --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Number/mod.pm @@ -0,0 +1,31 @@ +package Moose::Meta::Method::Accessor::Native::Number::mod; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Writer'; + +sub _minimum_arguments { 1 } + +sub _maximum_arguments { 1 } + +sub _potential_value { + my $self = shift; + my ($slot_access) = @_; + + return $slot_access . ' % $_[0]'; +} + +sub _inline_optimized_set_new_value { + my $self = shift; + my ($inv, $new, $slot_access) = @_; + + return $slot_access . ' %= $_[0];'; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Number/mul.pm b/lib/Moose/Meta/Method/Accessor/Native/Number/mul.pm new file mode 100644 index 0000000..6b019a6 --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Number/mul.pm @@ -0,0 +1,31 @@ +package Moose::Meta::Method::Accessor::Native::Number::mul; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Writer'; + +sub _minimum_arguments { 1 } + +sub _maximum_arguments { 1 } + +sub _potential_value { + my $self = shift; + my ($slot_access) = @_; + + return $slot_access . ' * $_[0]'; +} + +sub _inline_optimized_set_new_value { + my $self = shift; + my ($inv, $new, $slot_access) = @_; + + return $slot_access . ' *= $_[0];'; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Number/set.pm b/lib/Moose/Meta/Method/Accessor/Native/Number/set.pm new file mode 100644 index 0000000..2aa9c40 --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Number/set.pm @@ -0,0 +1,25 @@ +package Moose::Meta::Method::Accessor::Native::Number::set; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Role; + +with '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 = shift; + my ($inv, $new, $slot_access) = @_; + + return $slot_access . ' = $_[0];'; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Number/sub.pm b/lib/Moose/Meta/Method/Accessor/Native/Number/sub.pm new file mode 100644 index 0000000..c2fa157 --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Number/sub.pm @@ -0,0 +1,31 @@ +package Moose::Meta::Method::Accessor::Native::Number::sub; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Writer'; + +sub _minimum_arguments { 1 } + +sub _maximum_arguments { 1 } + +sub _potential_value { + my $self = shift; + my ($slot_access) = @_; + + return $slot_access . ' - $_[0]'; +} + +sub _inline_optimized_set_new_value { + my $self = shift; + my ($inv, $new, $slot_access) = @_; + + return $slot_access . ' -= $_[0];'; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Reader.pm b/lib/Moose/Meta/Method/Accessor/Native/Reader.pm new file mode 100644 index 0000000..df885e5 --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Reader.pm @@ -0,0 +1,47 @@ +package Moose::Meta::Method::Accessor::Native::Reader; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native'; + +requires '_return_value'; + +sub _generate_method { + my $self = shift; + + my $inv = '$self'; + my $slot_access = $self->_get_value($inv); + + return ( + 'sub {', + 'my ' . $inv . ' = shift;', + $self->_inline_curried_arguments, + $self->_inline_reader_core($inv, $slot_access, @_), + '}', + ); +} + +sub _inline_reader_core { + my $self = shift; + my ($inv, $slot_access, @extra) = @_; + + return ( + $self->_inline_check_argument_count, + $self->_inline_process_arguments($inv, $slot_access), + $self->_inline_check_arguments, + $self->_inline_check_lazy($inv, '$type_constraint', '$type_coercion', '$type_message'), + $self->_inline_return_value($slot_access), + ); +} + +sub _inline_process_arguments { return } + +sub _inline_check_arguments { return } + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/String/append.pm b/lib/Moose/Meta/Method/Accessor/Native/String/append.pm new file mode 100644 index 0000000..e941e5a --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/String/append.pm @@ -0,0 +1,31 @@ +package Moose::Meta::Method::Accessor::Native::String::append; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Writer'; + +sub _minimum_arguments { 1 } + +sub _maximum_arguments { 1 } + +sub _potential_value { + my $self = shift; + my ($slot_access) = @_; + + return '( ' . $slot_access . ' . $_[0] )'; +} + +sub _inline_optimized_set_new_value { + my $self = shift; + my ($inv, $new, $slot_access) = @_; + + return $slot_access . ' .= $_[0];'; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/String/chomp.pm b/lib/Moose/Meta/Method/Accessor/Native/String/chomp.pm new file mode 100644 index 0000000..49e2215 --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/String/chomp.pm @@ -0,0 +1,40 @@ +package Moose::Meta::Method::Accessor::Native::String::chomp; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Writer'; + +sub _maximum_arguments { 0 } + +sub _potential_value { + my $self = shift; + my ($slot_access) = @_; + + return '(do { ' + . 'my $val = ' . $slot_access . '; ' + . '@return = chomp $val; ' + . '$val ' + . '})'; +} + +sub _inline_optimized_set_new_value { + my $self = shift; + my ($inv, $new, $slot_access) = @_; + + return '@return = chomp ' . $slot_access . ';'; +} + +sub _return_value { + my $self = shift; + my ($slot_access) = @_; + + return '$return[0]'; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/String/chop.pm b/lib/Moose/Meta/Method/Accessor/Native/String/chop.pm new file mode 100644 index 0000000..c15fd0f --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/String/chop.pm @@ -0,0 +1,40 @@ +package Moose::Meta::Method::Accessor::Native::String::chop; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Writer'; + +sub _maximum_arguments { 0 } + +sub _potential_value { + my $self = shift; + my ($slot_access) = @_; + + return '(do { ' + . 'my $val = ' . $slot_access . '; ' + . '@return = chop $val; ' + . '$val; ' + . '})'; +} + +sub _inline_optimized_set_new_value { + my $self = shift; + my ($inv, $new, $slot_access) = @_; + + return '@return = chop ' . $slot_access . ';'; +} + +sub _return_value { + my $self = shift; + my ($slot_access) = @_; + + return '$return[0]'; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/String/clear.pm b/lib/Moose/Meta/Method/Accessor/Native/String/clear.pm new file mode 100644 index 0000000..7aec2c5 --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/String/clear.pm @@ -0,0 +1,24 @@ +package Moose::Meta::Method::Accessor::Native::String::clear; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Writer'; + +sub _maximum_arguments { 0 } + +sub _potential_value { '""' } + +sub _inline_optimized_set_new_value { + my $self = shift; + my ($inv, $new, $slot_access) = @_; + + return $slot_access . ' = "";'; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/String/inc.pm b/lib/Moose/Meta/Method/Accessor/Native/String/inc.pm new file mode 100644 index 0000000..3ee5605 --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/String/inc.pm @@ -0,0 +1,33 @@ +package Moose::Meta::Method::Accessor::Native::String::inc; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Writer'; + +sub _maximum_arguments { 0 } + +sub _potential_value { + my $self = shift; + my ($slot_access) = @_; + + return '(do { ' + . 'my $val = ' . $slot_access . '; ' + . '$val++; ' + . '$val; ' + . '})'; +} + +sub _inline_optimized_set_new_value { + my $self = shift; + my ($inv, $new, $slot_access) = @_; + + return $slot_access . '++;'; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/String/length.pm b/lib/Moose/Meta/Method/Accessor/Native/String/length.pm new file mode 100644 index 0000000..bf40b40 --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/String/length.pm @@ -0,0 +1,22 @@ +package Moose::Meta::Method::Accessor::Native::String::length; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Reader'; + +sub _maximum_arguments { 0 } + +sub _return_value { + my $self = shift; + my ($slot_access) = @_; + + return 'length ' . $slot_access; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/String/match.pm b/lib/Moose/Meta/Method/Accessor/Native/String/match.pm new file mode 100644 index 0000000..ae85a96 --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/String/match.pm @@ -0,0 +1,42 @@ +package Moose::Meta::Method::Accessor::Native::String::match; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Util (); +use Params::Util (); + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Reader'; + +sub _minimum_arguments { 1 } + +sub _maximum_arguments { 1 } + +sub _inline_check_arguments { + my $self = shift; + + return ( + 'if (!Moose::Util::_STRINGLIKE0($_[0]) && !Params::Util::_REGEX($_[0])) {', + $self->_inline_throw_exception( InvalidArgumentToMethod => + 'argument => $_[0],'. + 'type => "Str|RegexpRef",'. + 'type_of_argument => "string or regexp reference",'. + 'method_name => "match"', + ) . ';', + '}', + ); +} + +sub _return_value { + my $self = shift; + my ($slot_access) = @_; + + return $slot_access . ' =~ $_[0]'; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/String/prepend.pm b/lib/Moose/Meta/Method/Accessor/Native/String/prepend.pm new file mode 100644 index 0000000..87a0695 --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/String/prepend.pm @@ -0,0 +1,31 @@ +package Moose::Meta::Method::Accessor::Native::String::prepend; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Writer'; + +sub _minimum_arguments { 1 } + +sub _maximum_arguments { 1 } + +sub _potential_value { + my $self = shift; + my ($slot_access) = @_; + + return '$_[0] . ' . $slot_access; +} + +sub _inline_optimized_set_new_value { + my $self = shift; + my ($inv, $new, $slot_access) = @_; + + return $slot_access . ' = $_[0] . ' . $slot_access . ';'; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/String/replace.pm b/lib/Moose/Meta/Method/Accessor/Native/String/replace.pm new file mode 100644 index 0000000..6e33609 --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/String/replace.pm @@ -0,0 +1,69 @@ +package Moose::Meta::Method::Accessor::Native::String::replace; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Util (); +use Params::Util (); + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Writer'; + +sub _minimum_arguments { 1 } + +sub _maximum_arguments { 2 } + +sub _inline_check_arguments { + my $self = shift; + + return ( + 'if (!Moose::Util::_STRINGLIKE0($_[0]) && !Params::Util::_REGEX($_[0])) {', + $self->_inline_throw_exception( InvalidArgumentToMethod => + 'argument => $_[0],'. + 'method_name => "replace",'. + 'ordinal => "first",'. + 'type_of_argument => "string or regexp reference",'. + 'type => "Str|RegexpRef"', + ) . ';', + '}', + 'if (!Moose::Util::_STRINGLIKE0($_[1]) && !Params::Util::_CODELIKE($_[1])) {', + $self->_inline_throw_exception( InvalidArgumentToMethod => + 'argument => $_[1],'. + 'method_name => "replace",'. + 'ordinal => "second",'. + 'type_of_argument => "string or code reference",'. + 'type => "Str|CodeRef"', + ) . ';', + '}', + ); +} + +sub _potential_value { + my $self = shift; + my ($slot_access) = @_; + + return '(do { ' + . 'my $val = ' . $slot_access . '; ' + . 'ref $_[1] ' + . '? $val =~ s/$_[0]/$_[1]->()/e ' + . ': $val =~ s/$_[0]/$_[1]/; ' + . '$val; ' + . '})'; +} + +sub _inline_optimized_set_new_value { + my $self = shift; + my ($inv, $new, $slot_access) = @_; + + return ( + 'ref $_[1]', + '? ' . $slot_access . ' =~ s/$_[0]/$_[1]->()/e', + ': ' . $slot_access . ' =~ s/$_[0]/$_[1]/;', + ); +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/String/substr.pm b/lib/Moose/Meta/Method/Accessor/Native/String/substr.pm new file mode 100644 index 0000000..df82e23 --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/String/substr.pm @@ -0,0 +1,123 @@ +package Moose::Meta::Method::Accessor::Native::String::substr; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Util (); + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native::Reader', + 'Moose::Meta::Method::Accessor::Native::Writer'; + +sub _generate_method { + my $self = shift; + + my $inv = '$self'; + my $slot_access = $self->_get_value($inv); + + return ( + 'sub {', + 'my ' . $inv . ' = shift;', + $self->_inline_curried_arguments, + 'if (@_ == 1 || @_ == 2) {', + $self->_inline_reader_core($inv, $slot_access), + '}', + 'elsif (@_ == 3) {', + $self->_inline_writer_core($inv, $slot_access), + '}', + 'else {', + $self->_inline_check_argument_count, + '}', + '}', + ); +} + +sub _minimum_arguments { 1 } +sub _maximum_arguments { 3 } + +sub _inline_process_arguments { + my $self = shift; + my ($inv, $slot_access) = @_; + + return ( + 'my $offset = shift;', + 'my $length = @_ ? shift : length ' . $slot_access . ';', + 'my $replacement = shift;', + ); +} + +sub _inline_check_arguments { + my $self = shift; + my ($for_writer) = @_; + + my @code = ( + 'if ($offset !~ /^-?\d+$/) {', + $self->_inline_throw_exception( InvalidArgumentToMethod => + 'argument => $offset,'. + 'ordinal => "first",'. + 'type_of_argument => "integer",'. + 'method_name => "substr",'. + 'type => "Int"', + ) . ';', + '}', + 'if ($length !~ /^-?\d+$/) {', + $self->_inline_throw_exception( InvalidArgumentToMethod => + 'argument => $length,'. + 'ordinal => "second",'. + 'type_of_argument => "integer",'. + 'method_name => "substr",'. + 'type => "Int"', + ) . ';', + '}', + ); + + if ($for_writer) { + push @code, ( + 'if (!Moose::Util::_STRINGLIKE0($replacement)) {', + $self->_inline_throw_exception( InvalidArgumentToMethod => + 'argument => $replacement,'. + 'ordinal => "third",'. + 'type_of_argument => "string",'. + 'method_name => "substr",'. + 'type => "Str"', + ) . ';', + '}', + ); + } + + return @code; +} + +sub _potential_value { + my $self = shift; + my ($slot_access) = @_; + + return '(do { ' + . 'my $potential = ' . $slot_access . '; ' + . '@return = substr $potential, $offset, $length, $replacement; ' + . '$potential; ' + . '})'; +} + +sub _inline_optimized_set_new_value { + my $self = shift; + my ($inv, $new, $slot_access) = @_; + + return '@return = substr ' . $slot_access . ', ' + . '$offset, $length, $replacement;'; +} + +sub _return_value { + my $self = shift; + my ($slot_access, $for_writer) = @_; + + return '$return[0]' if $for_writer; + + return 'substr ' . $slot_access . ', $offset, $length'; +} + +no Moose::Role; + +1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Writer.pm b/lib/Moose/Meta/Method/Accessor/Native/Writer.pm new file mode 100644 index 0000000..b25e063 --- /dev/null +++ b/lib/Moose/Meta/Method/Accessor/Native/Writer.pm @@ -0,0 +1,174 @@ +package Moose::Meta::Method::Accessor::Native::Writer; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use List::Util 1.33 qw( any ); +use Moose::Util; + +use Moose::Role; + +with 'Moose::Meta::Method::Accessor::Native'; + +requires '_potential_value'; + +sub _generate_method { + my $self = shift; + + my $inv = '$self'; + my $slot_access = $self->_get_value($inv); + + return ( + 'sub {', + 'my ' . $inv . ' = shift;', + $self->_inline_curried_arguments, + $self->_inline_writer_core($inv, $slot_access), + '}', + ); +} + +sub _inline_writer_core { + my $self = shift; + my ($inv, $slot_access) = @_; + + my $potential = $self->_potential_value($slot_access); + my $old = '@old'; + + my @code; + push @code, ( + $self->_inline_check_argument_count, + $self->_inline_process_arguments($inv, $slot_access), + $self->_inline_check_arguments('for writer'), + $self->_inline_check_lazy($inv, '$type_constraint', '$type_coercion', '$type_message'), + ); + + if ($self->_return_value($slot_access)) { + # some writers will save the return value in this variable when they + # generate the potential value. + push @code, 'my @return;' + } + + push @code, ( + $self->_inline_coerce_new_values, + $self->_inline_copy_native_value(\$potential), + $self->_inline_tc_code($potential, '$type_constraint', '$type_coercion', '$type_message'), + $self->_inline_get_old_value_for_trigger($inv, $old), + $self->_inline_capture_return_value($slot_access), + $self->_inline_set_new_value($inv, $potential, $slot_access), + $self->_inline_trigger($inv, $slot_access, $old), + $self->_inline_return_value($slot_access, 'for writer'), + ); + + return @code; +} + +sub _inline_process_arguments { return } + +sub _inline_check_arguments { return } + +sub _inline_coerce_new_values { return } + +sub _writer_value_needs_copy { + my $self = shift; + + return $self->_constraint_must_be_checked; +} + +sub _constraint_must_be_checked { + my $self = shift; + + my $attr = $self->associated_attribute; + + return $attr->has_type_constraint + && ( !$self->_is_root_type( $attr->type_constraint ) + || ( $attr->should_coerce && $attr->type_constraint->has_coercion ) ); +} + +sub _is_root_type { + my $self = shift; + my $type = shift; + + if ( blessed($type) + && $type->can('does') + && $type->does('Specio::Constraint::Role::Interface') ) + { + require Specio::Library::Builtins; + return + any { $type->is_same_type_as( Specio::Library::Builtins::t($_) ) } + @{ $self->root_types }; + } + else { + my $name = $type->name; + return any { $name eq $_ } @{ $self->root_types }; + } +} + +sub _inline_copy_native_value { + my $self = shift; + my ($potential_ref) = @_; + + return unless $self->_writer_value_needs_copy; + + my $code = 'my $potential = ' . ${$potential_ref} . ';'; + + ${$potential_ref} = '$potential'; + + return $code; +} + +around _inline_tc_code => sub { + my $orig = shift; + my $self = shift; + my ($value, $tc, $coercion, $message, $for_lazy) = @_; + + return unless $for_lazy || $self->_constraint_must_be_checked; + + return $self->$orig(@_); +}; + +around _inline_check_constraint => sub { + my $orig = shift; + my $self = shift; + my ($value, $tc, $message, $for_lazy) = @_; + + return unless $for_lazy || $self->_constraint_must_be_checked; + + return $self->$orig(@_); +}; + +sub _inline_capture_return_value { return } + +sub _inline_set_new_value { + my $self = shift; + + return $self->_inline_store_value(@_) + if $self->_writer_value_needs_copy + || !$self->_slot_access_can_be_inlined + || !$self->_get_is_lvalue; + + return $self->_inline_optimized_set_new_value(@_); +} + +sub _get_is_lvalue { + my $self = shift; + + return $self->associated_attribute->associated_class->instance_metaclass->inline_get_is_lvalue; +} + +sub _inline_optimized_set_new_value { + my $self = shift; + + return $self->_inline_store_value(@_); +} + +sub _return_value { + my $self = shift; + my ($slot_access) = @_; + + return $slot_access; +} + +no Moose::Role; + +1; |