From: Ash Berlin Date: Sat, 18 Nov 2006 01:13:36 +0000 (+0000) Subject: Removed Class::Data::Accessor and DBIx::Class::AccessorGrouped and X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=3e11041012dc26df94860efefde4340bf927f2af;p=dbsrgits%2FDBIx-Class-Historic.git Removed Class::Data::Accessor and DBIx::Class::AccessorGrouped and replaced with Class::Accessor::Grouped. component_class type accessors now just inherited and so no longer automatcally require classes when set (noted in changes) Added auto_install to Makefile.PL --- diff --git a/Changes b/Changes index d93f058..719bfd2 100644 --- a/Changes +++ b/Changes @@ -16,6 +16,12 @@ Revision history for DBIx::Class - columns_info_for is deprecated, and no longer runs automatically. You can make it work like before via __PACKAGE__->column_info_from_storage(1) for now + - Replaced DBIx::Class::AccessorGroup and Class::Data::Accessor with + Class::Accessor::Grouped. Only user noticible change is to + table_class on ResultSourceProxy::Table (i.e. table objects in + schemas) and, resultset_class and result_class in ResultSource. + These accessors no longer automatically require the classes when + set. 0.07003 2006-XX-XX XX:XX:XX - Tweaks to resultset to allow inflate_result to return an array diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP index 1325801..9184f2a 100644 --- a/MANIFEST.SKIP +++ b/MANIFEST.SKIP @@ -25,6 +25,7 @@ \.tmp$ \.old$ \.bak$ +\..*?\.sw[po]$ \#$ \b\.# diff --git a/Makefile.PL b/Makefile.PL index 3df56d0..d8f960e 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -11,11 +11,11 @@ requires 'SQL::Abstract' => 1.20; requires 'SQL::Abstract::Limit' => 0.101; requires 'Class::C3' => 0.13; requires 'Storable' => 0; -requires 'Class::Data::Accessor' => 0.01; requires 'Carp::Clan' => 0; requires 'DBI' => 1.40; requires 'Module::Find' => 0; requires 'Class::Inspector' => 0; +requires 'Class::Accessor::Grouped' => 0; # Perl 5.8.0 doesn't have utf8::is_utf8() requires 'Encode' => 0 if ($] <= 5.008000); @@ -26,4 +26,6 @@ install_script 'script/dbicadmin'; tests "t/*.t t/*/*.t"; +auto_install; + WriteAll; diff --git a/lib/DBIx/Class.pm b/lib/DBIx/Class.pm index c977288..6d75377 100644 --- a/lib/DBIx/Class.pm +++ b/lib/DBIx/Class.pm @@ -4,9 +4,14 @@ use strict; use warnings; use vars qw($VERSION); -use base qw/DBIx::Class::Componentised Class::Data::Accessor/; +use base qw/DBIx::Class::Componentised Class::Accessor::Grouped/; + +sub mk_classdata { + my $self = shift; + $self->mk_group_accessors('inherited', $_[0]); + $self->set_inherited(@_) if @_ > 1; +} -sub mk_classdata { shift->mk_classaccessor(@_); } sub component_base_class { 'DBIx::Class' } # Always remember to do all digits for the version even if they're 0 diff --git a/lib/DBIx/Class/AccessorGroup.pm b/lib/DBIx/Class/AccessorGroup.pm deleted file mode 100644 index 56bcf1b..0000000 --- a/lib/DBIx/Class/AccessorGroup.pm +++ /dev/null @@ -1,342 +0,0 @@ -package DBIx::Class::AccessorGroup; - -use strict; -use warnings; - -use Carp::Clan qw/^DBIx::Class/; - -=head1 NAME - -DBIx::Class::AccessorGroup - Lets you build groups of accessors - -=head1 SYNOPSIS - -=head1 DESCRIPTION - -This class lets you build groups of accessors that will call different -getters and setters. - -=head1 METHODS - -=head2 mk_group_accessors - -=over 4 - -=item Arguments: $group, @fieldspec - -Returns: none - -=back - -Creates a set of accessors in a given group. - -$group is the name of the accessor group for the generated accessors; they -will call get_$group($field) on get and set_$group($field, $value) on set. - -@fieldspec is a list of field/accessor names; if a fieldspec is a scalar -this is used as both field and accessor name, if a listref it is expected to -be of the form [ $accessor, $field ]. - -=cut - -sub mk_group_accessors { - my ($self, $group, @fields) = @_; - - $self->_mk_group_accessors('make_group_accessor', $group, @fields); - return; -} - - -{ - no strict 'refs'; - no warnings 'redefine'; - - 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' ) { - carp("Having a data accessor named DESTROY in ". - "'$class' is unwise."); - } - - my $name = $field; - - ($name, $field) = @$field if ref $field; - - my $accessor = $self->$maker($group, $field); - my $alias = "_${name}_accessor"; - - #warn "$class $group $field $alias"; - - *{$class."\:\:$name"} = $accessor; - #unless defined &{$class."\:\:$field"} - - *{$class."\:\:$alias"} = $accessor; - #unless defined &{$class."\:\:$alias"} - } - } -} - -=head2 mk_group_ro_accessors - -=over 4 - -=item Arguments: $group, @fieldspec - -Returns: none - -=back - -Creates a set of read only accessors in a given group. Identical to - but accessors will throw an error if passed a value -rather than setting the value. - -=cut - -sub mk_group_ro_accessors { - my($self, $group, @fields) = @_; - - $self->_mk_group_accessors('make_group_ro_accessor', $group, @fields); -} - -=head2 mk_group_wo_accessors - -=over 4 - -=item Arguments: $group, @fieldspec - -Returns: none - -=back - -Creates a set of write only accessors in a given group. Identical to - but accessors will throw an error if not passed a -value rather than getting the value. - -=cut - -sub mk_group_wo_accessors { - my($self, $group, @fields) = @_; - - $self->_mk_group_accessors('make_group_wo_accessor', $group, @fields); -} - -=head2 make_group_accessor - -=over 4 - -=item Arguments: $group, $field - -Returns: $sub (\CODE) - -=back - -Returns a single accessor in a given group; called by mk_group_accessors -for each entry in @fieldspec. - -=cut - -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); - } - }; -} - -=head2 make_group_ro_accessor - -=over 4 - -=item Arguments: $group, $field - -Returns: $sub (\CODE) - -=back - -Returns a single read-only accessor in a given group; called by -mk_group_ro_accessors for each entry in @fieldspec. - -=cut - -sub make_group_ro_accessor { - my($class, $group, $field) = @_; - - my $get = "get_$group"; - - return sub { - my $self = shift; - - if(@_) { - my $caller = caller; - croak("'$caller' cannot alter the value of '$field' on ". - "objects of class '$class'"); - } - else { - return $self->$get($field); - } - }; -} - -=head2 make_group_wo_accessor - -=over 4 - -=item Arguments: $group, $field - -Returns: $sub (\CODE) - -=back - -Returns a single write-only accessor in a given group; called by -mk_group_wo_accessors for each entry in @fieldspec. - -=cut - -sub make_group_wo_accessor { - my($class, $group, $field) = @_; - - my $set = "set_$group"; - - return sub { - my $self = shift; - - unless (@_) { - my $caller = caller; - croak("'$caller' cannot access the value of '$field' on ". - "objects of class '$class'"); - } - else { - return $self->$set($field, @_); - } - }; -} - -=head2 get_simple - -=over 4 - -=item Arguments: $field - -Returns: $value - -=back - -Simple getter for hash-based objects which returns the value for the field -name passed as an argument. - -=cut - -sub get_simple { - my ($self, $get) = @_; - return $self->{$get}; -} - -=head2 set_simple - -=over 4 - -=item Arguments: $field, $new_value - -Returns: $new_value - -=back - -Simple setter for hash-based objects which sets and then returns the value -for the field name passed as an argument. - -=cut - -sub set_simple { - my ($self, $set, $val) = @_; - return $self->{$set} = $val; -} - -=head2 get_component_class - -=over 4 - -=item Arguments: $name - -Returns: $component_class - -=back - -Returns the class name for a component; returns an object key if called on -an object, or attempts to return classdata referenced by _$name if called -on a class. - -=cut - -sub get_component_class { - my ($self, $get) = @_; - if (ref $self) { - return $self->{$get}; - } else { - $get = "_$get"; - return $self->can($get) ? $self->$get : undef; - } -} - -=head2 set_component_class - -=over 4 - -=item Arguments: $name, $new_component_class - -Returns: $new_component_class - -=back - -Sets a component class name; attempts to require the class before setting -but does not error if unable to do so. Sets an object key of the given name -if called or an object or classdata called _$name if called on a class. - -=cut - -sub set_component_class { - my ($self, $set, $val) = @_; - eval "require $val"; - if ($@) { - my $val_path = $val; - $val_path =~ s{::}{/}g; - carp $@ unless $@ =~ /^Can't locate $val_path\.pm/; - } - if (ref $self) { - return $self->{$set} = $val; - } else { - $set = "_$set"; - return $self->can($set) ? - $self->$set($val) : - $self->mk_classdata($set => $val); - } -} - -1; - -=head1 AUTHORS - -Matt S. Trout - -=head1 LICENSE - -You may distribute this code under the same terms as Perl itself. - -=cut - diff --git a/lib/DBIx/Class/Core.pm b/lib/DBIx/Class/Core.pm index 7c48181..504480e 100644 --- a/lib/DBIx/Class/Core.pm +++ b/lib/DBIx/Class/Core.pm @@ -14,7 +14,7 @@ __PACKAGE__->load_components(qw/ PK Row ResultSourceProxy::Table - AccessorGroup/); + /); 1; @@ -50,8 +50,6 @@ The core modules currently are: =item L -=item L - =back =head1 AUTHORS diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm index 79d9cde..b6fbb05 100644 --- a/lib/DBIx/Class/ResultSet.pm +++ b/lib/DBIx/Class/ResultSet.pm @@ -12,7 +12,6 @@ use Storable; use DBIx::Class::ResultSetColumn; use base qw/DBIx::Class/; -__PACKAGE__->load_components(qw/AccessorGroup/); __PACKAGE__->mk_group_accessors('simple' => qw/result_source result_class/); =head1 NAME diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm index aeab10c..8cc5b6c 100644 --- a/lib/DBIx/Class/ResultSource.pm +++ b/lib/DBIx/Class/ResultSource.pm @@ -8,14 +8,13 @@ use Carp::Clan qw/^DBIx::Class/; use Storable; use base qw/DBIx::Class/; -__PACKAGE__->load_components(qw/AccessorGroup/); __PACKAGE__->mk_group_accessors('simple' => qw/_ordered_columns _columns _primaries _unique_constraints name resultset_attributes schema from _relationships column_info_from_storage source_name source_info/); -__PACKAGE__->mk_group_accessors('component_class' => qw/resultset_class +__PACKAGE__->mk_group_accessors('inherited' => qw/resultset_class result_class/); =head1 NAME diff --git a/lib/DBIx/Class/ResultSourceProxy/Table.pm b/lib/DBIx/Class/ResultSourceProxy/Table.pm index f70f2bc..0816dd7 100644 --- a/lib/DBIx/Class/ResultSourceProxy/Table.pm +++ b/lib/DBIx/Class/ResultSourceProxy/Table.pm @@ -4,10 +4,10 @@ use strict; use warnings; use base qw/DBIx::Class::ResultSourceProxy/; -__PACKAGE__->load_components(qw/AccessorGroup/); -__PACKAGE__->mk_group_accessors('component_class' => 'table_class'); -__PACKAGE__->table_class('DBIx::Class::ResultSource::Table'); +use DBIx::Class::ResultSource::Table; + +__PACKAGE__->mk_classdata(table_class => 'DBIx::Class::ResultSource::Table'); __PACKAGE__->mk_classdata('table_alias'); # FIXME: Doesn't actually do # anything yet! diff --git a/lib/DBIx/Class/Row.pm b/lib/DBIx/Class/Row.pm index 57f883f..7d9298d 100644 --- a/lib/DBIx/Class/Row.pm +++ b/lib/DBIx/Class/Row.pm @@ -6,8 +6,6 @@ use warnings; use base qw/DBIx::Class/; use Carp::Clan qw/^DBIx::Class/; -__PACKAGE__->load_components(qw/AccessorGroup/); - __PACKAGE__->mk_group_accessors('simple' => 'result_source'); =head1 NAME diff --git a/lib/DBIx/Class/Storage.pm b/lib/DBIx/Class/Storage.pm index f98001b..9a58b94 100644 --- a/lib/DBIx/Class/Storage.pm +++ b/lib/DBIx/Class/Storage.pm @@ -8,7 +8,6 @@ use base qw/DBIx::Class/; use Scalar::Util qw/weaken/; use Carp::Clan qw/^DBIx::Class/; -__PACKAGE__->load_components(qw/AccessorGroup/); __PACKAGE__->mk_group_accessors('simple' => qw/debug debugobj schema/); package # Hide from PAUSE diff --git a/lib/DBIx/Class/Storage/Statistics.pm b/lib/DBIx/Class/Storage/Statistics.pm index 09f79da..5d0ba47 100644 --- a/lib/DBIx/Class/Storage/Statistics.pm +++ b/lib/DBIx/Class/Storage/Statistics.pm @@ -2,7 +2,8 @@ package DBIx::Class::Storage::Statistics; use strict; use warnings; -use base qw/DBIx::Class::AccessorGroup Class::Data::Accessor/; +use base qw/Class::Accessor::Grouped/; + __PACKAGE__->mk_group_accessors(simple => qw/callback debugfh/); =head1 NAME