[ Index ]

PHP Cross Reference of Unnamed Project

title

Body

[close]

/se3-unattended/var/se3/unattended/install/linuxaux/opt/perl/lib/site_perl/5.10.0/i586-linux-thread-multi/DBI/Util/ -> _accessor.pm (source)

   1  package DBI::Util::_accessor;
   2  use strict;
   3  use Carp;
   4  our $VERSION = sprintf("0.%06d", q$Revision: 9478 $ =~ /(\d+)/);
   5  
   6  # inspired by Class::Accessor::Fast
   7  
   8  sub new {
   9      my($proto, $fields) = @_;
  10      my($class) = ref $proto || $proto;
  11      $fields ||= {};
  12  
  13      my @dubious = grep { !m/^_/ && !$proto->can($_) } keys %$fields;
  14      carp "$class doesn't have accessors for fields: @dubious" if @dubious;
  15  
  16      # make a (shallow) copy of $fields.
  17      bless {%$fields}, $class;
  18  }
  19  
  20  sub mk_accessors {
  21      my($self, @fields) = @_;
  22      $self->mk_accessors_using('make_accessor', @fields);
  23  }
  24  
  25  sub mk_accessors_using {
  26      my($self, $maker, @fields) = @_;
  27      my $class = ref $self || $self;
  28  
  29      # So we don't have to do lots of lookups inside the loop.
  30      $maker = $self->can($maker) unless ref $maker;
  31  
  32      no strict 'refs';
  33      foreach my $field (@fields) {
  34          my $accessor = $self->$maker($field);
  35          *{$class."\:\:$field"} = $accessor
  36              unless defined &{$class."\:\:$field"};
  37      }
  38      #my $hash_ref = \%{$class."\:\:_accessors_hash};
  39      #$hash_ref->{$_}++ for @fields;
  40      # XXX also copy down _accessors_hash of base class(es)
  41      # so one in this class is complete
  42      return;
  43  }
  44  
  45  sub make_accessor {
  46      my($class, $field) = @_;
  47      return sub {
  48          my $self = shift;
  49          return $self->{$field} unless @_;
  50          croak "Too many arguments to $field" if @_ > 1;
  51          return $self->{$field} = shift;
  52      };
  53  }
  54  
  55  sub make_accessor_autoviv_hashref {
  56      my($class, $field) = @_;
  57      return sub {
  58          my $self = shift;
  59          return $self->{$field} ||= {} unless @_;
  60          croak "Too many arguments to $field" if @_ > 1;
  61          return $self->{$field} = shift;
  62      };
  63  }
  64  
  65  1;


Generated: Tue Mar 17 22:47:18 2015 Cross-referenced by PHPXref 0.7.1