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
16 source_name sqlt_deploy_callback/);
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>)
32 Basic view support also exists, see L<<DBIx::Class::ResultSource::View>.
41 my ($class, $attrs) = @_;
42 $class = ref $class if ref $class;
44 my $new = bless { %{$attrs || {}} }, $class;
45 $new->{resultset_class} ||= 'DBIx::Class::ResultSet';
46 $new->{resultset_attributes} = { %{$new->{resultset_attributes} || {}} };
47 $new->{_ordered_columns} = [ @{$new->{_ordered_columns}||[]}];
48 $new->{_columns} = { %{$new->{_columns}||{}} };
49 $new->{_relationships} = { %{$new->{_relationships}||{}} };
50 $new->{name} ||= "!!NAME NOT SET!!";
51 $new->{_columns_info_loaded} ||= 0;
52 $new->{sqlt_deploy_callback} ||= "default_sqlt_deploy_hook";
62 =item Arguments: @columns
64 =item Return value: The ResultSource object
68 $source->add_columns(qw/col1 col2 col3/);
70 $source->add_columns('col1' => \%col1_info, 'col2' => \%col2_info, ...);
72 Adds columns to the result source. If supplied key => hashref pairs, uses
73 the hashref as the column_info for that column. Repeated calls of this
74 method will add more columns, not replace them.
76 The column names given will be created as accessor methods on your
77 L<DBIx::Class::Row> objects. You can change the name of the accessor
78 by supplying an L</accessor> in the column_info hash.
80 The contents of the column_info are not set in stone. The following
81 keys are currently recognised/used by DBIx::Class:
87 Use this to set the name of the accessor method for this column. If unset,
88 the name of the column will be used.
92 This contains the column type. It is automatically filled by the
93 L<SQL::Translator::Producer::DBIx::Class::File> producer, and the
94 L<DBIx::Class::Schema::Loader> module. If you do not enter a
95 data_type, DBIx::Class will attempt to retrieve it from the
96 database for you, using L<DBI>'s column_info method. The values of this
97 key are typically upper-cased.
99 Currently there is no standard set of values for the data_type. Use
100 whatever your database supports.
104 The length of your column, if it is a column type that can have a size
105 restriction. This is currently only used by L<DBIx::Class::Schema/deploy>.
109 Set this to a true value for a columns that is allowed to contain
110 NULL values. This is currently only used by L<DBIx::Class::Schema/deploy>.
112 =item is_auto_increment
114 Set this to a true value for a column whose value is somehow
115 automatically set. This is used to determine which columns to empty
116 when cloning objects using L<DBIx::Class::Row/copy>. It is also used by
117 L<DBIx::Class::Schema/deploy>.
121 Set this to a true or false value (not C<undef>) to explicitly specify
122 if this column contains numeric data. This controls how set_column
123 decides whether to consider a column dirty after an update: if
124 C<is_numeric> is true a numeric comparison C<< != >> will take place
125 instead of the usual C<eq>
127 If not specified the storage class will attempt to figure this out on
128 first access to the column, based on the column C<data_type>. The
129 result will be cached in this attribute.
133 Set this to a true value for a column that contains a key from a
134 foreign table. This is currently only used by
135 L<DBIx::Class::Schema/deploy>.
139 Set this to the default value which will be inserted into a column
140 by the database. Can contain either a value or a function (use a
141 reference to a scalar e.g. C<\'now()'> if you want a function). This
142 is currently only used by L<DBIx::Class::Schema/deploy>.
144 See the note on L<DBIx::Class::Row/new> for more information about possible
145 issues related to db-side default values.
149 Set this on a primary key column to the name of the sequence used to
150 generate a new key value. If not specified, L<DBIx::Class::PK::Auto>
151 will attempt to retrieve the name of the sequence from the database
156 Set this to a true value for a column whose value is retrieved
157 automatically from an oracle sequence. If you do not use an Oracle
158 trigger to get the nextval, you have to set sequence as well.
162 This is used by L<DBIx::Class::Schema/deploy> and L<SQL::Translator>
163 to add extra non-generic data to the column. For example: C<< extra
164 => { unsigned => 1} >> is used by the MySQL producer to set an integer
165 column to unsigned. For more details, see
166 L<SQL::Translator::Producer::MySQL>.
174 =item Arguments: $colname, [ \%columninfo ]
176 =item Return value: 1/0 (true/false)
180 $source->add_column('col' => \%info?);
182 Add a single column and optional column info. Uses the same column
183 info keys as L</add_columns>.
188 my ($self, @cols) = @_;
189 $self->_ordered_columns(\@cols) unless $self->_ordered_columns;
192 my $columns = $self->_columns;
193 while (my $col = shift @cols) {
194 # If next entry is { ... } use that for the column info, if not
195 # use an empty hashref
196 my $column_info = ref $cols[0] ? shift(@cols) : {};
197 push(@added, $col) unless exists $columns->{$col};
198 $columns->{$col} = $column_info;
200 push @{ $self->_ordered_columns }, @added;
204 sub add_column { shift->add_columns(@_); } # DO NOT CHANGE THIS TO GLOB
210 =item Arguments: $colname
212 =item Return value: 1/0 (true/false)
216 if ($source->has_column($colname)) { ... }
218 Returns true if the source has a column of this name, false otherwise.
223 my ($self, $column) = @_;
224 return exists $self->_columns->{$column};
231 =item Arguments: $colname
233 =item Return value: Hashref of info
237 my $info = $source->column_info($col);
239 Returns the column metadata hashref for a column, as originally passed
240 to L</add_columns>. See the description of L</add_columns> for information
241 on the contents of the hashref.
246 my ($self, $column) = @_;
247 $self->throw_exception("No such column $column")
248 unless exists $self->_columns->{$column};
249 #warn $self->{_columns_info_loaded}, "\n";
250 if ( ! $self->_columns->{$column}{data_type}
251 and $self->column_info_from_storage
252 and ! $self->{_columns_info_loaded}
253 and $self->schema and $self->storage )
255 $self->{_columns_info_loaded}++;
258 # eval for the case of storage without table
259 eval { $info = $self->storage->columns_info_for( $self->from ) };
261 for my $realcol ( keys %{$info} ) {
262 $lc_info->{lc $realcol} = $info->{$realcol};
264 foreach my $col ( keys %{$self->_columns} ) {
265 $self->_columns->{$col} = {
266 %{ $self->_columns->{$col} },
267 %{ $info->{$col} || $lc_info->{lc $col} || {} }
272 return $self->_columns->{$column};
279 =item Arguments: None
281 =item Return value: Ordered list of column names
285 my @column_names = $source->columns;
287 Returns all column names in the order they were declared to L</add_columns>.
293 $self->throw_exception(
294 "columns() is a read-only accessor, did you mean add_columns()?"
296 return @{$self->{_ordered_columns}||[]};
299 =head2 remove_columns
303 =item Arguments: @colnames
305 =item Return value: undefined
309 $source->remove_columns(qw/col1 col2 col3/);
311 Removes the given list of columns by name, from the result source.
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.
321 =item Arguments: $colname
323 =item Return value: undefined
327 $source->remove_column('col');
329 Remove a single column by name from the result source, similar to
332 B<Warning>: Removing a column that is also used in the sources primary
333 key, or in one of the sources unique constraints, B<will> result in a
334 broken result source.
339 my ($self, @to_remove) = @_;
341 my $columns = $self->_columns
346 delete $columns->{$_};
350 $self->_ordered_columns([ grep { not $to_remove{$_} } @{$self->_ordered_columns} ]);
353 sub remove_column { shift->remove_columns(@_); } # DO NOT CHANGE THIS TO GLOB
355 =head2 set_primary_key
359 =item Arguments: @cols
361 =item Return value: undefined
365 Defines one or more columns as primary key for this source. Should be
366 called after L</add_columns>.
368 Additionally, defines a L<unique constraint|add_unique_constraint>
371 The primary key columns are used by L<DBIx::Class::PK::Auto> to
372 retrieve automatically created values from the database.
376 sub set_primary_key {
377 my ($self, @cols) = @_;
378 # check if primary key columns are valid columns
379 foreach my $col (@cols) {
380 $self->throw_exception("No such column $col on table " . $self->name)
381 unless $self->has_column($col);
383 $self->_primaries(\@cols);
385 $self->add_unique_constraint(primary => \@cols);
388 =head2 primary_columns
392 =item Arguments: None
394 =item Return value: Ordered list of primary column names
398 Read-only accessor which returns the list of primary keys, supplied by
403 sub primary_columns {
404 return @{shift->_primaries||[]};
407 =head2 add_unique_constraint
411 =item Arguments: [ $name ], \@colnames
413 =item Return value: undefined
417 Declare a unique constraint on this source. Call once for each unique
420 # For UNIQUE (column1, column2)
421 __PACKAGE__->add_unique_constraint(
422 constraint_name => [ qw/column1 column2/ ],
425 Alternatively, you can specify only the columns:
427 __PACKAGE__->add_unique_constraint([ qw/column1 column2/ ]);
429 This will result in a unique constraint named C<table_column1_column2>, where
430 C<table> is replaced with the table name.
432 Unique constraints are used, for example, when you call
433 L<DBIx::Class::ResultSet/find>. Only columns in the constraint are searched.
435 Throws an error if any of the given column names do not yet exist on
440 sub add_unique_constraint {
445 $name ||= $self->name_unique_constraint($cols);
447 foreach my $col (@$cols) {
448 $self->throw_exception("No such column $col on table " . $self->name)
449 unless $self->has_column($col);
452 my %unique_constraints = $self->unique_constraints;
453 $unique_constraints{$name} = $cols;
454 $self->_unique_constraints(\%unique_constraints);
457 =head2 name_unique_constraint
461 =item Arguments: @colnames
463 =item Return value: Constraint name
467 $source->table('mytable');
468 $source->name_unique_constraint('col1', 'col2');
472 Return a name for a unique constraint containing the specified
473 columns. The name is created by joining the table name and each column
474 name, using an underscore character.
476 For example, a constraint on a table named C<cd> containing the columns
477 C<artist> and C<title> would result in a constraint name of C<cd_artist_title>.
479 This is used by L</add_unique_constraint> if you do not specify the
480 optional constraint name.
484 sub name_unique_constraint {
485 my ($self, $cols) = @_;
487 my $name = $self->name;
488 $name = $$name if ref $name;
490 return join '_', $name, @$cols;
493 =head2 unique_constraints
497 =item Arguments: None
499 =item Return value: Hash of unique constraint data
503 $source->unique_constraints();
505 Read-only accessor which returns a hash of unique constraints on this source.
507 The hash is keyed by constraint name, and contains an arrayref of
508 column names as values.
512 sub unique_constraints {
513 return %{shift->_unique_constraints||{}};
516 =head2 unique_constraint_names
520 =item Arguments: None
522 =item Return value: Unique constraint names
526 $source->unique_constraint_names();
528 Returns the list of unique constraint names defined on this source.
532 sub unique_constraint_names {
535 my %unique_constraints = $self->unique_constraints;
537 return keys %unique_constraints;
540 =head2 unique_constraint_columns
544 =item Arguments: $constraintname
546 =item Return value: List of constraint columns
550 $source->unique_constraint_columns('myconstraint');
552 Returns the list of columns that make up the specified unique constraint.
556 sub unique_constraint_columns {
557 my ($self, $constraint_name) = @_;
559 my %unique_constraints = $self->unique_constraints;
561 $self->throw_exception(
562 "Unknown unique constraint $constraint_name on '" . $self->name . "'"
563 ) unless exists $unique_constraints{$constraint_name};
565 return @{ $unique_constraints{$constraint_name} };
568 =head2 sqlt_deploy_callback
572 =item Arguments: $callback
576 __PACKAGE__->sqlt_deploy_callback('mycallbackmethod');
578 An accessor to set a callback to be called during deployment of
579 the schema via L<DBIx::Class::Schema/create_ddl_dir> or
580 L<DBIx::Class::Schema/deploy>.
582 The callback can be set as either a code reference or the name of a
583 method in the current result class.
585 If not set, the L</default_sqlt_deploy_hook> is called.
587 Your callback will be passed the $source object representing the
588 ResultSource instance being deployed, and the
589 L<SQL::Translator::Schema::Table> object being created from it. The
590 callback can be used to manipulate the table object or add your own
591 customised indexes. If you need to manipulate a non-table object, use
592 the L<DBIx::Class::Schema/sqlt_deploy_hook>.
594 See L<DBIx::Class::Manual::Cookbook/Adding Indexes And Functions To
595 Your SQL> for examples.
597 This sqlt deployment callback can only be used to manipulate
598 SQL::Translator objects as they get turned into SQL. To execute
599 post-deploy statements which SQL::Translator does not currently
600 handle, override L<DBIx::Class::Schema/deploy> in your Schema class
601 and call L<dbh_do|DBIx::Class::Storage::DBI/dbh_do>.
603 =head2 default_sqlt_deploy_hook
607 =item Arguments: $source, $sqlt_table
609 =item Return value: undefined
613 This is the sensible default for L</sqlt_deploy_callback>.
615 If a method named C<sqlt_deploy_hook> exists in your Result class, it
616 will be called and passed the current C<$source> and the
617 C<$sqlt_table> being deployed.
621 sub default_sqlt_deploy_hook {
624 my $class = $self->result_class;
626 if ($class and $class->can('sqlt_deploy_hook')) {
627 $class->sqlt_deploy_hook(@_);
631 sub _invoke_sqlt_deploy_hook {
633 if ( my $hook = $self->sqlt_deploy_callback) {
642 =item Arguments: None
644 =item Return value: $resultset
648 Returns a resultset for the given source. This will initially be created
651 $self->resultset_class->new($self, $self->resultset_attributes)
653 but is cached from then on unless resultset_class changes.
655 =head2 resultset_class
659 =item Arguments: $classname
661 =item Return value: $classname
665 package My::ResultSetClass;
666 use base 'DBIx::Class::ResultSet';
669 $source->resultset_class('My::ResultSet::Class');
671 Set the class of the resultset. This is useful if you want to create your
672 own resultset methods. Create your own class derived from
673 L<DBIx::Class::ResultSet>, and set it here. If called with no arguments,
674 this method returns the name of the existing resultset class, if one
677 =head2 resultset_attributes
681 =item Arguments: \%attrs
683 =item Return value: \%attrs
687 $source->resultset_attributes({ order_by => [ 'id' ] });
689 Store a collection of resultset attributes, that will be set on every
690 L<DBIx::Class::ResultSet> produced from this result source. For a full
691 list see L<DBIx::Class::ResultSet/ATTRIBUTES>.
697 $self->throw_exception(
698 'resultset does not take any arguments. If you want another resultset, '.
699 'call it on the schema instead.'
702 return $self->resultset_class->new(
705 %{$self->{resultset_attributes}},
706 %{$self->schema->default_resultset_attributes}
715 =item Arguments: $source_name
717 =item Result value: $source_name
721 Set an alternate name for the result source when it is loaded into a schema.
722 This is useful if you want to refer to a result source by a name other than
725 package ArchivedBooks;
726 use base qw/DBIx::Class/;
727 __PACKAGE__->table('books_archive');
728 __PACKAGE__->source_name('Books');
730 # from your schema...
731 $schema->resultset('Books')->find(1);
737 =item Arguments: None
739 =item Return value: FROM clause
743 my $from_clause = $source->from();
745 Returns an expression of the source to be supplied to storage to specify
746 retrieval from this source. In the case of a database, the required FROM
753 =item Arguments: None
755 =item Return value: A schema object
759 my $schema = $source->schema();
761 Returns the L<DBIx::Class::Schema> object that this result source
768 =item Arguments: None
770 =item Return value: A Storage object
774 $source->storage->debug(1);
776 Returns the storage handle for the current schema.
778 See also: L<DBIx::Class::Storage>
782 sub storage { shift->schema->storage; }
784 =head2 add_relationship
788 =item Arguments: $relname, $related_source_name, \%cond, [ \%attrs ]
790 =item Return value: 1/true if it succeeded
794 $source->add_relationship('relname', 'related_source', $cond, $attrs);
796 L<DBIx::Class::Relationship> describes a series of methods which
797 create pre-defined useful types of relationships. Look there first
798 before using this method directly.
800 The relationship name can be arbitrary, but must be unique for each
801 relationship attached to this result source. 'related_source' should
802 be the name with which the related result source was registered with
803 the current schema. For example:
805 $schema->source('Book')->add_relationship('reviews', 'Review', {
806 'foreign.book_id' => 'self.id',
809 The condition C<$cond> needs to be an L<SQL::Abstract>-style
810 representation of the join between the tables. For example, if you're
811 creating a relation from Author to Book,
813 { 'foreign.author_id' => 'self.id' }
815 will result in the JOIN clause
817 author me JOIN book foreign ON foreign.author_id = me.id
819 You can specify as many foreign => self mappings as necessary.
821 Valid attributes are as follows:
827 Explicitly specifies the type of join to use in the relationship. Any
828 SQL join type is valid, e.g. C<LEFT> or C<RIGHT>. It will be placed in
829 the SQL command immediately before C<JOIN>.
833 An arrayref containing a list of accessors in the foreign class to proxy in
834 the main class. If, for example, you do the following:
836 CD->might_have(liner_notes => 'LinerNotes', undef, {
837 proxy => [ qw/notes/ ],
840 Then, assuming LinerNotes has an accessor named notes, you can do:
842 my $cd = CD->find(1);
843 # set notes -- LinerNotes object is created if it doesn't exist
844 $cd->notes('Notes go here');
848 Specifies the type of accessor that should be created for the
849 relationship. Valid values are C<single> (for when there is only a single
850 related object), C<multi> (when there can be many), and C<filter> (for
851 when there is a single related object, but you also want the relationship
852 accessor to double as a column accessor). For C<multi> accessors, an
853 add_to_* method is also created, which calls C<create_related> for the
858 Throws an exception if the condition is improperly supplied, or cannot
863 sub add_relationship {
864 my ($self, $rel, $f_source_name, $cond, $attrs) = @_;
865 $self->throw_exception("Can't create relationship without join condition")
869 # Check foreign and self are right in cond
870 if ( (ref $cond ||'') eq 'HASH') {
872 $self->throw_exception("Keys of condition should be of form 'foreign.col', not '$_'")
873 if /\./ && !/^foreign\./;
877 my %rels = %{ $self->_relationships };
878 $rels{$rel} = { class => $f_source_name,
879 source => $f_source_name,
882 $self->_relationships(\%rels);
886 # XXX disabled. doesn't work properly currently. skip in tests.
888 my $f_source = $self->schema->source($f_source_name);
890 $self->ensure_class_loaded($f_source_name);
891 $f_source = $f_source_name->result_source;
892 #my $s_class = ref($self->schema);
893 #$f_source_name =~ m/^${s_class}::(.*)$/;
894 #$self->schema->register_class(($1 || $f_source_name), $f_source_name);
895 #$f_source = $self->schema->source($f_source_name);
897 return unless $f_source; # Can't test rel without f_source
899 eval { $self->_resolve_join($rel, 'me') };
901 if ($@) { # If the resolve failed, back out and re-throw the error
902 delete $rels{$rel}; #
903 $self->_relationships(\%rels);
904 $self->throw_exception("Error creating relationship $rel: $@");
913 =item Arguments: None
915 =item Return value: List of relationship names
919 my @relnames = $source->relationships();
921 Returns all relationship names for this source.
926 return keys %{shift->_relationships};
929 =head2 relationship_info
933 =item Arguments: $relname
935 =item Return value: Hashref of relation data,
939 Returns a hash of relationship information for the specified relationship
940 name. The keys/values are as specified for L</add_relationship>.
944 sub relationship_info {
945 my ($self, $rel) = @_;
946 return $self->_relationships->{$rel};
949 =head2 has_relationship
953 =item Arguments: $rel
955 =item Return value: 1/0 (true/false)
959 Returns true if the source has a relationship of this name, false otherwise.
963 sub has_relationship {
964 my ($self, $rel) = @_;
965 return exists $self->_relationships->{$rel};
968 =head2 reverse_relationship_info
972 =item Arguments: $relname
974 =item Return value: Hashref of relationship data
978 Looks through all the relationships on the source this relationship
979 points to, looking for one whose condition is the reverse of the
980 condition on this relationship.
982 A common use of this is to find the name of the C<belongs_to> relation
983 opposing a C<has_many> relation. For definition of these look in
984 L<DBIx::Class::Relationship>.
986 The returned hashref is keyed by the name of the opposing
987 relationship, and contains it's data in the same manner as
988 L</relationship_info>.
992 sub reverse_relationship_info {
993 my ($self, $rel) = @_;
994 my $rel_info = $self->relationship_info($rel);
997 return $ret unless ((ref $rel_info->{cond}) eq 'HASH');
999 my @cond = keys(%{$rel_info->{cond}});
1000 my @refkeys = map {/^\w+\.(\w+)$/} @cond;
1001 my @keys = map {$rel_info->{cond}->{$_} =~ /^\w+\.(\w+)$/} @cond;
1003 # Get the related result source for this relationship
1004 my $othertable = $self->related_source($rel);
1006 # Get all the relationships for that source that related to this source
1007 # whose foreign column set are our self columns on $rel and whose self
1008 # columns are our foreign columns on $rel.
1009 my @otherrels = $othertable->relationships();
1010 my $otherrelationship;
1011 foreach my $otherrel (@otherrels) {
1012 my $otherrel_info = $othertable->relationship_info($otherrel);
1014 my $back = $othertable->related_source($otherrel);
1015 next unless $back->source_name eq $self->source_name;
1019 if (ref $otherrel_info->{cond} eq 'HASH') {
1020 @othertestconds = ($otherrel_info->{cond});
1022 elsif (ref $otherrel_info->{cond} eq 'ARRAY') {
1023 @othertestconds = @{$otherrel_info->{cond}};
1029 foreach my $othercond (@othertestconds) {
1030 my @other_cond = keys(%$othercond);
1031 my @other_refkeys = map {/^\w+\.(\w+)$/} @other_cond;
1032 my @other_keys = map {$othercond->{$_} =~ /^\w+\.(\w+)$/} @other_cond;
1033 next if (!$self->_compare_relationship_keys(\@refkeys, \@other_keys) ||
1034 !$self->_compare_relationship_keys(\@other_refkeys, \@keys));
1035 $ret->{$otherrel} = $otherrel_info;
1041 sub compare_relationship_keys {
1042 carp 'compare_relationship_keys is a private method, stop calling it';
1044 $self->_compare_relationship_keys (@_);
1047 # Returns true if both sets of keynames are the same, false otherwise.
1048 sub _compare_relationship_keys {
1049 my ($self, $keys1, $keys2) = @_;
1051 # Make sure every keys1 is in keys2
1053 foreach my $key (@$keys1) {
1055 foreach my $prim (@$keys2) {
1056 if ($prim eq $key) {
1064 # Make sure every key2 is in key1
1066 foreach my $prim (@$keys2) {
1068 foreach my $key (@$keys1) {
1069 if ($prim eq $key) {
1082 carp 'resolve_join is a private method, stop calling it';
1084 $self->_resolve_join (@_);
1087 # Returns the {from} structure used to express JOIN conditions
1089 my ($self, $join, $alias, $seen, $jpath, $force_left) = @_;
1091 # we need a supplied one, because we do in-place modifications, no returns
1092 $self->throw_exception ('You must supply a seen hashref as the 3rd argument to _resolve_join')
1095 # This isn't quite right, we should actually dive into $seen and reconstruct
1096 # the entire path (the reference entry point would be the join conditional
1097 # with depth == current_depth - 1. At this point however nothing depends on
1098 # having the entire path, transcending related_resultset, so just leave it
1099 # as is, hairy enough already.
1102 if (ref $join eq 'ARRAY') {
1105 $self->_resolve_join($_, $alias, $seen, [@$jpath], $force_left);
1107 } elsif (ref $join eq 'HASH') {
1110 my $as = ($seen->{$_} ? join ('_', $_, $seen->{$_} + 1) : $_); # the actual seen value will be incremented below
1111 local $force_left->{force} = $force_left->{force};
1113 $self->_resolve_join($_, $alias, $seen, [@$jpath], $force_left),
1114 $self->related_source($_)->_resolve_join(
1115 $join->{$_}, $as, $seen, [@$jpath, $_], $force_left
1119 } elsif (ref $join) {
1120 $self->throw_exception("No idea how to resolve join reftype ".ref $join);
1123 my $count = ++$seen->{$join};
1124 my $as = ($count > 1 ? "${join}_${count}" : $join);
1126 my $rel_info = $self->relationship_info($join);
1127 $self->throw_exception("No such relationship ${join}") unless $rel_info;
1132 $type = $rel_info->{attrs}{join_type} || '';
1133 $force_left = 1 if lc($type) eq 'left';
1136 my $rel_src = $self->related_source($join);
1137 return [ { $as => $rel_src->from,
1138 -source_handle => $rel_src->handle,
1139 -join_type => $type,
1140 -join_path => [@$jpath, $join],
1142 -relation_chain_depth => $seen->{-relation_chain_depth} || 0,
1144 $self->_resolve_condition($rel_info->{cond}, $as, $alias) ];
1149 carp 'pk_depends_on is a private method, stop calling it';
1151 $self->_pk_depends_on (@_);
1154 # Determines whether a relation is dependent on an object from this source
1155 # having already been inserted. Takes the name of the relationship and a
1156 # hashref of columns of the related object.
1157 sub _pk_depends_on {
1158 my ($self, $relname, $rel_data) = @_;
1159 my $cond = $self->relationship_info($relname)->{cond};
1161 return 0 unless ref($cond) eq 'HASH';
1163 # map { foreign.foo => 'self.bar' } to { bar => 'foo' }
1165 my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond };
1167 # assume anything that references our PK probably is dependent on us
1168 # rather than vice versa, unless the far side is (a) defined or (b)
1171 my $rel_source = $self->related_source($relname);
1173 foreach my $p ($self->primary_columns) {
1174 if (exists $keyhash->{$p}) {
1175 unless (defined($rel_data->{$keyhash->{$p}})
1176 || $rel_source->column_info($keyhash->{$p})
1177 ->{is_auto_increment}) {
1186 sub resolve_condition {
1187 carp 'resolve_condition is a private method, stop calling it';
1189 $self->_resolve_condition (@_);
1192 # Resolves the passed condition to a concrete query fragment. If given an alias,
1193 # returns a join condition; if given an object, inverts that object to produce
1194 # a related conditional from that object.
1195 our $UNRESOLVABLE_CONDITION = \'1 = 0';
1197 sub _resolve_condition {
1198 my ($self, $cond, $as, $for) = @_;
1200 if (ref $cond eq 'HASH') {
1202 foreach my $k (keys %{$cond}) {
1203 my $v = $cond->{$k};
1204 # XXX should probably check these are valid columns
1205 $k =~ s/^foreign\.// ||
1206 $self->throw_exception("Invalid rel cond key ${k}");
1207 $v =~ s/^self\.// ||
1208 $self->throw_exception("Invalid rel cond val ${v}");
1209 if (ref $for) { # Object
1210 #warn "$self $k $for $v";
1211 unless ($for->has_column_loaded($v)) {
1212 if ($for->in_storage) {
1213 $self->throw_exception(
1214 "Column ${v} not loaded or not passed to new() prior to insert()"
1215 ." on ${for} trying to resolve relationship (maybe you forgot "
1216 ."to call ->discard_changes to get defaults from the db)"
1219 return $UNRESOLVABLE_CONDITION;
1221 $ret{$k} = $for->get_column($v);
1222 #$ret{$k} = $for->get_column($v) if $for->has_column_loaded($v);
1224 } elsif (!defined $for) { # undef, i.e. "no object"
1226 } elsif (ref $as eq 'HASH') { # reverse hashref
1227 $ret{$v} = $as->{$k};
1228 } elsif (ref $as) { # reverse object
1229 $ret{$v} = $as->get_column($k);
1230 } elsif (!defined $as) { # undef, i.e. "no reverse object"
1233 $ret{"${as}.${k}"} = "${for}.${v}";
1237 } elsif (ref $cond eq 'ARRAY') {
1238 return [ map { $self->_resolve_condition($_, $as, $for) } @$cond ];
1240 die("Can't handle this yet :(");
1244 # Legacy code, needs to go entirely away (fully replaced by _resolve_prefetch)
1245 sub resolve_prefetch {
1246 carp 'resolve_prefetch is a private method, stop calling it';
1248 my ($self, $pre, $alias, $seen, $order, $collapse) = @_;
1250 if( ref $pre eq 'ARRAY' ) {
1252 map { $self->resolve_prefetch( $_, $alias, $seen, $order, $collapse ) }
1255 elsif( ref $pre eq 'HASH' ) {
1258 $self->resolve_prefetch($_, $alias, $seen, $order, $collapse),
1259 $self->related_source($_)->resolve_prefetch(
1260 $pre->{$_}, "${alias}.$_", $seen, $order, $collapse)
1265 $self->throw_exception(
1266 "don't know how to resolve prefetch reftype ".ref($pre));
1269 my $count = ++$seen->{$pre};
1270 my $as = ($count > 1 ? "${pre}_${count}" : $pre);
1271 my $rel_info = $self->relationship_info( $pre );
1272 $self->throw_exception( $self->name . " has no such relationship '$pre'" )
1274 my $as_prefix = ($alias =~ /^.*?\.(.+)$/ ? $1.'.' : '');
1275 my $rel_source = $self->related_source($pre);
1277 if (exists $rel_info->{attrs}{accessor}
1278 && $rel_info->{attrs}{accessor} eq 'multi') {
1279 $self->throw_exception(
1280 "Can't prefetch has_many ${pre} (join cond too complex)")
1281 unless ref($rel_info->{cond}) eq 'HASH';
1282 my $dots = @{[$as_prefix =~ m/\./g]} + 1; # +1 to match the ".${as_prefix}"
1283 if (my ($fail) = grep { @{[$_ =~ m/\./g]} == $dots }
1284 keys %{$collapse}) {
1285 my ($last) = ($fail =~ /([^\.]+)$/);
1287 "Prefetching multiple has_many rels ${last} and ${pre} "
1288 .(length($as_prefix)
1289 ? "at the same level (${as_prefix}) "
1292 . 'will explode the number of row objects retrievable via ->next or ->all. '
1293 . 'Use at your own risk.'
1296 #my @col = map { (/^self\.(.+)$/ ? ("${as_prefix}.$1") : ()); }
1297 # values %{$rel_info->{cond}};
1298 $collapse->{".${as_prefix}${pre}"} = [ $rel_source->primary_columns ];
1299 # action at a distance. prepending the '.' allows simpler code
1300 # in ResultSet->_collapse_result
1301 my @key = map { (/^foreign\.(.+)$/ ? ($1) : ()); }
1302 keys %{$rel_info->{cond}};
1303 my @ord = (ref($rel_info->{attrs}{order_by}) eq 'ARRAY'
1304 ? @{$rel_info->{attrs}{order_by}}
1305 : (defined $rel_info->{attrs}{order_by}
1306 ? ($rel_info->{attrs}{order_by})
1308 push(@$order, map { "${as}.$_" } (@key, @ord));
1311 return map { [ "${as}.$_", "${as_prefix}${pre}.$_", ] }
1312 $rel_source->columns;
1316 # Accepts one or more relationships for the current source and returns an
1317 # array of column names for each of those relationships. Column names are
1318 # prefixed relative to the current source, in accordance with where they appear
1319 # in the supplied relationships. Needs an alias_map generated by
1320 # $rs->_joinpath_aliases
1322 sub _resolve_prefetch {
1323 my ($self, $pre, $alias, $alias_map, $order, $collapse, $pref_path) = @_;
1326 if( ref $pre eq 'ARRAY' ) {
1328 map { $self->_resolve_prefetch( $_, $alias, $alias_map, $order, $collapse, [ @$pref_path ] ) }
1331 elsif( ref $pre eq 'HASH' ) {
1334 $self->_resolve_prefetch($_, $alias, $alias_map, $order, $collapse, [ @$pref_path ] ),
1335 $self->related_source($_)->_resolve_prefetch(
1336 $pre->{$_}, "${alias}.$_", $alias_map, $order, $collapse, [ @$pref_path, $_] )
1341 $self->throw_exception(
1342 "don't know how to resolve prefetch reftype ".ref($pre));
1347 $p = $p->{$_} for (@$pref_path, $pre);
1349 $self->throw_exception (
1350 "Unable to resolve prefetch $pre - join alias map does not contain an entry for path "
1351 . join (' -> ', @$pref_path, $pre)
1352 ) if (ref $p->{-join_aliases} ne 'ARRAY' or not @{$p->{-join_aliases}} );
1354 my $as = shift @{$p->{-join_aliases}};
1356 my $rel_info = $self->relationship_info( $pre );
1357 $self->throw_exception( $self->name . " has no such relationship '$pre'" )
1359 my $as_prefix = ($alias =~ /^.*?\.(.+)$/ ? $1.'.' : '');
1360 my $rel_source = $self->related_source($pre);
1362 if (exists $rel_info->{attrs}{accessor}
1363 && $rel_info->{attrs}{accessor} eq 'multi') {
1364 $self->throw_exception(
1365 "Can't prefetch has_many ${pre} (join cond too complex)")
1366 unless ref($rel_info->{cond}) eq 'HASH';
1367 my $dots = @{[$as_prefix =~ m/\./g]} + 1; # +1 to match the ".${as_prefix}"
1368 if (my ($fail) = grep { @{[$_ =~ m/\./g]} == $dots }
1369 keys %{$collapse}) {
1370 my ($last) = ($fail =~ /([^\.]+)$/);
1372 "Prefetching multiple has_many rels ${last} and ${pre} "
1373 .(length($as_prefix)
1374 ? "at the same level (${as_prefix}) "
1377 . 'will explode the number of row objects retrievable via ->next or ->all. '
1378 . 'Use at your own risk.'
1381 #my @col = map { (/^self\.(.+)$/ ? ("${as_prefix}.$1") : ()); }
1382 # values %{$rel_info->{cond}};
1383 $collapse->{".${as_prefix}${pre}"} = [ $rel_source->primary_columns ];
1384 # action at a distance. prepending the '.' allows simpler code
1385 # in ResultSet->_collapse_result
1386 my @key = map { (/^foreign\.(.+)$/ ? ($1) : ()); }
1387 keys %{$rel_info->{cond}};
1388 my @ord = (ref($rel_info->{attrs}{order_by}) eq 'ARRAY'
1389 ? @{$rel_info->{attrs}{order_by}}
1390 : (defined $rel_info->{attrs}{order_by}
1391 ? ($rel_info->{attrs}{order_by})
1393 push(@$order, map { "${as}.$_" } (@key, @ord));
1396 return map { [ "${as}.$_", "${as_prefix}${pre}.$_", ] }
1397 $rel_source->columns;
1401 =head2 related_source
1405 =item Arguments: $relname
1407 =item Return value: $source
1411 Returns the result source object for the given relationship.
1415 sub related_source {
1416 my ($self, $rel) = @_;
1417 if( !$self->has_relationship( $rel ) ) {
1418 $self->throw_exception("No such relationship '$rel'");
1420 return $self->schema->source($self->relationship_info($rel)->{source});
1423 =head2 related_class
1427 =item Arguments: $relname
1429 =item Return value: $classname
1433 Returns the class name for objects in the given relationship.
1438 my ($self, $rel) = @_;
1439 if( !$self->has_relationship( $rel ) ) {
1440 $self->throw_exception("No such relationship '$rel'");
1442 return $self->schema->class($self->relationship_info($rel)->{source});
1447 Obtain a new handle to this source. Returns an instance of a
1448 L<DBIx::Class::ResultSourceHandle>.
1453 return new DBIx::Class::ResultSourceHandle({
1454 schema => $_[0]->schema,
1455 source_moniker => $_[0]->source_name
1459 =head2 throw_exception
1461 See L<DBIx::Class::Schema/"throw_exception">.
1465 sub throw_exception {
1467 if (defined $self->schema) {
1468 $self->schema->throw_exception(@_);
1476 Stores a hashref of per-source metadata. No specific key names
1477 have yet been standardized, the examples below are purely hypothetical
1478 and don't actually accomplish anything on their own:
1480 __PACKAGE__->source_info({
1481 "_tablespace" => 'fast_disk_array_3',
1482 "_engine" => 'InnoDB',
1489 $class->new({attribute_name => value});
1491 Creates a new ResultSource object. Not normally called directly by end users.
1493 =head2 column_info_from_storage
1497 =item Arguments: 1/0 (default: 0)
1499 =item Return value: 1/0
1503 __PACKAGE__->column_info_from_storage(1);
1505 Enables the on-demand automatic loading of the above column
1506 metadata from storage as neccesary. This is *deprecated*, and
1507 should not be used. It will be removed before 1.0.
1512 Matt S. Trout <mst@shadowcatsystems.co.uk>
1516 You may distribute this code under the same terms as Perl itself.