Current Path : /usr/local/lib/perl5/site_perl/5.8.9/mach/DBI/Util/ |
FreeBSD hs32.drive.ne.jp 9.1-RELEASE FreeBSD 9.1-RELEASE #1: Wed Jan 14 12:18:08 JST 2015 root@hs32.drive.ne.jp:/sys/amd64/compile/hs32 amd64 |
Current File : //usr/local/lib/perl5/site_perl/5.8.9/mach/DBI/Util/_accessor.pm |
package DBI::Util::_accessor; use strict; use Carp; our $VERSION = sprintf("0.%06d", q$Revision: 9478 $ =~ /(\d+)/); # 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;