From: Peter Rabbitson Date: Mon, 2 May 2016 16:26:10 +0000 (+0200) Subject: Proof of concept, no-downstream-changes-needed port to Moo X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=refs%2Fheads%2Fabandoned%2Fmooified_rsrc_poc;p=dbsrgits%2FDBIx-Class-Historic.git Proof of concept, no-downstream-changes-needed port to Moo Ran without a hitch against the list in c8b1011e --- diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm index d6ca1ed..18e2396 100644 --- a/lib/DBIx/Class/ResultSource.pm +++ b/lib/DBIx/Class/ResultSource.pm @@ -14,6 +14,7 @@ use Scalar::Util qw( blessed weaken isweak refaddr ); # FIXME - somehow breaks ResultSetManager, do not remove until investigated use DBIx::Class::ResultSet; +use Moo; use namespace::clean; my @hashref_attributes = qw( @@ -23,12 +24,20 @@ my @hashref_attributes = qw( my @arrayref_attributes = qw( _ordered_columns _primaries ); -__PACKAGE__->mk_group_accessors(simple => + +has [ @hashref_attributes, @arrayref_attributes, qw( source_name name column_info_from_storage sqlt_deploy_callback ), +] => ( + is => 'rw', ); +has '+name' => ( default => "!!NAME NOT SET!!" ); +has '+sqlt_deploy_callback' => ( default => 'default_sqlt_deploy_hook' ); + +# We use the CAG accessors for this due to the "load-on-get" logic +# not being cleanly triggerable from within Moo __PACKAGE__->mk_group_accessors(component_class => qw/ resultset_class result_class @@ -121,6 +130,16 @@ Creates a new ResultSource object. Not normally called directly by end users. =cut + +# FIXME +# +# haarg: one more question - is there a straightforward way to inline BUILD/BUILDARGS ? +# ( I have both ) +# not really. it's something we probably should do, but don't currently. + +# Because there are spots that call ->new($rsrc_object) in the wild +sub BUILDARGS { +{ %{ $_[1] || {} } } } + { my $rsrc_registry; @@ -132,19 +151,14 @@ Creates a new ResultSource object. Not normally called directly by end users. } values %{ $rsrc_registry->{ refaddr($_[0]) }{ derivatives } } } - sub new { - my ($class, $attrs) = @_; - $class = ref $class if ref $class; - - my $ancestor = delete $attrs->{__derived_from}; - - my $self = bless { %$attrs }, $class; + sub BUILD { + my $self = shift; DBIx::Class::_ENV_::ASSERT_NO_ERRONEOUS_METAINSTANCE_USE and # a constructor with 'name' as sole arg clearly isn't "inheriting" from anything - ( not ( keys(%$self) == 1 and exists $self->{name} ) ) + ( not ( keys(%{$_[0]}) == 1 and exists $_[0]->{name} ) ) and defined CORE::caller(1) and @@ -161,6 +175,15 @@ Creates a new ResultSource object. Not normally called directly by end users. Carp::confess("Incorrect instantiation of '$self': you almost certainly wanted to call ->clone() instead"); + my $ancestor = delete $_[0]->{__derived_from}; + + # Allow complete transparency to subclasses: ->new( \%random_stuff ) + %$self = ( + %{$_[0]}, + %$self, + ); + + my $own_slot = $rsrc_registry->{ my $own_addr = refaddr $self } = { derivatives => {} }; @@ -194,10 +217,8 @@ Creates a new ResultSource object. Not normally called directly by end users. } + # not a default because we use the CAG accessors, see top of file $self->{resultset_class} ||= 'DBIx::Class::ResultSet'; - $self->{name} ||= "!!NAME NOT SET!!"; - $self->{_columns_info_loaded} ||= 0; - $self->{sqlt_deploy_callback} ||= 'default_sqlt_deploy_hook'; $self->{$_} = { %{ $self->{$_} || {} } } for @hashref_attributes; diff --git a/xt/dist/pod_coverage.t b/xt/dist/pod_coverage.t index 004f35e..6d609c2 100644 --- a/xt/dist/pod_coverage.t +++ b/xt/dist/pod_coverage.t @@ -60,6 +60,8 @@ my $exceptions = { }, 'DBIx::Class::ResultSource' => { ignore => [qw/ + BUILD + BUILDARGS compare_relationship_keys pk_depends_on resolve_condition