lib/Moose/Autobox/Array.pm

   1 package Moose::Autobox::Array;
   2 use Moose::Role 'with';
   3 use autobox;
   4
   5 our $VERSION = '0.01';
   6
   7 with 'Moose::Autobox::Ref',
   8      'Moose::Autobox::List';
   9
  10 ## Array Interface
  11
  12 sub pop {
  13     my ($array) = @_;
  14     CORE::pop @$array;
  15 }
  16
  17 sub push {
  18     my ($array, @rest) = @_;
  19     CORE::push @$array, @rest;
  20     $array;
  21 }
  22
  23 sub unshift {
  24     my ($array, @rest) = @_;
  25     CORE::unshift @$array, @rest;
  26     $array;
  27 }
  28
  29 sub delete {
  30     my ($array, $index) = @_;
  31     CORE::delete $array->[$index];
  32 }
  33
  34 sub shift {
  35     my ($array) = @_;
  36     CORE::shift @$array;
  37 }
  38
  39 # NOTE:
  40 # sprintf args need to be reversed,
  41 # because the invocant is the array
  42 sub sprintf { CORE::sprintf $_[1], @{$_[0]} }
  43
  44 ## ::List interface implementation
  45
  46 sub head { $_[0]->[0] }
  47 sub tail { [ @{$_[0]}[ 1 .. $#{$_[0]} ] ] }
  48
  49 sub length {
  50     my ($array) = @_;
  51     CORE::scalar @$array;
  52 }
  53
  54 sub grep {
  55     my ($array, $sub) = @_;
  56     [ CORE::grep { $sub->($_) } @$array ];
  57 }
  58
  59 sub map {
  60     my ($array, $sub) = @_;
  61     [ CORE::map { $sub->($_) } @$array ];
  62 }
  63
  64 sub join {
  65     my ($array, $sep) = @_;
  66     $sep ||= '';
  67     CORE::join $sep, @$array;
  68 }
  69
  70 sub reverse {
  71     my ($array) = @_;
  72     [ CORE::reverse @$array ];
  73 }
  74
  75 sub sort {
  76     my ($array, $sub) = @_;
  77     $sub ||= sub { $a cmp $b };
  78     [ CORE::sort { $sub->($a, $b) } @$array ];
  79 }
  80
  81 # ::Value requirement
  82
  83 sub print { CORE::print @{$_[0]} }
  84
  85 ## ::Indexed implementation
  86
  87 sub exists {
  88     my ($array, $index) = @_;
  89     CORE::exists $array->[$index];
  90 }
  91
  92 sub keys {
  93     my ($array) = @_;
  94     [ 0 .. $#{$array} ];
  95 }
  96
  97 sub values {
  98     my ($array) = @_;
  99     [ @$array ];
 100 }
 101
 102 sub kv {
 103     my ($array) = @_;
 104     $array->keys->map(sub { [ $_, $array->[$_] ] });
 105 }
 106
 107 1;