matteo/lms-plugins
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases 1 Wiki Activity

Add Moose package
All checks were successful
release / release-plugins (push) Successful in 28s
Details

Browse Source
This commit is contained in:
mschuepbach
2024-04-24 13:33:38 +02:00
parent 24101a5c1a
commit d95734d3d0
413 changed files with 47294 additions and 1 deletions
Download Patch File Download Diff File Expand all files Collapse all files

28
CPAN/Moose/Meta/Method/Accessor/Native/Array.pm Normal file
View File

@@ -0,0 +1,28 @@
package Moose::Meta::Method::Accessor::Native::Array;
our $VERSION = '2.2207';
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;

27
CPAN/Moose/Meta/Method/Accessor/Native/Array/Writer.pm Normal file
View File

@@ -0,0 +1,27 @@
package Moose::Meta::Method::Accessor::Native::Array::Writer;
our $VERSION = '2.2207';
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;

56
CPAN/Moose/Meta/Method/Accessor/Native/Array/accessor.pm Normal file
View File

@@ -0,0 +1,56 @@
package Moose::Meta::Method::Accessor::Native::Array::accessor;
our $VERSION = '2.2207';
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;

28
CPAN/Moose/Meta/Method/Accessor/Native/Array/clear.pm Normal file
View File

@@ -0,0 +1,28 @@
package Moose::Meta::Method::Accessor::Native::Array::clear;
our $VERSION = '2.2207';
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;

22
CPAN/Moose/Meta/Method/Accessor/Native/Array/count.pm Normal file
View File

@@ -0,0 +1,22 @@
package Moose::Meta::Method::Accessor::Native::Array::count;
our $VERSION = '2.2207';
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;

50
CPAN/Moose/Meta/Method/Accessor/Native/Array/delete.pm Normal file
View File

@@ -0,0 +1,50 @@
package Moose::Meta::Method::Accessor::Native::Array::delete;
our $VERSION = '2.2207';
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;

22
CPAN/Moose/Meta/Method/Accessor/Native/Array/elements.pm Normal file
View File

@@ -0,0 +1,22 @@
package Moose::Meta::Method::Accessor::Native::Array::elements;
our $VERSION = '2.2207';
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;

42
CPAN/Moose/Meta/Method/Accessor/Native/Array/first.pm Normal file
View File

@@ -0,0 +1,42 @@
package Moose::Meta::Method::Accessor::Native::Array::first;
our $VERSION = '2.2207';
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;

51
CPAN/Moose/Meta/Method/Accessor/Native/Array/first_index.pm Normal file
View File

@@ -0,0 +1,51 @@
package Moose::Meta::Method::Accessor::Native::Array::first_index;
our $VERSION = '2.2207';
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 => "first_index",'.
'type_of_argument => "code reference",'.
'type => "CodeRef",',
) . ';',
'}',
);
}
sub _inline_return_value {
my $self = shift;
my ($slot_access) = @_;
return join '',
'my @values = @{ (' . $slot_access . ') };',
'my $f = $_[0];',
'foreach my $i ( 0 .. $#values ) {',
'local *_ = \\$values[$i];',
'return $i if $f->();',
'}',
'return -1;';
}
# Not called, but needed to satisfy the Reader role
sub _return_value { }
no Moose::Role;
1;

31
CPAN/Moose/Meta/Method/Accessor/Native/Array/get.pm Normal file
View File

@@ -0,0 +1,31 @@
package Moose::Meta::Method::Accessor::Native::Array::get;
our $VERSION = '2.2207';
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;

41
CPAN/Moose/Meta/Method/Accessor/Native/Array/grep.pm Normal file
View File

@@ -0,0 +1,41 @@
package Moose::Meta::Method::Accessor::Native::Array::grep;
our $VERSION = '2.2207';
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;

58
CPAN/Moose/Meta/Method/Accessor/Native/Array/insert.pm Normal file
View File

@@ -0,0 +1,58 @@
package Moose::Meta::Method::Accessor::Native::Array::insert;
our $VERSION = '2.2207';
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;

22
CPAN/Moose/Meta/Method/Accessor/Native/Array/is_empty.pm Normal file
View File

@@ -0,0 +1,22 @@
package Moose::Meta::Method::Accessor::Native::Array::is_empty;
our $VERSION = '2.2207';
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;

41
CPAN/Moose/Meta/Method/Accessor/Native/Array/join.pm Normal file
View File

@@ -0,0 +1,41 @@
package Moose::Meta::Method::Accessor::Native::Array::join;
our $VERSION = '2.2207';
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;

41
CPAN/Moose/Meta/Method/Accessor/Native/Array/map.pm Normal file
View File

@@ -0,0 +1,41 @@
package Moose::Meta::Method::Accessor::Native::Array::map;
our $VERSION = '2.2207';
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;

66
CPAN/Moose/Meta/Method/Accessor/Native/Array/natatime.pm Normal file
View File

@@ -0,0 +1,66 @@
package Moose::Meta::Method::Accessor::Native::Array::natatime;
our $VERSION = '2.2207';
use strict;
use warnings;
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 $step = $_[0];',
'my @values = @{ (' . $slot_access . ') };',
'my $iter = sub { splice @values, 0, $step };',
'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;

47
CPAN/Moose/Meta/Method/Accessor/Native/Array/pop.pm Normal file
View File

@@ -0,0 +1,47 @@
package Moose::Meta::Method::Accessor::Native::Array::pop;
our $VERSION = '2.2207';
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;

36
CPAN/Moose/Meta/Method/Accessor/Native/Array/push.pm Normal file
View File

@@ -0,0 +1,36 @@
package Moose::Meta::Method::Accessor::Native::Array::push;
our $VERSION = '2.2207';
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;

42
CPAN/Moose/Meta/Method/Accessor/Native/Array/reduce.pm Normal file
View File

@@ -0,0 +1,42 @@
package Moose::Meta::Method::Accessor::Native::Array::reduce;
our $VERSION = '2.2207';
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;

64
CPAN/Moose/Meta/Method/Accessor/Native/Array/set.pm Normal file
View File

@@ -0,0 +1,64 @@
package Moose::Meta::Method::Accessor::Native::Array::set;
our $VERSION = '2.2207';
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;

26
CPAN/Moose/Meta/Method/Accessor/Native/Array/shallow_clone.pm Normal file
View File

@@ -0,0 +1,26 @@
package Moose::Meta::Method::Accessor::Native::Array::shallow_clone;
our $VERSION = '2.2207';
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;

47
CPAN/Moose/Meta/Method/Accessor/Native/Array/shift.pm Normal file
View File

@@ -0,0 +1,47 @@
package Moose::Meta::Method::Accessor::Native::Array::shift;
our $VERSION = '2.2207';
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;

24
CPAN/Moose/Meta/Method/Accessor/Native/Array/shuffle.pm Normal file
View File

@@ -0,0 +1,24 @@
package Moose::Meta::Method::Accessor::Native::Array::shuffle;
our $VERSION = '2.2207';
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;

44
CPAN/Moose/Meta/Method/Accessor/Native/Array/sort.pm Normal file
View File

@@ -0,0 +1,44 @@
package Moose::Meta::Method::Accessor::Native::Array::sort;
our $VERSION = '2.2207';
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;

45
CPAN/Moose/Meta/Method/Accessor/Native/Array/sort_in_place.pm Normal file
View File

@@ -0,0 +1,45 @@
package Moose::Meta::Method::Accessor::Native::Array::sort_in_place;
our $VERSION = '2.2207';
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;

72
CPAN/Moose/Meta/Method/Accessor/Native/Array/splice.pm Normal file
View File

@@ -0,0 +1,72 @@
package Moose::Meta::Method::Accessor::Native::Array::splice;
our $VERSION = '2.2207';
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;

24
CPAN/Moose/Meta/Method/Accessor/Native/Array/uniq.pm Normal file
View File

@@ -0,0 +1,24 @@
package Moose::Meta::Method::Accessor::Native::Array::uniq;
our $VERSION = '2.2207';
use strict;
use warnings;
use List::Util 1.45 ();
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::uniq @{ (' . $slot_access . ') }';
}
no Moose::Role;
1;

36
CPAN/Moose/Meta/Method/Accessor/Native/Array/unshift.pm Normal file
View File

@@ -0,0 +1,36 @@
package Moose::Meta::Method::Accessor::Native::Array::unshift;
our $VERSION = '2.2207';
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;

20
CPAN/Moose/Meta/Method/Accessor/Native/Bool/not.pm Normal file
View File

@@ -0,0 +1,20 @@
package Moose::Meta::Method::Accessor::Native::Bool::not;
our $VERSION = '2.2207';
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;

24
CPAN/Moose/Meta/Method/Accessor/Native/Bool/set.pm Normal file
View File

@@ -0,0 +1,24 @@
package Moose::Meta::Method::Accessor::Native::Bool::set;
our $VERSION = '2.2207';
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;

29
CPAN/Moose/Meta/Method/Accessor/Native/Bool/toggle.pm Normal file
View File

@@ -0,0 +1,29 @@
package Moose::Meta::Method::Accessor::Native::Bool::toggle;
our $VERSION = '2.2207';
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;

24
CPAN/Moose/Meta/Method/Accessor/Native/Bool/unset.pm Normal file
View File

@@ -0,0 +1,24 @@
package Moose::Meta::Method::Accessor::Native::Bool::unset;
our $VERSION = '2.2207';
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;

20
CPAN/Moose/Meta/Method/Accessor/Native/Code/execute.pm Normal file
View File

@@ -0,0 +1,20 @@
package Moose::Meta::Method::Accessor::Native::Code::execute;
our $VERSION = '2.2207';
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;

20
CPAN/Moose/Meta/Method/Accessor/Native/Code/execute_method.pm Normal file
View File

@@ -0,0 +1,20 @@
package Moose::Meta::Method::Accessor::Native::Code::execute_method;
our $VERSION = '2.2207';
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;

167
CPAN/Moose/Meta/Method/Accessor/Native/Collection.pm Normal file
View File

@@ -0,0 +1,167 @@
package Moose::Meta::Method::Accessor::Native::Collection;
our $VERSION = '2.2207';
use strict;
use warnings;
use Moose::Role;
requires qw( _adds_members _new_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->can('parameterize') );
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;

24
CPAN/Moose/Meta/Method/Accessor/Native/Counter/Writer.pm Normal file
View File

@@ -0,0 +1,24 @@
package Moose::Meta::Method::Accessor::Native::Counter::Writer;
our $VERSION = '2.2207';
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;

30
CPAN/Moose/Meta/Method/Accessor/Native/Counter/dec.pm Normal file
View File

@@ -0,0 +1,30 @@
package Moose::Meta::Method::Accessor::Native::Counter::dec;
our $VERSION = '2.2207';
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;

30
CPAN/Moose/Meta/Method/Accessor/Native/Counter/inc.pm Normal file
View File

@@ -0,0 +1,30 @@
package Moose::Meta::Method::Accessor::Native::Counter::inc;
our $VERSION = '2.2207';
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;

36
CPAN/Moose/Meta/Method/Accessor/Native/Counter/reset.pm Normal file
View File

@@ -0,0 +1,36 @@
package Moose::Meta::Method::Accessor::Native::Counter::reset;
our $VERSION = '2.2207';
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;

25
CPAN/Moose/Meta/Method/Accessor/Native/Counter/set.pm Normal file
View File

@@ -0,0 +1,25 @@
package Moose::Meta::Method::Accessor::Native::Counter::set;
our $VERSION = '2.2207';
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;

28
CPAN/Moose/Meta/Method/Accessor/Native/Hash.pm Normal file
View File

@@ -0,0 +1,28 @@
package Moose::Meta::Method::Accessor::Native::Hash;
our $VERSION = '2.2207';
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;

41
CPAN/Moose/Meta/Method/Accessor/Native/Hash/Writer.pm Normal file
View File

@@ -0,0 +1,41 @@
package Moose::Meta::Method::Accessor::Native::Hash::Writer;
our $VERSION = '2.2207';
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;
return unless $self->associated_attribute->should_coerce;
return unless $self->_tc_member_type_can_coerce;
return <<'EOF';
if (@_) {
my %h = @_;
@h{ sort keys %h } = map { $member_coercion->($_) } @h{ sort keys %h };
}
EOF
}
sub _new_members { 'values %{ { @_ } }' }
sub _copy_old_value {
my $self = shift;
my ($slot_access) = @_;
return '{ %{ (' . $slot_access . ') } }';
}
no Moose::Role;
1;

61
CPAN/Moose/Meta/Method/Accessor/Native/Hash/accessor.pm Normal file
View File

@@ -0,0 +1,61 @@
package Moose::Meta::Method::Accessor::Native::Hash::accessor;
our $VERSION = '2.2207';
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;

37
CPAN/Moose/Meta/Method/Accessor/Native/Hash/clear.pm Normal file
View File

@@ -0,0 +1,37 @@
package Moose::Meta::Method::Accessor::Native::Hash::clear;
our $VERSION = '2.2207';
use strict;
use warnings;
use Moose::Role;
with 'Moose::Meta::Method::Accessor::Native::Hash::Writer';
sub _maximum_arguments { 0 }
sub _adds_members { 0 }
# The inner () in this expression is for the benefit of inlining code that
# might end up looking like "values %{ {} }". This is a syntax error in perl
# but 'values %{ { () } }' is not.
sub _potential_value { '{ ( ) }' }
# There are no new members so we don't need to coerce new values (none exist)
# and we always want to check the new (empty) hash as a whole.
sub _inline_coerce_new_values { '' }
sub _check_new_members_only { 0 }
sub _inline_optimized_set_new_value {
my $self = shift;
my ($inv, $new, $slot_access) = @_;
return $slot_access . ' = {};';
}
sub _return_value { '' }
no Moose::Role;
1;

22
CPAN/Moose/Meta/Method/Accessor/Native/Hash/count.pm Normal file
View File

@@ -0,0 +1,22 @@
package Moose::Meta::Method::Accessor::Native::Hash::count;
our $VERSION = '2.2207';
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;

31
CPAN/Moose/Meta/Method/Accessor/Native/Hash/defined.pm Normal file
View File

@@ -0,0 +1,31 @@
package Moose::Meta::Method::Accessor::Native::Hash::defined;
our $VERSION = '2.2207';
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;

46
CPAN/Moose/Meta/Method/Accessor/Native/Hash/delete.pm Normal file
View File

@@ -0,0 +1,46 @@
package Moose::Meta::Method::Accessor::Native::Hash::delete;
our $VERSION = '2.2207';
use strict;
use warnings;
use Moose::Role;
with 'Moose::Meta::Method::Accessor::Native::Hash::Writer';
sub _adds_members { 0 }
# There are no new members so we don't need to coerce new values (none exist)
# and we always want to check the new (empty) hash as a whole.
sub _inline_coerce_new_values { '' }
sub _check_new_members_only { 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;

23
CPAN/Moose/Meta/Method/Accessor/Native/Hash/elements.pm Normal file
View File

@@ -0,0 +1,23 @@
package Moose::Meta::Method::Accessor::Native::Hash::elements;
our $VERSION = '2.2207';
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;

31
CPAN/Moose/Meta/Method/Accessor/Native/Hash/exists.pm Normal file
View File

@@ -0,0 +1,31 @@
package Moose::Meta::Method::Accessor::Native::Hash::exists;
our $VERSION = '2.2207';
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;

35
CPAN/Moose/Meta/Method/Accessor/Native/Hash/get.pm Normal file
View File

@@ -0,0 +1,35 @@
package Moose::Meta::Method::Accessor::Native::Hash::get;
our $VERSION = '2.2207';
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;

22
CPAN/Moose/Meta/Method/Accessor/Native/Hash/is_empty.pm Normal file
View File

@@ -0,0 +1,22 @@
package Moose::Meta::Method::Accessor::Native::Hash::is_empty;
our $VERSION = '2.2207';
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;

22
CPAN/Moose/Meta/Method/Accessor/Native/Hash/keys.pm Normal file
View File

@@ -0,0 +1,22 @@
package Moose::Meta::Method::Accessor::Native::Hash::keys;
our $VERSION = '2.2207';
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;

23
CPAN/Moose/Meta/Method/Accessor/Native/Hash/kv.pm Normal file
View File

@@ -0,0 +1,23 @@
package Moose::Meta::Method::Accessor::Native::Hash::kv;
our $VERSION = '2.2207';
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;

99
CPAN/Moose/Meta/Method/Accessor/Native/Hash/set.pm Normal file
View File

@@ -0,0 +1,99 @@
package Moose::Meta::Method::Accessor::Native::Hash::set;
our $VERSION = '2.2207';
use strict;
use warnings;
use List::Util 1.32;
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 (
'@_ = List::Util::pairmap { $a => $member_coercion->($b) } @_;',
);
};
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;

26
CPAN/Moose/Meta/Method/Accessor/Native/Hash/shallow_clone.pm Normal file
View File

@@ -0,0 +1,26 @@
package Moose::Meta::Method::Accessor::Native::Hash::shallow_clone;
our $VERSION = '2.2207';
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;

22
CPAN/Moose/Meta/Method/Accessor/Native/Hash/values.pm Normal file
View File

@@ -0,0 +1,22 @@
package Moose::Meta::Method::Accessor::Native::Hash::values;
our $VERSION = '2.2207';
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;

29
CPAN/Moose/Meta/Method/Accessor/Native/Number/abs.pm Normal file
View File

@@ -0,0 +1,29 @@
package Moose::Meta::Method::Accessor::Native::Number::abs;
our $VERSION = '2.2207';
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;

31
CPAN/Moose/Meta/Method/Accessor/Native/Number/add.pm Normal file
View File

@@ -0,0 +1,31 @@
package Moose::Meta::Method::Accessor::Native::Number::add;
our $VERSION = '2.2207';
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;

31
CPAN/Moose/Meta/Method/Accessor/Native/Number/div.pm Normal file
View File

@@ -0,0 +1,31 @@
package Moose::Meta::Method::Accessor::Native::Number::div;
our $VERSION = '2.2207';
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;

31
CPAN/Moose/Meta/Method/Accessor/Native/Number/mod.pm Normal file
View File

@@ -0,0 +1,31 @@
package Moose::Meta::Method::Accessor::Native::Number::mod;
our $VERSION = '2.2207';
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;

31
CPAN/Moose/Meta/Method/Accessor/Native/Number/mul.pm Normal file
View File

@@ -0,0 +1,31 @@
package Moose::Meta::Method::Accessor::Native::Number::mul;
our $VERSION = '2.2207';
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;

25
CPAN/Moose/Meta/Method/Accessor/Native/Number/set.pm Normal file
View File

@@ -0,0 +1,25 @@
package Moose::Meta::Method::Accessor::Native::Number::set;
our $VERSION = '2.2207';
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;

31
CPAN/Moose/Meta/Method/Accessor/Native/Number/sub.pm Normal file
View File

@@ -0,0 +1,31 @@
package Moose::Meta::Method::Accessor::Native::Number::sub;
our $VERSION = '2.2207';
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;

47
CPAN/Moose/Meta/Method/Accessor/Native/Reader.pm Normal file
View File

@@ -0,0 +1,47 @@
package Moose::Meta::Method::Accessor::Native::Reader;
our $VERSION = '2.2207';
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;

31
CPAN/Moose/Meta/Method/Accessor/Native/String/append.pm Normal file
View File

@@ -0,0 +1,31 @@
package Moose::Meta::Method::Accessor::Native::String::append;
our $VERSION = '2.2207';
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;

40
CPAN/Moose/Meta/Method/Accessor/Native/String/chomp.pm Normal file
View File

@@ -0,0 +1,40 @@
package Moose::Meta::Method::Accessor::Native::String::chomp;
our $VERSION = '2.2207';
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;

40
CPAN/Moose/Meta/Method/Accessor/Native/String/chop.pm Normal file
View File

@@ -0,0 +1,40 @@
package Moose::Meta::Method::Accessor::Native::String::chop;
our $VERSION = '2.2207';
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;

24
CPAN/Moose/Meta/Method/Accessor/Native/String/clear.pm Normal file
View File

@@ -0,0 +1,24 @@
package Moose::Meta::Method::Accessor::Native::String::clear;
our $VERSION = '2.2207';
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;

33
CPAN/Moose/Meta/Method/Accessor/Native/String/inc.pm Normal file
View File

@@ -0,0 +1,33 @@
package Moose::Meta::Method::Accessor::Native::String::inc;
our $VERSION = '2.2207';
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;

22
CPAN/Moose/Meta/Method/Accessor/Native/String/length.pm Normal file
View File

@@ -0,0 +1,22 @@
package Moose::Meta::Method::Accessor::Native::String::length;
our $VERSION = '2.2207';
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;

42
CPAN/Moose/Meta/Method/Accessor/Native/String/match.pm Normal file
View File

@@ -0,0 +1,42 @@
package Moose::Meta::Method::Accessor::Native::String::match;
our $VERSION = '2.2207';
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;

31
CPAN/Moose/Meta/Method/Accessor/Native/String/prepend.pm Normal file
View File

@@ -0,0 +1,31 @@
package Moose::Meta::Method::Accessor::Native::String::prepend;
our $VERSION = '2.2207';
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;

69
CPAN/Moose/Meta/Method/Accessor/Native/String/replace.pm Normal file
View File

@@ -0,0 +1,69 @@
package Moose::Meta::Method::Accessor::Native::String::replace;
our $VERSION = '2.2207';
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;

123
CPAN/Moose/Meta/Method/Accessor/Native/String/substr.pm Normal file
View File

@@ -0,0 +1,123 @@
package Moose::Meta::Method::Accessor::Native::String::substr;
our $VERSION = '2.2207';
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;

174
CPAN/Moose/Meta/Method/Accessor/Native/Writer.pm Normal file
View File

@@ -0,0 +1,174 @@
package Moose::Meta::Method::Accessor::Native::Writer;
our $VERSION = '2.2207';
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;