1package Class::XSAccessor::Array;
2use 5.008;
3use strict;
4use warnings;
5use Carp qw/croak/;
6use Class::XSAccessor;
7use Class::XSAccessor::Heavy;
8
9our $VERSION = '1.19';
10
11sub import {
12  my $own_class = shift;
13  my ($caller_pkg) = caller();
14
15  # Support both { getters => ... } and plain getters => ...
16  my %opts = ref($_[0]) eq 'HASH' ? %{$_[0]} : @_;
17
18  $caller_pkg = $opts{class} if defined $opts{class};
19
20  my $read_subs      = $opts{getters} || {};
21  my $set_subs       = $opts{setters} || {};
22  my $acc_subs       = $opts{accessors} || {};
23  my $lvacc_subs     = $opts{lvalue_accessors} || {};
24  my $pred_subs      = $opts{predicates} || {};
25  my $construct_subs = $opts{constructors} || [defined($opts{constructor}) ? $opts{constructor} : ()];
26  my $true_subs      = $opts{true} || [];
27  my $false_subs     = $opts{false} || [];
28
29
30  foreach my $subtype ( ["getter", $read_subs],
31                        ["setter", $set_subs],
32                        ["accessor", $acc_subs],
33                        ["lvalue_accessor", $lvacc_subs],
34                        ["pred_subs", $pred_subs] )
35  {
36    my $subs = $subtype->[1];
37    foreach my $subname (keys %$subs) {
38      my $array_index = $subs->{$subname};
39      _generate_method($caller_pkg, $subname, $array_index, \%opts, $subtype->[0]);
40    }
41  }
42
43  foreach my $subtype ( ["constructor", $construct_subs],
44                        ["true", $true_subs],
45                        ["false", $false_subs] )
46  {
47    foreach my $subname (@{$subtype->[1]}) {
48      _generate_method($caller_pkg, $subname, "", \%opts, $subtype->[0]);
49    }
50  }
51}
52
53sub _generate_method {
54  my ($caller_pkg, $subname, $array_index, $opts, $type) = @_;
55
56  croak("Cannot use undef as a array index for generating an XS $type accessor. (Sub: $subname)")
57    if not defined $array_index;
58
59  $subname = "${caller_pkg}::$subname" if $subname !~ /::/;
60
61  Class::XSAccessor::Heavy::check_sub_existence($subname) if not $opts->{replace};
62  no warnings 'redefine'; # don't warn about an explicitly requested redefine
63
64  if ($type eq 'getter') {
65    newxs_getter($subname, $array_index);
66  }
67  if ($type eq 'lvalue_accessor') {
68    newxs_lvalue_accessor($subname, $array_index);
69  }
70  elsif ($type eq 'setter') {
71    newxs_setter($subname, $array_index, $opts->{chained}||0);
72  }
73  elsif ($type eq 'predicate') {
74    newxs_predicate($subname, $array_index);
75  }
76  elsif ($type eq 'constructor') {
77    newxs_constructor($subname);
78  }
79  elsif ($type eq 'true') {
80    Class::XSAccessor::newxs_boolean($subname, 1);
81  }
82  elsif ($type eq 'false') {
83    Class::XSAccessor::newxs_boolean($subname, 0);
84  }
85  else {
86    newxs_accessor($subname, $array_index, $opts->{chained}||0);
87  }
88}
89
901;
91
92__END__
93
94=head1 NAME
95
96Class::XSAccessor::Array - Generate fast XS accessors without runtime compilation
97
98=head1 SYNOPSIS
99
100  package MyClassUsingArraysAsInternalStorage;
101  use Class::XSAccessor::Array
102    constructor => 'new',
103    getters => {
104      get_foo => 0, # 0 is the array index to access
105      get_bar => 1,
106    },
107    setters => {
108      set_foo => 0,
109      set_bar => 1,
110    },
111    accessors => { # a mutator
112      buz => 2,
113    },
114    predicates => { # test for definedness
115      has_buz => 2,
116    },
117    lvalue_accessors => { # see below
118      baz => 3,
119    },
120    true => [ 'is_token', 'is_whitespace' ],
121    false => [ 'significant' ];
122
123  # The imported methods are implemented in fast XS.
124
125  # normal class code here.
126
127As of version 1.05, some alternative syntax forms are available:
128
129  package MyClass;
130
131  # Options can be passed as a HASH reference if you prefer it,
132  # which can also help PerlTidy to flow the statement correctly.
133  use Class::XSAccessor {
134    getters => {
135      get_foo => 0,
136      get_bar => 1,
137    },
138  };
139
140=head1 DESCRIPTION
141
142The module implements fast XS accessors both for getting at and
143setting an object attribute. Additionally, the module supports
144mutators and simple predicates (C<has_foo()> like tests for definedness
145of an attributes).
146The module works only with objects
147that are implemented as B<arrays>. Using it on hash-based objects is
148bound to make your life miserable. Refer to L<Class::XSAccessor> for
149an implementation that works with hash-based objects.
150
151A simple benchmark showed a significant performance
152advantage over writing accessors in Perl.
153
154Since version 0.10, the module can also generate simple constructors
155(implemented in XS) for you. Simply supply the
156C<constructor =E<gt> 'constructor_name'> option or the
157C<constructors =E<gt> ['new', 'create', 'spawn']> option.
158These constructors do the equivalent of the following Perl code:
159
160  sub new {
161    my $class = shift;
162    return bless [], ref($class)||$class;
163  }
164
165That means they can be called on objects and classes but will not
166clone objects entirely. Note that any parameters to new() will be
167discarded! If there is a better idiom for array-based objects, let
168me know.
169
170While generally more obscure than hash-based objects,
171objects using blessed arrays as internal representation
172are a bit faster as its somewhat faster to access arrays than hashes.
173Accordingly, this module is slightly faster (~10-15%) than
174L<Class::XSAccessor>, which works on hash-based objects.
175
176The method names may be fully qualified. In the example of the
177synopsis, you could have written C<MyClass::get_foo> instead
178of C<get_foo>. This way, you can install methods in classes other
179than the current class. See also: The C<class> option below.
180
181Since version 1.01, you can generate extremely simple methods which
182just return true or false (and always do so). If that seems like a
183really superfluous thing to you, then think of a large class hierarchy
184with interfaces such as PPI. This is implemented as the C<true>
185and C<false> options, see synopsis.
186
187=head1 OPTIONS
188
189In addition to specifying the types and names of accessors, you can add options
190which modify behaviour. The options are specified as key/value pairs just as the
191accessor declaration. Example:
192
193  use Class::XSAccessor::Array
194    getters => {
195      get_foo => 0,
196    },
197    replace => 1;
198
199The list of available options is:
200
201=head2 replace
202
203Set this to a true value to prevent C<Class::XSAccessor::Array> from
204complaining about replacing existing subroutines.
205
206=head2 chained
207
208Set this to a true value to change the return value of setters
209and mutators (when called with an argument).
210If C<chained> is enabled, the setters and accessors/mutators will
211return the object. Mutators called without an argument still
212return the value of the associated attribute.
213
214As with the other options, C<chained> affects all methods generated
215in the same C<use Class::XSAccessor::Array ...> statement.
216
217=head2 class
218
219By default, the accessors are generated in the calling class. Using
220the C<class> option, you can explicitly specify where the methods
221are to be generated.
222
223=head1 LVALUES
224
225Support for lvalue accessors via the keyword C<lvalue_accessors>
226was added in version 1.08. At this point, B<THEY ARE CONSIDERED HIGHLY
227EXPERIMENTAL>. Furthermore, their performance hasn't been benchmarked
228yet.
229
230The following example demonstrates an lvalue accessor:
231
232  package Address;
233  use Class::XSAccessor
234    constructor => 'new',
235    lvalue_accessors => { zip_code => 0 };
236
237  package main;
238  my $address = Address->new(2);
239  print $address->zip_code, "\n"; # prints 2
240  $address->zip_code = 76135; # <--- This is it!
241  print $address->zip_code, "\n"; # prints 76135
242
243=head1 CAVEATS
244
245Probably wouldn't work if your objects are I<tied>. But that's a strange thing to do anyway.
246
247Scary code exploiting strange XS features.
248
249If you think writing an accessor in XS should be a laughably simple exercise, then
250please contemplate how you could instantiate a new XS accessor for a new hash key
251or array index that's only known at run-time. Note that compiling C code at run-time
252a la Inline::C is a no go.
253
254Threading. With version 1.00, a memory leak has been B<fixed> that would leak a small amount of
255memory if you loaded C<Class::XSAccessor>-based classes in a subthread that hadn't been loaded
256in the "main" thread before. If the subthread then terminated, a hash key and an int per
257associated method used to be lost. Note that this mattered only if classes were B<only> loaded
258in a sort of throw-away thread.
259
260In the new implementation as of 1.00, the memory will not be released again either in the above
261situation. But it will be recycled when the same class or a similar class is loaded
262again in B<any> thread.
263
264=head1 SEE ALSO
265
266L<Class::XSAccessor>
267
268L<AutoXS>
269
270=head1 AUTHOR
271
272Steffen Mueller E<lt>smueller@cpan.orgE<gt>
273
274chocolateboy E<lt>chocolate@cpan.orgE<gt>
275
276=head1 COPYRIGHT AND LICENSE
277
278Copyright (C) 2008, 2009, 2010, 2011, 2012, 2013 by Steffen Mueller
279
280This library is free software; you can redistribute it and/or modify
281it under the same terms as Perl itself, either Perl version 5.8 or,
282at your option, any later version of Perl 5 you may have available.
283
284=cut
285