/usr/lib/x86_64-linux-gnu/perl5/5.22/DBI/Util/_accessor.pm is in libdbi-perl 1.634-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 | package DBI::Util::_accessor;
use strict;
use Carp;
our $VERSION = "0.009479";
# inspired by Class::Accessor::Fast
sub new {
my($proto, $fields) = @_;
my($class) = ref $proto || $proto;
$fields ||= {};
my @dubious = grep { !m/^_/ && !$proto->can($_) } keys %$fields;
carp "$class doesn't have accessors for fields: @dubious" if @dubious;
# make a (shallow) copy of $fields.
bless {%$fields}, $class;
}
sub mk_accessors {
my($self, @fields) = @_;
$self->mk_accessors_using('make_accessor', @fields);
}
sub mk_accessors_using {
my($self, $maker, @fields) = @_;
my $class = ref $self || $self;
# So we don't have to do lots of lookups inside the loop.
$maker = $self->can($maker) unless ref $maker;
no strict 'refs';
foreach my $field (@fields) {
my $accessor = $self->$maker($field);
*{$class."\:\:$field"} = $accessor
unless defined &{$class."\:\:$field"};
}
#my $hash_ref = \%{$class."\:\:_accessors_hash};
#$hash_ref->{$_}++ for @fields;
# XXX also copy down _accessors_hash of base class(es)
# so one in this class is complete
return;
}
sub make_accessor {
my($class, $field) = @_;
return sub {
my $self = shift;
return $self->{$field} unless @_;
croak "Too many arguments to $field" if @_ > 1;
return $self->{$field} = shift;
};
}
sub make_accessor_autoviv_hashref {
my($class, $field) = @_;
return sub {
my $self = shift;
return $self->{$field} ||= {} unless @_;
croak "Too many arguments to $field" if @_ > 1;
return $self->{$field} = shift;
};
}
1;
|