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 automatically
157 from a sequence or function (if supported by your Storage driver.) For a
158 sequence, if you do not use a trigger to get the nextval, you have to set the
159 L</sequence> value as well.
161 Also set this for MSSQL columns with the 'uniqueidentifier'
162 L<DBIx::Class::ResultSource/data_type> whose values you want to automatically
163 generate using C<NEWID()>, unless they are a primary key in which case this will
168 This is used by L<DBIx::Class::Schema/deploy> and L<SQL::Translator>
169 to add extra non-generic data to the column. For example: C<< extra
170 => { unsigned => 1} >> is used by the MySQL producer to set an integer
171 column to unsigned. For more details, see
172 L<SQL::Translator::Producer::MySQL>.
180 =item Arguments: $colname, [ \%columninfo ]
182 =item Return value: 1/0 (true/false)
186 $source->add_column('col' => \%info?);
188 Add a single column and optional column info. Uses the same column
189 info keys as L</add_columns>.
194 my ($self, @cols) = @_;
195 $self->_ordered_columns(\@cols) unless $self->_ordered_columns;
198 my $columns = $self->_columns;
199 while (my $col = shift @cols) {
200 # If next entry is { ... } use that for the column info, if not
201 # use an empty hashref
202 my $column_info = ref $cols[0] ? shift(@cols) : {};
203 push(@added, $col) unless exists $columns->{$col};
204 $columns->{$col} = $column_info;
206 push @{ $self->_ordered_columns }, @added;
210 sub add_column { shift->add_columns(@_); } # DO NOT CHANGE THIS TO GLOB
216 =item Arguments: $colname
218 =item Return value: 1/0 (true/false)
222 if ($source->has_column($colname)) { ... }
224 Returns true if the source has a column of this name, false otherwise.
229 my ($self, $column) = @_;
230 return exists $self->_columns->{$column};
237 =item Arguments: $colname
239 =item Return value: Hashref of info
243 my $info = $source->column_info($col);
245 Returns the column metadata hashref for a column, as originally passed
246 to L</add_columns>. See the description of L</add_columns> for information
247 on the contents of the hashref.
252 my ($self, $column) = @_;
253 $self->throw_exception("No such column $column")
254 unless exists $self->_columns->{$column};
255 #warn $self->{_columns_info_loaded}, "\n";
256 if ( ! $self->_columns->{$column}{data_type}
257 and $self->column_info_from_storage
258 and ! $self->{_columns_info_loaded}
259 and $self->schema and $self->storage )
261 $self->{_columns_info_loaded}++;
264 # eval for the case of storage without table
265 eval { $info = $self->storage->columns_info_for( $self->from ) };
267 for my $realcol ( keys %{$info} ) {
268 $lc_info->{lc $realcol} = $info->{$realcol};
270 foreach my $col ( keys %{$self->_columns} ) {
271 $self->_columns->{$col} = {
272 %{ $self->_columns->{$col} },
273 %{ $info->{$col} || $lc_info->{lc $col} || {} }
278 return $self->_columns->{$column};
285 =item Arguments: None
287 =item Return value: Ordered list of column names
291 my @column_names = $source->columns;
293 Returns all column names in the order they were declared to L</add_columns>.
299 $self->throw_exception(
300 "columns() is a read-only accessor, did you mean add_columns()?"
302 return @{$self->{_ordered_columns}||[]};
305 =head2 remove_columns
309 =item Arguments: @colnames
311 =item Return value: undefined
315 $source->remove_columns(qw/col1 col2 col3/);
317 Removes the given list of columns by name, from the result source.
319 B<Warning>: Removing a column that is also used in the sources primary
320 key, or in one of the sources unique constraints, B<will> result in a
321 broken result source.
327 =item Arguments: $colname
329 =item Return value: undefined
333 $source->remove_column('col');
335 Remove a single column by name from the result source, similar to
338 B<Warning>: Removing a column that is also used in the sources primary
339 key, or in one of the sources unique constraints, B<will> result in a
340 broken result source.
345 my ($self, @to_remove) = @_;
347 my $columns = $self->_columns
352 delete $columns->{$_};
356 $self->_ordered_columns([ grep { not $to_remove{$_} } @{$self->_ordered_columns} ]);
359 sub remove_column { shift->remove_columns(@_); } # DO NOT CHANGE THIS TO GLOB
361 =head2 set_primary_key
365 =item Arguments: @cols
367 =item Return value: undefined
371 Defines one or more columns as primary key for this source. Should be
372 called after L</add_columns>.
374 Additionally, defines a L<unique constraint|add_unique_constraint>
377 The primary key columns are used by L<DBIx::Class::PK::Auto> to
378 retrieve automatically created values from the database.
382 sub set_primary_key {
383 my ($self, @cols) = @_;
384 # check if primary key columns are valid columns
385 foreach my $col (@cols) {
386 $self->throw_exception("No such column $col on table " . $self->name)
387 unless $self->has_column($col);
389 $self->_primaries(\@cols);
391 $self->add_unique_constraint(primary => \@cols);
394 =head2 primary_columns
398 =item Arguments: None
400 =item Return value: Ordered list of primary column names
404 Read-only accessor which returns the list of primary keys, supplied by
409 sub primary_columns {
410 return @{shift->_primaries||[]};
413 =head2 add_unique_constraint
417 =item Arguments: [ $name ], \@colnames
419 =item Return value: undefined
423 Declare a unique constraint on this source. Call once for each unique
426 # For UNIQUE (column1, column2)
427 __PACKAGE__->add_unique_constraint(
428 constraint_name => [ qw/column1 column2/ ],
431 Alternatively, you can specify only the columns:
433 __PACKAGE__->add_unique_constraint([ qw/column1 column2/ ]);
435 This will result in a unique constraint named C<table_column1_column2>, where
436 C<table> is replaced with the table name.
438 Unique constraints are used, for example, when you call
439 L<DBIx::Class::ResultSet/find>. Only columns in the constraint are searched.
441 Throws an error if any of the given column names do not yet exist on
446 sub add_unique_constraint {
451 $name ||= $self->name_unique_constraint($cols);
453 foreach my $col (@$cols) {
454 $self->throw_exception("No such column $col on table " . $self->name)
455 unless $self->has_column($col);
458 my %unique_constraints = $self->unique_constraints;
459 $unique_constraints{$name} = $cols;
460 $self->_unique_constraints(\%unique_constraints);
463 =head2 name_unique_constraint
467 =item Arguments: @colnames
469 =item Return value: Constraint name
473 $source->table('mytable');
474 $source->name_unique_constraint('col1', 'col2');
478 Return a name for a unique constraint containing the specified
479 columns. The name is created by joining the table name and each column
480 name, using an underscore character.
482 For example, a constraint on a table named C<cd> containing the columns
483 C<artist> and C<title> would result in a constraint name of C<cd_artist_title>.
485 This is used by L</add_unique_constraint> if you do not specify the
486 optional constraint name.
490 sub name_unique_constraint {
491 my ($self, $cols) = @_;
493 return join '_', $self->name, @$cols;
496 =head2 unique_constraints
500 =item Arguments: None
502 =item Return value: Hash of unique constraint data
506 $source->unique_constraints();
508 Read-only accessor which returns a hash of unique constraints on this source.
510 The hash is keyed by constraint name, and contains an arrayref of
511 column names as values.
515 sub unique_constraints {
516 return %{shift->_unique_constraints||{}};
519 =head2 unique_constraint_names
523 =item Arguments: None
525 =item Return value: Unique constraint names
529 $source->unique_constraint_names();
531 Returns the list of unique constraint names defined on this source.
535 sub unique_constraint_names {
538 my %unique_constraints = $self->unique_constraints;
540 return keys %unique_constraints;
543 =head2 unique_constraint_columns
547 =item Arguments: $constraintname
549 =item Return value: List of constraint columns
553 $source->unique_constraint_columns('myconstraint');
555 Returns the list of columns that make up the specified unique constraint.
559 sub unique_constraint_columns {
560 my ($self, $constraint_name) = @_;
562 my %unique_constraints = $self->unique_constraints;
564 $self->throw_exception(
565 "Unknown unique constraint $constraint_name on '" . $self->name . "'"
566 ) unless exists $unique_constraints{$constraint_name};
568 return @{ $unique_constraints{$constraint_name} };
571 =head2 sqlt_deploy_callback
575 =item Arguments: $callback
579 __PACKAGE__->sqlt_deploy_callback('mycallbackmethod');
581 An accessor to set a callback to be called during deployment of
582 the schema via L<DBIx::Class::Schema/create_ddl_dir> or
583 L<DBIx::Class::Schema/deploy>.
585 The callback can be set as either a code reference or the name of a
586 method in the current result class.
588 If not set, the L</default_sqlt_deploy_hook> is called.
590 Your callback will be passed the $source object representing the
591 ResultSource instance being deployed, and the
592 L<SQL::Translator::Schema::Table> object being created from it. The
593 callback can be used to manipulate the table object or add your own
594 customised indexes. If you need to manipulate a non-table object, use
595 the L<DBIx::Class::Schema/sqlt_deploy_hook>.
597 See L<DBIx::Class::Manual::Cookbook/Adding Indexes And Functions To
598 Your SQL> for examples.
600 This sqlt deployment callback can only be used to manipulate
601 SQL::Translator objects as they get turned into SQL. To execute
602 post-deploy statements which SQL::Translator does not currently
603 handle, override L<DBIx::Class::Schema/deploy> in your Schema class
604 and call L<dbh_do|DBIx::Class::Storage::DBI/dbh_do>.
606 =head2 default_sqlt_deploy_hook
610 =item Arguments: $source, $sqlt_table
612 =item Return value: undefined
616 This is the sensible default for L</sqlt_deploy_callback>.
618 If a method named C<sqlt_deploy_hook> exists in your Result class, it
619 will be called and passed the current C<$source> and the
620 C<$sqlt_table> being deployed.
624 sub default_sqlt_deploy_hook {
627 my $class = $self->result_class;
629 if ($class and $class->can('sqlt_deploy_hook')) {
630 $class->sqlt_deploy_hook(@_);
634 sub _invoke_sqlt_deploy_hook {
636 if ( my $hook = $self->sqlt_deploy_callback) {
645 =item Arguments: None
647 =item Return value: $resultset
651 Returns a resultset for the given source. This will initially be created
654 $self->resultset_class->new($self, $self->resultset_attributes)
656 but is cached from then on unless resultset_class changes.
658 =head2 resultset_class
662 =item Arguments: $classname
664 =item Return value: $classname
668 package My::ResultSetClass;
669 use base 'DBIx::Class::ResultSet';
672 $source->resultset_class('My::ResultSet::Class');
674 Set the class of the resultset. This is useful if you want to create your
675 own resultset methods. Create your own class derived from
676 L<DBIx::Class::ResultSet>, and set it here. If called with no arguments,
677 this method returns the name of the existing resultset class, if one
680 =head2 resultset_attributes
684 =item Arguments: \%attrs
686 =item Return value: \%attrs
690 $source->resultset_attributes({ order_by => [ 'id' ] });
692 Store a collection of resultset attributes, that will be set on every
693 L<DBIx::Class::ResultSet> produced from this result source. For a full
694 list see L<DBIx::Class::ResultSet/ATTRIBUTES>.
700 $self->throw_exception(
701 'resultset does not take any arguments. If you want another resultset, '.
702 'call it on the schema instead.'
705 return $self->resultset_class->new(
708 %{$self->{resultset_attributes}},
709 %{$self->schema->default_resultset_attributes}
718 =item Arguments: $source_name
720 =item Result value: $source_name
724 Set an alternate name for the result source when it is loaded into a schema.
725 This is useful if you want to refer to a result source by a name other than
728 package ArchivedBooks;
729 use base qw/DBIx::Class/;
730 __PACKAGE__->table('books_archive');
731 __PACKAGE__->source_name('Books');
733 # from your schema...
734 $schema->resultset('Books')->find(1);
740 =item Arguments: None
742 =item Return value: FROM clause
746 my $from_clause = $source->from();
748 Returns an expression of the source to be supplied to storage to specify
749 retrieval from this source. In the case of a database, the required FROM
756 =item Arguments: None
758 =item Return value: A schema object
762 my $schema = $source->schema();
764 Returns the L<DBIx::Class::Schema> object that this result source
771 =item Arguments: None
773 =item Return value: A Storage object
777 $source->storage->debug(1);
779 Returns the storage handle for the current schema.
781 See also: L<DBIx::Class::Storage>
785 sub storage { shift->schema->storage; }
787 =head2 add_relationship
791 =item Arguments: $relname, $related_source_name, \%cond, [ \%attrs ]
793 =item Return value: 1/true if it succeeded
797 $source->add_relationship('relname', 'related_source', $cond, $attrs);
799 L<DBIx::Class::Relationship> describes a series of methods which
800 create pre-defined useful types of relationships. Look there first
801 before using this method directly.
803 The relationship name can be arbitrary, but must be unique for each
804 relationship attached to this result source. 'related_source' should
805 be the name with which the related result source was registered with
806 the current schema. For example:
808 $schema->source('Book')->add_relationship('reviews', 'Review', {
809 'foreign.book_id' => 'self.id',
812 The condition C<$cond> needs to be an L<SQL::Abstract>-style
813 representation of the join between the tables. For example, if you're
814 creating a relation from Author to Book,
816 { 'foreign.author_id' => 'self.id' }
818 will result in the JOIN clause
820 author me JOIN book foreign ON foreign.author_id = me.id
822 You can specify as many foreign => self mappings as necessary.
824 Valid attributes are as follows:
830 Explicitly specifies the type of join to use in the relationship. Any
831 SQL join type is valid, e.g. C<LEFT> or C<RIGHT>. It will be placed in
832 the SQL command immediately before C<JOIN>.
836 An arrayref containing a list of accessors in the foreign class to proxy in
837 the main class. If, for example, you do the following:
839 CD->might_have(liner_notes => 'LinerNotes', undef, {
840 proxy => [ qw/notes/ ],
843 Then, assuming LinerNotes has an accessor named notes, you can do:
845 my $cd = CD->find(1);
846 # set notes -- LinerNotes object is created if it doesn't exist
847 $cd->notes('Notes go here');
851 Specifies the type of accessor that should be created for the
852 relationship. Valid values are C<single> (for when there is only a single
853 related object), C<multi> (when there can be many), and C<filter> (for
854 when there is a single related object, but you also want the relationship
855 accessor to double as a column accessor). For C<multi> accessors, an
856 add_to_* method is also created, which calls C<create_related> for the
861 Throws an exception if the condition is improperly supplied, or cannot
866 sub add_relationship {
867 my ($self, $rel, $f_source_name, $cond, $attrs) = @_;
868 $self->throw_exception("Can't create relationship without join condition")
872 # Check foreign and self are right in cond
873 if ( (ref $cond ||'') eq 'HASH') {
875 $self->throw_exception("Keys of condition should be of form 'foreign.col', not '$_'")
876 if /\./ && !/^foreign\./;
880 my %rels = %{ $self->_relationships };
881 $rels{$rel} = { class => $f_source_name,
882 source => $f_source_name,
885 $self->_relationships(\%rels);
889 # XXX disabled. doesn't work properly currently. skip in tests.
891 my $f_source = $self->schema->source($f_source_name);
893 $self->ensure_class_loaded($f_source_name);
894 $f_source = $f_source_name->result_source;
895 #my $s_class = ref($self->schema);
896 #$f_source_name =~ m/^${s_class}::(.*)$/;
897 #$self->schema->register_class(($1 || $f_source_name), $f_source_name);
898 #$f_source = $self->schema->source($f_source_name);
900 return unless $f_source; # Can't test rel without f_source
902 eval { $self->_resolve_join($rel, 'me', {}, []) };
904 if ($@) { # If the resolve failed, back out and re-throw the error
905 delete $rels{$rel}; #
906 $self->_relationships(\%rels);
907 $self->throw_exception("Error creating relationship $rel: $@");
916 =item Arguments: None
918 =item Return value: List of relationship names
922 my @relnames = $source->relationships();
924 Returns all relationship names for this source.
929 return keys %{shift->_relationships};
932 =head2 relationship_info
936 =item Arguments: $relname
938 =item Return value: Hashref of relation data,
942 Returns a hash of relationship information for the specified relationship
943 name. The keys/values are as specified for L</add_relationship>.
947 sub relationship_info {
948 my ($self, $rel) = @_;
949 return $self->_relationships->{$rel};
952 =head2 has_relationship
956 =item Arguments: $rel
958 =item Return value: 1/0 (true/false)
962 Returns true if the source has a relationship of this name, false otherwise.
966 sub has_relationship {
967 my ($self, $rel) = @_;
968 return exists $self->_relationships->{$rel};
971 =head2 reverse_relationship_info
975 =item Arguments: $relname
977 =item Return value: Hashref of relationship data
981 Looks through all the relationships on the source this relationship
982 points to, looking for one whose condition is the reverse of the
983 condition on this relationship.
985 A common use of this is to find the name of the C<belongs_to> relation
986 opposing a C<has_many> relation. For definition of these look in
987 L<DBIx::Class::Relationship>.
989 The returned hashref is keyed by the name of the opposing
990 relationship, and contains its data in the same manner as
991 L</relationship_info>.
995 sub reverse_relationship_info {
996 my ($self, $rel) = @_;
997 my $rel_info = $self->relationship_info($rel);
1000 return $ret unless ((ref $rel_info->{cond}) eq 'HASH');
1002 my @cond = keys(%{$rel_info->{cond}});
1003 my @refkeys = map {/^\w+\.(\w+)$/} @cond;
1004 my @keys = map {$rel_info->{cond}->{$_} =~ /^\w+\.(\w+)$/} @cond;
1006 # Get the related result source for this relationship
1007 my $othertable = $self->related_source($rel);
1009 # Get all the relationships for that source that related to this source
1010 # whose foreign column set are our self columns on $rel and whose self
1011 # columns are our foreign columns on $rel.
1012 my @otherrels = $othertable->relationships();
1013 my $otherrelationship;
1014 foreach my $otherrel (@otherrels) {
1015 my $otherrel_info = $othertable->relationship_info($otherrel);
1017 my $back = $othertable->related_source($otherrel);
1018 next unless $back->source_name eq $self->source_name;
1022 if (ref $otherrel_info->{cond} eq 'HASH') {
1023 @othertestconds = ($otherrel_info->{cond});
1025 elsif (ref $otherrel_info->{cond} eq 'ARRAY') {
1026 @othertestconds = @{$otherrel_info->{cond}};
1032 foreach my $othercond (@othertestconds) {
1033 my @other_cond = keys(%$othercond);
1034 my @other_refkeys = map {/^\w+\.(\w+)$/} @other_cond;
1035 my @other_keys = map {$othercond->{$_} =~ /^\w+\.(\w+)$/} @other_cond;
1036 next if (!$self->_compare_relationship_keys(\@refkeys, \@other_keys) ||
1037 !$self->_compare_relationship_keys(\@other_refkeys, \@keys));
1038 $ret->{$otherrel} = $otherrel_info;
1044 sub compare_relationship_keys {
1045 carp 'compare_relationship_keys is a private method, stop calling it';
1047 $self->_compare_relationship_keys (@_);
1050 # Returns true if both sets of keynames are the same, false otherwise.
1051 sub _compare_relationship_keys {
1052 my ($self, $keys1, $keys2) = @_;
1054 # Make sure every keys1 is in keys2
1056 foreach my $key (@$keys1) {
1058 foreach my $prim (@$keys2) {
1059 if ($prim eq $key) {
1067 # Make sure every key2 is in key1
1069 foreach my $prim (@$keys2) {
1071 foreach my $key (@$keys1) {
1072 if ($prim eq $key) {
1085 carp 'resolve_join is a private method, stop calling it';
1087 $self->_resolve_join (@_);
1090 # Returns the {from} structure used to express JOIN conditions
1092 my ($self, $join, $alias, $seen, $jpath, $force_left) = @_;
1094 # we need a supplied one, because we do in-place modifications, no returns
1095 $self->throw_exception ('You must supply a seen hashref as the 3rd argument to _resolve_join')
1096 unless ref $seen eq 'HASH';
1098 $self->throw_exception ('You must supply a joinpath arrayref as the 4th argument to _resolve_join')
1099 unless ref $jpath eq 'ARRAY';
1103 if (ref $join eq 'ARRAY') {
1106 $self->_resolve_join($_, $alias, $seen, $jpath, $force_left);
1108 } elsif (ref $join eq 'HASH') {
1111 my $as = ($seen->{$_} ? join ('_', $_, $seen->{$_} + 1) : $_); # the actual seen value will be incremented below
1112 local $force_left->{force} = $force_left->{force};
1114 $self->_resolve_join($_, $alias, $seen, [@$jpath], $force_left),
1115 $self->related_source($_)->_resolve_join(
1116 $join->{$_}, $as, $seen, [@$jpath, $_], $force_left
1120 } elsif (ref $join) {
1121 $self->throw_exception("No idea how to resolve join reftype ".ref $join);
1124 return() unless defined $join;
1126 my $count = ++$seen->{$join};
1127 my $as = ($count > 1 ? "${join}_${count}" : $join);
1129 my $rel_info = $self->relationship_info($join);
1130 $self->throw_exception("No such relationship ${join}") unless $rel_info;
1135 $type = $rel_info->{attrs}{join_type} || '';
1136 $force_left = 1 if lc($type) eq 'left';
1139 my $rel_src = $self->related_source($join);
1140 return [ { $as => $rel_src->from,
1141 -source_handle => $rel_src->handle,
1142 -join_type => $type,
1143 -join_path => [@$jpath, $join],
1145 -relation_chain_depth => $seen->{-relation_chain_depth} || 0,
1147 $self->_resolve_condition($rel_info->{cond}, $as, $alias) ];
1152 carp 'pk_depends_on is a private method, stop calling it';
1154 $self->_pk_depends_on (@_);
1157 # Determines whether a relation is dependent on an object from this source
1158 # having already been inserted. Takes the name of the relationship and a
1159 # hashref of columns of the related object.
1160 sub _pk_depends_on {
1161 my ($self, $relname, $rel_data) = @_;
1162 my $cond = $self->relationship_info($relname)->{cond};
1164 return 0 unless ref($cond) eq 'HASH';
1166 # map { foreign.foo => 'self.bar' } to { bar => 'foo' }
1168 my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond };
1170 # assume anything that references our PK probably is dependent on us
1171 # rather than vice versa, unless the far side is (a) defined or (b)
1174 my $rel_source = $self->related_source($relname);
1176 foreach my $p ($self->primary_columns) {
1177 if (exists $keyhash->{$p}) {
1178 unless (defined($rel_data->{$keyhash->{$p}})
1179 || $rel_source->column_info($keyhash->{$p})
1180 ->{is_auto_increment}) {
1189 sub resolve_condition {
1190 carp 'resolve_condition is a private method, stop calling it';
1192 $self->_resolve_condition (@_);
1195 # Resolves the passed condition to a concrete query fragment. If given an alias,
1196 # returns a join condition; if given an object, inverts that object to produce
1197 # a related conditional from that object.
1198 our $UNRESOLVABLE_CONDITION = \'1 = 0';
1200 sub _resolve_condition {
1201 my ($self, $cond, $as, $for) = @_;
1202 if (ref $cond eq 'HASH') {
1204 foreach my $k (keys %{$cond}) {
1205 my $v = $cond->{$k};
1206 # XXX should probably check these are valid columns
1207 $k =~ s/^foreign\.// ||
1208 $self->throw_exception("Invalid rel cond key ${k}");
1209 $v =~ s/^self\.// ||
1210 $self->throw_exception("Invalid rel cond val ${v}");
1211 if (ref $for) { # Object
1212 #warn "$self $k $for $v";
1213 unless ($for->has_column_loaded($v)) {
1214 if ($for->in_storage) {
1215 $self->throw_exception(
1216 "Column ${v} not loaded or not passed to new() prior to insert()"
1217 ." on ${for} trying to resolve relationship (maybe you forgot "
1218 ."to call ->discard_changes to get defaults from the db)"
1221 return $UNRESOLVABLE_CONDITION;
1223 $ret{$k} = $for->get_column($v);
1224 #$ret{$k} = $for->get_column($v) if $for->has_column_loaded($v);
1226 } elsif (!defined $for) { # undef, i.e. "no object"
1228 } elsif (ref $as eq 'HASH') { # reverse hashref
1229 $ret{$v} = $as->{$k};
1230 } elsif (ref $as) { # reverse object
1231 $ret{$v} = $as->get_column($k);
1232 } elsif (!defined $as) { # undef, i.e. "no reverse object"
1235 $ret{"${as}.${k}"} = "${for}.${v}";
1239 } elsif (ref $cond eq 'ARRAY') {
1240 return [ map { $self->_resolve_condition($_, $as, $for) } @$cond ];
1242 die("Can't handle condition $cond yet :(");
1246 # Legacy code, needs to go entirely away (fully replaced by _resolve_prefetch)
1247 sub resolve_prefetch {
1248 carp 'resolve_prefetch is a private method, stop calling it';
1250 my ($self, $pre, $alias, $seen, $order, $collapse) = @_;
1252 if( ref $pre eq 'ARRAY' ) {
1254 map { $self->resolve_prefetch( $_, $alias, $seen, $order, $collapse ) }
1257 elsif( ref $pre eq 'HASH' ) {
1260 $self->resolve_prefetch($_, $alias, $seen, $order, $collapse),
1261 $self->related_source($_)->resolve_prefetch(
1262 $pre->{$_}, "${alias}.$_", $seen, $order, $collapse)
1267 $self->throw_exception(
1268 "don't know how to resolve prefetch reftype ".ref($pre));
1271 my $count = ++$seen->{$pre};
1272 my $as = ($count > 1 ? "${pre}_${count}" : $pre);
1273 my $rel_info = $self->relationship_info( $pre );
1274 $self->throw_exception( $self->name . " has no such relationship '$pre'" )
1276 my $as_prefix = ($alias =~ /^.*?\.(.+)$/ ? $1.'.' : '');
1277 my $rel_source = $self->related_source($pre);
1279 if (exists $rel_info->{attrs}{accessor}
1280 && $rel_info->{attrs}{accessor} eq 'multi') {
1281 $self->throw_exception(
1282 "Can't prefetch has_many ${pre} (join cond too complex)")
1283 unless ref($rel_info->{cond}) eq 'HASH';
1284 my $dots = @{[$as_prefix =~ m/\./g]} + 1; # +1 to match the ".${as_prefix}"
1285 if (my ($fail) = grep { @{[$_ =~ m/\./g]} == $dots }
1286 keys %{$collapse}) {
1287 my ($last) = ($fail =~ /([^\.]+)$/);
1289 "Prefetching multiple has_many rels ${last} and ${pre} "
1290 .(length($as_prefix)
1291 ? "at the same level (${as_prefix}) "
1294 . 'will explode the number of row objects retrievable via ->next or ->all. '
1295 . 'Use at your own risk.'
1298 #my @col = map { (/^self\.(.+)$/ ? ("${as_prefix}.$1") : ()); }
1299 # values %{$rel_info->{cond}};
1300 $collapse->{".${as_prefix}${pre}"} = [ $rel_source->primary_columns ];
1301 # action at a distance. prepending the '.' allows simpler code
1302 # in ResultSet->_collapse_result
1303 my @key = map { (/^foreign\.(.+)$/ ? ($1) : ()); }
1304 keys %{$rel_info->{cond}};
1305 my @ord = (ref($rel_info->{attrs}{order_by}) eq 'ARRAY'
1306 ? @{$rel_info->{attrs}{order_by}}
1307 : (defined $rel_info->{attrs}{order_by}
1308 ? ($rel_info->{attrs}{order_by})
1310 push(@$order, map { "${as}.$_" } (@key, @ord));
1313 return map { [ "${as}.$_", "${as_prefix}${pre}.$_", ] }
1314 $rel_source->columns;
1318 # Accepts one or more relationships for the current source and returns an
1319 # array of column names for each of those relationships. Column names are
1320 # prefixed relative to the current source, in accordance with where they appear
1321 # in the supplied relationships. Needs an alias_map generated by
1322 # $rs->_joinpath_aliases
1324 sub _resolve_prefetch {
1325 my ($self, $pre, $alias, $alias_map, $order, $collapse, $pref_path) = @_;
1328 if( ref $pre eq 'ARRAY' ) {
1330 map { $self->_resolve_prefetch( $_, $alias, $alias_map, $order, $collapse, [ @$pref_path ] ) }
1333 elsif( ref $pre eq 'HASH' ) {
1336 $self->_resolve_prefetch($_, $alias, $alias_map, $order, $collapse, [ @$pref_path ] ),
1337 $self->related_source($_)->_resolve_prefetch(
1338 $pre->{$_}, "${alias}.$_", $alias_map, $order, $collapse, [ @$pref_path, $_] )
1343 $self->throw_exception(
1344 "don't know how to resolve prefetch reftype ".ref($pre));
1348 $p = $p->{$_} for (@$pref_path, $pre);
1350 $self->throw_exception (
1351 "Unable to resolve prefetch $pre - join alias map does not contain an entry for path: "
1352 . join (' -> ', @$pref_path, $pre)
1353 ) if (ref $p->{-join_aliases} ne 'ARRAY' or not @{$p->{-join_aliases}} );
1355 my $as = shift @{$p->{-join_aliases}};
1357 my $rel_info = $self->relationship_info( $pre );
1358 $self->throw_exception( $self->name . " has no such relationship '$pre'" )
1360 my $as_prefix = ($alias =~ /^.*?\.(.+)$/ ? $1.'.' : '');
1361 my $rel_source = $self->related_source($pre);
1363 if (exists $rel_info->{attrs}{accessor}
1364 && $rel_info->{attrs}{accessor} eq 'multi') {
1365 $self->throw_exception(
1366 "Can't prefetch has_many ${pre} (join cond too complex)")
1367 unless ref($rel_info->{cond}) eq 'HASH';
1368 my $dots = @{[$as_prefix =~ m/\./g]} + 1; # +1 to match the ".${as_prefix}"
1369 if (my ($fail) = grep { @{[$_ =~ m/\./g]} == $dots }
1370 keys %{$collapse}) {
1371 my ($last) = ($fail =~ /([^\.]+)$/);
1373 "Prefetching multiple has_many rels ${last} and ${pre} "
1374 .(length($as_prefix)
1375 ? "at the same level (${as_prefix}) "
1378 . 'will explode the number of row objects retrievable via ->next or ->all. '
1379 . 'Use at your own risk.'
1382 #my @col = map { (/^self\.(.+)$/ ? ("${as_prefix}.$1") : ()); }
1383 # values %{$rel_info->{cond}};
1384 $collapse->{".${as_prefix}${pre}"} = [ $rel_source->primary_columns ];
1385 # action at a distance. prepending the '.' allows simpler code
1386 # in ResultSet->_collapse_result
1387 my @key = map { (/^foreign\.(.+)$/ ? ($1) : ()); }
1388 keys %{$rel_info->{cond}};
1389 my @ord = (ref($rel_info->{attrs}{order_by}) eq 'ARRAY'
1390 ? @{$rel_info->{attrs}{order_by}}
1391 : (defined $rel_info->{attrs}{order_by}
1392 ? ($rel_info->{attrs}{order_by})
1394 push(@$order, map { "${as}.$_" } (@key, @ord));
1397 return map { [ "${as}.$_", "${as_prefix}${pre}.$_", ] }
1398 $rel_source->columns;
1402 =head2 related_source
1406 =item Arguments: $relname
1408 =item Return value: $source
1412 Returns the result source object for the given relationship.
1416 sub related_source {
1417 my ($self, $rel) = @_;
1418 if( !$self->has_relationship( $rel ) ) {
1419 $self->throw_exception("No such relationship '$rel'");
1421 return $self->schema->source($self->relationship_info($rel)->{source});
1424 =head2 related_class
1428 =item Arguments: $relname
1430 =item Return value: $classname
1434 Returns the class name for objects in the given relationship.
1439 my ($self, $rel) = @_;
1440 if( !$self->has_relationship( $rel ) ) {
1441 $self->throw_exception("No such relationship '$rel'");
1443 return $self->schema->class($self->relationship_info($rel)->{source});
1448 Obtain a new handle to this source. Returns an instance of a
1449 L<DBIx::Class::ResultSourceHandle>.
1454 return new DBIx::Class::ResultSourceHandle({
1455 schema => $_[0]->schema,
1456 source_moniker => $_[0]->source_name
1460 =head2 throw_exception
1462 See L<DBIx::Class::Schema/"throw_exception">.
1466 sub throw_exception {
1468 if (defined $self->schema) {
1469 $self->schema->throw_exception(@_);
1477 Stores a hashref of per-source metadata. No specific key names
1478 have yet been standardized, the examples below are purely hypothetical
1479 and don't actually accomplish anything on their own:
1481 __PACKAGE__->source_info({
1482 "_tablespace" => 'fast_disk_array_3',
1483 "_engine" => 'InnoDB',
1490 $class->new({attribute_name => value});
1492 Creates a new ResultSource object. Not normally called directly by end users.
1494 =head2 column_info_from_storage
1498 =item Arguments: 1/0 (default: 0)
1500 =item Return value: 1/0
1504 __PACKAGE__->column_info_from_storage(1);
1506 Enables the on-demand automatic loading of the above column
1507 metadata from storage as neccesary. This is *deprecated*, and
1508 should not be used. It will be removed before 1.0.
1513 Matt S. Trout <mst@shadowcatsystems.co.uk>
1517 You may distribute this code under the same terms as Perl itself.