File Coverage

blib/lib/Object/Array.pm
Criterion Covered Total %
statement 36 36 100.0
branch 4 4 100.0
condition 2 2 100.0
subroutine 14 14 100.0
pod 2 2 100.0
total 58 58 100.0


line stmt bran cond sub pod time code
1             package Object::Array;
2              
3 3     3   102783 use strict;
  3         6  
  3         119  
4 3     3   15 use warnings;
  3         5  
  3         86  
5 3     3   16 use Scalar::Util ();
  3         9  
  3         78  
6              
7 3     3   2901 use Module::Pluggable (require => 1);
  3         40288  
  3         21  
8              
9             for my $plugin (__PACKAGE__->plugins) {
10             $plugin->import('-all');
11             }
12              
13 3         42 use Sub::Exporter -setup => {
14             exports => [ Array => \&_array_generator ],
15 3     3   3768 };
  3         62670  
16              
17 3     3   1205 use 5.006001;
  3         11  
  3         1480  
18              
19             =head1 NAME
20              
21             Object::Array - array references with accessors
22              
23             =head1 VERSION
24              
25             Version 0.060
26              
27             =cut
28              
29             our $VERSION = '0.060';
30              
31             =head1 SYNOPSIS
32              
33             use Object::Array qw(Array);
34             my $array = Object::Array->new; # or
35             $array = Object::Array->new(\@array); # or
36             $array = Array(\@array);
37             $array->push(1..5);
38             print $array->shift;
39             $_++ for grep { $_ < 4 } @{ $array };
40             $array->[0] = "a pony";
41              
42             =head1 IMPORTANT NOTE
43              
44             Several of these methods do not behave exactly like their
45             builtin counterparts.
46              
47             Specifically, any method that you would expect to return a
48             list does so, but B. In scalar
49             context, these methods will return an Object::Array object
50             constructed from a copy of the list that would have been
51             returned.
52              
53             This sounds more complicated than it is. It means that you
54             can chain some methods together, e.g.
55              
56             $arr->grep(sub { defined })->[-1];
57              
58             instead of the more bracing
59              
60             ${ $arr->grep(sub { defined }) }[-1];
61              
62             Currently, these array objects only contain copies of the
63             original values. In the future, they will retain references
64             to the original object, and this sort of thing will be possible:
65              
66             $arr->grep(sub { defined })->[-1]++;
67              
68             =head1 METHODS
69              
70             =head2 new
71              
72             my $array = Object::Array->new;
73             # or use existing array
74             my $array = Object::Array->new(\@a);
75              
76             Creates a new array object, either from scratch or from an
77             existing array.
78              
79             Using an existing array will mean that any changes to C<<
80             $array >> also affect the original array object. If you
81             don't want that, copy the data first or use something like
82             Storable's C<< dclone >>.
83              
84             =head2 isa
85              
86             Overridden to respond to 'ARRAY'.
87              
88             =head2 ref
89              
90             Returns a reference to the underlying array.
91              
92             =cut
93              
94             my %real;
95              
96 124     124   845 sub _addr { Scalar::Util::refaddr($_[0]) }
97              
98 93     93   26164 sub _real { $real{shift->_addr} }
99             *ref = \&_real;
100              
101             sub _array {
102 5     5   21 my ($self, @values) = @_;
103 5 100       30 return wantarray ? @values : ref($self)->new(\@values);
104             }
105              
106             # for exporting
107             sub _array_generator {
108 2     2   252 my ($class) = @_;
109 2     28   13 return sub { $class->new(@_) };
  28         333  
110             }
111              
112             use overload (
113 3         41 q(@{}) => 'ref',
114             fallback => 1,
115 3     3   22 );
  3         6  
116            
117             sub new {
118 31     31 1 44 my $class = shift;
119 31   100     83 my $real = shift || [];
120              
121 31         77 my $self = bless \$real => $class;
122            
123 31         75 $real{$self->_addr} = $real;
124              
125 31         117 return $self;
126             }
127              
128             sub isa {
129 2     2 1 963 my ($class, $type) = @_;
130 2 100       9 return 1 if $type eq 'ARRAY';
131 1         10 return $class->SUPER::isa($type);
132             }
133              
134             =head1 SEE ALSO
135              
136             L
137              
138             L
139              
140             =head1 AUTHOR
141              
142             Hans Dieter Pearcey, C<< >>
143              
144             =head1 BUGS
145              
146             Please report any bugs or feature requests to
147             C, or through the web interface at
148             L.
149             I will be notified, and then you'll automatically be notified of progress on
150             your bug as I make changes.
151              
152             =head1 SUPPORT
153              
154             You can find documentation for this module with the perldoc command.
155              
156             perldoc Object::Array
157              
158             You can also look for information at:
159              
160             =over 4
161              
162             =item * AnnoCPAN: Annotated CPAN documentation
163              
164             L
165              
166             =item * CPAN Ratings
167              
168             L
169              
170             =item * RT: CPAN's request tracker
171              
172             L
173              
174             =item * Search CPAN
175              
176             L
177              
178             =back
179              
180             =head1 ACKNOWLEDGEMENTS
181              
182             =head1 COPYRIGHT & LICENSE
183              
184             Copyright 2006 Hans Dieter Pearcey, all rights reserved.
185              
186             This program is free software; you can redistribute it and/or modify it
187             under the same terms as Perl itself.
188              
189             =cut
190              
191             1; # End of Object::Array