# FIXME - somehow breaks ResultSetManager, do not remove until investigated
use DBIx::Class::ResultSet;
+use Moo;
use namespace::clean;
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
__PACKAGE__->table_class('DBIx::Class::ResultSource::View');
__PACKAGE__->table('year2000cds');
- __PACKAGE__->result_source_instance->is_virtual(1);
- __PACKAGE__->result_source_instance->view_definition(
+ __PACKAGE__->result_source->is_virtual(1);
+ __PACKAGE__->result_source->view_definition(
"SELECT cdid, artist, title FROM cd WHERE year ='2000'"
);
=cut
+
+# FIXME
+#
+# <ribasushi> haarg: one more question - is there a straightforward way to inline BUILD/BUILDARGS ?
+# <ribasushi> ( I have both )
+# <haarg> 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;
} 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
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 => {} };
}
+ # 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;
my ($self, @cols) = @_;
$self->_ordered_columns(\@cols) unless $self->_ordered_columns;
- my @added;
+ my ( @added, $colinfos );
my $columns = $self->_columns;
+
while (my $col = shift @cols) {
- my $column_info = {};
- if ($col =~ s/^\+//) {
- $column_info = $self->column_info($col);
- }
+ my $column_info =
+ (
+ $col =~ s/^\+//
+ and
+ ( $colinfos ||= $self->columns_info )->{$col}
+ )
+ ||
+ {}
+ ;
# If next entry is { ... } use that for the column info, if not
# use an empty hashref
push(@added, $col) unless exists $columns->{$col};
$columns->{$col} = $column_info;
}
+
push @{ $self->_ordered_columns }, @added;
return $self;
}
=cut
sub column_info {
- my ($self, $column) = @_;
- $self->throw_exception("No such column $column")
- unless exists $self->_columns->{$column};
-
- if ( ! $self->_columns->{$column}{data_type}
- and ! $self->{_columns_info_loaded}
- and $self->column_info_from_storage
- and my $stor = dbic_internal_try { $self->schema->storage } )
- {
- $self->{_columns_info_loaded}++;
-
- # try for the case of storage without table
- dbic_internal_try {
- my $info = $stor->columns_info_for( $self->from );
- my $lc_info = { map
- { (lc $_) => $info->{$_} }
- ( keys %$info )
- };
-
- foreach my $col ( keys %{$self->_columns} ) {
- $self->_columns->{$col} = {
- %{ $self->_columns->{$col} },
- %{ $info->{$col} || $lc_info->{lc $col} || {} }
- };
- }
- };
- }
+ DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
- return $self->_columns->{$column};
+ #my ($self, $column) = @_;
+ $_[0]->columns_info([ $_[1] ])->{$_[1]};
}
=head2 columns
}
}
else {
+ # the shallow copy is crucial - there are exists() checks within
+ # the wider codebase
%ret = %$colinfo;
}
=back
- __PACKAGE__->result_source_instance->sqlt_deploy_callback('mycallbackmethod');
+ __PACKAGE__->result_source->sqlt_deploy_callback('mycallbackmethod');
or
- __PACKAGE__->result_source_instance->sqlt_deploy_callback(sub {
+ __PACKAGE__->result_source->sqlt_deploy_callback(sub {
my ($source_instance, $sqlt_table) = @_;
...
} );
# auto-increment
my $rel_source = $self->related_source($rel_name);
+ my $colinfos;
+
foreach my $p ($self->primary_columns) {
- if (exists $keyhash->{$p}) {
- unless (defined($rel_data->{$keyhash->{$p}})
- || $rel_source->column_info($keyhash->{$p})
- ->{is_auto_increment}) {
- return 0;
- }
- }
+ return 0 if (
+ exists $keyhash->{$p}
+ and
+ ! defined( $rel_data->{$keyhash->{$p}} )
+ and
+ ! ( $colinfos ||= $rel_source->columns_info )
+ ->{$keyhash->{$p}}{is_auto_increment}
+ )
}
return 1;
else {
my $class = $self->relationship_info($rel)->{class};
$self->ensure_class_loaded($class);
- $class->result_source_instance;
+ $class->result_source;
}
}
projects / dbsrgits/DBIx-Class-Historic.git / blobdiff