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      'Moose::Autobox::Indexed';
  10
  11 ## Array Interface
  12
  13 sub pop {
  14     my ($array) = @_;
  15     CORE::pop @$array;
  16 }
  17
  18 sub push {
  19     my ($array, @rest) = @_;
  20     CORE::push @$array, @rest;
  21     $array;
  22 }
  23
  24 sub unshift {
  25     my ($array, @rest) = @_;
  26     CORE::unshift @$array, @rest;
  27     $array;
  28 }
  29
  30 sub delete {
  31     my ($array, $index) = @_;
  32     CORE::delete $array->[$index];
  33 }
  34
  35 sub shift {
  36     my ($array) = @_;
  37     CORE::shift @$array;
  38 }
  39
  40 # NOTE:
  41 # sprintf args need to be reversed,
  42 # because the invocant is the array
  43 sub sprintf { CORE::sprintf $_[1], @{$_[0]} }
  44
  45 ## ::List interface implementation
  46
  47 sub head { $_[0]->[0] }
  48 sub tail { [ @{$_[0]}[ 1 .. $#{$_[0]} ] ] }
  49
  50 sub length {
  51     my ($array) = @_;
  52     CORE::scalar @$array;
  53 }
  54
  55 sub grep {
  56     my ($array, $sub) = @_;
  57     [ CORE::grep { $sub->($_) } @$array ];
  58 }
  59
  60 sub map {
  61     my ($array, $sub) = @_;
  62     [ CORE::map { $sub->($_) } @$array ];
  63 }
  64
  65 sub join {
  66     my ($array, $sep) = @_;
  67     $sep ||= '';
  68     CORE::join $sep, @$array;
  69 }
  70
  71 sub reverse {
  72     my ($array) = @_;
  73     [ CORE::reverse @$array ];
  74 }
  75
  76 sub sort {
  77     my ($array, $sub) = @_;
  78     $sub ||= sub { $a cmp $b };
  79     [ CORE::sort { $sub->($a, $b) } @$array ];
  80 }
  81
  82 ## ::Indexed implementation
  83
  84 sub at {
  85     my ($array, $index) = @_;
  86     $array->[$index];
  87 }
  88
  89 sub put {
  90     my ($array, $index, $value) = @_;
  91     $array->[$index] = $value;
  92 }
  93
  94 sub exists {
  95     my ($array, $index) = @_;
  96     CORE::exists $array->[$index];
  97 }
  98
  99 sub keys {
 100     my ($array) = @_;
 101     [ 0 .. $#{$array} ];
 102 }
 103
 104 sub values {
 105     my ($array) = @_;
 106     [ @$array ];
 107 }
 108
 109 sub kv {
 110     my ($array) = @_;
 111     $array->keys->map(sub { [ $_, $array->[$_] ] });
 112 }
 113
 114 1;
 115
 116 __END__
 117
 118 =pod
 119
 120 =head1 NAME
 121
 122 Moose::Autobox::Array - the Array role
 123
 124 =head1 SYNOPOSIS
 125
 126   use Moose::Autobox;
 127   use autobox;
 128
 129   [ 1..5 ]->isa('ARRAY'); # true
 130   [ a..z ]->does('Moose::Autobox::Array'); # true
 131   [ 0..2 ]->does('Moose::Autobox::List'); # true
 132
 133   print "Squares: " . [ 1 .. 10 ]->map(sub { $_ * $_ })->join(', ');
 134
 135   print [ 1, 'number' ]->sprintf('%d is the loneliest %s');
 136
 137 =head1 DESCRIPTION
 138
 139 This is a role to describe operations on the Array type.
 140
 141 =head1 METHODS
 142
 143 =over 4
 144
 145 =item B<pop>
 146
 147 =item B<push ($value)>
 148
 149 =item B<shift>
 150
 151 =item B<unshift ($value)>
 152
 153 =item B<delete ($index)>
 154
 155 =item B<sprintf ($format_string)>
 156
 157 =back
 158
 159 =head2 Indexed implementation
 160
 161 =over 4
 162
 163 =item B<at ($index)>
 164
 165 =item B<put ($index, $value)>
 166
 167 =item B<exists ($index)>
 168
 169 =item B<keys>
 170
 171 =item B<values>
 172
 173 =item B<kv>
 174
 175 =back
 176
 177 =head2 List implementation
 178
 179 =over 4
 180
 181 =item B<head>
 182
 183 =item B<tail>
 184
 185 =item B<join (?$seperator)>
 186
 187 =item B<length>
 188
 189 =item B<map (\&block)>
 190
 191 =item B<grep (\&block)>
 192
 193 =item B<reverse>
 194
 195 =item B<sort (?\&block)>
 196
 197 =back
 198
 199 =over 4
 200
 201 =item B<meta>
 202
 203 =back
 204
 205 =head1 BUGS
 206
 207 All complex software has bugs lurking in it, and this module is no
 208 exception. If you find a bug please either email me, or add the bug
 209 to cpan-RT.
 210
 211 =head1 AUTHOR
 212
 213 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 214
 215 =head1 COPYRIGHT AND LICENSE
 216
 217 Copyright 2006 by Infinity Interactive, Inc.
 218
 219 L<http://www.iinteractive.com>
 220
 221 This library is free software; you can redistribute it and/or modify
 222 it under the same terms as Perl itself.
 223
 224 =cut