__PACKAGE__->mk_group_accessors('simple' => qw/_ordered_columns
_columns _primaries _unique_constraints name resultset_attributes
schema from _relationships column_info_from_storage source_info
- source_name/);
+ source_name sqlt_deploy_callback/);
__PACKAGE__->mk_group_accessors('component_class' => qw/resultset_class
result_class/);
A ResultSource is a component of a schema from which results can be directly
retrieved, most usually a table (see L<DBIx::Class::ResultSource::Table>)
+Basic view support also exists, see L<<DBIx::Class::ResultSource::View>.
+
=head1 METHODS
=pod
-=head2 new
-
- $class->new();
-
- $class->new({attribute_name => value});
-
-Creates a new ResultSource object. Not normally called directly by end users.
-
=cut
sub new {
$new->{_relationships} = { %{$new->{_relationships}||{}} };
$new->{name} ||= "!!NAME NOT SET!!";
$new->{_columns_info_loaded} ||= 0;
+ $new->{sqlt_deploy_callback} ||= "default_sqlt_deploy_hook";
return $new;
}
=pod
-=head2 source_info
+=head2 add_columns
-Stores a hashref of per-source metadata. No specific key names
-have yet been standardized, the examples below are purely hypothetical
-and don't actually accomplish anything on their own:
+=over
- __PACKAGE__->source_info({
- "_tablespace" => 'fast_disk_array_3',
- "_engine" => 'InnoDB',
- });
+=item Arguments: @columns
-=head2 add_columns
+=item Return value: The ResultSource object
- $table->add_columns(qw/col1 col2 col3/);
+=back
+
+ $source->add_columns(qw/col1 col2 col3/);
- $table->add_columns('col1' => \%col1_info, 'col2' => \%col2_info, ...);
+ $source->add_columns('col1' => \%col1_info, 'col2' => \%col2_info, ...);
Adds columns to the result source. If supplied key => hashref pairs, uses
the hashref as the column_info for that column. Repeated 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<DBIx::Class::Row> objects. You can change the name of the accessor
by supplying an L</accessor> in the column_info hash.
The contents of the column_info are not set in stone. The following
Set this to a true value for a column whose value is somehow
automatically set. This is used to determine which columns to empty
-when cloning objects using C<copy>. It is also used by
+when cloning objects using L<DBIx::Class::Row/copy>. It is also used by
L<DBIx::Class::Schema/deploy>.
=item is_foreign_key
=item default_value
Set this to the default value which will be inserted into a column
-by the database. Can contain either a value or a function. This is
-currently only used by L<DBIx::Class::Schema/deploy>.
+by the database. Can contain either a value or a function (use a
+reference to a scalar e.g. C<\'now()'> if you want a function). This
+is currently only used by L<DBIx::Class::Schema/deploy>.
+
+See the note on L<DBIx::Class::Row/new> for more information about possible
+issues related to db-side default values.
=item sequence
=item auto_nextval
Set this to a true value for a column whose value is retrieved
-automatically from an oracle sequence. If you do not use an oracle
+automatically from an oracle sequence. If you do not use an Oracle
trigger to get the nextval, you have to set sequence as well.
=item extra
=head2 add_column
- $table->add_column('col' => \%info?);
+=over
+
+=item Arguments: $colname, [ \%columninfo ]
-Convenience alias to add_columns.
+=item Return value: 1/0 (true/false)
+
+=back
+
+ $source->add_column('col' => \%info?);
+
+Add a single column and optional column info. Uses the same column
+info keys as L</add_columns>.
=cut
=head2 has_column
- if ($obj->has_column($col)) { ... }
+=over
+
+=item Arguments: $colname
+
+=item Return value: 1/0 (true/false)
+
+=back
+
+ if ($source->has_column($colname)) { ... }
Returns true if the source has a column of this name, false otherwise.
=head2 column_info
- my $info = $obj->column_info($col);
+=over
+
+=item Arguments: $colname
+
+=item Return value: Hashref of info
-Returns the column metadata hashref for a column. See the description
-of add_column for information on the contents of the hashref.
+=back
+
+ my $info = $source->column_info($col);
+
+Returns the column metadata hashref for a column, as originally passed
+to L</add_columns>. See the description of L</add_columns> for information
+on the contents of the hashref.
=cut
return $self->_columns->{$column};
}
-=head2 column_info_from_storage
+=head2 columns
-Enables the on-demand automatic loading of the above column
-metadata from storage as neccesary. This is *deprecated*, and
-should not be used. It will be removed before 1.0.
+=over
- __PACKAGE__->column_info_from_storage(1);
+=item Arguments: None
-=head2 columns
+=item Return value: Ordered list of column names
+
+=back
- my @column_names = $obj->columns;
+ my @column_names = $source->columns;
-Returns all column names in the order they were declared to add_columns.
+Returns all column names in the order they were declared to L</add_columns>.
=cut
=head2 remove_columns
- $table->remove_columns(qw/col1 col2 col3/);
+=over
+
+=item Arguments: @colnames
+
+=item Return value: undefined
+
+=back
+
+ $source->remove_columns(qw/col1 col2 col3/);
-Removes columns from the result source.
+Removes the given list of columns by name, from the result source.
+
+B<Warning>: Removing a column that is also used in the sources primary
+key, or in one of the sources unique constraints, B<will> result in a
+broken result source.
=head2 remove_column
- $table->remove_column('col');
+=over
-Convenience alias to remove_columns.
+=item Arguments: $colname
-=cut
+=item Return value: undefined
-sub remove_columns {
- my ($self, @cols) = @_;
+=back
- return unless $self->_ordered_columns;
+ $source->remove_column('col');
- my $columns = $self->_columns;
- my @remaining;
+Remove a single column by name from the result source, similar to
+L</remove_columns>.
- foreach my $col (@{$self->_ordered_columns}) {
- push @remaining, $col unless grep(/$col/, @cols);
- }
+B<Warning>: Removing a column that is also used in the sources primary
+key, or in one of the sources unique constraints, B<will> result in a
+broken result source.
+
+=cut
- foreach (@cols) {
+sub remove_columns {
+ my ($self, @to_remove) = @_;
+
+ my $columns = $self->_columns
+ or return;
+
+ my %to_remove;
+ for (@to_remove) {
delete $columns->{$_};
- };
+ ++$to_remove{$_};
+ }
- $self->_ordered_columns(\@remaining);
+ $self->_ordered_columns([ grep { not $to_remove{$_} } @{$self->_ordered_columns} ]);
}
sub remove_column { shift->remove_columns(@_); } # DO NOT CHANGE THIS TO GLOB
=item Arguments: @cols
+=item Return value: undefined
+
=back
Defines one or more columns as primary key for this source. Should be
-called after C<add_columns>.
+called after L</add_columns>.
-Additionally, defines a unique constraint named C<primary>.
+Additionally, defines a L<unique constraint|add_unique_constraint>
+named C<primary>.
The primary key columns are used by L<DBIx::Class::PK::Auto> to
retrieve automatically created values from the database.
=head2 primary_columns
-Read-only accessor which returns the list of primary keys.
+=over 4
+
+=item Arguments: None
+
+=item Return value: Ordered list of primary column names
+
+=back
+
+Read-only accessor which returns the list of primary keys, supplied by
+L</set_primary_key>.
=cut
=head2 add_unique_constraint
+=over 4
+
+=item Arguments: [ $name ], \@colnames
+
+=item Return value: undefined
+
+=back
+
Declare a unique constraint on this source. Call once for each unique
constraint.
Unique constraints are used, for example, when you call
L<DBIx::Class::ResultSet/find>. Only columns in the constraint are searched.
+Throws an error if any of the given column names do not yet exist on
+the result source.
+
=cut
sub add_unique_constraint {
=head2 name_unique_constraint
-Return a name for a unique constraint containing the specified columns. These
-names consist of the table name and each column name, separated by underscores.
+=over 4
+
+=item Arguments: @colnames
+
+=item Return value: Constraint name
+
+=back
+
+ $source->table('mytable');
+ $source->name_unique_constraint('col1', 'col2');
+ # returns
+ 'mytable_col1_col2'
+
+Return a name for a unique constraint containing the specified
+columns. The name is created by joining the table name and each column
+name, using an underscore character.
For example, a constraint on a table named C<cd> containing the columns
C<artist> and C<title> would result in a constraint name of C<cd_artist_title>.
+This is used by L</add_unique_constraint> if you do not specify the
+optional constraint name.
+
=cut
sub name_unique_constraint {
=head2 unique_constraints
-Read-only accessor which returns the list of unique constraints on this source.
+=over 4
+
+=item Arguments: None
+
+=item Return value: Hash of unique constraint data
+
+=back
+
+ $source->unique_constraints();
+
+Read-only accessor which returns a hash of unique constraints on this source.
+
+The hash is keyed by constraint name, and contains an arrayref of
+column names as values.
=cut
=head2 unique_constraint_names
+=over 4
+
+=item Arguments: None
+
+=item Return value: Unique constraint names
+
+=back
+
+ $source->unique_constraint_names();
+
Returns the list of unique constraint names defined on this source.
=cut
=head2 unique_constraint_columns
+=over 4
+
+=item Arguments: $constraintname
+
+=item Return value: List of constraint columns
+
+=back
+
+ $source->unique_constraint_columns('myconstraint');
+
Returns the list of columns that make up the specified unique constraint.
=cut
return @{ $unique_constraints{$constraint_name} };
}
+=head2 sqlt_deploy_callback
+
+=over
+
+=item Arguments: $callback
+
+=back
+
+ __PACKAGE__->sqlt_deploy_callback('mycallbackmethod');
+
+An accessor to set a callback to be called during deployment of
+the schema via L<DBIx::Class::Schema/create_ddl_dir> or
+L<DBIx::Class::Schema/deploy>.
+
+The callback can be set as either a code reference or the name of a
+method in the current result class.
+
+If not set, the L</default_sqlt_deploy_hook> is called.
+
+Your callback will be passed the $source object representing the
+ResultSource instance being deployed, and the
+L<SQL::Translator::Schema::Table> object being created from it. The
+callback can be used to manipulate the table object or add your own
+customised indexes. If you need to manipulate a non-table object, use
+the L<DBIx::Class::Schema/sqlt_deploy_hook>.
+
+See L<DBIx::Class::Manual::Cookbook/Adding Indexes And Functions To
+Your SQL> for examples.
+
+This sqlt deployment callback can only be used to manipulate
+SQL::Translator objects as they get turned into SQL. To execute
+post-deploy statements which SQL::Translator does not currently
+handle, override L<DBIx::Class::Schema/deploy> in your Schema class
+and call L<dbh_do|DBIx::Class::Storage::DBI/dbh_do>.
+
+=head2 default_sqlt_deploy_hook
+
+=over
+
+=item Arguments: $source, $sqlt_table
+
+=item Return value: undefined
+
+=back
+
+This is the sensible default for L</sqlt_deploy_callback>.
+
+If a method named C<sqlt_deploy_hook> exists in your Result class, it
+will be called and passed the current C<$source> and the
+C<$sqlt_table> being deployed.
+
+=cut
+
+sub default_sqlt_deploy_hook {
+ my $self = shift;
+
+ my $class = $self->result_class;
+
+ if ($class and $class->can('sqlt_deploy_hook')) {
+ $class->sqlt_deploy_hook(@_);
+ }
+}
+
+sub _invoke_sqlt_deploy_hook {
+ my $self = shift;
+ if ( my $hook = $self->sqlt_deploy_callback) {
+ $self->$hook(@_);
+ }
+}
+
+=head2 resultset
+
+=over 4
+
+=item Arguments: None
+
+=item Return value: $resultset
+
+=back
+
+Returns a resultset for the given source. This will initially be created
+on demand by calling
+
+ $self->resultset_class->new($self, $self->resultset_attributes)
+
+but is cached from then on unless resultset_class changes.
+
+=head2 resultset_class
+
+=over 4
+
+=item Arguments: $classname
+
+=item Return value: $classname
+
+=back
+
+ package My::ResultSetClass;
+ use base 'DBIx::Class::ResultSet';
+ ...
+
+ $source->resultset_class('My::ResultSet::Class');
+
+Set the class of the resultset. This is useful if you want to create your
+own resultset methods. Create your own class derived from
+L<DBIx::Class::ResultSet>, and set it here. If called with no arguments,
+this method returns the name of the existing resultset class, if one
+exists.
+
+=head2 resultset_attributes
+
+=over 4
+
+=item Arguments: \%attrs
+
+=item Return value: \%attrs
+
+=back
+
+ $source->resultset_attributes({ order_by => [ 'id' ] });
+
+Store a collection of resultset attributes, that will be set on every
+L<DBIx::Class::ResultSet> produced from this result source. For a full
+list see L<DBIx::Class::ResultSet/ATTRIBUTES>.
+
+=cut
+
+sub resultset {
+ my $self = shift;
+ $self->throw_exception(
+ 'resultset does not take any arguments. If you want another resultset, '.
+ 'call it on the schema instead.'
+ ) if scalar @_;
+
+ return $self->resultset_class->new(
+ $self,
+ {
+ %{$self->{resultset_attributes}},
+ %{$self->schema->default_resultset_attributes}
+ },
+ );
+}
+
+=head2 source_name
+
+=over 4
+
+=item Arguments: $source_name
+
+=item Result value: $source_name
+
+=back
+
+Set an alternate name for the result source when it is loaded into a schema.
+This is useful if you want to refer to a result source by a name other than
+its class name.
+
+ package ArchivedBooks;
+ use base qw/DBIx::Class/;
+ __PACKAGE__->table('books_archive');
+ __PACKAGE__->source_name('Books');
+
+ # from your schema...
+ $schema->resultset('Books')->find(1);
+
=head2 from
+=over 4
+
+=item Arguments: None
+
+=item Return value: FROM clause
+
+=back
+
+ my $from_clause = $source->from();
+
Returns an expression of the source to be supplied to storage to specify
retrieval from this source. In the case of a database, the required FROM
clause contents.
=head2 schema
+=over 4
+
+=item Arguments: None
+
+=item Return value: A schema object
+
+=back
+
+ my $schema = $source->schema();
+
Returns the L<DBIx::Class::Schema> object that this result source
-belongs too.
+belongs to.
=head2 storage
+=over 4
+
+=item Arguments: None
+
+=item Return value: A Storage object
+
+=back
+
+ $source->storage->debug(1);
+
Returns the storage handle for the current schema.
See also: L<DBIx::Class::Storage>
=head2 add_relationship
+=over 4
+
+=item Arguments: $relname, $related_source_name, \%cond, [ \%attrs ]
+
+=item Return value: 1/true if it succeeded
+
+=back
+
$source->add_relationship('relname', 'related_source', $cond, $attrs);
+L<DBIx::Class::Relationship> describes a series of methods which
+create pre-defined useful types of relationships. Look there first
+before using this method directly.
+
The relationship name can be arbitrary, but must be unique for each
relationship attached to this result source. 'related_source' should
be the name with which the related result source was registered with
The condition C<$cond> needs to be an L<SQL::Abstract>-style
representation of the join between the tables. For example, if you're
-creating a rel from Author to Book,
+creating a relation from Author to Book,
{ 'foreign.author_id' => 'self.id' }
=back
+Throws an exception if the condition is improperly supplied, or cannot
+be resolved.
+
=cut
sub add_relationship {
}
return unless $f_source; # Can't test rel without f_source
- eval { $self->resolve_join($rel, 'me') };
+ eval { $self->_resolve_join($rel, 'me') };
if ($@) { # If the resolve failed, back out and re-throw the error
delete $rels{$rel}; #
=head2 relationships
+=over 4
+
+=item Arguments: None
+
+=item Return value: List of relationship names
+
+=back
+
+ my @relnames = $source->relationships();
+
Returns all relationship names for this source.
=cut
=item Arguments: $relname
+=item Return value: Hashref of relation data,
+
=back
Returns a hash of relationship information for the specified relationship
-name.
+name. The keys/values are as specified for L</add_relationship>.
=cut
=item Arguments: $rel
+=item Return value: 1/0 (true/false)
+
=back
Returns true if the source has a relationship of this name, false otherwise.
=item Arguments: $relname
+=item Return value: Hashref of relationship data
+
=back
-Returns an array of hash references of relationship information for
-the other side of the specified relationship name.
+Looks through all the relationships on the source this relationship
+points to, looking for one whose condition is the reverse of the
+condition on this relationship.
+
+A common use of this is to find the name of the C<belongs_to> relation
+opposing a C<has_many> relation. For definition of these look in
+L<DBIx::Class::Relationship>.
+
+The returned hashref is keyed by the name of the opposing
+relationship, and contains it's data in the same manner as
+L</relationship_info>.
=cut
my @other_cond = keys(%$othercond);
my @other_refkeys = map {/^\w+\.(\w+)$/} @other_cond;
my @other_keys = map {$othercond->{$_} =~ /^\w+\.(\w+)$/} @other_cond;
- next if (!$self->compare_relationship_keys(\@refkeys, \@other_keys) ||
- !$self->compare_relationship_keys(\@other_refkeys, \@keys));
+ next if (!$self->_compare_relationship_keys(\@refkeys, \@other_keys) ||
+ !$self->_compare_relationship_keys(\@other_refkeys, \@keys));
$ret->{$otherrel} = $otherrel_info;
}
}
return $ret;
}
-=head2 compare_relationship_keys
-
-=over 4
-
-=item Arguments: $keys1, $keys2
-
-=back
-
-Returns true if both sets of keynames are the same, false otherwise.
-
-=cut
-
sub compare_relationship_keys {
+ carp 'compare_relationship_keys is a private method, stop calling it';
+ my $self = shift;
+ $self->_compare_relationship_keys (@_);
+}
+
+# Returns true if both sets of keynames are the same, false otherwise.
+sub _compare_relationship_keys {
my ($self, $keys1, $keys2) = @_;
# Make sure every keys1 is in keys2
return $found;
}
-=head2 resolve_join
-
-=over 4
+sub resolve_join {
+ carp 'resolve_join is a private method, stop calling it';
+ my $self = shift;
+ $self->_resolve_join (@_);
+}
-=item Arguments: $relation
+# Returns the {from} structure used to express JOIN conditions
+sub _resolve_join {
+ my ($self, $join, $alias, $seen, $force_left, $jpath) = @_;
-=back
+ # we need a supplied one, because we do in-place modifications, no returns
+ $self->throw_exception ('You must supply a seen hashref as the 3rd argument to _resolve_join')
+ unless $seen;
-Returns the join structure required for the related result source.
+ $force_left ||= { force => 0 };
-=cut
+ # This isn't quite right, we should actually dive into $seen and reconstruct
+ # the entire path (the reference entry point would be the join conditional
+ # with depth == current_depth - 1. At this point however nothing depends on
+ # having the entire path, transcending related_resultset, so just leave it
+ # as is, hairy enough already.
+ $jpath ||= [];
-sub resolve_join {
- my ($self, $join, $alias, $seen, $force_left) = @_;
- $seen ||= {};
- $force_left ||= { force => 0 };
if (ref $join eq 'ARRAY') {
- return map { $self->resolve_join($_, $alias, $seen) } @$join;
+ return
+ map {
+ local $force_left->{force} = $force_left->{force};
+ $self->_resolve_join($_, $alias, $seen, $force_left, [@$jpath]);
+ } @$join;
} elsif (ref $join eq 'HASH') {
return
map {
- my $as = ($seen->{$_} ? $_.'_'.($seen->{$_}+1) : $_);
- local $force_left->{force};
+ my $as = ($seen->{$_} ? join ('_', $_, $seen->{$_} + 1) : $_); # the actual seen value will be incremented below
+ local $force_left->{force} = $force_left->{force};
(
- $self->resolve_join($_, $alias, $seen, $force_left),
- $self->related_source($_)->resolve_join(
- $join->{$_}, $as, $seen, $force_left
+ $self->_resolve_join($_, $alias, $seen, $force_left, [@$jpath]),
+ $self->related_source($_)->_resolve_join(
+ $join->{$_}, $as, $seen, $force_left, [@$jpath, $_]
)
);
} keys %$join;
} elsif (ref $join) {
$self->throw_exception("No idea how to resolve join reftype ".ref $join);
} else {
+
my $count = ++$seen->{$join};
- #use Data::Dumper; warn Dumper($seen);
my $as = ($count > 1 ? "${join}_${count}" : $join);
+
my $rel_info = $self->relationship_info($join);
$self->throw_exception("No such relationship ${join}") unless $rel_info;
my $type;
$type = $rel_info->{attrs}{join_type} || '';
$force_left->{force} = 1 if lc($type) eq 'left';
}
- return [ { $as => $self->related_source($join)->from,
- -join_type => $type },
- $self->resolve_condition($rel_info->{cond}, $as, $alias) ];
+
+ my $rel_src = $self->related_source($join);
+ return [ { $as => $rel_src->from,
+ -result_source => $rel_src,
+ -join_type => $type,
+ -join_path => [@$jpath, $join],
+ -alias => $as,
+ -relation_chain_depth => $seen->{-relation_chain_depth} || 0,
+ },
+ $self->_resolve_condition($rel_info->{cond}, $as, $alias) ];
}
}
-=head2 pk_depends_on
-
-=over 4
-
-=item Arguments: $relname, $rel_data
-
-=back
-
-Determines whether a relation is dependent on an object from this source
-having already been inserted. Takes the name of the relationship and a
-hashref of columns of the related object.
-
-=cut
-
sub pk_depends_on {
+ carp 'pk_depends_on is a private method, stop calling it';
+ my $self = shift;
+ $self->_pk_depends_on (@_);
+}
+
+# Determines whether a relation is dependent on an object from this source
+# 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 $cond = $self->relationship_info($relname)->{cond};
return 1;
}
-=head2 resolve_condition
-
-=over 4
-
-=item Arguments: $cond, $as, $alias|$object
-
-=back
-
-Resolves the passed condition to a concrete query fragment. If given an alias,
-returns a join condition; if given an object, inverts that object to produce
-a related conditional from that object.
-
-=cut
+sub resolve_condition {
+ carp 'resolve_condition is a private method, stop calling it';
+ my $self = shift;
+ $self->_resolve_condition (@_);
+}
+# Resolves the passed condition to a concrete query fragment. If given an alias,
+# returns a join condition; if given an object, inverts that object to produce
+# a related conditional from that object.
our $UNRESOLVABLE_CONDITION = \'1 = 0';
-sub resolve_condition {
+sub _resolve_condition {
my ($self, $cond, $as, $for) = @_;
#warn %$cond;
if (ref $cond eq 'HASH') {
#warn "$self $k $for $v";
unless ($for->has_column_loaded($v)) {
if ($for->in_storage) {
- $self->throw_exception("Column ${v} not loaded on ${for} trying to reolve relationship");
+ $self->throw_exception(
+ "Column ${v} not loaded or not passed to new() prior to insert()"
+ ." on ${for} trying to resolve relationship (maybe you forgot "
+ ."to call ->discard_changes to get defaults from the db)"
+ );
}
- return [ $UNRESOLVABLE_CONDITION ];
+ return $UNRESOLVABLE_CONDITION;
}
$ret{$k} = $for->get_column($v);
#$ret{$k} = $for->get_column($v) if $for->has_column_loaded($v);
}
return \%ret;
} elsif (ref $cond eq 'ARRAY') {
- return [ map { $self->resolve_condition($_, $as, $for) } @$cond ];
+ return [ map { $self->_resolve_condition($_, $as, $for) } @$cond ];
} else {
die("Can't handle this yet :(");
}
}
-=head2 resolve_prefetch
-
-=over 4
-
-=item Arguments: hashref/arrayref/scalar
-
-=back
-
-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. Examples:
-
- my $source = $schema->resultset('Tag')->source;
- @columns = $source->resolve_prefetch( { cd => 'artist' } );
-
- # @columns =
- #(
- # 'cd.cdid',
- # 'cd.artist',
- # 'cd.title',
- # 'cd.year',
- # 'cd.artist.artistid',
- # 'cd.artist.name'
- #)
-
- @columns = $source->resolve_prefetch( qw[/ cd /] );
-
- # @columns =
- #(
- # 'cd.cdid',
- # 'cd.artist',
- # 'cd.title',
- # 'cd.year'
- #)
-
- $source = $schema->resultset('CD')->source;
- @columns = $source->resolve_prefetch( qw[/ artist producer /] );
-
- # @columns =
- #(
- # 'artist.artistid',
- # 'artist.name',
- # 'producer.producerid',
- # 'producer.name'
- #)
-
-=cut
-
+# Legacy code, needs to go entirely away (fully replaced by _resolve_prefetch)
sub resolve_prefetch {
+ carp 'resolve_prefetch is a private method, stop calling it';
+
my ($self, $pre, $alias, $seen, $order, $collapse) = @_;
$seen ||= {};
- #$alias ||= $self->name;
- #warn $alias, Dumper $pre;
if( ref $pre eq 'ARRAY' ) {
return
map { $self->resolve_prefetch( $_, $alias, $seen, $order, $collapse ) }
$self->related_source($_)->resolve_prefetch(
$pre->{$_}, "${alias}.$_", $seen, $order, $collapse)
} keys %$pre;
- #die Dumper \@ret;
return @ret;
}
elsif( ref $pre ) {
if (my ($fail) = grep { @{[$_ =~ m/\./g]} == $dots }
keys %{$collapse}) {
my ($last) = ($fail =~ /([^\.]+)$/);
- $self->throw_exception(
- "Can't prefetch multiple has_many rels ${last} and ${pre}"
- .(length($as_prefix) ? "at the same level (${as_prefix})"
- : "at top level"
- ));
+ 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->primary_columns ];
+ # action at a distance. prepending the '.' allows simpler code
+ # in ResultSet->_collapse_result
+ my @key = map { (/^foreign\.(.+)$/ ? ($1) : ()); }
+ keys %{$rel_info->{cond}};
+ my @ord = (ref($rel_info->{attrs}{order_by}) eq 'ARRAY'
+ ? @{$rel_info->{attrs}{order_by}}
+ : (defined $rel_info->{attrs}{order_by}
+ ? ($rel_info->{attrs}{order_by})
+ : ()));
+ push(@$order, map { "${as}.$_" } (@key, @ord));
+ }
+
+ return map { [ "${as}.$_", "${as_prefix}${pre}.$_", ] }
+ $rel_source->columns;
+ }
+}
+
+# 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. Needs an alias_map generated by
+# $rs->_joinpath_aliases
+
+sub _resolve_prefetch {
+ my ($self, $pre, $alias, $alias_map, $order, $collapse, $pref_path) = @_;
+ $pref_path ||= [];
+
+ if( 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->name . " has no such relationship '$pre'" )
+ unless $rel_info;
+ my $as_prefix = ($alias =~ /^.*?\.(.+)$/ ? $1.'.' : '');
+ my $rel_source = $self->related_source($pre);
+
+ if (exists $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}};
return map { [ "${as}.$_", "${as_prefix}${pre}.$_", ] }
$rel_source->columns;
- #warn $alias, Dumper (\@ret);
- #return @ret;
}
}
=item Arguments: $relname
+=item Return value: $source
+
=back
Returns the result source object for the given relationship.
=item Arguments: $relname
+=item Return value: $classname
+
=back
Returns the class name for objects in the given relationship.
return $self->schema->class($self->relationship_info($rel)->{source});
}
-=head2 resultset
-
-Returns a resultset for the given source. This will initially be created
-on demand by calling
-
- $self->resultset_class->new($self, $self->resultset_attributes)
-
-but is cached from then on unless resultset_class changes.
-
-=head2 resultset_class
-
-` package My::ResultSetClass;
- use base 'DBIx::Class::ResultSet';
- ...
-
- $source->resultset_class('My::ResultSet::Class');
-
-Set the class of the resultset, this is useful if you want to create your
-own resultset methods. Create your own class derived from
-L<DBIx::Class::ResultSet>, and set it here. If called with no arguments,
-this method returns the name of the existing resultset class, if one
-exists.
-
-=head2 resultset_attributes
-
- $source->resultset_attributes({ order_by => [ 'id' ] });
-
-Specify here any attributes you wish to pass to your specialised
-resultset. For a full list of these, please see
-L<DBIx::Class::ResultSet/ATTRIBUTES>.
-
-=cut
-
-sub resultset {
- my $self = shift;
- $self->throw_exception(
- 'resultset does not take any arguments. If you want another resultset, '.
- 'call it on the schema instead.'
- ) if scalar @_;
-
- return $self->resultset_class->new(
- $self,
- {
- %{$self->{resultset_attributes}},
- %{$self->schema->default_resultset_attributes}
- },
- );
-}
-
-=head2 source_name
-
-=over 4
-
-=item Arguments: $source_name
-
-=back
-
-Set the name of the result source when it is loaded into a schema.
-This is usefull if you want to refer to a result source by a name other than
-its class name.
-
- package ArchivedBooks;
- use base qw/DBIx::Class/;
- __PACKAGE__->table('books_archive');
- __PACKAGE__->source_name('Books');
-
- # from your schema...
- $schema->resultset('Books')->find(1);
-
=head2 handle
Obtain a new handle to this source. Returns an instance of a
}
}
-=head2 sqlt_deploy_hook($sqlt_table)
+=head2 source_info
-An optional sub which you can declare in your own Schema class that will get
-passed the L<SQL::Translator::Schema::Table> object when you deploy the schema
-via L</create_ddl_dir> or L</deploy>.
+Stores a hashref of per-source metadata. No specific key names
+have yet been standardized, the examples below are purely hypothetical
+and don't actually accomplish anything on their own:
+
+ __PACKAGE__->source_info({
+ "_tablespace" => 'fast_disk_array_3',
+ "_engine" => 'InnoDB',
+ });
+
+=head2 new
+
+ $class->new();
+
+ $class->new({attribute_name => value});
+
+Creates a new ResultSource object. Not normally called directly by end users.
+
+=head2 column_info_from_storage
+
+=over
+
+=item Arguments: 1/0 (default: 0)
+
+=item Return value: 1/0
+
+=back
+
+ __PACKAGE__->column_info_from_storage(1);
+
+Enables the on-demand automatic loading of the above column
+metadata from storage as neccesary. This is *deprecated*, and
+should not be used. It will be removed before 1.0.
-For an example of what you can do with this, see
-L<DBIx::Class::Manual::Cookbook/Adding Indexes And Functions To Your SQL>.
=head1 AUTHORS