This file is indexed.

/usr/lib/perl5/Class/XSAccessor/Array.pm is in libclass-xsaccessor-perl 1.19-1build1.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
package Class::XSAccessor::Array;
use 5.008;
use strict;
use warnings;
use Carp qw/croak/;
use Class::XSAccessor;
use Class::XSAccessor::Heavy;

our $VERSION = '1.19';

sub import {
  my $own_class = shift;
  my ($caller_pkg) = caller();

  # Support both { getters => ... } and plain getters => ...
  my %opts = ref($_[0]) eq 'HASH' ? %{$_[0]} : @_;

  $caller_pkg = $opts{class} if defined $opts{class};

  my $read_subs      = $opts{getters} || {};
  my $set_subs       = $opts{setters} || {};
  my $acc_subs       = $opts{accessors} || {};
  my $lvacc_subs     = $opts{lvalue_accessors} || {};
  my $pred_subs      = $opts{predicates} || {};
  my $construct_subs = $opts{constructors} || [defined($opts{constructor}) ? $opts{constructor} : ()];  
  my $true_subs      = $opts{true} || [];
  my $false_subs     = $opts{false} || [];


  foreach my $subtype ( ["getter", $read_subs],
                        ["setter", $set_subs],
                        ["accessor", $acc_subs],
                        ["lvalue_accessor", $lvacc_subs],
                        ["pred_subs", $pred_subs] )
  {
    my $subs = $subtype->[1];
    foreach my $subname (keys %$subs) {
      my $array_index = $subs->{$subname};
      _generate_method($caller_pkg, $subname, $array_index, \%opts, $subtype->[0]);
    }
  }
   
  foreach my $subtype ( ["constructor", $construct_subs],
                        ["true", $true_subs],
                        ["false", $false_subs] )
  {
    foreach my $subname (@{$subtype->[1]}) {
      _generate_method($caller_pkg, $subname, "", \%opts, $subtype->[0]);
    }
  }
}

sub _generate_method {
  my ($caller_pkg, $subname, $array_index, $opts, $type) = @_;

  croak("Cannot use undef as a array index for generating an XS $type accessor. (Sub: $subname)")
    if not defined $array_index;

  $subname = "${caller_pkg}::$subname" if $subname !~ /::/;

  Class::XSAccessor::Heavy::check_sub_existence($subname) if not $opts->{replace};
  no warnings 'redefine'; # don't warn about an explicitly requested redefine

  if ($type eq 'getter') {
    newxs_getter($subname, $array_index);
  }
  if ($type eq 'lvalue_accessor') {
    newxs_lvalue_accessor($subname, $array_index);
  }
  elsif ($type eq 'setter') {
    newxs_setter($subname, $array_index, $opts->{chained}||0);
  }
  elsif ($type eq 'predicate') {
    newxs_predicate($subname, $array_index);
  }
  elsif ($type eq 'constructor') {
    newxs_constructor($subname);
  }
  elsif ($type eq 'true') {
    Class::XSAccessor::newxs_boolean($subname, 1);
  }
  elsif ($type eq 'false') {
    Class::XSAccessor::newxs_boolean($subname, 0);
  }
  else {
    newxs_accessor($subname, $array_index, $opts->{chained}||0);
  }
}

1;

__END__

=head1 NAME

Class::XSAccessor::Array - Generate fast XS accessors without runtime compilation

=head1 SYNOPSIS
  
  package MyClassUsingArraysAsInternalStorage;
  use Class::XSAccessor::Array
    constructor => 'new',
    getters => {
      get_foo => 0, # 0 is the array index to access
      get_bar => 1,
    },
    setters => {
      set_foo => 0,
      set_bar => 1,
    },
    accessors => { # a mutator
      buz => 2,
    },
    predicates => { # test for definedness
      has_buz => 2,
    },
    lvalue_accessors => { # see below
      baz => 3,
    },
    true => [ 'is_token', 'is_whitespace' ],
    false => [ 'significant' ];
  
  # The imported methods are implemented in fast XS.
  
  # normal class code here.

As of version 1.05, some alternative syntax forms are available:

  package MyClass;
  
  # Options can be passed as a HASH reference if you prefer it,
  # which can also help PerlTidy to flow the statement correctly.
  use Class::XSAccessor {
    getters => {
      get_foo => 0,
      get_bar => 1,
    },
  };

=head1 DESCRIPTION

The module implements fast XS accessors both for getting at and
setting an object attribute. Additionally, the module supports
mutators and simple predicates (C<has_foo()> like tests for definedness
of an attributes).
The module works only with objects
that are implemented as B<arrays>. Using it on hash-based objects is
bound to make your life miserable. Refer to L<Class::XSAccessor> for
an implementation that works with hash-based objects.

A simple benchmark showed a significant performance
advantage over writing accessors in Perl.

Since version 0.10, the module can also generate simple constructors
(implemented in XS) for you. Simply supply the
C<constructor =E<gt> 'constructor_name'> option or the
C<constructors =E<gt> ['new', 'create', 'spawn']> option.
These constructors do the equivalent of the following Perl code:

  sub new {
    my $class = shift;
    return bless [], ref($class)||$class;
  }

That means they can be called on objects and classes but will not
clone objects entirely. Note that any parameters to new() will be
discarded! If there is a better idiom for array-based objects, let
me know.

While generally more obscure than hash-based objects,
objects using blessed arrays as internal representation
are a bit faster as its somewhat faster to access arrays than hashes.
Accordingly, this module is slightly faster (~10-15%) than
L<Class::XSAccessor>, which works on hash-based objects.

The method names may be fully qualified. In the example of the
synopsis, you could have written C<MyClass::get_foo> instead
of C<get_foo>. This way, you can install methods in classes other
than the current class. See also: The C<class> option below.

Since version 1.01, you can generate extremely simple methods which
just return true or false (and always do so). If that seems like a
really superfluous thing to you, then think of a large class hierarchy
with interfaces such as PPI. This is implemented as the C<true>
and C<false> options, see synopsis.

=head1 OPTIONS

In addition to specifying the types and names of accessors, you can add options
which modify behaviour. The options are specified as key/value pairs just as the
accessor declaration. Example:

  use Class::XSAccessor::Array
    getters => {
      get_foo => 0,
    },
    replace => 1;

The list of available options is:

=head2 replace

Set this to a true value to prevent C<Class::XSAccessor::Array> from
complaining about replacing existing subroutines.

=head2 chained

Set this to a true value to change the return value of setters
and mutators (when called with an argument).
If C<chained> is enabled, the setters and accessors/mutators will
return the object. Mutators called without an argument still
return the value of the associated attribute.

As with the other options, C<chained> affects all methods generated
in the same C<use Class::XSAccessor::Array ...> statement.

=head2 class

By default, the accessors are generated in the calling class. Using
the C<class> option, you can explicitly specify where the methods
are to be generated.

=head1 LVALUES

Support for lvalue accessors via the keyword C<lvalue_accessors>
was added in version 1.08. At this point, B<THEY ARE CONSIDERED HIGHLY
EXPERIMENTAL>. Furthermore, their performance hasn't been benchmarked
yet.

The following example demonstrates an lvalue accessor:

  package Address;
  use Class::XSAccessor
    constructor => 'new',
    lvalue_accessors => { zip_code => 0 };
  
  package main;
  my $address = Address->new(2);
  print $address->zip_code, "\n"; # prints 2
  $address->zip_code = 76135; # <--- This is it!
  print $address->zip_code, "\n"; # prints 76135

=head1 CAVEATS

Probably wouldn't work if your objects are I<tied>. But that's a strange thing to do anyway.

Scary code exploiting strange XS features.

If you think writing an accessor in XS should be a laughably simple exercise, then
please contemplate how you could instantiate a new XS accessor for a new hash key
or array index that's only known at run-time. Note that compiling C code at run-time
a la Inline::C is a no go.

Threading. With version 1.00, a memory leak has been B<fixed> that would leak a small amount of
memory if you loaded C<Class::XSAccessor>-based classes in a subthread that hadn't been loaded
in the "main" thread before. If the subthread then terminated, a hash key and an int per
associated method used to be lost. Note that this mattered only if classes were B<only> loaded
in a sort of throw-away thread.

In the new implementation as of 1.00, the memory will not be released again either in the above
situation. But it will be recycled when the same class or a similar class is loaded
again in B<any> thread.

=head1 SEE ALSO

L<Class::XSAccessor>

L<AutoXS>

=head1 AUTHOR

Steffen Mueller E<lt>smueller@cpan.orgE<gt>

chocolateboy E<lt>chocolate@cpan.orgE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2008, 2009, 2010, 2011, 2012, 2013 by Steffen Mueller

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8 or,
at your option, any later version of Perl 5 you may have available.

=cut