lib/Moose/Meta/Method/Accessor/Native/Array/natatime.pm

   1 package Moose::Meta::Method::Accessor::Native::Array::natatime;
   2
   3 use strict;
   4 use warnings;
   5
   6 use List::MoreUtils ();
   7 use Params::Util ();
   8
   9 use Moose::Role;
  10
  11 with 'Moose::Meta::Method::Accessor::Native::Reader' => {
  12     -excludes => [
  13         qw(
  14             _minimum_arguments
  15             _maximum_arguments
  16             _inline_check_arguments
  17             _inline_return_value
  18             )
  19     ]
  20 };
  21
  22 sub _minimum_arguments { 1 }
  23
  24 sub _maximum_arguments { 2 }
  25
  26 sub _inline_check_arguments {
  27     my $self = shift;
  28
  29     return (
  30         'if (!defined($_[0]) || $_[0] !~ /^\d+$/) {',
  31             $self->_inline_throw_error(
  32                 '"The n value passed to natatime must be an integer"',
  33             ) . ';',
  34         '}',
  35         'if (@_ == 2 && !Params::Util::_CODELIKE($_[1])) {',
  36             $self->_inline_throw_error(
  37                 '"The second argument passed to natatime must be a code '
  38               . 'reference"',
  39             ) . ';',
  40         '}',
  41     );
  42 }
  43
  44 sub _inline_return_value {
  45     my $self = shift;
  46     my ($slot_access) = @_;
  47
  48     return (
  49         'my $iter = List::MoreUtils::natatime($_[0], @{ (' . $slot_access . ') });',
  50         'if ($_[1]) {',
  51             'while (my @vals = $iter->()) {',
  52                 '$_[1]->(@vals);',
  53             '}',
  54         '}',
  55         'else {',
  56             'return $iter;',
  57         '}',
  58     );
  59 }
  60
  61 # Not called, but needed to satisfy the Reader role
  62 sub _return_value { }
  63
  64 no Moose::Role;
  65
  66 1;