From: Matt S Trout Date: Thu, 21 Jul 2005 13:43:19 +0000 (+0000) Subject: Added our own accessor system (ripped from C::A) and a bunch more compat code X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=fe5d862bdaa631796cb26e5fea232a81458e68f8;p=dbsrgits%2FDBIx-Class-Historic.git Added our own accessor system (ripped from C::A) and a bunch more compat code --- diff --git a/lib/DBIx/Class/AccessorGroup.pm b/lib/DBIx/Class/AccessorGroup.pm new file mode 100644 index 0000000..51dd7bc --- /dev/null +++ b/lib/DBIx/Class/AccessorGroup.pm @@ -0,0 +1,110 @@ +package DBIx::Class::AccessorGroup; + +sub mk_group_accessors { + my($self, $group, @fields) = @_; + + $self->_mk_group_accessors('make_group_accessor', $group, @fields); +} + + +{ + no strict 'refs'; + + sub _mk_group_accessors { + my($self, $maker, $group, @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; + + foreach my $field (@fields) { + if( $field eq 'DESTROY' ) { + require Carp; + &Carp::carp("Having a data accessor named DESTROY in ". + "'$class' is unwise."); + } + + my $accessor = $self->$maker($group, $field); + my $alias = "_${field}_accessor"; + + *{$class."\:\:$field"} = $accessor + unless defined &{$class."\:\:$field"}; + + *{$class."\:\:$alias"} = $accessor + unless defined &{$class."\:\:$alias"}; + } + } +} + +sub mk_group_ro_accessors { + my($self, $group, @fields) = @_; + + $self->_mk_group_accessors('make_group_ro_accessor', $group, @fields); +} + +sub mk_group_wo_accessors { + my($self, $group, @fields) = @_; + + $self->_mk_group_accessors('make_group_wo_accessor', $group, @fields); +} + +sub make_group_accessor { + my ($class, $group, $field) = @_; + + my $set = "set_$group"; + my $get = "get_$group"; + + # Build a closure around $field. + return sub { + my $self = shift; + + if(@_) { + return $self->set($field, @_); + } + else { + return $self->get($field); + } + }; +} + +sub make_group_ro_accessor { + my($class, $group, $field) = @_; + + my $get = "get_$group"; + + return sub { + my $self = shift; + + if(@_) { + my $caller = caller; + require Carp; + Carp::croak("'$caller' cannot alter the value of '$field' on ". + "objects of class '$class'"); + } + else { + return $self->get($field); + } + }; +} + +sub make_group_wo_accessor { + my($class, $group, $field) = @_; + + my $set = "set_$group"; + + return sub { + my $self = shift; + + unless (@_) { + my $caller = caller; + require Carp; + Carp::croak("'$caller' cannot access the value of '$field' on ". + "objects of class '$class'"); + } + else { + return $self->set($field, @_); + } + }; +} + +1; diff --git a/lib/DBIx/Class/CDBICompat/AttributeAPI.pm b/lib/DBIx/Class/CDBICompat/AttributeAPI.pm new file mode 100644 index 0000000..8dee47f --- /dev/null +++ b/lib/DBIx/Class/CDBICompat/AttributeAPI.pm @@ -0,0 +1,33 @@ +package DBIx::Class::CDBICompat::AttributeAPI; + +sub _attrs { + my ($self, @atts) = @_; + return @{$self->{_column_data}}{@atts}; +} + +*_attr = \&_attrs; + +sub _attribute_store { + my $self = shift; + my $vals = @_ == 1 ? shift: {@_}; + my (@cols) = keys %$vals; + @{$self->{_column_data}}{@cols} = @{$vals}{@cols}; +} + +sub _attribute_set { + my $self = shift; + my $vals = @_ == 1 ? shift: {@_}; + $self->set_column($_, $vals->{$_}) for keys %{$vals}; +} + +sub _attribute_delete { + my ($self, $attr) = @_; + delete $self->{_column_data}{$attr}; +} + +sub _attribute_exists { + my ($self, $attr) = @_; + exists $self->{_column_data}{$attr}; +} + +1; diff --git a/lib/DBIx/Class/CDBICompat/GetSet.pm b/lib/DBIx/Class/CDBICompat/GetSet.pm new file mode 100644 index 0000000..a748c55 --- /dev/null +++ b/lib/DBIx/Class/CDBICompat/GetSet.pm @@ -0,0 +1,18 @@ +package DBIx::Class::CDBICompat::GetSet; + +#use base qw/Class::Accessor/; + +sub get { + my ($self, @cols) = @_; + if (@cols > 1) { + return map { $self->get_column($_) } @cols; + } else { + return $self->get_column($_[1]); + } +} + +sub set { + return shift->set_column(@_); +} + +1; diff --git a/lib/DBIx/Class/CDBICompat/LazyLoading.pm b/lib/DBIx/Class/CDBICompat/LazyLoading.pm new file mode 100644 index 0000000..ed61535 --- /dev/null +++ b/lib/DBIx/Class/CDBICompat/LazyLoading.pm @@ -0,0 +1,36 @@ +package DBIx::Class::CDBICompat::LazyLoading; + +use strict; +use warnings; + +sub _select_columns { + return shift->columns('Essential'); +} + +sub get_column { + my ($self, $col) = @_; + if ((ref $self) && (!exists $self->{'_column_data'}{$col}) + && $self->{'_in_database'}) { + $self->_flesh(grep { exists $self->_column_groups->{$_}{$col} + && $_ ne 'All' } + keys %{ $self->_column_groups || {} }); + } + $self->NEXT::get_column(@_[1..$#_]); +} + +sub _flesh { + my ($self, @groups) = @_; + my %want; + $want{$_} = 1 for map { keys %{$self->_column_groups->{$_}} } @groups; + if (my @want = grep { !exists $self->{'_column_data'}{$_} } keys %want) { + my $sth = $self->_get_sth('select', \@want, $self->_table_name, + $self->_ident_cond); + $sth->execute($self->_ident_values); + my @val = $sth->fetchrow_array; + foreach my $w (@want) { + $self->{'_column_data'}{$w} = shift @val; + } + } +} + +1; diff --git a/lib/DBIx/Class/CDBICompat/Triggers.pm b/lib/DBIx/Class/CDBICompat/Triggers.pm new file mode 100644 index 0000000..21826f9 --- /dev/null +++ b/lib/DBIx/Class/CDBICompat/Triggers.pm @@ -0,0 +1,31 @@ +package DBIx::Class::CDBICompat::Triggers; + +use Class::Trigger; + +sub insert { + my $self = shift; + $self->call_trigger('before_create'); + $self->NEXT::insert(@_); + $self->call_trigger('after_create'); + return $self; +} + +sub update { + my $self = shift; + $self->call_trigger('before_update'); + my @to_update = keys %{$self->{_dirty_columns} || {}}; + return -1 unless @to_update; + $self->NEXT::update(@_); + $self->call_trigger('after_update'); + return $self; +} + +sub delete { + my $self = shift; + $self->call_trigger('before_delete') if ref $self; + $self->NEXT::delete(@_); + $self->call_trigger('after_delete') if ref $self; + return $self; +} + +1;