[gitmo/Moose-Autobox.git] / lib / Moose / Autobox / Array.pm

package Moose::Autobox::Array;
use Moose::Role 'with';
use autobox;

our $VERSION = '0.01';

with 'Moose::Autobox::Ref',
     'Moose::Autobox::List',
     'Moose::Autobox::Indexed';
    
## Array Interface

sub pop { 
    my ($array) = @_;    
    CORE::pop @$array; 
}

sub push { 
    my ($array, @rest) = @_;
    CORE::push @$array, @rest;  
    $array; 
}

sub unshift { 
    my ($array, @rest) = @_;    
    CORE::unshift @$array, @rest; 
    $array; 
}

sub delete { 
    my ($array, $index) = @_;    
    CORE::delete $array->[$index];
}

sub shift { 
    my ($array) = @_;    
    CORE::shift @$array; 
}     

# NOTE: 
# sprintf args need to be reversed, 
# because the invocant is the array
sub sprintf { CORE::sprintf $_[1], @{$_[0]} }

## ::List interface implementation

sub head { $_[0]->[0] }
sub tail { [ @{$_[0]}[ 1 .. $#{$_[0]} ] ] }
 
sub length {
    my ($array) = @_;
    CORE::scalar @$array;
}

sub grep { 
    my ($array, $sub) = @_; 
    [ CORE::grep { $sub->($_) } @$array ]; 
}

sub map { 
    my ($array, $sub) = @_; 
    [ CORE::map { $sub->($_) } @$array ]; 
}

sub join { 
    my ($array, $sep) = @_;    
    $sep ||= ''; 
    CORE::join $sep, @$array; 
}

sub reverse { 
    my ($array) = @_;
    [ CORE::reverse @$array ];
}

sub sort { 
    my ($array, $sub) = @_;     
    $sub ||= sub { $a cmp $b }; 
    [ CORE::sort { $sub->($a, $b) } @$array ]; 
}    

## ::Indexed implementation

sub at {
    my ($array, $index) = @_;
    $array->[$index];
} 

sub put {
    my ($array, $index, $value) = @_;
    $array->[$index] = $value;
}

sub exists {
    my ($array, $index) = @_;    
    CORE::exists $array->[$index];    
}

sub keys { 
    my ($array) = @_;    
    [ 0 .. $#{$array} ];
}

sub values { 
    my ($array) = @_;    
    [ @$array ];
}

sub kv {
    my ($array) = @_;   
    $array->keys->map(sub { [ $_, $array->[$_] ] });
}

1;

__END__

=pod

=head1 NAME 

Moose::Autobox::Array - the Array role

=head1 SYNOPOSIS

  use Moose::Autobox;
  use autobox;
    
  [ 1..5 ]->isa('ARRAY'); # true
  [ a..z ]->does('Moose::Autobox::Array'); # true
  [ 0..2 ]->does('Moose::Autobox::List'); # true  
    
  print "Squares: " . [ 1 .. 10 ]->map(sub { $_ * $_ })->join(', ');
  
  print [ 1, 'number' ]->sprintf('%d is the loneliest %s');

=head1 DESCRIPTION

This is a role to describe operations on the Array type. 

=head1 METHODS

=over 4

=item B<pop>

=item B<push ($value)>

=item B<shift>

=item B<unshift ($value)>

=item B<delete ($index)>

=item B<sprintf ($format_string)>

=back

=head2 Indexed implementation

=over 4

=item B<at ($index)>

=item B<put ($index, $value)>

=item B<exists ($index)>

=item B<keys>

=item B<values>

=item B<kv>

=back

=head2 List implementation

=over 4

=item B<head>

=item B<tail>

=item B<join (?$seperator)>

=item B<length>

=item B<map (\&block)>

=item B<grep (\&block)>

=item B<reverse>

=item B<sort (?\&block)>

=back

=over 4

=item B<meta>

=back

=head1 BUGS

All complex software has bugs lurking in it, and this module is no 
exception. If you find a bug please either email me, or add the bug
to cpan-RT.

=head1 AUTHOR

Stevan Little E<lt>stevan@iinteractive.comE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright 2006 by Infinity Interactive, Inc.

L<http://www.iinteractive.com>

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut
Commit	Line	Data
5f654d8e	1	package Moose::Autobox::Array;
5f654d8e	2	use Moose::Role 'with';
252ab1a2	3	use autobox;
5f654d8e	4
	5	our $VERSION = '0.01';
	6
e6bb88b0	7	with 'Moose::Autobox::Ref',
31d40d73	8	'Moose::Autobox::List',
31d40d73	9	'Moose::Autobox::Indexed';
6cf5bcf2	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	}
5f654d8e	29
6cf5bcf2	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]} ] ] }
e6bb88b0	49
5f654d8e	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 {
feffe00c	66	my ($array, $sep) = @_;
feffe00c	67	$sep \|\|= '';
5f654d8e	68	CORE::join $sep, @$array;
	69	}
	70
	71	sub reverse {
	72	my ($array) = @_;
e6bb88b0	73	[ CORE::reverse @$array ];
5f654d8e	74	}
	75
	76	sub sort {
	77	my ($array, $sub) = @_;
	78	$sub \|\|= sub { $a cmp $b };
	79	[ CORE::sort { $sub->($a, $b) } @$array ];
5dc78481	80	}
5dc78481	81
260cc81f	82	## ::Indexed implementation
5dc78481	83
260cc81f	84	sub at {
	85	my ($array, $index) = @_;
	86	$array->[$index];
	87	}
5dc78481	88
260cc81f	89	sub put {
	90	my ($array, $index, $value) = @_;
	91	$array->[$index] = $value;
	92	}
5dc78481	93
6cf5bcf2	94	sub exists {
	95	my ($array, $index) = @_;
	96	CORE::exists $array->[$index];
	97	}
5dc78481	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) = @_;
feffe00c	111	$array->keys->map(sub { [ $_, $array->[$_] ] });
5dc78481	112	}
e6bb88b0	113
5f654d8e	114	1;
31d40d73	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
5272f13f	129	[ 1..5 ]->isa('ARRAY'); # true
	130	[ a..z ]->does('Moose::Autobox::Array'); # true
	131	[ 0..2 ]->does('Moose::Autobox::List'); # true
	132
31d40d73	133	print "Squares: " . [ 1 .. 10 ]->map(sub { $_ * $_ })->join(', ');
5272f13f	134
5272f13f	135	print [ 1, 'number' ]->sprintf('%d is the loneliest %s');
31d40d73	136
	137	=head1 DESCRIPTION
	138
8937074a	139	This is a role to describe operations on the Array type.
8937074a	140
260cc81f	141	=head1 METHODS
	142
	143	=over 4
	144
260cc81f	145	=item B<pop>
260cc81f	146
5272f13f	147	=item B<push ($value)>
260cc81f	148
	149	=item B<shift>
	150
5272f13f	151	=item B<unshift ($value)>
260cc81f	152
5272f13f	153	=item B<delete ($index)>
260cc81f	154
5272f13f	155	=item B<sprintf ($format_string)>
260cc81f	156
	157	=back
	158
5272f13f	159	=head2 Indexed implementation
260cc81f	160
	161	=over 4
	162
5272f13f	163	=item B<at ($index)>
260cc81f	164
5272f13f	165	=item B<put ($index, $value)>
260cc81f	166
5272f13f	167	=item B<exists ($index)>
260cc81f	168
	169	=item B<keys>
	170
260cc81f	171	=item B<values>
260cc81f	172
5272f13f	173	=item B<kv>
5272f13f	174
260cc81f	175	=back
260cc81f	176
5272f13f	177	=head2 List implementation
260cc81f	178
	179	=over 4
	180
	181	=item B<head>
	182
	183	=item B<tail>
	184
5272f13f	185	=item B<join (?$seperator)>
260cc81f	186
	187	=item B<length>
	188
5272f13f	189	=item B<map (\&block)>
260cc81f	190
5272f13f	191	=item B<grep (\&block)>
260cc81f	192
	193	=item B<reverse>
	194
5272f13f	195	=item B<sort (?\&block)>
	196
	197	=back
	198
	199	=over 4
	200
	201	=item B<meta>
260cc81f	202
	203	=back
	204
31d40d73	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