1 package DBIx::Class::ResultSource;
6 use DBIx::Class::ResultSet;
7 use DBIx::Class::ResultSourceHandle;
8 use Carp::Clan qw/^DBIx::Class/;
11 use base qw/DBIx::Class/;
13 __PACKAGE__->mk_group_accessors('simple' => qw/_ordered_columns
14 _columns _primaries _unique_constraints name resultset_attributes
15 schema from _relationships column_info_from_storage source_info
18 __PACKAGE__->mk_group_accessors('component_class' => qw/resultset_class
23 DBIx::Class::ResultSource - Result source object
29 A ResultSource is a component of a schema from which results can be directly
30 retrieved, most usually a table (see L<DBIx::Class::ResultSource::Table>)
39 my ($class, $attrs) = @_;
40 $class = ref $class if ref $class;
42 my $new = bless { %{$attrs || {}} }, $class;
43 $new->{resultset_class} ||= 'DBIx::Class::ResultSet';
44 $new->{resultset_attributes} = { %{$new->{resultset_attributes} || {}} };
45 $new->{_ordered_columns} = [ @{$new->{_ordered_columns}||[]}];
46 $new->{_columns} = { %{$new->{_columns}||{}} };
47 $new->{_relationships} = { %{$new->{_relationships}||{}} };
48 $new->{name} ||= "!!NAME NOT SET!!";
49 $new->{_columns_info_loaded} ||= 0;
59 =item Arguments: @columns
61 =item Return value: The ResultSource object
65 $source->add_columns(qw/col1 col2 col3/);
67 $source->add_columns('col1' => \%col1_info, 'col2' => \%col2_info, ...);
69 Adds columns to the result source. If supplied key => hashref pairs, uses
70 the hashref as the column_info for that column. Repeated calls of this
71 method will add more columns, not replace them.
73 The column names given will be created as accessor methods on your
74 L<DBIx::Class::Row> objects, you can change the name of the accessor
75 by supplying an L</accessor> in the column_info hash.
77 The contents of the column_info are not set in stone. The following
78 keys are currently recognised/used by DBIx::Class:
84 Use this to set the name of the accessor method for this column. If unset,
85 the name of the column will be used.
89 This contains the column type. It is automatically filled by the
90 L<SQL::Translator::Producer::DBIx::Class::File> producer, and the
91 L<DBIx::Class::Schema::Loader> module. If you do not enter a
92 data_type, DBIx::Class will attempt to retrieve it from the
93 database for you, using L<DBI>'s column_info method. The values of this
94 key are typically upper-cased.
96 Currently there is no standard set of values for the data_type. Use
97 whatever your database supports.
101 The length of your column, if it is a column type that can have a size
102 restriction. This is currently only used by L<DBIx::Class::Schema/deploy>.
106 Set this to a true value for a columns that is allowed to contain
107 NULL values. This is currently only used by L<DBIx::Class::Schema/deploy>.
109 =item is_auto_increment
111 Set this to a true value for a column whose value is somehow
112 automatically set. This is used to determine which columns to empty
113 when cloning objects using C<copy>. It is also used by
114 L<DBIx::Class::Schema/deploy>.
118 Set this to a true value for a column that contains a key from a
119 foreign table. This is currently only used by
120 L<DBIx::Class::Schema/deploy>.
124 Set this to the default value which will be inserted into a column
125 by the database. Can contain either a value or a function. This is
126 currently only used by L<DBIx::Class::Schema/deploy>.
130 Set this on a primary key column to the name of the sequence used to
131 generate a new key value. If not specified, L<DBIx::Class::PK::Auto>
132 will attempt to retrieve the name of the sequence from the database
137 Set this to a true value for a column whose value is retrieved
138 automatically from an oracle sequence. If you do not use an oracle
139 trigger to get the nextval, you have to set sequence as well.
143 This is used by L<DBIx::Class::Schema/deploy> and L<SQL::Translator>
144 to add extra non-generic data to the column. For example: C<< extra
145 => { unsigned => 1} >> is used by the MySQL producer to set an integer
146 column to unsigned. For more details, see
147 L<SQL::Translator::Producer::MySQL>.
155 =item Arguments: $colname, [ \%columninfo ]
157 =item Return value: 1/0 (true/false)
161 $source->add_column('col' => \%info?);
163 Add a single column and optional column info. Uses the same column
164 info keys as L</add_columns>.
169 my ($self, @cols) = @_;
170 $self->_ordered_columns(\@cols) unless $self->_ordered_columns;
173 my $columns = $self->_columns;
174 while (my $col = shift @cols) {
175 # If next entry is { ... } use that for the column info, if not
176 # use an empty hashref
177 my $column_info = ref $cols[0] ? shift(@cols) : {};
178 push(@added, $col) unless exists $columns->{$col};
179 $columns->{$col} = $column_info;
181 push @{ $self->_ordered_columns }, @added;
185 sub add_column { shift->add_columns(@_); } # DO NOT CHANGE THIS TO GLOB
191 =item Arguments: $colname
193 =item Return value: 1/0 (true/false)
197 if ($source->has_column($colname)) { ... }
199 Returns true if the source has a column of this name, false otherwise.
204 my ($self, $column) = @_;
205 return exists $self->_columns->{$column};
212 =item Arguments: $colname
214 =item Return value: Hashref of info
218 my $info = $source->column_info($col);
220 Returns the column metadata hashref for a column, as originally passed
221 to L</add_columns>. See the description of L</add_columns> for information
222 on the contents of the hashref.
227 my ($self, $column) = @_;
228 $self->throw_exception("No such column $column")
229 unless exists $self->_columns->{$column};
230 #warn $self->{_columns_info_loaded}, "\n";
231 if ( ! $self->_columns->{$column}{data_type}
232 and $self->column_info_from_storage
233 and ! $self->{_columns_info_loaded}
234 and $self->schema and $self->storage )
236 $self->{_columns_info_loaded}++;
239 # eval for the case of storage without table
240 eval { $info = $self->storage->columns_info_for( $self->from ) };
242 for my $realcol ( keys %{$info} ) {
243 $lc_info->{lc $realcol} = $info->{$realcol};
245 foreach my $col ( keys %{$self->_columns} ) {
246 $self->_columns->{$col} = {
247 %{ $self->_columns->{$col} },
248 %{ $info->{$col} || $lc_info->{lc $col} || {} }
253 return $self->_columns->{$column};
260 =item Arguments: None
262 =item Return value: Ordered list of column names
266 my @column_names = $source->columns;
268 Returns all column names in the order they were declared to L</add_columns>.
274 $self->throw_exception(
275 "columns() is a read-only accessor, did you mean add_columns()?"
277 return @{$self->{_ordered_columns}||[]};
280 =head2 remove_columns
284 =item Arguments: @colnames
286 =item Return value: undefined
290 $source->remove_columns(qw/col1 col2 col3/);
292 Removes the given list of columns by name, from the result source.
294 B<Warning>: Removing a column that is also used in the sources primary
295 key, or in one of the sources unique constraints, B<will> result in a
296 broken result source.
302 =item Arguments: $colname
304 =item Return value: undefined
308 $source->remove_column('col');
310 Remove a single column by name from the result source, similar to
313 B<Warning>: Removing a column that is also used in the sources primary
314 key, or in one of the sources unique constraints, B<will> result in a
315 broken result source.
320 my ($self, @cols) = @_;
322 return unless $self->_ordered_columns;
324 my $columns = $self->_columns;
327 foreach my $col (@{$self->_ordered_columns}) {
328 push @remaining, $col unless grep(/$col/, @cols);
332 delete $columns->{$_};
335 $self->_ordered_columns(\@remaining);
338 sub remove_column { shift->remove_columns(@_); } # DO NOT CHANGE THIS TO GLOB
340 =head2 set_primary_key
344 =item Arguments: @cols
346 =item Return value: undefined
350 Defines one or more columns as primary key for this source. Should be
351 called after L</add_columns>.
353 Additionally, defines a L<unique constraint|add_unique_constraint>
356 The primary key columns are used by L<DBIx::Class::PK::Auto> to
357 retrieve automatically created values from the database.
361 sub set_primary_key {
362 my ($self, @cols) = @_;
363 # check if primary key columns are valid columns
364 foreach my $col (@cols) {
365 $self->throw_exception("No such column $col on table " . $self->name)
366 unless $self->has_column($col);
368 $self->_primaries(\@cols);
370 $self->add_unique_constraint(primary => \@cols);
373 =head2 primary_columns
377 =item Arguments: None
379 =item Return value: Ordered list of primary column names
383 Read-only accessor which returns the list of primary keys, supplied by
388 sub primary_columns {
389 return @{shift->_primaries||[]};
392 =head2 add_unique_constraint
396 =item Arguments: [ $name ], \@colnames
398 =item Return value: undefined
402 Declare a unique constraint on this source. Call once for each unique
405 # For UNIQUE (column1, column2)
406 __PACKAGE__->add_unique_constraint(
407 constraint_name => [ qw/column1 column2/ ],
410 Alternatively, you can specify only the columns:
412 __PACKAGE__->add_unique_constraint([ qw/column1 column2/ ]);
414 This will result in a unique constraint named C<table_column1_column2>, where
415 C<table> is replaced with the table name.
417 Unique constraints are used, for example, when you call
418 L<DBIx::Class::ResultSet/find>. Only columns in the constraint are searched.
420 Throws an error if any of the given column names do not yet exist on
425 sub add_unique_constraint {
430 $name ||= $self->name_unique_constraint($cols);
432 foreach my $col (@$cols) {
433 $self->throw_exception("No such column $col on table " . $self->name)
434 unless $self->has_column($col);
437 my %unique_constraints = $self->unique_constraints;
438 $unique_constraints{$name} = $cols;
439 $self->_unique_constraints(\%unique_constraints);
442 =head2 name_unique_constraint
446 =item Arguments: @colnames
448 =item Return value: Constraint name
452 $source->table('mytable');
453 $source->name_unique_constraint('col1', 'col2');
457 Return a name for a unique constraint containing the specified
458 columns. The name is created by joining the table name and each column
459 name, using an underscore character.
461 For example, a constraint on a table named C<cd> containing the columns
462 C<artist> and C<title> would result in a constraint name of C<cd_artist_title>.
464 This is used by L</add_unique_constraint> if you do not specify the
465 optional constraint name.
469 sub name_unique_constraint {
470 my ($self, $cols) = @_;
472 return join '_', $self->name, @$cols;
475 =head2 unique_constraints
479 =item Arguments: None
481 =item Return value: Hash of unique constraint data
485 $source->unique_constraints();
487 Read-only accessor which returns a hash of unique constraints on this source.
489 The hash is keyed by constraint name, and contains an arrayref of
490 column names as values.
494 sub unique_constraints {
495 return %{shift->_unique_constraints||{}};
498 =head2 unique_constraint_names
502 =item Arguments: None
504 =item Return value: Unique constraint names
508 $source->unique_constraint_names();
510 Returns the list of unique constraint names defined on this source.
514 sub unique_constraint_names {
517 my %unique_constraints = $self->unique_constraints;
519 return keys %unique_constraints;
522 =head2 unique_constraint_columns
526 =item Arguments: $constraintname
528 =item Return value: List of constraint columns
532 $source->unique_constraint_columns('myconstraint');
534 Returns the list of columns that make up the specified unique constraint.
538 sub unique_constraint_columns {
539 my ($self, $constraint_name) = @_;
541 my %unique_constraints = $self->unique_constraints;
543 $self->throw_exception(
544 "Unknown unique constraint $constraint_name on '" . $self->name . "'"
545 ) unless exists $unique_constraints{$constraint_name};
547 return @{ $unique_constraints{$constraint_name} };
554 =item Arguments: None
556 =item Return value: $resultset
560 Returns a resultset for the given source. This will initially be created
563 $self->resultset_class->new($self, $self->resultset_attributes)
565 but is cached from then on unless resultset_class changes.
567 =head2 resultset_class
571 =item Arguments: $classname
573 =item Return value: $classname
577 package My::ResultSetClass;
578 use base 'DBIx::Class::ResultSet';
581 $source->resultset_class('My::ResultSet::Class');
583 Set the class of the resultset, this is useful if you want to create your
584 own resultset methods. Create your own class derived from
585 L<DBIx::Class::ResultSet>, and set it here. If called with no arguments,
586 this method returns the name of the existing resultset class, if one
589 =head2 resultset_attributes
593 =item Arguments: \%attrs
595 =item Return value: \%attrs
599 $source->resultset_attributes({ order_by => [ 'id' ] });
601 Store a collection of resultset attributes, that will be set on every
602 L<DBIx::Class::ResultSet> produced from this result source. For a full
603 list see L<DBIx::Class::ResultSet/ATTRIBUTES>.
609 $self->throw_exception(
610 'resultset does not take any arguments. If you want another resultset, '.
611 'call it on the schema instead.'
614 return $self->resultset_class->new(
617 %{$self->{resultset_attributes}},
618 %{$self->schema->default_resultset_attributes}
627 =item Arguments: $source_name
629 =item Result value: $source_name
633 Set an alternate name for the result source when it is loaded into a schema.
634 This is useful if you want to refer to a result source by a name other than
637 package ArchivedBooks;
638 use base qw/DBIx::Class/;
639 __PACKAGE__->table('books_archive');
640 __PACKAGE__->source_name('Books');
642 # from your schema...
643 $schema->resultset('Books')->find(1);
649 =item Arguments: None
651 =item Return value: FROM clause
655 my $from_clause = $source->from();
657 Returns an expression of the source to be supplied to storage to specify
658 retrieval from this source. In the case of a database, the required FROM
665 =item Arguments: None
667 =item Return value: A schema object
671 my $schema = $source->schema();
673 Returns the L<DBIx::Class::Schema> object that this result source
680 =item Arguments: None
682 =item Return value: A Storage object
686 $source->storage->debug(1);
688 Returns the storage handle for the current schema.
690 See also: L<DBIx::Class::Storage>
694 sub storage { shift->schema->storage; }
696 =head2 add_relationship
700 =item Arguments: $relname, $related_source_name, \%cond, [ \%attrs ]
702 =item Return value: 1/true if it succeeded
706 $source->add_relationship('relname', 'related_source', $cond, $attrs);
708 L<DBIx::Class::Relationship> describes a series of methods which
709 create pre-defined useful types of relationships. Look there first
710 before using this method directly.
712 The relationship name can be arbitrary, but must be unique for each
713 relationship attached to this result source. 'related_source' should
714 be the name with which the related result source was registered with
715 the current schema. For example:
717 $schema->source('Book')->add_relationship('reviews', 'Review', {
718 'foreign.book_id' => 'self.id',
721 The condition C<$cond> needs to be an L<SQL::Abstract>-style
722 representation of the join between the tables. For example, if you're
723 creating a relation from Author to Book,
725 { 'foreign.author_id' => 'self.id' }
727 will result in the JOIN clause
729 author me JOIN book foreign ON foreign.author_id = me.id
731 You can specify as many foreign => self mappings as necessary.
733 Valid attributes are as follows:
739 Explicitly specifies the type of join to use in the relationship. Any
740 SQL join type is valid, e.g. C<LEFT> or C<RIGHT>. It will be placed in
741 the SQL command immediately before C<JOIN>.
745 An arrayref containing a list of accessors in the foreign class to proxy in
746 the main class. If, for example, you do the following:
748 CD->might_have(liner_notes => 'LinerNotes', undef, {
749 proxy => [ qw/notes/ ],
752 Then, assuming LinerNotes has an accessor named notes, you can do:
754 my $cd = CD->find(1);
755 # set notes -- LinerNotes object is created if it doesn't exist
756 $cd->notes('Notes go here');
760 Specifies the type of accessor that should be created for the
761 relationship. Valid values are C<single> (for when there is only a single
762 related object), C<multi> (when there can be many), and C<filter> (for
763 when there is a single related object, but you also want the relationship
764 accessor to double as a column accessor). For C<multi> accessors, an
765 add_to_* method is also created, which calls C<create_related> for the
770 Throws an exception if the condition is improperly supplied, or cannot
771 be resolved using L</resolve_join>.
775 sub add_relationship {
776 my ($self, $rel, $f_source_name, $cond, $attrs) = @_;
777 $self->throw_exception("Can't create relationship without join condition")
781 # Check foreign and self are right in cond
782 if ( (ref $cond ||'') eq 'HASH') {
784 $self->throw_exception("Keys of condition should be of form 'foreign.col', not '$_'")
785 if /\./ && !/^foreign\./;
789 my %rels = %{ $self->_relationships };
790 $rels{$rel} = { class => $f_source_name,
791 source => $f_source_name,
794 $self->_relationships(\%rels);
798 # XXX disabled. doesn't work properly currently. skip in tests.
800 my $f_source = $self->schema->source($f_source_name);
802 $self->ensure_class_loaded($f_source_name);
803 $f_source = $f_source_name->result_source;
804 #my $s_class = ref($self->schema);
805 #$f_source_name =~ m/^${s_class}::(.*)$/;
806 #$self->schema->register_class(($1 || $f_source_name), $f_source_name);
807 #$f_source = $self->schema->source($f_source_name);
809 return unless $f_source; # Can't test rel without f_source
811 eval { $self->resolve_join($rel, 'me') };
813 if ($@) { # If the resolve failed, back out and re-throw the error
814 delete $rels{$rel}; #
815 $self->_relationships(\%rels);
816 $self->throw_exception("Error creating relationship $rel: $@");
825 =item Arguments: None
827 =item Return value: List of relationship names
831 my @relnames = $source->relationships();
833 Returns all relationship names for this source.
838 return keys %{shift->_relationships};
841 =head2 relationship_info
845 =item Arguments: $relname
847 =item Return value: Hashref of relation data,
851 Returns a hash of relationship information for the specified relationship
852 name. The keys/values are as specified for L</add_relationship>.
856 sub relationship_info {
857 my ($self, $rel) = @_;
858 return $self->_relationships->{$rel};
861 =head2 has_relationship
865 =item Arguments: $rel
867 =item Return value: 1/0 (true/false)
871 Returns true if the source has a relationship of this name, false otherwise.
875 sub has_relationship {
876 my ($self, $rel) = @_;
877 return exists $self->_relationships->{$rel};
880 =head2 reverse_relationship_info
884 =item Arguments: $relname
886 =item Return value: Hashref of relationship data
890 Looks through all the relationships on the source this relationship
891 points to, looking for one whose condition is the reverse of the
892 condition on this relationship.
894 A common use of this is to find the name of the C<belongs_to> relation
895 opposing a C<has_many> relation. For definition of these look in
896 L<DBIx::Class::Relationship>.
898 The returned hashref is keyed by the name of the opposing
899 relationship, and contains it's data in the same manner as
900 L</relationship_info>.
904 sub reverse_relationship_info {
905 my ($self, $rel) = @_;
906 my $rel_info = $self->relationship_info($rel);
909 return $ret unless ((ref $rel_info->{cond}) eq 'HASH');
911 my @cond = keys(%{$rel_info->{cond}});
912 my @refkeys = map {/^\w+\.(\w+)$/} @cond;
913 my @keys = map {$rel_info->{cond}->{$_} =~ /^\w+\.(\w+)$/} @cond;
915 # Get the related result source for this relationship
916 my $othertable = $self->related_source($rel);
918 # Get all the relationships for that source that related to this source
919 # whose foreign column set are our self columns on $rel and whose self
920 # columns are our foreign columns on $rel.
921 my @otherrels = $othertable->relationships();
922 my $otherrelationship;
923 foreach my $otherrel (@otherrels) {
924 my $otherrel_info = $othertable->relationship_info($otherrel);
926 my $back = $othertable->related_source($otherrel);
927 next unless $back->source_name eq $self->source_name;
931 if (ref $otherrel_info->{cond} eq 'HASH') {
932 @othertestconds = ($otherrel_info->{cond});
934 elsif (ref $otherrel_info->{cond} eq 'ARRAY') {
935 @othertestconds = @{$otherrel_info->{cond}};
941 foreach my $othercond (@othertestconds) {
942 my @other_cond = keys(%$othercond);
943 my @other_refkeys = map {/^\w+\.(\w+)$/} @other_cond;
944 my @other_keys = map {$othercond->{$_} =~ /^\w+\.(\w+)$/} @other_cond;
945 next if (!$self->compare_relationship_keys(\@refkeys, \@other_keys) ||
946 !$self->compare_relationship_keys(\@other_refkeys, \@keys));
947 $ret->{$otherrel} = $otherrel_info;
953 =head2 compare_relationship_keys
957 =item Arguments: \@keys1, \@keys2
959 =item Return value: 1/0 (true/false)
963 Returns true if both sets of keynames are the same, false otherwise.
967 sub compare_relationship_keys {
968 my ($self, $keys1, $keys2) = @_;
970 # Make sure every keys1 is in keys2
972 foreach my $key (@$keys1) {
974 foreach my $prim (@$keys2) {
983 # Make sure every key2 is in key1
985 foreach my $prim (@$keys2) {
987 foreach my $key (@$keys1) {
1000 =head2 sqlt_deploy_hook
1004 =item Arguments: $source, $sqlt_table
1006 =item Return value: undefined
1010 This is NOT a method of C<ResultSource>.
1012 An optional sub which you can declare in your own Result class that will get
1013 passed the L<SQL::Translator::Schema::Table> object when you deploy the schema
1014 via L</create_ddl_dir> or L</deploy>.
1016 This is useful to make L<SQL::Translator> create non-unique indexes,
1017 or set table options such as C<Engine=INNOFB>.
1019 For an example of what you can do with this, see
1020 L<DBIx::Class::Manual::Cookbook/Adding Indexes And Functions To Your SQL>.
1026 =item Arguments: $relation
1028 =item Return value: Join condition arrayref
1032 Returns the join structure required for the related result source.
1037 my ($self, $join, $alias, $seen, $force_left) = @_;
1039 $force_left ||= { force => 0 };
1040 if (ref $join eq 'ARRAY') {
1041 return map { $self->resolve_join($_, $alias, $seen) } @$join;
1042 } elsif (ref $join eq 'HASH') {
1045 my $as = ($seen->{$_} ? $_.'_'.($seen->{$_}+1) : $_);
1046 local $force_left->{force};
1048 $self->resolve_join($_, $alias, $seen, $force_left),
1049 $self->related_source($_)->resolve_join(
1050 $join->{$_}, $as, $seen, $force_left
1054 } elsif (ref $join) {
1055 $self->throw_exception("No idea how to resolve join reftype ".ref $join);
1057 my $count = ++$seen->{$join};
1058 #use Data::Dumper; warn Dumper($seen);
1059 my $as = ($count > 1 ? "${join}_${count}" : $join);
1060 my $rel_info = $self->relationship_info($join);
1061 $self->throw_exception("No such relationship ${join}") unless $rel_info;
1063 if ($force_left->{force}) {
1066 $type = $rel_info->{attrs}{join_type} || '';
1067 $force_left->{force} = 1 if lc($type) eq 'left';
1069 return [ { $as => $self->related_source($join)->from,
1070 -join_type => $type },
1071 $self->resolve_condition($rel_info->{cond}, $as, $alias) ];
1075 =head2 pk_depends_on
1079 =item Arguments: $relname, $rel_data
1081 =item Return value: 1/0 (true/false)
1085 Determines whether a relation is dependent on an object from this source
1086 having already been inserted. Takes the name of the relationship and a
1087 hashref of columns of the related object.
1092 my ($self, $relname, $rel_data) = @_;
1093 my $cond = $self->relationship_info($relname)->{cond};
1095 return 0 unless ref($cond) eq 'HASH';
1097 # map { foreign.foo => 'self.bar' } to { bar => 'foo' }
1099 my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond };
1101 # assume anything that references our PK probably is dependent on us
1102 # rather than vice versa, unless the far side is (a) defined or (b)
1105 my $rel_source = $self->related_source($relname);
1107 foreach my $p ($self->primary_columns) {
1108 if (exists $keyhash->{$p}) {
1109 unless (defined($rel_data->{$keyhash->{$p}})
1110 || $rel_source->column_info($keyhash->{$p})
1111 ->{is_auto_increment}) {
1120 =head2 resolve_condition
1124 =item Arguments: $cond, $as, $alias|$object
1128 Resolves the passed condition to a concrete query fragment. If given an alias,
1129 returns a join condition; if given an object, inverts that object to produce
1130 a related conditional from that object.
1134 our $UNRESOLVABLE_CONDITION = \'1 = 0';
1136 sub resolve_condition {
1137 my ($self, $cond, $as, $for) = @_;
1139 if (ref $cond eq 'HASH') {
1141 foreach my $k (keys %{$cond}) {
1142 my $v = $cond->{$k};
1143 # XXX should probably check these are valid columns
1144 $k =~ s/^foreign\.// ||
1145 $self->throw_exception("Invalid rel cond key ${k}");
1146 $v =~ s/^self\.// ||
1147 $self->throw_exception("Invalid rel cond val ${v}");
1148 if (ref $for) { # Object
1149 #warn "$self $k $for $v";
1150 unless ($for->has_column_loaded($v)) {
1151 if ($for->in_storage) {
1152 $self->throw_exception("Column ${v} not loaded on ${for} trying to resolve relationship");
1154 return $UNRESOLVABLE_CONDITION;
1156 $ret{$k} = $for->get_column($v);
1157 #$ret{$k} = $for->get_column($v) if $for->has_column_loaded($v);
1159 } elsif (!defined $for) { # undef, i.e. "no object"
1161 } elsif (ref $as eq 'HASH') { # reverse hashref
1162 $ret{$v} = $as->{$k};
1163 } elsif (ref $as) { # reverse object
1164 $ret{$v} = $as->get_column($k);
1165 } elsif (!defined $as) { # undef, i.e. "no reverse object"
1168 $ret{"${as}.${k}"} = "${for}.${v}";
1172 } elsif (ref $cond eq 'ARRAY') {
1173 return [ map { $self->resolve_condition($_, $as, $for) } @$cond ];
1175 die("Can't handle this yet :(");
1179 =head2 resolve_prefetch
1183 =item Arguments: hashref/arrayref/scalar
1187 Accepts one or more relationships for the current source and returns an
1188 array of column names for each of those relationships. Column names are
1189 prefixed relative to the current source, in accordance with where they appear
1190 in the supplied relationships. Examples:
1192 my $source = $schema->resultset('Tag')->source;
1193 @columns = $source->resolve_prefetch( { cd => 'artist' } );
1201 # 'cd.artist.artistid',
1205 @columns = $source->resolve_prefetch( qw[/ cd /] );
1215 $source = $schema->resultset('CD')->source;
1216 @columns = $source->resolve_prefetch( qw[/ artist producer /] );
1220 # 'artist.artistid',
1222 # 'producer.producerid',
1228 sub resolve_prefetch {
1229 my ($self, $pre, $alias, $seen, $order, $collapse) = @_;
1231 #$alias ||= $self->name;
1232 #warn $alias, Dumper $pre;
1233 if( ref $pre eq 'ARRAY' ) {
1235 map { $self->resolve_prefetch( $_, $alias, $seen, $order, $collapse ) }
1238 elsif( ref $pre eq 'HASH' ) {
1241 $self->resolve_prefetch($_, $alias, $seen, $order, $collapse),
1242 $self->related_source($_)->resolve_prefetch(
1243 $pre->{$_}, "${alias}.$_", $seen, $order, $collapse)
1249 $self->throw_exception(
1250 "don't know how to resolve prefetch reftype ".ref($pre));
1253 my $count = ++$seen->{$pre};
1254 my $as = ($count > 1 ? "${pre}_${count}" : $pre);
1255 my $rel_info = $self->relationship_info( $pre );
1256 $self->throw_exception( $self->name . " has no such relationship '$pre'" )
1258 my $as_prefix = ($alias =~ /^.*?\.(.+)$/ ? $1.'.' : '');
1259 my $rel_source = $self->related_source($pre);
1261 if (exists $rel_info->{attrs}{accessor}
1262 && $rel_info->{attrs}{accessor} eq 'multi') {
1263 $self->throw_exception(
1264 "Can't prefetch has_many ${pre} (join cond too complex)")
1265 unless ref($rel_info->{cond}) eq 'HASH';
1266 my $dots = @{[$as_prefix =~ m/\./g]} + 1; # +1 to match the ".${as_prefix}"
1267 if (my ($fail) = grep { @{[$_ =~ m/\./g]} == $dots }
1268 keys %{$collapse}) {
1269 my ($last) = ($fail =~ /([^\.]+)$/);
1271 "Prefetching multiple has_many rels ${last} and ${pre} "
1272 .(length($as_prefix)
1273 ? "at the same level (${as_prefix}) "
1276 . 'will currently disrupt both the functionality of $rs->count(), '
1277 . 'and the amount of objects retrievable via $rs->next(). '
1278 . 'Use at your own risk.'
1281 #my @col = map { (/^self\.(.+)$/ ? ("${as_prefix}.$1") : ()); }
1282 # values %{$rel_info->{cond}};
1283 $collapse->{".${as_prefix}${pre}"} = [ $rel_source->primary_columns ];
1284 # action at a distance. prepending the '.' allows simpler code
1285 # in ResultSet->_collapse_result
1286 my @key = map { (/^foreign\.(.+)$/ ? ($1) : ()); }
1287 keys %{$rel_info->{cond}};
1288 my @ord = (ref($rel_info->{attrs}{order_by}) eq 'ARRAY'
1289 ? @{$rel_info->{attrs}{order_by}}
1290 : (defined $rel_info->{attrs}{order_by}
1291 ? ($rel_info->{attrs}{order_by})
1293 push(@$order, map { "${as}.$_" } (@key, @ord));
1296 return map { [ "${as}.$_", "${as_prefix}${pre}.$_", ] }
1297 $rel_source->columns;
1298 #warn $alias, Dumper (\@ret);
1303 =head2 related_source
1307 =item Arguments: $relname
1309 =item Return value: $source
1313 Returns the result source object for the given relationship.
1317 sub related_source {
1318 my ($self, $rel) = @_;
1319 if( !$self->has_relationship( $rel ) ) {
1320 $self->throw_exception("No such relationship '$rel'");
1322 return $self->schema->source($self->relationship_info($rel)->{source});
1325 =head2 related_class
1329 =item Arguments: $relname
1331 =item Return value: $classname
1335 Returns the class name for objects in the given relationship.
1340 my ($self, $rel) = @_;
1341 if( !$self->has_relationship( $rel ) ) {
1342 $self->throw_exception("No such relationship '$rel'");
1344 return $self->schema->class($self->relationship_info($rel)->{source});
1349 Obtain a new handle to this source. Returns an instance of a
1350 L<DBIx::Class::ResultSourceHandle>.
1355 return new DBIx::Class::ResultSourceHandle({
1356 schema => $_[0]->schema,
1357 source_moniker => $_[0]->source_name
1361 =head2 throw_exception
1363 See L<DBIx::Class::Schema/"throw_exception">.
1367 sub throw_exception {
1369 if (defined $self->schema) {
1370 $self->schema->throw_exception(@_);
1378 Stores a hashref of per-source metadata. No specific key names
1379 have yet been standardized, the examples below are purely hypothetical
1380 and don't actually accomplish anything on their own:
1382 __PACKAGE__->source_info({
1383 "_tablespace" => 'fast_disk_array_3',
1384 "_engine" => 'InnoDB',
1391 $class->new({attribute_name => value});
1393 Creates a new ResultSource object. Not normally called directly by end users.
1397 =head2 column_info_from_storage
1401 =item Arguments: 1/0 (default: 0)
1403 =item Return value: 1/0
1407 Enables the on-demand automatic loading of the above column
1408 metadata from storage as neccesary. This is *deprecated*, and
1409 should not be used. It will be removed before 1.0.
1411 __PACKAGE__->column_info_from_storage(1);
1415 Matt S. Trout <mst@shadowcatsystems.co.uk>
1419 You may distribute this code under the same terms as Perl itself.