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