my $slot_access = $self->_inline_get($inv);
my $value = $self->_value_needs_copy ? '$val' : '$_[1]';
my $old = '@old';
- my $default = '$default';
$self->_compile_code([
'sub {',
'if (scalar(@_) >= 2) {',
$self->_inline_copy_value($value),
$self->_inline_check_required,
- $self->_inline_check_coercion($value),
- $self->_inline_check_constraint($value),
+ $self->_inline_tc_code($value),
$self->_inline_get_old_value_for_trigger($inv, $old),
$self->_inline_store($inv, $value),
$self->_inline_trigger($inv, $value, $old),
'}',
- $self->_inline_check_lazy($inv, $default),
+ $self->_inline_check_lazy($inv),
$self->_inline_post_body(@_),
'return ' . $self->_inline_auto_deref($slot_access) . ';',
'}',
$self->_inline_pre_body(@_),
$self->_inline_copy_value($value),
$self->_inline_check_required,
- $self->_inline_check_coercion($value),
- $self->_inline_check_constraint($value),
+ $self->_inline_tc_code($value),
$self->_inline_get_old_value_for_trigger($inv, $old),
$self->_inline_store($inv, $value),
$self->_inline_post_body(@_),
my $inv = '$_[0]';
my $slot_access = $self->_inline_get($inv);
- my $default = '$default';
$self->_compile_code([
'sub {',
'data => \@_'
) . ';',
'}',
- $self->_inline_check_lazy($inv, $default),
+ $self->_inline_check_lazy($inv),
$self->_inline_post_body(@_),
'return ' . $self->_inline_auto_deref($slot_access) . ';',
'}',
: $self->SUPER::_generate_clearer_method(@_);
}
-sub _inline_pre_body { '' }
-sub _inline_post_body { '' }
+sub _inline_pre_body { return }
+sub _inline_post_body { return }
sub _inline_check_constraint {
my $self = shift;
'}';
}
+sub _inline_tc_code {
+ my $self = shift;
+ return (
+ $self->_inline_check_coercion(@_),
+ $self->_inline_check_constraint(@_),
+ );
+}
+
sub _inline_check_coercion {
my $self = shift;
my ($value) = @_;
my ($instance, $default) = @_;
my $attr = $self->associated_attribute;
- return '' unless $attr->is_lazy;
+ return unless $attr->is_lazy;
my $slot_exists = $self->_inline_has($instance);
return 'if (!' . $slot_exists . ') {',
- $self->_inline_init_from_default($instance, $default),
+ $self->_inline_init_from_default($instance, '$default', 'lazy'),
'}';
}
sub _inline_init_from_default {
my $self = shift;
- my ($instance, $default) = @_;
+ my ($instance, $default, $for_lazy) = @_;
my $attr = $self->associated_attribute;
# XXX: should this throw an error instead?
return $self->_inline_generate_default($instance, $default),
$attr->has_type_constraint
- ? ($self->_inline_check_coercion($default),
- $self->_inline_check_constraint($default))
+ # intentionally not using _inline_tc_code, since that can be
+ # overridden to do things like possibly only do member tc
+ # checks, which isn't appropriate for checking the result
+ # of a default
+ ? ($self->_inline_check_coercion($default, $for_lazy),
+ $self->_inline_check_constraint($default, $for_lazy))
: (),
$self->_inline_init_slot($attr, $instance, $default);
}
return $class->$orig(%options);
};
-around _new => sub {
- shift;
+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 );
+ $self->{'body'} = $self->_compile_code( [$self->_generate_method] );
return;
}
sub _inline_curried_arguments {
my $self = shift;
- return q{} unless @{ $self->curried_arguments };
+ return unless @{ $self->curried_arguments };
- return 'unshift @_, @curried;'
+ return ('unshift @_, @curried;');
}
sub _inline_check_argument_count {
my $self = shift;
- my $code = q{};
-
- if ( my $min = $self->_minimum_arguments ) {
- my $err_msg = sprintf(
- q{"Cannot call %s without at least %s argument%s"},
- $self->delegate_to_method,
- $min,
- ( $min == 1 ? q{} : 's' )
+ my @code;
+
+ if (my $min = $self->_minimum_arguments) {
+ push @code, (
+ 'if (@_ < ' . $min . ') {',
+ $self->_inline_throw_error(
+ sprintf(
+ '"Cannot call %s without at least %s argument%s"',
+ $self->delegate_to_method,
+ $min,
+ ($min == 1 ? '' : 's'),
+ )
+ ) . ';',
+ '}',
);
-
- $code
- .= "\n"
- . $self->_inline_throw_error($err_msg)
- . " unless \@_ >= $min;";
}
- if ( defined( my $max = $self->_maximum_arguments ) ) {
- my $err_msg = sprintf(
- q{"Cannot call %s with %s argument%s"},
- $self->delegate_to_method,
- ( $max ? "more than $max" : 'any' ),
- ( $max == 1 ? q{} : 's' )
+ if (defined(my $max = $self->_maximum_arguments)) {
+ push @code, (
+ 'if (@_ > ' . $max . ') {',
+ $self->_inline_throw_error(
+ sprintf(
+ '"Cannot call %s with %s argument%s"',
+ $self->delegate_to_method,
+ $max ? "more than $max" : 'any',
+ ($max == 1 ? '' : 's'),
+ )
+ ) . ';',
+ '}',
);
-
- $code
- .= "\n"
- . $self->_inline_throw_error($err_msg)
- . " if \@_ > $max;";
}
- return $code;
+ 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 _inline_get => sub {
- my ( $self, $instance ) = @_;
+ my $self = shift;
+ my ($instance) = @_;
return $self->_slot_access_can_be_inlined
? super()
- : "${instance}->\$reader";
+ : $instance . '->$reader';
};
override _inline_store => sub {
- my ( $self, $instance, $value ) = @_;
+ my $self = shift;
+ my ($instance, $value) = @_;
return $self->_slot_access_can_be_inlined
? super()
- : "${instance}->\$writer($value)";
+ : $instance . '->$writer(' . $value . ')';
};
override _eval_environment => sub {
our $AUTHORITY = 'cpan:STEVAN';
sub _inline_check_var_is_valid_index {
- my ( $self, $var ) = @_;
-
- return $self->_inline_throw_error( q{'The index passed to }
- . $self->delegate_to_method
- . q{ must be an integer'} )
- . qq{ unless defined $var && $var =~ /^-?\\d+\$/;};
+ my $self = shift;
+ my ($var) = @_;
+
+ return (
+ 'if (!defined(' . $var . ') || ' . $var . ' !~ /^-?\d+$/) {',
+ $self->_inline_throw_error(
+ '"The index passed to '
+ . $self->delegate_to_method
+ . ' must be an integer"',
+ ) . ';',
+ '}',
+ );
}
no Moose::Role;
use Moose::Role;
-with 'Moose::Meta::Method::Accessor::Native::Writer',
+with 'Moose::Meta::Method::Accessor::Native::Writer' => {
+ -excludes => ['_inline_coerce_new_values'],
+ },
'Moose::Meta::Method::Accessor::Native::Array',
'Moose::Meta::Method::Accessor::Native::Collection';
sub _new_members {'@_'}
sub _inline_copy_old_value {
- my ( $self, $slot_access ) = @_;
+ my $self = shift;
+ my ($slot_access) = @_;
return '[ @{(' . $slot_access . ')} ]';
}
sub _generate_method {
my $self = shift;
- my $inv = '$self';
-
- my $code = 'sub {';
- $code .= "\n" . $self->_inline_pre_body(@_);
-
- $code .= "\n" . 'my $self = shift;';
-
- $code .= "\n" . $self->_inline_curried_arguments;
-
- $code .= "\n" . $self->_inline_check_lazy($inv);
-
+ my $inv = '$self';
my $slot_access = $self->_inline_get($inv);
- # get
- $code .= "\n" . 'if ( @_ == 1 ) {';
-
- $code .= "\n" . $self->_inline_check_var_is_valid_index('$_[0]');
-
- $code
- .= "\n"
- . 'return '
- . $self
- ->Moose::Meta::Method::Accessor::Native::Array::get::_return_value(
- $slot_access)
- . ';';
-
- # set
- $code .= "\n" . '} else {';
-
- $code .= "\n" . $self->_writer_core( $inv, $slot_access );
-
- $code .= "\n" . $self->_inline_post_body(@_);
-
- $code .= "\n}";
- $code .= "\n}";
-
- return $code;
+ return (
+ 'sub {',
+ $self->_inline_pre_body(@_),
+ 'my ' . $inv . ' = shift;',
+ $self->_inline_curried_arguments,
+ $self->_inline_check_lazy($inv),
+ # 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->_writer_core($inv, $slot_access),
+ $self->_inline_post_body(@_),
+ '}',
+ '}',
+ );
}
sub _minimum_arguments {1}
-excludes => [
qw(
_maximum_arguments
- _inline_optimized_set_new_value
+ _optimized_set_new_value
_return_value
)
]
sub _potential_value { return '[]' }
-sub _inline_optimized_set_new_value {
- my ( $self, $inv, $new, $slot_access ) = @_;
+sub _optimized_set_new_value {
+ my $self = shift;
+ my ($inv, $new, $slot_access) = @_;
- return "$slot_access = []";
+ return $slot_access . ' = []';
}
-sub _return_value { return q{} }
+sub _return_value { return '' }
no Moose::Role;
sub _maximum_arguments { 0 }
sub _return_value {
- my ( $self, $slot_access ) = @_;
+ my $self = shift;
+ my ($slot_access) = @_;
- return "scalar \@{ ($slot_access) }";
+ return 'scalar @{ (' . $slot_access . ') }';
}
no Moose::Role;
_minimum_arguments
_maximum_arguments
_inline_check_arguments
- _inline_optimized_set_new_value
+ _optimized_set_new_value
_return_value
)
],
sub _adds_members { 0 }
sub _potential_value {
- my ( $self, $slot_access ) = @_;
+ my $self = shift;
+ my ($slot_access) = @_;
- return
- "( do { my \@potential = \@{ ($slot_access) }; \@return = splice \@potential, \$_[0], 1; \\\@potential } )";
+ return '(do { '
+ . 'my @potential = @{ (' . $slot_access . ') }; '
+ . '@return = splice @potential, $_[0], 1; '
+ . '\@potential; '
+ . '})';
}
-sub _inline_optimized_set_new_value {
- my ( $self, $inv, $new, $slot_access ) = @_;
+sub _optimized_set_new_value {
+ my $self = shift;
+ my ($inv, $new, $slot_access) = @_;
- return "\@return = splice \@{ ($slot_access) }, \$_[0], 1";
+ return '@return = splice @{ (' . $slot_access . ') }, $_[0], 1';
}
sub _return_value {
- my ( $self, $slot_access ) = @_;
+ my $self = shift;
+ my ($slot_access) = @_;
- return 'return $return[0];';
+ return '$return[0]';
}
no Moose::Role;
sub _maximum_arguments { 0 }
sub _return_value {
- my $self = shift;
- my $slot_access = shift;
+ my $self = shift;
+ my ($slot_access) = @_;
- return "\@{ ($slot_access) }";
+ return '@{ (' . $slot_access . ') }';
}
no Moose::Role;
sub _inline_check_arguments {
my $self = shift;
- return $self->_inline_throw_error(
- q{'The argument passed to first must be a code reference'})
- . q{ unless Params::Util::_CODELIKE( $_[0] );};
+ return (
+ 'if (!Params::Util::_CODELIKE($_[0])) {',
+ $self->_inline_throw_error(
+ '"The argument passed to first must be a code reference"',
+ ) . ';',
+ '}',
+ );
}
sub _return_value {
- my $self = shift;
- my $slot_access = shift;
+ my $self = shift;
+ my ($slot_access) = @_;
- return "&List::Util::first( \$_[0], \@{ ($slot_access) } )";
+ return '&List::Util::first( $_[0], @{ (' . $slot_access . ') } )';
}
no Moose::Role;
}
sub _return_value {
- my $self = shift;
- my $slot_access = shift;
+ my $self = shift;
+ my ($slot_access) = @_;
- return "${slot_access}->[ \$_[0] ]";
+ return $slot_access . '->[ $_[0] ]';
}
1;
sub _inline_check_arguments {
my $self = shift;
- return $self->_inline_throw_error(
- q{'The argument passed to grep must be a code reference'})
- . q{ unless Params::Util::_CODELIKE( $_[0] );};
+ return (
+ 'if (!Params::Util::_CODELIKE($_[0])) {',
+ $self->_inline_throw_error(
+ '"The argument passed to grep must be a code reference"',
+ ) . ';',
+ '}',
+ );
}
sub _return_value {
- my $self = shift;
- my $slot_access = shift;
+ my $self = shift;
+ my ($slot_access) = @_;
- return "grep { \$_[0]->() } \@{ ($slot_access) }";
+ return 'grep { $_[0]->() } @{ (' . $slot_access . ') }';
}
no Moose::Role;
qw(
_minimum_arguments
_maximum_arguments
+ _inline_coerce_new_values
_new_members
- _inline_optimized_set_new_value
+ _optimized_set_new_value
_return_value
)
]
sub _adds_members { 1 }
sub _potential_value {
- my ( $self, $slot_access ) = @_;
+ my $self = shift;
+ my ($slot_access) = @_;
- return
- "( do { my \@potential = \@{ ($slot_access) }; splice \@potential, \$_[0], 0, \$_[1]; \\\@potential } )";
+ 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].
-around _inline_coerce_new_values => sub {
- shift;
+sub _inline_coerce_new_values {
my $self = shift;
- return q{} unless $self->associated_attribute->should_coerce;
+ return unless $self->associated_attribute->should_coerce;
- return q{} unless $self->_tc_member_type_can_coerce;
+ return unless $self->_tc_member_type_can_coerce;
- return '@_ = ( $_[0], $member_tc_obj->coerce( $_[1] ) );';
+ return '@_ = ($_[0], $member_tc_obj->coerce($_[1]));';
};
sub _new_members { '$_[1]' }
-sub _inline_optimized_set_new_value {
- my ( $self, $inv, $new, $slot_access ) = @_;
+sub _optimized_set_new_value {
+ my $self = shift;
+ my ($inv, $new, $slot_access) = @_;
- return "splice \@{ ($slot_access) }, \$_[0], 0, \$_[1];";
+ return 'splice @{ (' . $slot_access . ') }, $_[0], 0, $_[1]';
}
sub _return_value {
- my ( $self, $slot_access ) = @_;
+ my $self = shift;
+ my ($slot_access) = @_;
- return "return ${slot_access}->[ \$_[0] ];";
+ return $slot_access . '->[ $_[0] ]';
}
no Moose::Role;
sub _maximum_arguments { 0 }
sub _return_value {
- my $self = shift;
- my $slot_access = shift;
+ my $self = shift;
+ my ($slot_access) = @_;
- return "\@{ ($slot_access) } ? 0 : 1";
+ return '@{ (' . $slot_access . ') } ? 0 : 1';
}
no Moose::Role;
sub _inline_check_arguments {
my $self = shift;
- return $self->_inline_throw_error(
- q{'The argument passed to join must be a string'})
- . ' unless Moose::Util::_STRINGLIKE0( $_[0] );';
+ return (
+ 'if (!Moose::Util::_STRINGLIKE0($_[0])) {',
+ $self->_inline_throw_error(
+ '"The argument passed to join must be a string"',
+ ) . ';',
+ '}',
+ );
}
sub _return_value {
- my $self = shift;
- my $slot_access = shift;
+ my $self = shift;
+ my ($slot_access) = @_;
- return "join \$_[0], \@{ ($slot_access) }";
+ return 'join $_[0], @{ (' . $slot_access . ') }';
}
no Moose::Role;
sub _inline_check_arguments {
my $self = shift;
- return $self->_inline_throw_error(
- q{'The argument passed to map must be a code reference'})
- . q{ unless Params::Util::_CODELIKE( $_[0] );};
+ return (
+ 'if (!Params::Util::_CODELIKE($_[0])) {',
+ $self->_inline_throw_error(
+ '"The argument passed to map must be a code reference"',
+ ) . ';',
+ '}',
+ );
}
sub _return_value {
- my $self = shift;
- my $slot_access = shift;
+ my $self = shift;
+ my ($slot_access) = @_;
- return "map { \$_[0]->() } \@{ ($slot_access) }";
+ return 'map { $_[0]->() } @{ (' . $slot_access . ') }';
}
no Moose::Role;
sub _inline_check_arguments {
my $self = shift;
- return $self->_inline_throw_error(
- q{'The n value passed to natatime must be an integer'})
- . ' unless defined $_[0] && $_[0] =~ /^\\d+$/;' . "\n"
- . $self->_inline_throw_error(
- q{'The second argument passed to natatime must be a code reference'})
- . q{ if @_ == 2 && ! Params::Util::_CODELIKE( $_[1] );};
+ return (
+ 'if (!defined($_[0]) || $_[0] !~ /^\d+$/) {',
+ $self->_inline_throw_error(
+ '"The n value passed to natatime must be an integer"',
+ ) . ';',
+ '}',
+ 'if (@_ == 2 && !Params::Util::_CODELIKE($_[1])) {',
+ $self->_inline_throw_error(
+ '"The second argument passed to natatime must be a code '
+ . 'reference"',
+ ) . ';',
+ '}',
+ );
}
sub _inline_return_value {
- my ( $self, $slot_access ) = @_;
-
- return
- "my \$iter = List::MoreUtils::natatime( \$_[0], \@{ ($slot_access) } );"
- . "\n"
- . 'if ( $_[1] ) {' . "\n"
- . 'while (my @vals = $iter->()) {' . "\n"
- . '$_[1]->(@vals);' . "\n" . '}' . "\n"
- . '} else {' . "\n"
- . 'return $iter;' . "\n" . '}';
+ 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
-excludes => [
qw( _maximum_arguments
_inline_capture_return_value
- _inline_optimized_set_new_value
+ _optimized_set_new_value
_return_value )
]
};
sub _adds_members { 0 }
sub _potential_value {
- my ( $self, $slot_access ) = @_;
+ my $self = shift;
+ my ($slot_access) = @_;
- return "[ \@{ ($slot_access) } > 1 ? \@{ ($slot_access) }[ 0 .. \$#{ ($slot_access) } - 1 ] : () ]";
+ return '[ @{ (' . $slot_access . ') } > 1 '
+ . '? @{ (' . $slot_access . ') }[0..$#{ (' . $slot_access . ') } - 1] '
+ . ': () ]';
}
sub _inline_capture_return_value {
- my ( $self, $slot_access ) = @_;
+ my $self = shift;
+ my ($slot_access) = @_;
- return "my \$old = ${slot_access}->[-1];";
+ return 'my $old = ' . $slot_access . '->[-1];';
}
-sub _inline_optimized_set_new_value {
- my ( $self, $inv, $new, $slot_access ) = @_;
+sub _optimized_set_new_value {
+ my $self = shift;
+ my ($inv, $new, $slot_access) = @_;
- return "pop \@{ ($slot_access) }";
+ return 'pop @{ (' . $slot_access . ') }';
}
sub _return_value {
- my ( $self, $slot_access ) = @_;
+ my $self = shift;
+ my ($slot_access) = @_;
- return 'return $old;';
+ return '$old';
}
no Moose::Role;
with 'Moose::Meta::Method::Accessor::Native::Array::Writer' => {
-excludes => [
qw(
- _inline_optimized_set_new_value
+ _optimized_set_new_value
_return_value
)
]
sub _adds_members { 1 }
sub _potential_value {
- my ( $self, $slot_access ) = @_;
+ my $self = shift;
+ my ($slot_access) = @_;
- return "[ \@{ ($slot_access) }, \@_ ]";
+ return '[ @{ (' . $slot_access . ') }, @_ ]';
}
-sub _inline_optimized_set_new_value {
- my ( $self, $inv, $new, $slot_access ) = @_;
+sub _optimized_set_new_value {
+ my $self = shift;
+ my ($inv, $new, $slot_access) = @_;
- return "push \@{ ($slot_access) }, \@_";
+ return 'push @{ (' . $slot_access . ') }, @_';
}
sub _return_value {
- my ( $self, $slot_access ) = @_;
+ my $self = shift;
+ my ($slot_access) = @_;
- return "return scalar \@{ ($slot_access) }";
+ return 'scalar @{ (' . $slot_access . ') }';
}
no Moose::Role;
sub _inline_check_arguments {
my $self = shift;
- return $self->_inline_throw_error(
- q{'The argument passed to reduce must be a code reference'})
- . q{ unless Params::Util::_CODELIKE( $_[0] );};
+ return (
+ 'if (!Params::Util::_CODELIKE($_[0])) {',
+ $self->_inline_throw_error(
+ '"The argument passed to reduce must be a code reference"',
+ ) . ';',
+ '}',
+ );
}
sub _return_value {
- my $self = shift;
- my $slot_access = shift;
+ my $self = shift;
+ my ($slot_access) = @_;
- return "List::Util::reduce { \$_[0]->( \$a, \$b ) } \@{ ($slot_access) }";
+ return 'List::Util::reduce { $_[0]->($a, $b) } @{ (' . $slot_access . ') }';
}
no Moose::Role;
_minimum_arguments
_maximum_arguments
_inline_check_arguments
+ _inline_coerce_new_values
_new_members
- _inline_optimized_set_new_value
+ _optimized_set_new_value
_return_value
)
]
sub _adds_members { 1 }
sub _potential_value {
- my ( $self, $slot_access ) = @_;
+ my $self = shift;
+ my ($slot_access) = @_;
- return
- "( do { my \@potential = \@{ ($slot_access) }; \$potential[ \$_[0] ] = \$_[1]; \\\@potential } )";
+ 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].
-around _inline_coerce_new_values => sub {
- shift;
+sub _inline_coerce_new_values {
my $self = shift;
- return q{} unless $self->associated_attribute->should_coerce;
+ return unless $self->associated_attribute->should_coerce;
- return q{} unless $self->_tc_member_type_can_coerce;
+ return unless $self->_tc_member_type_can_coerce;
- return '@_ = ( $_[0], $member_tc_obj->coerce( $_[1] ) );';
+ return '@_ = ($_[0], $member_tc_obj->coerce($_[1]));';
};
sub _new_members { '$_[1]' }
-sub _inline_optimized_set_new_value {
- my ( $self, $inv, $new, $slot_access ) = @_;
+sub _optimized_set_new_value {
+ my $self = shift;
+ my ($inv, $new, $slot_access) = @_;
- return "${slot_access}->[ \$_[0] ] = \$_[1]";
+ return $slot_access . '->[$_[0]] = $_[1]';
}
sub _return_value {
- my ( $self, $slot_access ) = @_;
+ my $self = shift;
+ my ($slot_access) = @_;
- return "return ${slot_access}->[ \$_[0] ];";
+ return $slot_access . '->[$_[0]]';
}
no Moose::Role;
qw(
_maximum_arguments
_inline_capture_return_value
- _inline_optimized_set_new_value
+ _optimized_set_new_value
_return_value
)
]
sub _adds_members { 0 }
sub _potential_value {
- my ( $self, $slot_access ) = @_;
+ my $self = shift;
+ my ($slot_access) = @_;
- return "[ \@{ ($slot_access) } > 1 ? \@{ ($slot_access) }[ 1 .. \$#{ ($slot_access) } ] : () ]";
+ return '[ @{ (' . $slot_access . ') } > 1 '
+ . '? @{ (' . $slot_access . ') }[1..$#{ (' . $slot_access . ') }] '
+ . ': () ]';
}
sub _inline_capture_return_value {
- my ( $self, $slot_access ) = @_;
+ my $self = shift;
+ my ($slot_access) = @_;
- return "my \$old = ${slot_access}->[0];";
+ return 'my $old = ' . $slot_access . '->[0];';
}
-sub _inline_optimized_set_new_value {
- my ( $self, $inv, $new, $slot_access ) = @_;
+sub _optimized_set_new_value {
+ my $self = shift;
+ my ($inv, $new, $slot_access) = @_;
- return "shift \@{ ($slot_access) };";
+ return 'shift @{ (' . $slot_access . ') }';
}
sub _return_value {
- my ( $self, $slot_access ) = @_;
+ my $self = shift;
+ my ($slot_access) = @_;
- return 'return $old';
+ return '$old';
}
no Moose::Role;
sub _maximum_arguments { 0 }
sub _return_value {
- my $self = shift;
- my $slot_access = shift;
+ my $self = shift;
+ my ($slot_access) = @_;
- return "List::Util::shuffle \@{ ($slot_access) }";
+ return 'List::Util::shuffle @{ (' . $slot_access . ') }';
}
no Moose::Role;
sub _inline_check_arguments {
my $self = shift;
- return $self->_inline_throw_error(
- q{'The argument passed to sort must be a code reference'})
- . q{ if @_ && ! Params::Util::_CODELIKE( $_[0] );};
+ return (
+ 'if (@_ && !Params::Util::_CODELIKE($_[0])) {',
+ $self->_inline_throw_error(
+ '"The argument passed to sort must be a code reference"',
+ ) . ';',
+ '}',
+ );
}
sub _return_value {
- my $self = shift;
- my $slot_access = shift;
+ my $self = shift;
+ my ($slot_access) = @_;
- return
- "\$_[0] ? sort { \$_[0]->( \$a, \$b ) } \@{ ($slot_access) } : sort \@{ ($slot_access) }";
+ return '$_[0] '
+ . '? sort { $_[0]->($a, $b) } @{ (' . $slot_access . ') } '
+ . ': sort @{ (' . $slot_access . ') }';
}
no Moose::Role;
sub _inline_check_arguments {
my $self = shift;
- return $self->_inline_throw_error(
- q{'The argument passed to sort_in_place must be a code reference'})
- . q{ if @_ && ! Params::Util::_CODELIKE( $_[0] );};
+ return (
+ 'if (@_ && !Params::Util::_CODELIKE($_[0])) {',
+ $self->_inline_throw_error(
+ '"The argument passed to sort_in_place must be a code '
+ . 'reference"',
+ ) . ';',
+ '}',
+ );
}
sub _adds_members { 0 }
sub _potential_value {
- my ( $self, $slot_access ) = @_;
+ my $self = shift;
+ my ($slot_access) = @_;
- return
- "[ \$_[0] ? sort { \$_[0]->( \$a, \$b ) } \@{ ($slot_access) } : sort \@{ ($slot_access) } ]";
+ return '[ $_[0] '
+ . '? sort { $_[0]->($a, $b) } @{ (' . $slot_access . ') } '
+ . ': sort @{ (' . $slot_access . ') } ]';
}
-sub _return_value { return q{} }
+sub _return_value { return '' }
no Moose::Role;
_minimum_arguments
_inline_process_arguments
_inline_check_arguments
- _inline_optimized_set_new_value
+ _optimized_set_new_value
_return_value
)
]
sub _adds_members { 1 }
sub _inline_process_arguments {
- return 'my $idx = shift;' . "\n" . 'my $len = @_ ? shift : undef;';
+ return (
+ 'my $idx = shift;',
+ 'my $len = @_ ? shift : undef;',
+ );
}
sub _inline_check_arguments {
my $self = shift;
- return
- $self->_inline_check_var_is_valid_index('$idx') . "\n"
- . $self->_inline_throw_error(q{'The length argument passed to splice must be an integer'})
- . ' if defined $len && $len !~ /^-?\\d+$/;';
+ return (
+ $self->_inline_check_var_is_valid_index('$idx'),
+ 'if (defined($len) && $len !~ /^-?\d+$/) {',
+ $self->_inline_throw_error(
+ '"The length argument passed to splice must be an integer"',
+ ) . ';',
+ '}',
+ );
}
sub _potential_value {
- my ( $self, $slot_access ) = @_;
-
- return "( do { my \@potential = \@{ ($slot_access) };"
- . '@return = defined $len ? ( splice @potential, $idx, $len, @_ ) : ( splice @potential, $idx ); \\@potential } )';
+ 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, $inv, $new, $slot_access ) = @_;
+sub _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 )";
+ return '@return = defined $len '
+ . '? (splice @{ (' . $slot_access . ') }, $idx, $len, @_) '
+ . ': (splice @{ (' . $slot_access . ') }, $idx)';
}
sub _return_value {
- my ($self, $slot_access) = @_;
+ my $self = shift;
+ my ($slot_access) = @_;
- return 'return wantarray ? @return : $return[-1]';
+ return 'wantarray ? @return : $return[-1]';
}
no Moose::Role;
sub _maximum_arguments { 0 }
sub _return_value {
- my $self = shift;
- my $slot_access = shift;
+ my $self = shift;
+ my ($slot_access) = @_;
- return "List::MoreUtils::uniq \@{ ($slot_access) }";
+ return 'List::MoreUtils::uniq @{ (' . $slot_access . ') }';
}
no Moose::Role;
with 'Moose::Meta::Method::Accessor::Native::Array::Writer' => {
-excludes => [
qw(
- _inline_optimized_set_new_value
+ _optimized_set_new_value
_return_value
)
]
sub _adds_members { 1 }
sub _potential_value {
- my ( $self, $slot_access ) = @_;
+ my $self = shift;
+ my ($slot_access) = @_;
- return "[ \@_, \@{ ($slot_access) } ]";
+ return '[ @_, @{ (' . $slot_access . ') } ]';
}
-sub _inline_optimized_set_new_value {
- my ( $self, $inv, $new, $slot_access ) = @_;
+sub _optimized_set_new_value {
+ my $self = shift;
+ my ($inv, $new, $slot_access) = @_;
- return "unshift \@{ ($slot_access) }, \@_";
+ return 'unshift @{ (' . $slot_access . ') }, @_';
}
sub _return_value {
- my ( $self, $slot_access ) = @_;
+ my $self = shift;
+ my ($slot_access) = @_;
- return "return scalar \@{ ($slot_access) }";
+ return 'scalar @{ (' . $slot_access . ') }';
}
no Moose::Role;
sub _maximum_arguments { 0 }
sub _return_value {
- my ( $self, $slot_access ) = @_;
+ my $self = shift;
+ my ($slot_access) = @_;
- return "! $slot_access";
+ return '!' . $slot_access;
}
1;
-excludes => [
qw(
_maximum_arguments
- _inline_optimized_set_new_value
+ _optimized_set_new_value
)
]
};
sub _potential_value { 1 }
-sub _inline_optimized_set_new_value {
- my ( $self, $inv, $new, $slot_access ) = @_;
+sub _optimized_set_new_value {
+ my $self = shift;
+ my ($inv, $new, $slot_access) = @_;
- return "$slot_access = 1";
+ return $slot_access . ' = 1';
}
no Moose::Role;
-excludes => [
qw(
_maximum_arguments
- _inline_optimized_set_new_value
+ _optimized_set_new_value
)
]
};
sub _maximum_arguments { 0 }
sub _potential_value {
- my ( $self, $slot_access ) = @_;
+ my $self = shift;
+ my ($slot_access) = @_;
- return "$slot_access ? 0 : 1";
+ return $slot_access . ' ? 0 : 1';
}
-sub _inline_optimized_set_new_value {
- my ( $self, $inv, $new, $slot_access ) = @_;
+sub _optimized_set_new_value {
+ my $self = shift;
+ my ($inv, $new, $slot_access) = @_;
- return "$slot_access = $slot_access ? 0 : 1";
+ return $slot_access . ' = ' . $slot_access . ' ? 0 : 1';
}
no Moose::Role;
-excludes => [
qw(
_maximum_arguments
- _inline_optimized_set_new_value
+ _optimized_set_new_value
)
]
};
sub _potential_value { 0 }
-sub _inline_optimized_set_new_value {
- my ( $self, $inv, $new, $slot_access ) = @_;
+sub _optimized_set_new_value {
+ my $self = shift;
+ my ($inv, $new, $slot_access) = @_;
- return "$slot_access = 0";
+ return $slot_access . ' = 0';
}
no Moose::Role;
with 'Moose::Meta::Method::Accessor::Native::Reader';
sub _return_value {
- my ( $self, $slot_access ) = @_;
+ my $self = shift;
+ my ($slot_access) = @_;
- return "${slot_access}->(\@_)";
+ return $slot_access . '->(@_)';
}
no Moose::Role;
with 'Moose::Meta::Method::Accessor::Native::Reader';
sub _return_value {
- my ( $self, $slot_access ) = @_;
+ my $self = shift;
+ my ($slot_access) = @_;
- return "${slot_access}->(\$self, \@_)";
+ return $slot_access . '->($self, @_)';
}
no Moose::Role;
requires qw( _adds_members );
-around _inline_coerce_new_values => sub {
- shift;
+sub _inline_coerce_new_values {
my $self = shift;
- return q{} unless $self->associated_attribute->should_coerce;
+ return unless $self->associated_attribute->should_coerce;
- return q{} unless $self->_tc_member_type_can_coerce;
+ return unless $self->_tc_member_type_can_coerce;
- return
- '('
- . $self->_new_members
- . ') = map { $member_tc_obj->coerce($_) } '
- . $self->_new_members . ';';
-};
+ return (
+ '(' . $self->_new_members . ') = map { $member_tc_obj->coerce($_) }',
+ $self->_new_members . ';',
+ );
+}
sub _tc_member_type_can_coerce {
my $self = shift;
sub _tc_member_type {
my $self = shift;
- for (
- my $tc = $self->associated_attribute->type_constraint;
- $tc;
- $tc = $tc->parent
- ) {
-
+ my $tc = $self->associated_attribute->type_constraint;
+ while ($tc) {
return $tc->type_parameter
if $tc->can('type_parameter');
+ $tc = $tc->parent;
}
return;
}
-around _value_needs_copy => sub {
- shift;
+sub _value_needs_copy {
my $self = shift;
return $self->_constraint_must_be_checked
&& !$self->_check_new_members_only;
-};
+}
-around _inline_tc_code => sub {
- shift;
- my ( $self, $potential_value ) = @_;
+sub _inline_tc_code {
+ my $self = shift;
+ my ($potential_value) = @_;
- return q{} unless $self->_constraint_must_be_checked;
+ return unless $self->_constraint_must_be_checked;
- if ( $self->_check_new_members_only ) {
- return q{} unless $self->_adds_members;
+ if ($self->_check_new_members_only) {
+ return unless $self->_adds_members;
- return $self->_inline_check_member_constraint( $self->_new_members );
+ return $self->_inline_check_member_constraint($self->_new_members);
}
else {
- return $self->_inline_check_coercion($potential_value) . "\n"
- . $self->_inline_check_constraint($potential_value);
+ return (
+ $self->_inline_check_coercion($potential_value),
+ $self->_inline_check_constraint($potential_value),
+ );
}
-};
+}
sub _check_new_members_only {
my $self = shift;
}
sub _inline_check_member_constraint {
- my ( $self, $new_value ) = @_;
+ my $self = shift;
+ my ($new_value) = @_;
my $attr_name = $self->associated_attribute->name;
- return '$member_tc->($_) || '
- . $self->_inline_throw_error(
- qq{"A new member value for '$attr_name' does not pass its type constraint because: "}
- . ' . $member_tc->get_message($_)',
- "data => \$_"
- ) . " for $new_value;";
+ return (
+ 'for (' . $new_value . ') {',
+ 'if (!$member_tc->($_)) {',
+ $self->_inline_throw_error(
+ '"A new member value for ' . $attr_name
+ . ' does not pass its type constraint because: "'
+ . ' . $member_tc->get_message($_)',
+ 'data => $_',
+ ) . ';',
+ '}',
+ '}',
+ );
}
-around _inline_get_old_value_for_trigger => sub {
- shift;
- my ( $self, $instance ) = @_;
+sub _inline_get_old_value_for_trigger {
+ my $self = shift;
+ my ($instance, $old) = @_;
my $attr = $self->associated_attribute;
- return '' unless $attr->has_trigger;
+ return unless $attr->has_trigger;
- return
- 'my @old = '
- . $self->_inline_has($instance) . q{ ? }
- . $self->_inline_copy_old_value( $self->_inline_get($instance) )
- . ": ();\n";
-};
+ return (
+ 'my ' . $old . ' = ' . $self->_inline_has($instance),
+ '? ' . $self->_inline_copy_old_value($self->_inline_get($instance)),
+ ': ();',
+ );
+}
around _eval_environment => sub {
my $orig = shift;
qw(
_minimum_arguments
_maximum_arguments
- _inline_optimized_set_new_value
+ _optimized_set_new_value
)
]
};
sub _maximum_arguments {1}
sub _potential_value {
- my ( $self, $slot_access ) = @_;
+ my $self = shift;
+ my ($slot_access) = @_;
- return "$slot_access - ( defined \$_[0] ? \$_[0] : 1 )";
+ return $slot_access . ' - ( defined $_[0] ? $_[0] : 1 )';
}
-sub _inline_optimized_set_new_value {
- my ( $self, $inv, $new, $slot_access ) = @_;
+sub _optimized_set_new_value {
+ my $self = shift;
+ my ($inv, $new, $slot_access) = @_;
- return "$slot_access -= defined \$_[0] ? \$_[0] : 1";
+ return $slot_access . ' -= defined $_[0] ? $_[0] : 1';
}
no Moose::Role;
qw(
_minimum_arguments
_maximum_arguments
- _inline_optimized_set_new_value
+ _optimized_set_new_value
)
]
};
sub _maximum_arguments { 1 }
sub _potential_value {
- my ( $self, $slot_access ) = @_;
+ my $self = shift;
+ my ($slot_access) = @_;
- return "$slot_access + ( defined \$_[0] ? \$_[0] : 1 )";
+ return $slot_access . ' + ( defined $_[0] ? $_[0] : 1 )';
}
-sub _inline_optimized_set_new_value {
- my ( $self, $inv, $new, $slot_access ) = @_;
+sub _optimized_set_new_value {
+ my $self = shift;
+ my ($inv, $new, $slot_access) = @_;
- return "$slot_access += defined \$_[0] ? \$_[0] : 1";
+ return $slot_access . ' += defined $_[0] ? $_[0] : 1';
}
no Moose::Role;
-excludes => [
qw(
_maximum_arguments
- _inline_optimized_set_new_value
+ _optimized_set_new_value
)
]
};
sub _maximum_arguments { 0 }
sub _potential_value {
- my ( $self, $slot_access ) = @_;
+ my $self = shift;
+ my ($slot_access) = @_;
- return "\$attr->default(\$self)"
+ return '$attr->default($self)';
}
-sub _inline_optimized_set_new_value {
- my ( $self, $inv, $new, $slot_access ) = @_;
+sub _optimized_set_new_value {
+ my $self = shift;
+ my ($inv, $new, $slot_access) = @_;
- return "$slot_access = \$attr->default(\$self)";
+ return $slot_access . ' = $attr->default($self)';
}
no Moose::Role;
qw(
_minimum_arguments
_maximum_arguments
- _inline_optimized_set_new_value
+ _optimized_set_new_value
)
]
};
sub _potential_value {'$_[0]'}
-sub _inline_optimized_set_new_value {
- my ( $self, $inv, $new, $slot_access ) = @_;
+sub _optimized_set_new_value {
+ my $self = shift;
+ my ($inv, $new, $slot_access) = @_;
- return "$slot_access = \$_[0];";
+ return $slot_access . ' = $_[0]';
}
no Moose::Role;
use Moose::Role;
sub _inline_check_var_is_valid_key {
- my ( $self, $var ) = @_;
+ my $self = shift;
+ my ($var) = @_;
- return $self->_inline_throw_error( q{'The key passed to }
- . $self->delegate_to_method
- . q{ must be a defined value'} )
- . qq{ unless defined $var;};
+ return (
+ 'if (!defined(' . $var . ')) {',
+ $self->_inline_throw_error(
+ '"The key passed to '
+ . $self->delegate_to_method
+ . ' must be a defined value"',
+ ) . ';',
+ '}',
+ );
}
no Moose::Role;
use Moose::Role;
-with 'Moose::Meta::Method::Accessor::Native::Writer',
+with 'Moose::Meta::Method::Accessor::Native::Writer' => {
+ -excludes => ['_inline_coerce_new_values'],
+ },
'Moose::Meta::Method::Accessor::Native::Hash',
'Moose::Meta::Method::Accessor::Native::Collection';
sub _new_values {'@values'}
sub _inline_copy_old_value {
- my ( $self, $slot_access ) = @_;
+ my $self = shift;
+ my ($slot_access) = @_;
return '{ %{(' . $slot_access . ')} }';
}
sub _generate_method {
my $self = shift;
- my $inv = '$self';
-
- my $code = 'sub {';
- $code .= "\n" . $self->_inline_pre_body(@_);
-
- $code .= "\n" . 'my $self = shift;';
-
- $code .= "\n" . $self->_inline_curried_arguments;
-
- $code .= "\n" . $self->_inline_check_lazy($inv);
-
+ my $inv = '$self';
my $slot_access = $self->_inline_get($inv);
- # get
- $code .= "\n" . 'if ( @_ == 1 ) {';
-
- $code .= "\n" . $self->_inline_check_var_is_valid_key('$_[0]');
-
- $code
- .= "\n"
- . 'return '
- . $self
- ->Moose::Meta::Method::Accessor::Native::Hash::get::_return_value(
- $slot_access)
- . ';';
-
- # set
- $code .= "\n" . '} else {';
-
- $code .= "\n" . $self->_writer_core( $inv, $slot_access );
-
- $code .= "\n" . $self->_inline_post_body(@_);
-
- $code .= "\n}";
- $code .= "\n}";
-
- return $code;
+ return (
+ 'sub {',
+ $self->_inline_pre_body(@_),
+ 'my ' . $inv . ' = shift;',
+ $self->_inline_curried_arguments,
+ $self->_inline_check_lazy($inv),
+ # get
+ 'if (@_ == 1) {',
+ $self->_inline_check_var_is_valid_key('$_[0]'),
+ $self->Moose::Meta::Method::Accessor::Native::Hash::get::_inline_return_value($slot_access),
+ '}',
+ # set
+ 'else {',
+ $self->_writer_core($inv, $slot_access),
+ $self->_inline_post_body(@_),
+ '}',
+ '}',
+ );
}
sub _minimum_arguments {1}
-excludes => [
qw(
_maximum_arguments
- _inline_optimized_set_new_value
+ _optimized_set_new_value
_return_value
)
]
sub _potential_value { return '{}' }
-sub _inline_optimized_set_new_value {
- my ( $self, $inv, $new, $slot_access ) = @_;
+sub _optimized_set_new_value {
+ my $self = shift;
+ my ($inv, $new, $slot_access) = @_;
- return "$slot_access = {}";
+ return $slot_access . ' = {}';
}
-sub _return_value { return q{} }
+sub _return_value { return '' }
no Moose::Role;
sub _maximum_arguments { 0 }
sub _return_value {
- my $self = shift;
- my $slot_access = shift;
+ my $self = shift;
+ my ($slot_access) = @_;
- return "scalar keys \%{ ($slot_access) }";
+ return 'scalar keys %{ (' . $slot_access . ') }';
}
no Moose::Role;
}
sub _return_value {
- my $self = shift;
- my $slot_access = shift;
+ my $self = shift;
+ my ($slot_access) = @_;
- return "defined ${slot_access}->{ \$_[0] }";
+ return 'defined ' . $slot_access . '->{ $_[0] }';
}
no Moose::Role;
with 'Moose::Meta::Method::Accessor::Native::Hash::Writer' => {
-excludes => [
qw(
- _inline_optimized_set_new_value
+ _optimized_set_new_value
_return_value
)
],
sub _adds_members { 0 }
sub _potential_value {
- my ( $self, $slot_access ) = @_;
-
- return "( do { my \%potential = %{ ($slot_access) }; \@return = delete \@potential{\@_}; \\\%potential; } )";
+ my $self = shift;
+ my ($slot_access) = @_;
+
+ return '(do { '
+ . 'my %potential = %{ (' . $slot_access . ') }; '
+ . '@return = delete @potential{@_}; '
+ . '\%potential; '
+ . '})';
}
-sub _inline_optimized_set_new_value {
- my ( $self, $inv, $new, $slot_access ) = @_;
+sub _optimized_set_new_value {
+ my $self = shift;
+ my ($inv, $new, $slot_access) = @_;
- return "\@return = delete \@{ ($slot_access) }{\@_}";
+ return '@return = delete @{ (' . $slot_access . ') }{@_}';
}
sub _return_value {
- my ( $self, $slot_access ) = @_;
+ my $self = shift;
+ my ($slot_access) = @_;
- return 'return wantarray ? @return : $return[-1];';
+ return 'wantarray ? @return : $return[-1]';
}
no Moose::Role;
sub _maximum_arguments { 0 }
sub _return_value {
- my $self = shift;
- my $slot_access = shift;
+ my $self = shift;
+ my ($slot_access) = @_;
- return "map { \$_, ${slot_access}->{\$_} } keys \%{ ($slot_access) }";
+ return 'map { $_, ' . $slot_access . '->{$_} } '
+ . 'keys %{ (' . $slot_access . ') }';
}
no Moose::Role;
}
sub _return_value {
- my $self = shift;
- my $slot_access = shift;
+ my $self = shift;
+ my ($slot_access) = shift;
- return "exists ${slot_access}->{ \$_[0] }";
+ return 'exists ' . $slot_access . '->{ $_[0] }';
}
no Moose::Role;
sub _inline_check_arguments {
my $self = shift;
- return
- 'for (@_) {' . "\n"
- . $self->_inline_check_var_is_valid_key('$_') . "\n" . '}';
+ return (
+ 'for (@_) {',
+ $self->_inline_check_var_is_valid_key('$_'),
+ '}',
+ );
}
sub _return_value {
- my $self = shift;
- my $slot_access = shift;
+ my $self = shift;
+ my ($slot_access) = @_;
- return "\@_ > 1 ? \@{ ($slot_access) }{\@_} : ${slot_access}->{ \$_[0] }";
+ return '@_ > 1 '
+ . '? @{ (' . $slot_access . ') }{@_} '
+ . ': ' . $slot_access . '->{$_[0]}';
}
no Moose::Role;
sub _maximum_arguments { 0 }
sub _return_value {
- my $self = shift;
- my $slot_access = shift;
+ my $self = shift;
+ my ($slot_access) = @_;
- return "scalar keys \%{ ($slot_access) } ? 0 : 1";
+ return 'scalar keys %{ (' . $slot_access . ') } ? 0 : 1';
}
no Moose::Role;
sub _maximum_arguments { 0 }
sub _return_value {
- my $self = shift;
- my $slot_access = shift;
+ my $self = shift;
+ my ($slot_access) = @_;
- return "keys \%{ ($slot_access) }";
+ return 'keys %{ (' . $slot_access . ') }';
}
no Moose::Role;
sub _maximum_arguments { 0 }
sub _return_value {
- my $self = shift;
- my $slot_access = shift;
+ my $self = shift;
+ my ($slot_access) = @_;
- return "map { [ \$_, ${slot_access}->{\$_} ] } keys \%{ ($slot_access) }";
+ return 'map { [ $_, ' . $slot_access . '->{$_} ] } '
+ . 'keys %{ (' . $slot_access . ') }';
}
no Moose::Role;
_maximum_arguments
_inline_process_arguments
_inline_check_arguments
- _inline_optimized_set_new_value
+ _inline_coerce_new_values
+ _optimized_set_new_value
_return_value
)
],
my $orig = shift;
my $self = shift;
- return
- $self->$orig(@_) . "\n"
- . $self->_inline_throw_error(
- q{'You must pass an even number of arguments to set'})
- . ' if @_ % 2;';
+ return (
+ $self->$orig(@_),
+ 'if (@_ % 2) {',
+ $self->_inline_throw_error(
+ '"You must pass an even number of arguments to set"',
+ ) . ';',
+ '}',
+ );
};
sub _inline_process_arguments {
my $self = shift;
- return 'my @keys_idx = grep { ! ($_ % 2) } 0..$#_;' . "\n"
- . 'my @values_idx = grep { $_ % 2 } 0..$#_;';
+ return (
+ 'my @keys_idx = grep { ! ($_ % 2) } 0..$#_;',
+ 'my @values_idx = grep { $_ % 2 } 0..$#_;',
+ );
}
sub _inline_check_arguments {
my $self = shift;
- return
- 'for (@keys_idx) {' . "\n"
- . $self->_inline_throw_error(
- q{'Hash keys passed to set must be defined'})
- . ' unless defined $_[$_];' . "\n" . '}';
+ return (
+ 'for (@keys_idx) {',
+ 'if (!defined($_[$_])) {',
+ $self->_inline_throw_error(
+ '"Hash keys passed to set must be defined"',
+ ) . ';',
+ '}',
+ '}',
+ );
}
sub _adds_members { 1 }
# We need to override this because while @_ can be written to, we cannot write
# directly to $_[1].
-around _inline_coerce_new_values => sub {
- shift;
+sub _inline_coerce_new_values {
my $self = shift;
- return q{} unless $self->associated_attribute->should_coerce;
+ return unless $self->associated_attribute->should_coerce;
- return q{} unless $self->_tc_member_type_can_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_tc_obj->coerce($val);'
- . '}';
+ return (
+ 'my $iter = List::MoreUtils::natatime(2, @_);',
+ '@_ = ();',
+ 'while (my ($key, $val) = $iter->()) {',
+ 'push @_, $key, $member_tc_obj->coerce($val);',
+ '}',
+ );
};
sub _potential_value {
- my ( $self, $slot_access ) = @_;
+ my $self = shift;
+ my ($slot_access) = @_;
- return "{ %{ ($slot_access) }, \@_ }";
+ return '{ %{ (' . $slot_access . ') }, @_ }';
}
sub _new_members { '@_[ @values_idx ]' }
-sub _inline_optimized_set_new_value {
- my ( $self, $inv, $new, $slot_access ) = @_;
+sub _optimized_set_new_value {
+ my $self = shift;
+ my ($inv, $new, $slot_access) = @_;
- return "\@{ ($slot_access) }{ \@_[ \@keys_idx] } = \@_[ \@values_idx ]";
+ return '@{ (' . $slot_access . ') }{ @_[@keys_idx] } = @_[@values_idx]';
}
sub _return_value {
- my ( $self, $slot_access ) = @_;
+ my $self = shift;
+ my ($slot_access) = @_;
- return "return wantarray ? \@{ ($slot_access) }{ \@_[ \@keys_idx ] } : ${slot_access}->{ \$_[ \$keys_idx[0] ] };";
+ return 'wantarray '
+ . '? @{ (' . $slot_access . ') }{ @_[@keys_idx] } '
+ . ': ' . $slot_access . '->{ $_[$keys_idx[0]] }';
}
no Moose::Role;
sub _maximum_arguments { 0 }
sub _return_value {
- my $self = shift;
- my $slot_access = shift;
+ my $self = shift;
+ my ($slot_access) = @_;
- return "values \%{ ($slot_access) }";
+ return 'values %{ (' . $slot_access . ') }';
}
no Moose::Role;
-excludes => [
qw(
_maximum_arguments
- _inline_optimized_set_new_value
+ _optimized_set_new_value
)
]
};
sub _maximum_arguments {0}
sub _potential_value {
- my ( $self, $slot_access ) = @_;
+ my $self = shift;
+ my ($slot_access) = @_;
- return "abs($slot_access)";
+ return 'abs(' . $slot_access . ')';
}
-sub _inline_optimized_set_new_value {
- my ( $self, $inv, $new, $slot_access ) = @_;
+sub _optimized_set_new_value {
+ my $self = shift;
+ my ($inv, $new, $slot_access) = @_;
- return "$slot_access = abs($slot_access)";
+ return $slot_access . ' = abs(' . $slot_access . ')';
}
no Moose::Role;
qw(
_minimum_arguments
_maximum_arguments
- _inline_optimized_set_new_value
+ _optimized_set_new_value
)
]
};
sub _maximum_arguments {1}
sub _potential_value {
- my ( $self, $slot_access ) = @_;
+ my $self = shift;
+ my ($slot_access) = @_;
- return "$slot_access + \$_[0]";
+ return $slot_access . ' + $_[0]';
}
-sub _inline_optimized_set_new_value {
- my ( $self, $inv, $new, $slot_access ) = @_;
+sub _optimized_set_new_value {
+ my $self = shift;
+ my ($inv, $new, $slot_access) = @_;
- return "$slot_access += \$_[0]";
+ return $slot_access . ' += $_[0]';
}
no Moose::Role;
qw(
_minimum_arguments
_maximum_arguments
- _inline_optimized_set_new_value
+ _optimized_set_new_value
)
]
};
sub _maximum_arguments {1}
sub _potential_value {
- my ( $self, $slot_access ) = @_;
+ my $self = shift;
+ my ($slot_access) = @_;
- return "$slot_access / \$_[0]";
+ return $slot_access . ' / $_[0]';
}
-sub _inline_optimized_set_new_value {
- my ( $self, $inv, $new, $slot_access ) = @_;
+sub _optimized_set_new_value {
+ my $self = shift;
+ my ($inv, $new, $slot_access) = @_;
- return "$slot_access /= \$_[0]";
+ return $slot_access . ' /= $_[0]';
}
no Moose::Role;
qw(
_minimum_arguments
_maximum_arguments
- _inline_optimized_set_new_value
+ _optimized_set_new_value
)
]
};
sub _maximum_arguments {1}
sub _potential_value {
- my ( $self, $slot_access ) = @_;
+ my $self = shift;
+ my ($slot_access) = @_;
- return "$slot_access % \$_[0]";
+ return $slot_access . ' % $_[0]';
}
-sub _inline_optimized_set_new_value {
- my ( $self, $inv, $new, $slot_access ) = @_;
+sub _optimized_set_new_value {
+ my $self = shift;
+ my ($inv, $new, $slot_access) = @_;
- return "$slot_access %= \$_[0]";
+ return $slot_access . ' %= $_[0]';
}
no Moose::Role;
qw(
_minimum_arguments
_maximum_arguments
- _inline_optimized_set_new_value
+ _optimized_set_new_value
)
]
};
sub _maximum_arguments {1}
sub _potential_value {
- my ( $self, $slot_access ) = @_;
+ my $self = shift;
+ my ($slot_access) = @_;
- return "$slot_access * \$_[0]";
+ return $slot_access . ' * $_[0]';
}
-sub _inline_optimized_set_new_value {
- my ( $self, $inv, $new, $slot_access ) = @_;
+sub _optimized_set_new_value {
+ my $self = shift;
+ my ($inv, $new, $slot_access) = @_;
- return "$slot_access *= \$_[0]";
+ return $slot_access . ' *= $_[0]';
}
no Moose::Role;
qw(
_minimum_arguments
_maximum_arguments
- _inline_optimized_set_new_value
+ _optimized_set_new_value
)
]
};
sub _potential_value {'$_[0]'}
-sub _inline_optimized_set_new_value {
- my ( $self, $inv, $new, $slot_access ) = @_;
+sub _optimized_set_new_value {
+ my $self = shift;
+ my ($inv, $new, $slot_access) = @_;
- return "$slot_access = \$_[0]";
+ return $slot_access . ' = $_[0]';
}
no Moose::Role;
qw(
_minimum_arguments
_maximum_arguments
- _inline_optimized_set_new_value
+ _optimized_set_new_value
)
]
};
sub _maximum_arguments {1}
sub _potential_value {
- my ( $self, $slot_access ) = @_;
+ my $self = shift;
+ my ($slot_access) = @_;
- return "$slot_access - \$_[0]";
+ return $slot_access . ' - $_[0]';
}
-sub _inline_optimized_set_new_value {
- my ( $self, $inv, $new, $slot_access ) = @_;
+sub _optimized_set_new_value {
+ my $self = shift;
+ my ($inv, $new, $slot_access) = @_;
- return "$slot_access -= \$_[0]";
+ return $slot_access . ' -= $_[0]';
}
no Moose::Role;
sub _generate_method {
my $self = shift;
- my $inv = '$self';
-
- my $code = 'sub {';
- $code .= "\n" . $self->_inline_pre_body(@_);
-
- $code .= "\n" . 'my $self = shift;';
-
- $code .= "\n" . $self->_inline_curried_arguments;
-
+ my $inv = '$self';
my $slot_access = $self->_inline_get($inv);
- $code .= "\n" . $self->_reader_core( $inv, $slot_access, @_ );
-
- $code .= "\n}";
-
- return $code;
+ return (
+ 'sub {',
+ $self->_inline_pre_body(@_),
+ 'my ' . $inv . ' = shift;',
+ $self->_inline_curried_arguments,
+ $self->_reader_core($inv, $slot_access, @_),
+ '}',
+ );
}
sub _reader_core {
- my ( $self, $inv, $slot_access, @extra ) = @_;
-
- my $code = q{};
-
- $code .= "\n" . $self->_inline_check_argument_count;
- $code .= "\n" . $self->_inline_process_arguments( $inv, $slot_access );
- $code .= "\n" . $self->_inline_check_arguments;
-
- $code .= "\n" . $self->_inline_check_lazy($inv);
- $code .= "\n" . $self->_inline_post_body(@extra);
- $code .= "\n" . $self->_inline_return_value($slot_access);
-
- return $code;
+ 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),
+ $self->_inline_post_body(@extra),
+ $self->_inline_return_value($slot_access),
+ );
}
-sub _inline_process_arguments {q{}}
+sub _inline_process_arguments { return }
-sub _inline_check_arguments {q{}}
-
-sub _inline_return_value {
- my ( $self, $slot_access ) = @_;
-
- 'return ' . $self->_return_value($slot_access) . ';';
-}
+sub _inline_check_arguments { return }
no Moose::Role;
qw(
_minimum_arguments
_maximum_arguments
- _inline_optimized_set_new_value
+ _optimized_set_new_value
)
]
};
sub _maximum_arguments { 1 }
sub _potential_value {
- my ( $self, $slot_access ) = @_;
+ my $self = shift;
+ my ($slot_access) = @_;
- return "( $slot_access . \$_[0] )";
+ return '( ' . $slot_access . ' . $_[0] )';
}
-sub _inline_optimized_set_new_value {
- my ( $self, $inv, $new, $slot_access ) = @_;
+sub _optimized_set_new_value {
+ my $self = shift;
+ my ($inv, $new, $slot_access) = @_;
- return "$slot_access .= \$_[0]";
+ return $slot_access . ' .= $_[0]';
}
no Moose::Role;
-excludes => [
qw(
_maximum_arguments
- _inline_optimized_set_new_value
+ _optimized_set_new_value
_return_value
)
]
sub _maximum_arguments {0}
sub _potential_value {
- my ( $self, $slot_access ) = @_;
-
- return "( do { my \$val = $slot_access; \@return = chomp \$val; \$val } )";
+ my $self = shift;
+ my ($slot_access) = @_;
+
+ return '(do { '
+ . 'my $val = ' . $slot_access . '; '
+ . '@return = chomp $val; '
+ . '$val '
+ . '})';
}
-sub _inline_optimized_set_new_value {
- my ( $self, $inv, $new, $slot_access ) = @_;
+sub _optimized_set_new_value {
+ my $self = shift;
+ my ($inv, $new, $slot_access) = @_;
- return "\@return = chomp $slot_access";
+ return '@return = chomp ' . $slot_access;
}
sub _return_value {
- my ( $self, $slot_access ) = @_;
+ my $self = shift;
+ my ($slot_access) = @_;
return '$return[0]';
}
-excludes => [
qw(
_maximum_arguments
- _inline_optimized_set_new_value
+ _optimized_set_new_value
_return_value
)
]
sub _maximum_arguments { 0 }
sub _potential_value {
- my ( $self, $slot_access ) = @_;
-
- return "( do { my \$val = $slot_access; \@return = chop \$val; \$val } )";
+ my $self = shift;
+ my ($slot_access) = @_;
+
+ return '(do { '
+ . 'my $val = ' . $slot_access . '; '
+ . '@return = chop $val; '
+ . '$val; '
+ . '})';
}
-sub _inline_optimized_set_new_value {
- my ( $self, $inv, $new, $slot_access ) = @_;
+sub _optimized_set_new_value {
+ my $self = shift;
+ my ($inv, $new, $slot_access) = @_;
- return "\@return = chop $slot_access";
+ return '@return = chop ' . $slot_access;
}
sub _return_value {
- my ( $self, $slot_access ) = @_;
+ my $self = shift;
+ my ($slot_access) = @_;
return '$return[0]';
}
-excludes => [
qw(
_maximum_arguments
- _inline_optimized_set_new_value
+ _optimized_set_new_value
)
]
};
sub _maximum_arguments { 0 }
sub _potential_value {
- my ( $self, $slot_access ) = @_;
+ my $self = shift;
+ my ($slot_access) = @_;
- return "q{}";
+ return '""';
}
-sub _inline_optimized_set_new_value {
- my ( $self, $inv, $new, $slot_access ) = @_;
+sub _optimized_set_new_value {
+ my $self = shift;
+ my ($inv, $new, $slot_access) = @_;
- return "$slot_access = q{}";
+ return $slot_access . ' = ""';
}
no Moose::Role;
-excludes => [
qw(
_maximum_arguments
- _inline_optimized_set_new_value
+ _optimized_set_new_value
)
]
};
sub _maximum_arguments { 0 }
sub _potential_value {
- my ( $self, $slot_access ) = @_;
-
- return "( do { my \$val = $slot_access; \$val++; \$val } )";
+ my $self = shift;
+ my ($slot_access) = @_;
+
+ return '(do { '
+ . 'my $val = ' . $slot_access . '; '
+ . '$val++; '
+ . '$val; '
+ . '})';
}
-sub _inline_optimized_set_new_value {
- my ( $self, $inv, $new, $slot_access ) = @_;
+sub _optimized_set_new_value {
+ my $self = shift;
+ my ($inv, $new, $slot_access) = @_;
- return "${slot_access}++";
+ return $slot_access . '++';
}
no Moose::Role;
sub _maximum_arguments { 0 }
sub _return_value {
- my ( $self, $slot_access ) = @_;
+ my $self = shift;
+ my ($slot_access) = @_;
- return "length $slot_access";
+ return 'length ' . $slot_access;
}
no Moose::Role;
sub _inline_check_arguments {
my $self = shift;
- return $self->_inline_throw_error(
- q{'The argument passed to match must be a string or regexp reference'}
- ) . q{ unless Moose::Util::_STRINGLIKE0( $_[0] ) || Params::Util::_REGEX( $_[0] );};
+ return (
+ 'if (!Moose::Util::_STRINGLIKE0($_[0]) && !Params::Util::_REGEX($_[0])) {',
+ $self->_inline_throw_error(
+ '"The argument passed to match must be a string or regexp '
+ . 'reference"',
+ ) . ';',
+ '}',
+ );
}
sub _return_value {
- my ( $self, $slot_access ) = @_;
+ my $self = shift;
+ my ($slot_access) = @_;
- return "$slot_access =~ \$_[0]";
+ return $slot_access . ' =~ $_[0]';
}
no Moose::Role;
qw(
_minimum_arguments
_maximum_arguments
- _inline_optimized_set_new_value
+ _optimized_set_new_value
)
]
};
sub _maximum_arguments { 1 }
sub _potential_value {
- my ( $self, $slot_access ) = @_;
+ my $self = shift;
+ my ($slot_access) = @_;
- return "( \$_[0] . $slot_access )";
+ return '( $_[0] . ' . $slot_access . ' )';
}
-sub _inline_optimized_set_new_value {
- my ( $self, $inv, $new, $slot_access ) = @_;
+sub _optimized_set_new_value {
+ my $self = shift;
+ my ($inv, $new, $slot_access) = @_;
- return "$slot_access = \$_[0] . $slot_access";
+ return $slot_access . ' = $_[0] . ' . $slot_access;
}
no Moose::Role;
_minimum_arguments
_maximum_arguments
_inline_check_arguments
- _inline_optimized_set_new_value
+ _optimized_set_new_value
)
]
};
sub _inline_check_arguments {
my $self = shift;
- return $self->_inline_throw_error(
- q{'The first argument passed to replace must be a string or regexp reference'}
- )
- . q{ unless Moose::Util::_STRINGLIKE0( $_[0] ) || Params::Util::_REGEX( $_[0] );}
- . $self->_inline_throw_error(
- q{'The second argument passed to replace must be a string or code reference'}
- ) . q{ unless Moose::Util::_STRINGLIKE0( $_[1] ) || Params::Util::_CODELIKE( $_[1] );};
+ return (
+ 'if (!Moose::Util::_STRINGLIKE0($_[0]) && !Params::Util::_REGEX($_[0])) {',
+ $self->_inline_throw_error(
+ '"The first argument passed to replace must be a string or '
+ . 'regexp reference"'
+ ) . ';',
+ '}',
+ 'if (!Moose::Util::_STRINGLIKE0($_[1]) && !Params::Util::_CODELIKE($_[1])) {',
+ $self->_inline_throw_error(
+ '"The second argument passed to replace must be a string or '
+ . 'code reference"'
+ ) . ';',
+ '}',
+ );
}
sub _potential_value {
- my ( $self, $slot_access ) = @_;
+ my $self = shift;
+ my ($slot_access) = @_;
- return "( do { my \$val = $slot_access; ref \$_[1] ? \$val =~ s/\$_[0]/\$_[1]->()/e : \$val =~ s/\$_[0]/\$_[1]/; \$val } )";
+ 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, $inv, $new, $slot_access ) = @_;
+sub _optimized_set_new_value {
+ my $self = shift;
+ my ($inv, $new, $slot_access) = @_;
- return "if ( ref \$_[1] ) { $slot_access =~ s/\$_[0]/\$_[1]->()/e; } else { $slot_access =~ s/\$_[0]/\$_[1]/; }";
+ return '(do { '
+ . 'ref $_[1] '
+ . '? ' . $slot_access . ' =~ s/$_[0]/$_[1]->()/e '
+ . ': ' . $slot_access . ' =~ s/$_[0]/$_[1]/; '
+ . '})';
}
no Moose::Role;
_maximum_arguments
_inline_process_arguments
_inline_check_arguments
- _inline_optimized_set_new_value
+ _optimized_set_new_value
_return_value
)
]
sub _generate_method {
my $self = shift;
- my $inv = '$self';
-
+ my $inv = '$self';
my $slot_access = $self->_inline_get($inv);
- my $code = 'sub {';
-
- $code .= "\n" . $self->_inline_pre_body(@_);
- $code .= "\n" . 'my $self = shift;';
-
- $code .= "\n" . $self->_inline_curried_arguments;
-
- $code .= "\n" . 'if ( @_ == 1 || @_ == 2 ) {';
-
- $code .= $self->_reader_core( $inv, $slot_access );
-
- $code .= "\n" . '} elsif ( @_ == 3 ) {';
-
- $code .= $self->_writer_core( $inv, $slot_access );
-
- $code .= "\n" . $self->_inline_post_body(@_);
-
- $code .= "\n" . '} else {';
-
- $code .= "\n" . $self->_inline_check_argument_count;
-
- $code .= "\n" . '}';
- $code .= "\n" . '}';
-
- return $code;
+ return (
+ 'sub {',
+ $self->_inline_pre_body(@_),
+ 'my ' . $inv . ' = shift;',
+ $self->_inline_curried_arguments,
+ 'if (@_ == 1 || @_ == 2) {',
+ $self->_reader_core($inv, $slot_access),
+ '}',
+ 'elsif (@_ == 3) {',
+ $self->_writer_core($inv, $slot_access),
+ $self->_inline_post_body(@_),
+ '}',
+ 'else {',
+ $self->_inline_check_argument_count,
+ '}',
+ '}',
+ );
}
sub _minimum_arguments {1}
sub _maximum_arguments {3}
sub _inline_process_arguments {
- my ( $self, $inv, $slot_access ) = @_;
+ my $self = shift;
+ my ($inv, $slot_access) = @_;
- return
- 'my $offset = shift;' . "\n"
- . "my \$length = \@_ ? shift : length $slot_access;" . "\n"
- . 'my $replacement = shift;';
+ return (
+ 'my $offset = shift;',
+ 'my $length = @_ ? shift : length ' . $slot_access . ';',
+ 'my $replacement = shift;',
+ );
}
sub _inline_check_arguments {
- my ( $self, $for_writer ) = @_;
-
- my $code
- = $self->_inline_throw_error(
- q{'The first argument passed to substr must be an integer'})
- . q{ unless $offset =~ /^-?\\d+$/;} . "\n"
- . $self->_inline_throw_error(
- q{'The second argument passed to substr must be an integer'})
- . q{ unless $length =~ /^-?\\d+$/;};
+ my $self = shift;
+ my ($for_writer) = @_;
+
+ my @code = (
+ 'if ($offset !~ /^-?\d+$/) {',
+ $self->_inline_throw_error(
+ '"The first argument passed to substr must be an integer"'
+ ) . ';',
+ '}',
+ 'if ($length !~ /^-?\d+$/) {',
+ $self->_inline_throw_error(
+ '"The second argument passed to substr must be an integer"'
+ ) . ';',
+ '}',
+ );
if ($for_writer) {
- $code
- .= "\n"
- . $self->_inline_throw_error(
- q{'The third argument passed to substr must be a string'})
- . q{ unless Moose::Util::_STRINGLIKE0($replacement);};
+ push @code, (
+ 'if (!Moose::Util::_STRINGLIKE0($replacement)) {',
+ $self->_inline_throw_error(
+ '"The third argument passed to substr must be a string"'
+ ) . ';',
+ '}',
+ );
}
- return $code;
+ return @code;
}
sub _potential_value {
- my ( $self, $slot_access ) = @_;
+ my $self = shift;
+ my ($slot_access) = @_;
- return
- "( do { my \$potential = $slot_access; \@return = substr \$potential, \$offset, \$length, \$replacement; \$potential; } )";
+ return '(do { '
+ . 'my $potential = ' . $slot_access . '; '
+ . '@return = substr $potential, $offset, $length, $replacement; '
+ . '$potential; '
+ . '})';
}
-sub _inline_optimized_set_new_value {
- my ( $self, $inv, $new, $slot_access ) = @_;
+sub _optimized_set_new_value {
+ my $self = shift;
+ my ($inv, $new, $slot_access) = @_;
- return "\@return = substr $slot_access, \$offset, \$length, \$replacement";
+ return '@return = substr ' . $slot_access . ', '
+ . '$offset, $length, $replacement';
}
sub _return_value {
- my ( $self, $slot_access, $for_writer ) = @_;
+ my $self = shift;
+ my ($slot_access, $for_writer) = @_;
return '$return[0]' if $for_writer;
- return "substr $slot_access, \$offset, \$length";
+ return 'substr ' . $slot_access . ', $offset, $length';
}
no Moose::Role;
sub _generate_method {
my $self = shift;
- my $inv = '$self';
-
+ my $inv = '$self';
my $slot_access = $self->_inline_get($inv);
- my $code = 'sub {';
-
- $code .= "\n" . $self->_inline_pre_body(@_);
-
- $code .= "\n" . 'my $self = shift;';
-
- $code .= "\n" . $self->_inline_curried_arguments;
-
- $code .= $self->_writer_core( $inv, $slot_access );
-
- $code .= "\n" . $self->_inline_post_body(@_);
-
- $code .= "\n}";
-
- return $code;
+ return (
+ 'sub {',
+ $self->_inline_pre_body(@_),
+ 'my ' . $inv . ' = shift;',
+ $self->_inline_curried_arguments,
+ $self->_writer_core($inv, $slot_access),
+ $self->_inline_post_body(@_),
+ '}',
+ );
}
sub _writer_core {
- my ( $self, $inv, $slot_access ) = @_;
-
- my $code = q{};
-
- $code .= "\n" . $self->_inline_check_argument_count;
- $code .= "\n" . $self->_inline_process_arguments( $inv, $slot_access );
- $code .= "\n" . $self->_inline_check_arguments('for writer');
+ my $self = shift;
+ my ($inv, $slot_access) = @_;
- $code .= "\n" . $self->_inline_check_lazy($inv);
+ my $potential = $self->_potential_value($slot_access);
+ my $old = '@old';
- my $potential_value = $self->_potential_value($slot_access);
+ 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),
+ );
- if ( $self->_return_value($slot_access) ) {
+ if ($self->_return_value($slot_access)) {
# some writers will save the return value in this variable when they
# generate the potential value.
- $code .= "\n" . 'my @return;';
+ push @code, 'my @return;'
}
- # This is only needed by collections.
- $code .= "\n" . $self->_inline_coerce_new_values;
- $code .= "\n" . $self->_inline_copy_native_value( \$potential_value );
- $code .= "\n"
- . $self->_inline_tc_code(
- $potential_value
- );
-
- $code .= "\n" . $self->_inline_get_old_value_for_trigger($inv);
- $code .= "\n" . $self->_inline_capture_return_value($slot_access);
- $code .= "\n"
- . $self->_inline_set_new_value(
- $inv,
- $potential_value,
- $slot_access,
- ) . ';';
- $code .= "\n" . $self->_inline_trigger( $inv, $slot_access, '@old' );
- $code .= "\n" . $self->_return_value( $slot_access, 'for writer' );
-
- return $code;
+ push @code, (
+ $self->_inline_coerce_new_values,
+ $self->_inline_copy_native_value(\$potential),
+ $self->_inline_tc_code($potential),
+ $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 {q{}}
+sub _inline_process_arguments { return }
-sub _inline_check_arguments {q{}}
+sub _inline_check_arguments { return }
-sub _inline_coerce_new_values {q{}}
+sub _inline_coerce_new_values { return }
sub _value_needs_copy {
my $self = shift;
}
sub _is_root_type {
- my ($self, $type) = @_;
+ my $self = shift;
+ my ($type) = @_;
- my $name = $type->name();
+ my $name = $type->name;
return any { $name eq $_ } @{ $self->root_types };
}
sub _inline_copy_native_value {
- my ( $self, $potential_ref ) = @_;
+ my $self = shift;
+ my ($potential_ref) = @_;
- return q{} unless $self->_value_needs_copy;
+ return unless $self->_value_needs_copy;
- my $code = "my \$potential = ${$potential_ref};";
+ my $code = 'my $potential = ' . ${$potential_ref} . ';';
${$potential_ref} = '$potential';
- return $code;
+ return ($code);
}
-sub _inline_tc_code {
- my ( $self, $potential_value ) = @_;
+around _inline_tc_code => sub {
+ my $orig = shift;
+ my $self = shift;
+ my ($value, $for_lazy) = @_;
- return q{} unless $self->_constraint_must_be_checked;
+ return unless $for_lazy || $self->_constraint_must_be_checked;
- return $self->_inline_check_coercion($potential_value) . "\n"
- . $self->_inline_check_constraint($potential_value);
-}
+ return $self->$orig(@_);
+};
sub _inline_check_coercion {
- my ( $self, $value ) = @_;
+ my $self = shift;
+ my ($value) = @_;
my $attr = $self->associated_attribute;
-
- return q{}
- unless $attr->should_coerce
- && $attr->type_constraint->has_coercion;
+ return unless $attr->should_coerce && $attr->type_constraint->has_coercion;
# We want to break the aliasing in @_ in case the coercion tries to make a
# destructive change to an array member.
- return "$value = \$type_constraint_obj->coerce($value);";
+ return ($value . ' = $type_constraint_obj->coerce(' . $value . ');');
}
-override _inline_check_constraint => sub {
- my ( $self, $value, $for_lazy ) = @_;
+around _inline_check_constraint => sub {
+ my $orig = shift;
+ my $self = shift;
+ my ($value, $for_lazy) = @_;
- return q{} unless $for_lazy || $self->_constraint_must_be_checked;
+ return unless $for_lazy || $self->_constraint_must_be_checked;
- return super();
+ return $self->$orig(@_);
};
-sub _inline_capture_return_value { return q{} }
+sub _inline_capture_return_value { return }
-sub _inline_set_new_value {
+sub _set_new_value {
my $self = shift;
return $self->_inline_store(@_)
|| !$self->_slot_access_can_be_inlined
|| !$self->_inline_get_is_lvalue;
- return $self->_inline_optimized_set_new_value(@_);
+ return $self->_optimized_set_new_value(@_);
+}
+
+sub _inline_set_new_value {
+ my $self = shift;
+ return $self->_set_new_value(@_) . ';';
}
sub _inline_get_is_lvalue {
return $self->associated_attribute->associated_class->instance_metaclass->inline_get_is_lvalue;
}
-sub _inline_optimized_set_new_value {
+sub _optimized_set_new_value {
my $self = shift;
return $self->_inline_store(@_);
}
sub _return_value {
- my ( $self, $slot_access ) = @_;
+ my $self = shift;
+ my ($slot_access) = @_;
return $slot_access;
}
projects / gitmo/Moose.git / commitdiff