From 7c48e67cf07ee41bfde7139a62bb232bd23a4a48 Mon Sep 17 00:00:00 2001
From: Lorry Tar Creator <lorry-tar-importer@baserock.org>
Date: Wed, 6 Jun 2012 16:41:29 +0000
Subject: Imported from
 /srv/lorry/lorry-area/perl-dbi-tarball/DBI-1.622.tar.gz.

---
 lib/DBI/Util/_accessor.pm | 65 +++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 65 insertions(+)
 create mode 100644 lib/DBI/Util/_accessor.pm

(limited to 'lib/DBI/Util/_accessor.pm')

diff --git a/lib/DBI/Util/_accessor.pm b/lib/DBI/Util/_accessor.pm
new file mode 100644
index 0000000..7836ebe
--- /dev/null
+++ b/lib/DBI/Util/_accessor.pm
@@ -0,0 +1,65 @@
+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;
-- 
cgit v1.2.1