use strict;
use warnings;
-use base qw/DBIx::Class::ResultSource::RowParser DBIx::Class/;
-
use DBIx::Class::ResultSet;
use DBIx::Class::ResultSourceHandle;
use DBIx::Class::Exception;
use DBIx::Class::Carp;
-use DBIx::Class::GlobalDestruction;
+use Devel::GlobalDestruction;
use Try::Tiny;
use List::Util 'first';
use Scalar::Util qw/blessed weaken isweak/;
-
use namespace::clean;
+use base qw/DBIx::Class/;
+
__PACKAGE__->mk_group_accessors(simple => qw/
source_name name source_info
_ordered_columns _columns _primaries _unique_constraints
$schema->source($source_name);
-=item From a Row object:
+=item From a Result object:
$row->result_source;
=item Arguments: @columns
-=item Return value: The ResultSource object
+=item Return Value: L<$result_source|/new>
=back
calls of this method will add more columns, not replace them.
The column names given will be created as accessor methods on your
-L<DBIx::Class::Row> objects. You can change the name of the accessor
+L<Result|DBIx::Class::Manual::ResultClass> objects. You can change the name of the accessor
by supplying an L</accessor> in the column_info hash.
If a column name beginning with a plus sign ('+col1') is provided, the
=item Arguments: $colname, \%columninfo?
-=item Return value: 1/0 (true/false)
+=item Return Value: 1/0 (true/false)
=back
=item Arguments: $colname
-=item Return value: 1/0 (true/false)
+=item Return Value: 1/0 (true/false)
=back
=item Arguments: $colname
-=item Return value: Hashref of info
+=item Return Value: Hashref of info
=back
=over
-=item Arguments: None
+=item Arguments: none
-=item Return value: Ordered list of column names
+=item Return Value: Ordered list of column names
=back
=item Arguments: \@colnames ?
-=item Return value: Hashref of column name/info pairs
+=item Return Value: Hashref of column name/info pairs
=back
=item Arguments: @colnames
-=item Return value: undefined
+=item Return Value: not defined
=back
=item Arguments: $colname
-=item Return value: undefined
+=item Return Value: not defined
=back
=item Arguments: @cols
-=item Return value: undefined
+=item Return Value: not defined
=back
=over 4
-=item Arguments: None
+=item Arguments: none
-=item Return value: Ordered list of primary column names
+=item Return Value: Ordered list of primary column names
=back
=item Arguments: $sequence_name
-=item Return value: undefined
+=item Return Value: not defined
=back
=item Arguments: $name?, \@colnames
-=item Return value: undefined
+=item Return Value: not defined
=back
=item Arguments: @constraints
-=item Return value: undefined
+=item Return Value: not defined
=back
=item Arguments: \@colnames
-=item Return value: Constraint name
+=item Return Value: Constraint name
=back
=over 4
-=item Arguments: None
+=item Arguments: none
-=item Return value: Hash of unique constraint data
+=item Return Value: Hash of unique constraint data
=back
=over 4
-=item Arguments: None
+=item Arguments: none
-=item Return value: Unique constraint names
+=item Return Value: Unique constraint names
=back
=item Arguments: $constraintname
-=item Return value: List of constraint columns
+=item Return Value: List of constraint columns
=back
=item Arguments: $callback_name | \&callback_code
-=item Return value: $callback_name | \&callback_code
+=item Return Value: $callback_name | \&callback_code
=back
}
}
+=head2 result_class
+
+=over 4
+
+=item Arguments: $classname
+
+=item Return Value: $classname
+
+=back
+
+ use My::Schema::ResultClass::Inflator;
+ ...
+
+ use My::Schema::Artist;
+ ...
+ __PACKAGE__->result_class('My::Schema::ResultClass::Inflator');
+
+Set the default result class for this source. You can use this to create
+and use your own result inflator. See L<DBIx::Class::ResultSet/result_class>
+for more details.
+
+Please note that setting this to something like
+L<DBIx::Class::ResultClass::HashRefInflator> will make every result unblessed
+and make life more difficult. Inflators like those are better suited to
+temporary usage via L<DBIx::Class::ResultSet/result_class>.
+
=head2 resultset
=over 4
-=item Arguments: None
+=item Arguments: none
-=item Return value: $resultset
+=item Return Value: L<$resultset|DBIx::Class::ResultSet>
=back
=item Arguments: $classname
-=item Return value: $classname
+=item Return Value: $classname
=back
=item Arguments: \%attrs
-=item Return value: \%attrs
+=item Return Value: \%attrs
=back
=over 4
-=item Arguments: None
+=item Arguments: none
=item Result value: $name
=over 4
-=item Arguments: None
+=item Arguments: none
-=item Return value: FROM clause
+=item Return Value: FROM clause
=back
=over 4
-=item Arguments: $schema
+=item Arguments: L<$schema?|DBIx::Class::Schema>
-=item Return value: A schema object
+=item Return Value: L<$schema|DBIx::Class::Schema>
=back
=over 4
-=item Arguments: None
+=item Arguments: none
-=item Return value: A Storage object
+=item Return Value: L<$storage|DBIx::Class::Storage>
=back
$source->storage->debug(1);
-Returns the storage handle for the current schema.
-
-See also: L<DBIx::Class::Storage>
+Returns the L<storage handle|DBIx::Class::Storage> for the current schema.
=cut
=over 4
-=item Arguments: $relname, $related_source_name, \%cond, [ \%attrs ]
+=item Arguments: $rel_name, $related_source_name, \%cond, \%attrs?
-=item Return value: 1/true if it succeeded
+=item Return Value: 1/true if it succeeded
=back
- $source->add_relationship('relname', 'related_source', $cond, $attrs);
+ $source->add_relationship('rel_name', 'related_source', $cond, $attrs);
L<DBIx::Class::Relationship> describes a series of methods which
create pre-defined useful types of relationships. Look there first
=over 4
-=item Arguments: None
+=item Arguments: none
-=item Return value: List of relationship names
+=item Return Value: L<@rel_names|DBIx::Class::Relationship>
=back
=over 4
-=item Arguments: $relname
+=item Arguments: L<$rel_name|DBIx::Class::Relationship>
-=item Return value: Hashref of relation data,
+=item Return Value: L<\%rel_data|DBIx::Class::Relationship::Base/add_relationship>
=back
Returns a hash of relationship information for the specified relationship
-name. The keys/values are as specified for L</add_relationship>.
+name. The keys/values are as specified for L<DBIx::Class::Relationship::Base/add_relationship>.
=cut
=over 4
-=item Arguments: $rel
+=item Arguments: L<$rel_name|DBIx::Class::Relationship>
-=item Return value: 1/0 (true/false)
+=item Return Value: 1/0 (true/false)
=back
=over 4
-=item Arguments: $relname
+=item Arguments: L<$rel_name|DBIx::Class::Relationship>
-=item Return value: Hashref of relationship data
+=item Return Value: L<\%rel_data|DBIx::Class::Relationship::Base/add_relationship>
=back
,
-join_path => [@$jpath, { $join => $as } ],
-is_single => (
- (! $rel_info->{attrs}{accessor})
- or
+ $rel_info->{attrs}{accessor}
+ &&
first { $rel_info->{attrs}{accessor} eq $_ } (qw/single filter/)
),
-alias => $as,
# having already been inserted. Takes the name of the relationship and a
# hashref of columns of the related object.
sub _pk_depends_on {
- my ($self, $relname, $rel_data) = @_;
+ my ($self, $rel_name, $rel_data) = @_;
- my $relinfo = $self->relationship_info($relname);
+ my $relinfo = $self->relationship_info($rel_name);
# don't assume things if the relationship direction is specified
return $relinfo->{attrs}{is_foreign_key_constraint}
# assume anything that references our PK probably is dependent on us
# rather than vice versa, unless the far side is (a) defined or (b)
# auto-increment
- my $rel_source = $self->related_source($relname);
+ my $rel_source = $self->related_source($rel_name);
foreach my $p ($self->primary_columns) {
if (exists $keyhash->{$p}) {
# list of non-triviail values (notmally conditions) returned as a part
# of a joinfree condition hash
sub _resolve_condition {
- my ($self, $cond, $as, $for, $relname) = @_;
+ my ($self, $cond, $as, $for, $rel_name) = @_;
my $obj_rel = !!blessed $for;
self_alias => $obj_rel ? $as : $for,
foreign_alias => $relalias,
self_resultsource => $self,
- foreign_relname => $relname || ($obj_rel ? $as : $for),
+ foreign_relname => $rel_name || ($obj_rel ? $as : $for),
self_rowobj => $obj_rel ? $for : undef
});
# FIXME sanity check until things stabilize, remove at some point
$self->throw_exception (
- "A join-free condition returned for relationship '$relname' without a row-object to chain from"
+ "A join-free condition returned for relationship '$rel_name' without a row-object to chain from"
) unless $obj_rel;
# FIXME another sanity check
first { $_ !~ /^\Q$relalias.\E.+/ } keys %$joinfree_cond
) {
$self->throw_exception (
- "The join-free condition returned for relationship '$relname' must be a hash "
+ "The join-free condition returned for relationship '$rel_name' must be a hash "
.'reference with all keys being valid columns on the related result source'
);
}
}
# see which parts of the joinfree cond are conditionals
- my $relcol_list = { map { $_ => 1 } $self->related_source($relname)->columns };
+ my $relcol_list = { map { $_ => 1 } $self->related_source($rel_name)->columns };
for my $c (keys %$joinfree_cond) {
my ($colname) = $c =~ /^ (?: \Q$relalias.\E )? (.+)/x;
elsif (ref $cond eq 'ARRAY') {
my (@ret, $crosstable);
for (@$cond) {
- my ($cond, $crosstab) = $self->_resolve_condition($_, $as, $for, $relname);
+ my ($cond, $crosstab) = $self->_resolve_condition($_, $as, $for, $rel_name);
push @ret, $cond;
$crosstable ||= $crosstab;
}
return wantarray ? (\@ret, $crosstable) : \@ret;
}
else {
- $self->throw_exception ("Can't handle condition $cond for relationship '$relname' yet :(");
+ $self->throw_exception ("Can't handle condition $cond for relationship '$rel_name' yet :(");
+ }
+}
+
+# Accepts one or more relationships for the current source and returns an
+# array of column names for each of those relationships. Column names are
+# prefixed relative to the current source, in accordance with where they appear
+# in the supplied relationships.
+sub _resolve_prefetch {
+ my ($self, $pre, $alias, $alias_map, $order, $collapse, $pref_path) = @_;
+ $pref_path ||= [];
+
+ if (not defined $pre or not length $pre) {
+ return ();
+ }
+ elsif( ref $pre eq 'ARRAY' ) {
+ return
+ map { $self->_resolve_prefetch( $_, $alias, $alias_map, $order, $collapse, [ @$pref_path ] ) }
+ @$pre;
+ }
+ elsif( ref $pre eq 'HASH' ) {
+ my @ret =
+ map {
+ $self->_resolve_prefetch($_, $alias, $alias_map, $order, $collapse, [ @$pref_path ] ),
+ $self->related_source($_)->_resolve_prefetch(
+ $pre->{$_}, "${alias}.$_", $alias_map, $order, $collapse, [ @$pref_path, $_] )
+ } keys %$pre;
+ return @ret;
+ }
+ elsif( ref $pre ) {
+ $self->throw_exception(
+ "don't know how to resolve prefetch reftype ".ref($pre));
+ }
+ else {
+ my $p = $alias_map;
+ $p = $p->{$_} for (@$pref_path, $pre);
+
+ $self->throw_exception (
+ "Unable to resolve prefetch '$pre' - join alias map does not contain an entry for path: "
+ . join (' -> ', @$pref_path, $pre)
+ ) if (ref $p->{-join_aliases} ne 'ARRAY' or not @{$p->{-join_aliases}} );
+
+ my $as = shift @{$p->{-join_aliases}};
+
+ my $rel_info = $self->relationship_info( $pre );
+ $self->throw_exception( $self->source_name . " has no such relationship '$pre'" )
+ unless $rel_info;
+ my $as_prefix = ($alias =~ /^.*?\.(.+)$/ ? $1.'.' : '');
+ my $rel_source = $self->related_source($pre);
+
+ if ($rel_info->{attrs}{accessor} && $rel_info->{attrs}{accessor} eq 'multi') {
+ $self->throw_exception(
+ "Can't prefetch has_many ${pre} (join cond too complex)")
+ unless ref($rel_info->{cond}) eq 'HASH';
+ my $dots = @{[$as_prefix =~ m/\./g]} + 1; # +1 to match the ".${as_prefix}"
+
+ if (my ($fail) = grep { @{[$_ =~ m/\./g]} == $dots }
+ keys %{$collapse}) {
+ my ($last) = ($fail =~ /([^\.]+)$/);
+ carp (
+ "Prefetching multiple has_many rels ${last} and ${pre} "
+ .(length($as_prefix)
+ ? "at the same level (${as_prefix}) "
+ : "at top level "
+ )
+ . 'will explode the number of row objects retrievable via ->next or ->all. '
+ . 'Use at your own risk.'
+ );
+ }
+
+ #my @col = map { (/^self\.(.+)$/ ? ("${as_prefix}.$1") : ()); }
+ # values %{$rel_info->{cond}};
+ $collapse->{".${as_prefix}${pre}"} = [ $rel_source->_pri_cols ];
+ # action at a distance. prepending the '.' allows simpler code
+ # in ResultSet->_collapse_result
+ my @key = map { (/^foreign\.(.+)$/ ? ($1) : ()); }
+ keys %{$rel_info->{cond}};
+ push @$order, map { "${as}.$_" } @key;
+
+ if (my $rel_order = $rel_info->{attrs}{order_by}) {
+ # this is kludgy and incomplete, I am well aware
+ # but the parent method is going away entirely anyway
+ # so sod it
+ my $sql_maker = $self->storage->sql_maker;
+ my ($orig_ql, $orig_qr) = $sql_maker->_quote_chars;
+ my $sep = $sql_maker->name_sep;
+
+ # install our own quoter, so we can catch unqualified stuff
+ local $sql_maker->{quote_char} = ["\x00", "\xFF"];
+
+ my $quoted_prefix = "\x00${as}\xFF";
+
+ for my $chunk ( $sql_maker->_order_by_chunks ($rel_order) ) {
+ my @bind;
+ ($chunk, @bind) = @$chunk if ref $chunk;
+
+ $chunk = "${quoted_prefix}${sep}${chunk}"
+ unless $chunk =~ /\Q$sep/;
+
+ $chunk =~ s/\x00/$orig_ql/g;
+ $chunk =~ s/\xFF/$orig_qr/g;
+ push @$order, \[$chunk, @bind];
+ }
+ }
+ }
+
+ return map { [ "${as}.$_", "${as_prefix}${pre}.$_", ] }
+ $rel_source->columns;
}
}
=over 4
-=item Arguments: $relname
+=item Arguments: $rel_name
-=item Return value: $source
+=item Return Value: $source
=back
=over 4
-=item Arguments: $relname
+=item Arguments: $rel_name
-=item Return value: $classname
+=item Return Value: $classname
=back
=over 4
-=item Arguments: None
+=item Arguments: none
-=item Return value: $source_handle
+=item Return Value: L<$source_handle|DBIx::Class::ResultSourceHandle>
=back
=item Arguments: 1/0 (default: 0)
-=item Return value: 1/0
+=item Return Value: 1/0
=back
should not be used. It will be removed before 1.0.
-=head1 AUTHORS
+=head1 AUTHOR AND CONTRIBUTORS
-Matt S. Trout <mst@shadowcatsystems.co.uk>
+See L<AUTHOR|DBIx::Class/AUTHOR> and L<CONTRIBUTORS|DBIx::Class/CONTRIBUTORS> in DBIx::Class
=head1 LICENSE