1 package DBIx::Class::ResultSource;
6 use DBIx::Class::ResultSet;
7 use DBIx::Class::ResultSourceHandle;
9 use DBIx::Class::Exception;
10 use Carp::Clan qw/^DBIx::Class/;
12 use base qw/DBIx::Class/;
14 __PACKAGE__->mk_group_accessors('simple' => qw/_ordered_columns
15 _columns _primaries _unique_constraints name resultset_attributes
16 schema from _relationships column_info_from_storage source_info
17 source_name sqlt_deploy_callback/);
19 __PACKAGE__->mk_group_accessors('component_class' => qw/resultset_class
24 DBIx::Class::ResultSource - Result source object
28 # Create a table based result source, in a result class.
30 package MyDB::Schema::Result::Artist;
31 use base qw/DBIx::Class::Core/;
33 __PACKAGE__->table('artist');
34 __PACKAGE__->add_columns(qw/ artistid name /);
35 __PACKAGE__->set_primary_key('artistid');
36 __PACKAGE__->has_many(cds => 'MyDB::Schema::Result::CD');
40 # Create a query (view) based result source, in a result class
41 package MyDB::Schema::Result::Year2000CDs;
42 use base qw/DBIx::Class::Core/;
44 __PACKAGE__->load_components('InflateColumn::DateTime');
45 __PACKAGE__->table_class('DBIx::Class::ResultSource::View');
47 __PACKAGE__->table('year2000cds');
48 __PACKAGE__->result_source_instance->is_virtual(1);
49 __PACKAGE__->result_source_instance->view_definition(
50 "SELECT cdid, artist, title FROM cd WHERE year ='2000'"
56 A ResultSource is an object that represents a source of data for querying.
58 This class is a base class for various specialised types of result
59 sources, for example L<DBIx::Class::ResultSource::Table>. Table is the
60 default result source type, so one is created for you when defining a
61 result class as described in the synopsis above.
63 More specifically, the L<DBIx::Class::Core> base class pulls in the
64 L<DBIx::Class::ResultSourceProxy::Table> component, which defines
65 the L<table|DBIx::Class::ResultSourceProxy::Table/table> method.
66 When called, C<table> creates and stores an instance of
67 L<DBIx::Class::ResultSoure::Table>. Luckily, to use tables as result
68 sources, you don't need to remember any of this.
70 Result sources representing select queries, or views, can also be
71 created, see L<DBIx::Class::ResultSource::View> for full details.
73 =head2 Finding result source objects
75 As mentioned above, a result source instance is created and stored for
76 you when you define a L<Result Class|DBIx::Class::Manual::Glossary/Result Class>.
78 You can retrieve the result source at runtime in the following ways:
82 =item From a Schema object:
84 $schema->source($source_name);
86 =item From a Row object:
90 =item From a ResultSet object:
103 my ($class, $attrs) = @_;
104 $class = ref $class if ref $class;
106 my $new = bless { %{$attrs || {}} }, $class;
107 $new->{resultset_class} ||= 'DBIx::Class::ResultSet';
108 $new->{resultset_attributes} = { %{$new->{resultset_attributes} || {}} };
109 $new->{_ordered_columns} = [ @{$new->{_ordered_columns}||[]}];
110 $new->{_columns} = { %{$new->{_columns}||{}} };
111 $new->{_relationships} = { %{$new->{_relationships}||{}} };
112 $new->{name} ||= "!!NAME NOT SET!!";
113 $new->{_columns_info_loaded} ||= 0;
114 $new->{sqlt_deploy_callback} ||= "default_sqlt_deploy_hook";
124 =item Arguments: @columns
126 =item Return value: The ResultSource object
130 $source->add_columns(qw/col1 col2 col3/);
132 $source->add_columns('col1' => \%col1_info, 'col2' => \%col2_info, ...);
134 Adds columns to the result source. If supplied colname => hashref
135 pairs, uses the hashref as the L</column_info> for that column. Repeated
136 calls of this method will add more columns, not replace them.
138 The column names given will be created as accessor methods on your
139 L<DBIx::Class::Row> objects. You can change the name of the accessor
140 by supplying an L</accessor> in the column_info hash.
142 The contents of the column_info are not set in stone. The following
143 keys are currently recognised/used by DBIx::Class:
149 { accessor => '_name' }
151 # example use, replace standard accessor with one of your own:
153 my ($self, $value) = @_;
155 die "Name cannot contain digits!" if($value =~ /\d/);
156 $self->_name($value);
158 return $self->_name();
161 Use this to set the name of the accessor method for this column. If unset,
162 the name of the column will be used.
166 { data_type => 'integer' }
168 This contains the column type. It is automatically filled if you use the
169 L<SQL::Translator::Producer::DBIx::Class::File> producer, or the
170 L<DBIx::Class::Schema::Loader> module.
172 Currently there is no standard set of values for the data_type. Use
173 whatever your database supports.
179 The length of your column, if it is a column type that can have a size
180 restriction. This is currently only used to create tables from your
181 schema, see L<DBIx::Class::Schema/deploy>.
187 Set this to a true value for a columns that is allowed to contain NULL
188 values, default is false. This is currently only used to create tables
189 from your schema, see L<DBIx::Class::Schema/deploy>.
191 =item is_auto_increment
193 { is_auto_increment => 1 }
195 Set this to a true value for a column whose value is somehow
196 automatically set, defaults to false. This is used to determine which
197 columns to empty when cloning objects using
198 L<DBIx::Class::Row/copy>. It is also used by
199 L<DBIx::Class::Schema/deploy>.
205 Set this to a true or false value (not C<undef>) to explicitly specify
206 if this column contains numeric data. This controls how set_column
207 decides whether to consider a column dirty after an update: if
208 C<is_numeric> is true a numeric comparison C<< != >> will take place
209 instead of the usual C<eq>
211 If not specified the storage class will attempt to figure this out on
212 first access to the column, based on the column C<data_type>. The
213 result will be cached in this attribute.
217 { is_foreign_key => 1 }
219 Set this to a true value for a column that contains a key from a
220 foreign table, defaults to false. This is currently only used to
221 create tables from your schema, see L<DBIx::Class::Schema/deploy>.
225 { default_value => \'now()' }
227 Set this to the default value which will be inserted into a column by
228 the database. Can contain either a value or a function (use a
229 reference to a scalar e.g. C<\'now()'> if you want a function). This
230 is currently only used to create tables from your schema, see
231 L<DBIx::Class::Schema/deploy>.
233 See the note on L<DBIx::Class::Row/new> for more information about possible
234 issues related to db-side default values.
238 { sequence => 'my_table_seq' }
240 Set this on a primary key column to the name of the sequence used to
241 generate a new key value. If not specified, L<DBIx::Class::PK::Auto>
242 will attempt to retrieve the name of the sequence from the database
247 Set this to a true value for a column whose value is retrieved automatically
248 from a sequence or function (if supported by your Storage driver.) For a
249 sequence, if you do not use a trigger to get the nextval, you have to set the
250 L</sequence> value as well.
252 Also set this for MSSQL columns with the 'uniqueidentifier'
253 L<DBIx::Class::ResultSource/data_type> whose values you want to automatically
254 generate using C<NEWID()>, unless they are a primary key in which case this will
259 This is used by L<DBIx::Class::Schema/deploy> and L<SQL::Translator>
260 to add extra non-generic data to the column. For example: C<< extra
261 => { unsigned => 1} >> is used by the MySQL producer to set an integer
262 column to unsigned. For more details, see
263 L<SQL::Translator::Producer::MySQL>.
271 =item Arguments: $colname, \%columninfo?
273 =item Return value: 1/0 (true/false)
277 $source->add_column('col' => \%info);
279 Add a single column and optional column info. Uses the same column
280 info keys as L</add_columns>.
285 my ($self, @cols) = @_;
286 $self->_ordered_columns(\@cols) unless $self->_ordered_columns;
289 my $columns = $self->_columns;
290 while (my $col = shift @cols) {
291 # If next entry is { ... } use that for the column info, if not
292 # use an empty hashref
293 my $column_info = ref $cols[0] ? shift(@cols) : {};
294 push(@added, $col) unless exists $columns->{$col};
295 $columns->{$col} = $column_info;
297 push @{ $self->_ordered_columns }, @added;
301 sub add_column { shift->add_columns(@_); } # DO NOT CHANGE THIS TO GLOB
307 =item Arguments: $colname
309 =item Return value: 1/0 (true/false)
313 if ($source->has_column($colname)) { ... }
315 Returns true if the source has a column of this name, false otherwise.
320 my ($self, $column) = @_;
321 return exists $self->_columns->{$column};
328 =item Arguments: $colname
330 =item Return value: Hashref of info
334 my $info = $source->column_info($col);
336 Returns the column metadata hashref for a column, as originally passed
337 to L</add_columns>. See L</add_columns> above for information on the
338 contents of the hashref.
343 my ($self, $column) = @_;
344 $self->throw_exception("No such column $column")
345 unless exists $self->_columns->{$column};
346 #warn $self->{_columns_info_loaded}, "\n";
347 if ( ! $self->_columns->{$column}{data_type}
348 and $self->column_info_from_storage
349 and ! $self->{_columns_info_loaded}
350 and $self->schema and $self->storage )
352 $self->{_columns_info_loaded}++;
355 # eval for the case of storage without table
356 eval { $info = $self->storage->columns_info_for( $self->from ) };
358 for my $realcol ( keys %{$info} ) {
359 $lc_info->{lc $realcol} = $info->{$realcol};
361 foreach my $col ( keys %{$self->_columns} ) {
362 $self->_columns->{$col} = {
363 %{ $self->_columns->{$col} },
364 %{ $info->{$col} || $lc_info->{lc $col} || {} }
369 return $self->_columns->{$column};
376 =item Arguments: None
378 =item Return value: Ordered list of column names
382 my @column_names = $source->columns;
384 Returns all column names in the order they were declared to L</add_columns>.
390 $self->throw_exception(
391 "columns() is a read-only accessor, did you mean add_columns()?"
393 return @{$self->{_ordered_columns}||[]};
396 =head2 remove_columns
400 =item Arguments: @colnames
402 =item Return value: undefined
406 $source->remove_columns(qw/col1 col2 col3/);
408 Removes the given list of columns by name, from the result source.
410 B<Warning>: Removing a column that is also used in the sources primary
411 key, or in one of the sources unique constraints, B<will> result in a
412 broken result source.
418 =item Arguments: $colname
420 =item Return value: undefined
424 $source->remove_column('col');
426 Remove a single column by name from the result source, similar to
429 B<Warning>: Removing a column that is also used in the sources primary
430 key, or in one of the sources unique constraints, B<will> result in a
431 broken result source.
436 my ($self, @to_remove) = @_;
438 my $columns = $self->_columns
443 delete $columns->{$_};
447 $self->_ordered_columns([ grep { not $to_remove{$_} } @{$self->_ordered_columns} ]);
450 sub remove_column { shift->remove_columns(@_); } # DO NOT CHANGE THIS TO GLOB
452 =head2 set_primary_key
456 =item Arguments: @cols
458 =item Return value: undefined
462 Defines one or more columns as primary key for this source. Must be
463 called after L</add_columns>.
465 Additionally, defines a L<unique constraint|add_unique_constraint>
468 The primary key columns are used by L<DBIx::Class::PK::Auto> to
469 retrieve automatically created values from the database. They are also
470 used as default joining columns when specifying relationships, see
471 L<DBIx::Class::Relationship>.
475 sub set_primary_key {
476 my ($self, @cols) = @_;
477 # check if primary key columns are valid columns
478 foreach my $col (@cols) {
479 $self->throw_exception("No such column $col on table " . $self->name)
480 unless $self->has_column($col);
482 $self->_primaries(\@cols);
484 $self->add_unique_constraint(primary => \@cols);
487 =head2 primary_columns
491 =item Arguments: None
493 =item Return value: Ordered list of primary column names
497 Read-only accessor which returns the list of primary keys, supplied by
502 sub primary_columns {
503 return @{shift->_primaries||[]};
508 my @pcols = $self->primary_columns
509 or $self->throw_exception (sprintf(
510 'Operation requires a primary key to be declared on %s via set_primary_key',
516 =head2 add_unique_constraint
520 =item Arguments: $name?, \@colnames
522 =item Return value: undefined
526 Declare a unique constraint on this source. Call once for each unique
529 # For UNIQUE (column1, column2)
530 __PACKAGE__->add_unique_constraint(
531 constraint_name => [ qw/column1 column2/ ],
534 Alternatively, you can specify only the columns:
536 __PACKAGE__->add_unique_constraint([ qw/column1 column2/ ]);
538 This will result in a unique constraint named
539 C<table_column1_column2>, where C<table> is replaced with the table
542 Unique constraints are used, for example, when you pass the constraint
543 name as the C<key> attribute to L<DBIx::Class::ResultSet/find>. Then
544 only columns in the constraint are searched.
546 Throws an error if any of the given column names do not yet exist on
551 sub add_unique_constraint {
556 $name ||= $self->name_unique_constraint($cols);
558 foreach my $col (@$cols) {
559 $self->throw_exception("No such column $col on table " . $self->name)
560 unless $self->has_column($col);
563 my %unique_constraints = $self->unique_constraints;
564 $unique_constraints{$name} = $cols;
565 $self->_unique_constraints(\%unique_constraints);
568 =head2 name_unique_constraint
572 =item Arguments: @colnames
574 =item Return value: Constraint name
578 $source->table('mytable');
579 $source->name_unique_constraint('col1', 'col2');
583 Return a name for a unique constraint containing the specified
584 columns. The name is created by joining the table name and each column
585 name, using an underscore character.
587 For example, a constraint on a table named C<cd> containing the columns
588 C<artist> and C<title> would result in a constraint name of C<cd_artist_title>.
590 This is used by L</add_unique_constraint> if you do not specify the
591 optional constraint name.
595 sub name_unique_constraint {
596 my ($self, $cols) = @_;
598 my $name = $self->name;
599 $name = $$name if (ref $name eq 'SCALAR');
601 return join '_', $name, @$cols;
604 =head2 unique_constraints
608 =item Arguments: None
610 =item Return value: Hash of unique constraint data
614 $source->unique_constraints();
616 Read-only accessor which returns a hash of unique constraints on this
619 The hash is keyed by constraint name, and contains an arrayref of
620 column names as values.
624 sub unique_constraints {
625 return %{shift->_unique_constraints||{}};
628 =head2 unique_constraint_names
632 =item Arguments: None
634 =item Return value: Unique constraint names
638 $source->unique_constraint_names();
640 Returns the list of unique constraint names defined on this source.
644 sub unique_constraint_names {
647 my %unique_constraints = $self->unique_constraints;
649 return keys %unique_constraints;
652 =head2 unique_constraint_columns
656 =item Arguments: $constraintname
658 =item Return value: List of constraint columns
662 $source->unique_constraint_columns('myconstraint');
664 Returns the list of columns that make up the specified unique constraint.
668 sub unique_constraint_columns {
669 my ($self, $constraint_name) = @_;
671 my %unique_constraints = $self->unique_constraints;
673 $self->throw_exception(
674 "Unknown unique constraint $constraint_name on '" . $self->name . "'"
675 ) unless exists $unique_constraints{$constraint_name};
677 return @{ $unique_constraints{$constraint_name} };
680 =head2 sqlt_deploy_callback
684 =item Arguments: $callback
688 __PACKAGE__->sqlt_deploy_callback('mycallbackmethod');
690 An accessor to set a callback to be called during deployment of
691 the schema via L<DBIx::Class::Schema/create_ddl_dir> or
692 L<DBIx::Class::Schema/deploy>.
694 The callback can be set as either a code reference or the name of a
695 method in the current result class.
697 If not set, the L</default_sqlt_deploy_hook> is called.
699 Your callback will be passed the $source object representing the
700 ResultSource instance being deployed, and the
701 L<SQL::Translator::Schema::Table> object being created from it. The
702 callback can be used to manipulate the table object or add your own
703 customised indexes. If you need to manipulate a non-table object, use
704 the L<DBIx::Class::Schema/sqlt_deploy_hook>.
706 See L<DBIx::Class::Manual::Cookbook/Adding Indexes And Functions To
707 Your SQL> for examples.
709 This sqlt deployment callback can only be used to manipulate
710 SQL::Translator objects as they get turned into SQL. To execute
711 post-deploy statements which SQL::Translator does not currently
712 handle, override L<DBIx::Class::Schema/deploy> in your Schema class
713 and call L<dbh_do|DBIx::Class::Storage::DBI/dbh_do>.
715 =head2 default_sqlt_deploy_hook
719 =item Arguments: $source, $sqlt_table
721 =item Return value: undefined
725 This is the sensible default for L</sqlt_deploy_callback>.
727 If a method named C<sqlt_deploy_hook> exists in your Result class, it
728 will be called and passed the current C<$source> and the
729 C<$sqlt_table> being deployed.
733 sub default_sqlt_deploy_hook {
736 my $class = $self->result_class;
738 if ($class and $class->can('sqlt_deploy_hook')) {
739 $class->sqlt_deploy_hook(@_);
743 sub _invoke_sqlt_deploy_hook {
745 if ( my $hook = $self->sqlt_deploy_callback) {
754 =item Arguments: None
756 =item Return value: $resultset
760 Returns a resultset for the given source. This will initially be created
763 $self->resultset_class->new($self, $self->resultset_attributes)
765 but is cached from then on unless resultset_class changes.
767 =head2 resultset_class
771 =item Arguments: $classname
773 =item Return value: $classname
777 package My::Schema::ResultSet::Artist;
778 use base 'DBIx::Class::ResultSet';
781 # In the result class
782 __PACKAGE__->resultset_class('My::Schema::ResultSet::Artist');
785 $source->resultset_class('My::Schema::ResultSet::Artist');
787 Set the class of the resultset. This is useful if you want to create your
788 own resultset methods. Create your own class derived from
789 L<DBIx::Class::ResultSet>, and set it here. If called with no arguments,
790 this method returns the name of the existing resultset class, if one
793 =head2 resultset_attributes
797 =item Arguments: \%attrs
799 =item Return value: \%attrs
803 # In the result class
804 __PACKAGE__->resultset_attributes({ order_by => [ 'id' ] });
807 $source->resultset_attributes({ order_by => [ 'id' ] });
809 Store a collection of resultset attributes, that will be set on every
810 L<DBIx::Class::ResultSet> produced from this result source. For a full
811 list see L<DBIx::Class::ResultSet/ATTRIBUTES>.
817 $self->throw_exception(
818 'resultset does not take any arguments. If you want another resultset, '.
819 'call it on the schema instead.'
822 return $self->resultset_class->new(
825 %{$self->{resultset_attributes}},
826 %{$self->schema->default_resultset_attributes}
835 =item Arguments: $source_name
837 =item Result value: $source_name
841 Set an alternate name for the result source when it is loaded into a schema.
842 This is useful if you want to refer to a result source by a name other than
845 package ArchivedBooks;
846 use base qw/DBIx::Class/;
847 __PACKAGE__->table('books_archive');
848 __PACKAGE__->source_name('Books');
850 # from your schema...
851 $schema->resultset('Books')->find(1);
857 =item Arguments: None
859 =item Return value: FROM clause
863 my $from_clause = $source->from();
865 Returns an expression of the source to be supplied to storage to specify
866 retrieval from this source. In the case of a database, the required FROM
873 =item Arguments: None
875 =item Return value: A schema object
879 my $schema = $source->schema();
881 Returns the L<DBIx::Class::Schema> object that this result source
888 =item Arguments: None
890 =item Return value: A Storage object
894 $source->storage->debug(1);
896 Returns the storage handle for the current schema.
898 See also: L<DBIx::Class::Storage>
902 sub storage { shift->schema->storage; }
904 =head2 add_relationship
908 =item Arguments: $relname, $related_source_name, \%cond, [ \%attrs ]
910 =item Return value: 1/true if it succeeded
914 $source->add_relationship('relname', 'related_source', $cond, $attrs);
916 L<DBIx::Class::Relationship> describes a series of methods which
917 create pre-defined useful types of relationships. Look there first
918 before using this method directly.
920 The relationship name can be arbitrary, but must be unique for each
921 relationship attached to this result source. 'related_source' should
922 be the name with which the related result source was registered with
923 the current schema. For example:
925 $schema->source('Book')->add_relationship('reviews', 'Review', {
926 'foreign.book_id' => 'self.id',
929 The condition C<$cond> needs to be an L<SQL::Abstract>-style
930 representation of the join between the tables. For example, if you're
931 creating a relation from Author to Book,
933 { 'foreign.author_id' => 'self.id' }
935 will result in the JOIN clause
937 author me JOIN book foreign ON foreign.author_id = me.id
939 You can specify as many foreign => self mappings as necessary.
941 Valid attributes are as follows:
947 Explicitly specifies the type of join to use in the relationship. Any
948 SQL join type is valid, e.g. C<LEFT> or C<RIGHT>. It will be placed in
949 the SQL command immediately before C<JOIN>.
953 An arrayref containing a list of accessors in the foreign class to proxy in
954 the main class. If, for example, you do the following:
956 CD->might_have(liner_notes => 'LinerNotes', undef, {
957 proxy => [ qw/notes/ ],
960 Then, assuming LinerNotes has an accessor named notes, you can do:
962 my $cd = CD->find(1);
963 # set notes -- LinerNotes object is created if it doesn't exist
964 $cd->notes('Notes go here');
968 Specifies the type of accessor that should be created for the
969 relationship. Valid values are C<single> (for when there is only a single
970 related object), C<multi> (when there can be many), and C<filter> (for
971 when there is a single related object, but you also want the relationship
972 accessor to double as a column accessor). For C<multi> accessors, an
973 add_to_* method is also created, which calls C<create_related> for the
978 Throws an exception if the condition is improperly supplied, or cannot
983 sub add_relationship {
984 my ($self, $rel, $f_source_name, $cond, $attrs) = @_;
985 $self->throw_exception("Can't create relationship without join condition")
989 # Check foreign and self are right in cond
990 if ( (ref $cond ||'') eq 'HASH') {
992 $self->throw_exception("Keys of condition should be of form 'foreign.col', not '$_'")
993 if /\./ && !/^foreign\./;
997 my %rels = %{ $self->_relationships };
998 $rels{$rel} = { class => $f_source_name,
999 source => $f_source_name,
1002 $self->_relationships(\%rels);
1006 # XXX disabled. doesn't work properly currently. skip in tests.
1008 my $f_source = $self->schema->source($f_source_name);
1009 unless ($f_source) {
1010 $self->ensure_class_loaded($f_source_name);
1011 $f_source = $f_source_name->result_source;
1012 #my $s_class = ref($self->schema);
1013 #$f_source_name =~ m/^${s_class}::(.*)$/;
1014 #$self->schema->register_class(($1 || $f_source_name), $f_source_name);
1015 #$f_source = $self->schema->source($f_source_name);
1017 return unless $f_source; # Can't test rel without f_source
1019 eval { $self->_resolve_join($rel, 'me', {}, []) };
1021 if ($@) { # If the resolve failed, back out and re-throw the error
1022 delete $rels{$rel}; #
1023 $self->_relationships(\%rels);
1024 $self->throw_exception("Error creating relationship $rel: $@");
1029 =head2 relationships
1033 =item Arguments: None
1035 =item Return value: List of relationship names
1039 my @relnames = $source->relationships();
1041 Returns all relationship names for this source.
1046 return keys %{shift->_relationships};
1049 =head2 relationship_info
1053 =item Arguments: $relname
1055 =item Return value: Hashref of relation data,
1059 Returns a hash of relationship information for the specified relationship
1060 name. The keys/values are as specified for L</add_relationship>.
1064 sub relationship_info {
1065 my ($self, $rel) = @_;
1066 return $self->_relationships->{$rel};
1069 =head2 has_relationship
1073 =item Arguments: $rel
1075 =item Return value: 1/0 (true/false)
1079 Returns true if the source has a relationship of this name, false otherwise.
1083 sub has_relationship {
1084 my ($self, $rel) = @_;
1085 return exists $self->_relationships->{$rel};
1088 =head2 reverse_relationship_info
1092 =item Arguments: $relname
1094 =item Return value: Hashref of relationship data
1098 Looks through all the relationships on the source this relationship
1099 points to, looking for one whose condition is the reverse of the
1100 condition on this relationship.
1102 A common use of this is to find the name of the C<belongs_to> relation
1103 opposing a C<has_many> relation. For definition of these look in
1104 L<DBIx::Class::Relationship>.
1106 The returned hashref is keyed by the name of the opposing
1107 relationship, and contains its data in the same manner as
1108 L</relationship_info>.
1112 sub reverse_relationship_info {
1113 my ($self, $rel) = @_;
1114 my $rel_info = $self->relationship_info($rel);
1117 return $ret unless ((ref $rel_info->{cond}) eq 'HASH');
1119 my @cond = keys(%{$rel_info->{cond}});
1120 my @refkeys = map {/^\w+\.(\w+)$/} @cond;
1121 my @keys = map {$rel_info->{cond}->{$_} =~ /^\w+\.(\w+)$/} @cond;
1123 # Get the related result source for this relationship
1124 my $othertable = $self->related_source($rel);
1126 # Get all the relationships for that source that related to this source
1127 # whose foreign column set are our self columns on $rel and whose self
1128 # columns are our foreign columns on $rel.
1129 my @otherrels = $othertable->relationships();
1130 my $otherrelationship;
1131 foreach my $otherrel (@otherrels) {
1132 my $otherrel_info = $othertable->relationship_info($otherrel);
1134 my $back = $othertable->related_source($otherrel);
1135 next unless $back->source_name eq $self->source_name;
1139 if (ref $otherrel_info->{cond} eq 'HASH') {
1140 @othertestconds = ($otherrel_info->{cond});
1142 elsif (ref $otherrel_info->{cond} eq 'ARRAY') {
1143 @othertestconds = @{$otherrel_info->{cond}};
1149 foreach my $othercond (@othertestconds) {
1150 my @other_cond = keys(%$othercond);
1151 my @other_refkeys = map {/^\w+\.(\w+)$/} @other_cond;
1152 my @other_keys = map {$othercond->{$_} =~ /^\w+\.(\w+)$/} @other_cond;
1153 next if (!$self->_compare_relationship_keys(\@refkeys, \@other_keys) ||
1154 !$self->_compare_relationship_keys(\@other_refkeys, \@keys));
1155 $ret->{$otherrel} = $otherrel_info;
1161 sub compare_relationship_keys {
1162 carp 'compare_relationship_keys is a private method, stop calling it';
1164 $self->_compare_relationship_keys (@_);
1167 # Returns true if both sets of keynames are the same, false otherwise.
1168 sub _compare_relationship_keys {
1169 my ($self, $keys1, $keys2) = @_;
1171 # Make sure every keys1 is in keys2
1173 foreach my $key (@$keys1) {
1175 foreach my $prim (@$keys2) {
1176 if ($prim eq $key) {
1184 # Make sure every key2 is in key1
1186 foreach my $prim (@$keys2) {
1188 foreach my $key (@$keys1) {
1189 if ($prim eq $key) {
1201 # Returns the {from} structure used to express JOIN conditions
1203 my ($self, $join, $alias, $seen, $jpath, $parent_force_left) = @_;
1205 # we need a supplied one, because we do in-place modifications, no returns
1206 $self->throw_exception ('You must supply a seen hashref as the 3rd argument to _resolve_join')
1207 unless ref $seen eq 'HASH';
1209 $self->throw_exception ('You must supply a joinpath arrayref as the 4th argument to _resolve_join')
1210 unless ref $jpath eq 'ARRAY';
1212 $jpath = [@$jpath]; # copy
1214 if (not defined $join) {
1217 elsif (ref $join eq 'ARRAY') {
1220 $self->_resolve_join($_, $alias, $seen, $jpath, $parent_force_left);
1223 elsif (ref $join eq 'HASH') {
1226 for my $rel (keys %$join) {
1228 my $rel_info = $self->relationship_info($rel)
1229 or $self->throw_exception("No such relationship ${rel}");
1231 my $force_left = $parent_force_left;
1232 $force_left ||= lc($rel_info->{attrs}{join_type}||'') eq 'left';
1234 # the actual seen value will be incremented by the recursion
1235 my $as = $self->storage->relname_to_table_alias(
1236 $rel, ($seen->{$rel} && $seen->{$rel} + 1)
1240 $self->_resolve_join($rel, $alias, $seen, [@$jpath], $force_left),
1241 $self->related_source($rel)->_resolve_join(
1242 $join->{$rel}, $as, $seen, [@$jpath, { $rel => $as }], $force_left
1250 $self->throw_exception("No idea how to resolve join reftype ".ref $join);
1253 my $count = ++$seen->{$join};
1254 my $as = $self->storage->relname_to_table_alias(
1255 $join, ($count > 1 && $count)
1258 my $rel_info = $self->relationship_info($join)
1259 or $self->throw_exception("No such relationship ${join}");
1261 my $rel_src = $self->related_source($join);
1262 return [ { $as => $rel_src->from,
1263 -source_handle => $rel_src->handle,
1264 -join_type => $parent_force_left
1266 : $rel_info->{attrs}{join_type}
1268 -join_path => [@$jpath, { $join => $as } ],
1270 $rel_info->{attrs}{accessor}
1272 List::Util::first { $rel_info->{attrs}{accessor} eq $_ } (qw/single filter/)
1275 -relation_chain_depth => $seen->{-relation_chain_depth} || 0,
1277 $self->_resolve_condition($rel_info->{cond}, $as, $alias) ];
1282 carp 'pk_depends_on is a private method, stop calling it';
1284 $self->_pk_depends_on (@_);
1287 # Determines whether a relation is dependent on an object from this source
1288 # having already been inserted. Takes the name of the relationship and a
1289 # hashref of columns of the related object.
1290 sub _pk_depends_on {
1291 my ($self, $relname, $rel_data) = @_;
1293 my $relinfo = $self->relationship_info($relname);
1295 # don't assume things if the relationship direction is specified
1296 return $relinfo->{attrs}{is_foreign_key_constraint}
1297 if exists ($relinfo->{attrs}{is_foreign_key_constraint});
1299 my $cond = $relinfo->{cond};
1300 return 0 unless ref($cond) eq 'HASH';
1302 # map { foreign.foo => 'self.bar' } to { bar => 'foo' }
1303 my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond };
1305 # assume anything that references our PK probably is dependent on us
1306 # rather than vice versa, unless the far side is (a) defined or (b)
1308 my $rel_source = $self->related_source($relname);
1310 foreach my $p ($self->primary_columns) {
1311 if (exists $keyhash->{$p}) {
1312 unless (defined($rel_data->{$keyhash->{$p}})
1313 || $rel_source->column_info($keyhash->{$p})
1314 ->{is_auto_increment}) {
1323 sub resolve_condition {
1324 carp 'resolve_condition is a private method, stop calling it';
1326 $self->_resolve_condition (@_);
1329 # Resolves the passed condition to a concrete query fragment. If given an alias,
1330 # returns a join condition; if given an object, inverts that object to produce
1331 # a related conditional from that object.
1332 our $UNRESOLVABLE_CONDITION = \'1 = 0';
1334 sub _resolve_condition {
1335 my ($self, $cond, $as, $for) = @_;
1336 if (ref $cond eq 'HASH') {
1338 foreach my $k (keys %{$cond}) {
1339 my $v = $cond->{$k};
1340 # XXX should probably check these are valid columns
1341 $k =~ s/^foreign\.// ||
1342 $self->throw_exception("Invalid rel cond key ${k}");
1343 $v =~ s/^self\.// ||
1344 $self->throw_exception("Invalid rel cond val ${v}");
1345 if (ref $for) { # Object
1346 #warn "$self $k $for $v";
1347 unless ($for->has_column_loaded($v)) {
1348 if ($for->in_storage) {
1349 $self->throw_exception(sprintf
1350 "Unable to resolve relationship '%s' from object %s: column '%s' not "
1351 . 'loaded from storage (or not passed to new() prior to insert()). You '
1352 . 'probably need to call ->discard_changes to get the server-side defaults '
1353 . 'from the database.',
1359 return $UNRESOLVABLE_CONDITION;
1361 $ret{$k} = $for->get_column($v);
1362 #$ret{$k} = $for->get_column($v) if $for->has_column_loaded($v);
1364 } elsif (!defined $for) { # undef, i.e. "no object"
1366 } elsif (ref $as eq 'HASH') { # reverse hashref
1367 $ret{$v} = $as->{$k};
1368 } elsif (ref $as) { # reverse object
1369 $ret{$v} = $as->get_column($k);
1370 } elsif (!defined $as) { # undef, i.e. "no reverse object"
1373 $ret{"${as}.${k}"} = "${for}.${v}";
1377 } elsif (ref $cond eq 'ARRAY') {
1378 return [ map { $self->_resolve_condition($_, $as, $for) } @$cond ];
1380 die("Can't handle condition $cond yet :(");
1385 # Accepts one or more relationships for the current source and returns an
1386 # array of column names for each of those relationships. Column names are
1387 # prefixed relative to the current source, in accordance with where they appear
1388 # in the supplied relationships.
1390 sub _resolve_prefetch {
1391 my ($self, $pre, $alias, $alias_map, $order, $collapse, $pref_path) = @_;
1394 if (not defined $pre) {
1397 elsif( ref $pre eq 'ARRAY' ) {
1399 map { $self->_resolve_prefetch( $_, $alias, $alias_map, $order, $collapse, [ @$pref_path ] ) }
1402 elsif( ref $pre eq 'HASH' ) {
1405 $self->_resolve_prefetch($_, $alias, $alias_map, $order, $collapse, [ @$pref_path ] ),
1406 $self->related_source($_)->_resolve_prefetch(
1407 $pre->{$_}, "${alias}.$_", $alias_map, $order, $collapse, [ @$pref_path, $_] )
1412 $self->throw_exception(
1413 "don't know how to resolve prefetch reftype ".ref($pre));
1417 $p = $p->{$_} for (@$pref_path, $pre);
1419 $self->throw_exception (
1420 "Unable to resolve prefetch '$pre' - join alias map does not contain an entry for path: "
1421 . join (' -> ', @$pref_path, $pre)
1422 ) if (ref $p->{-join_aliases} ne 'ARRAY' or not @{$p->{-join_aliases}} );
1424 my $as = shift @{$p->{-join_aliases}};
1426 my $rel_info = $self->relationship_info( $pre );
1427 $self->throw_exception( $self->name . " has no such relationship '$pre'" )
1429 my $as_prefix = ($alias =~ /^.*?\.(.+)$/ ? $1.'.' : '');
1430 my $rel_source = $self->related_source($pre);
1432 if ($rel_info->{attrs}{accessor} && $rel_info->{attrs}{accessor} eq 'multi') {
1433 $self->throw_exception(
1434 "Can't prefetch has_many ${pre} (join cond too complex)")
1435 unless ref($rel_info->{cond}) eq 'HASH';
1436 my $dots = @{[$as_prefix =~ m/\./g]} + 1; # +1 to match the ".${as_prefix}"
1437 if (my ($fail) = grep { @{[$_ =~ m/\./g]} == $dots }
1438 keys %{$collapse}) {
1439 my ($last) = ($fail =~ /([^\.]+)$/);
1441 "Prefetching multiple has_many rels ${last} and ${pre} "
1442 .(length($as_prefix)
1443 ? "at the same level (${as_prefix}) "
1446 . 'will explode the number of row objects retrievable via ->next or ->all. '
1447 . 'Use at your own risk.'
1450 #my @col = map { (/^self\.(.+)$/ ? ("${as_prefix}.$1") : ()); }
1451 # values %{$rel_info->{cond}};
1452 $collapse->{".${as_prefix}${pre}"} = [ $rel_source->primary_columns ];
1453 # action at a distance. prepending the '.' allows simpler code
1454 # in ResultSet->_collapse_result
1455 my @key = map { (/^foreign\.(.+)$/ ? ($1) : ()); }
1456 keys %{$rel_info->{cond}};
1457 my @ord = (ref($rel_info->{attrs}{order_by}) eq 'ARRAY'
1458 ? @{$rel_info->{attrs}{order_by}}
1460 : (defined $rel_info->{attrs}{order_by}
1461 ? ($rel_info->{attrs}{order_by})
1463 push(@$order, map { "${as}.$_" } (@key, @ord));
1466 return map { [ "${as}.$_", "${as_prefix}${pre}.$_", ] }
1467 $rel_source->columns;
1471 =head2 related_source
1475 =item Arguments: $relname
1477 =item Return value: $source
1481 Returns the result source object for the given relationship.
1485 sub related_source {
1486 my ($self, $rel) = @_;
1487 if( !$self->has_relationship( $rel ) ) {
1488 $self->throw_exception("No such relationship '$rel'");
1490 return $self->schema->source($self->relationship_info($rel)->{source});
1493 =head2 related_class
1497 =item Arguments: $relname
1499 =item Return value: $classname
1503 Returns the class name for objects in the given relationship.
1508 my ($self, $rel) = @_;
1509 if( !$self->has_relationship( $rel ) ) {
1510 $self->throw_exception("No such relationship '$rel'");
1512 return $self->schema->class($self->relationship_info($rel)->{source});
1517 Obtain a new handle to this source. Returns an instance of a
1518 L<DBIx::Class::ResultSourceHandle>.
1523 return DBIx::Class::ResultSourceHandle->new({
1524 schema => $_[0]->schema,
1525 source_moniker => $_[0]->source_name
1529 =head2 throw_exception
1531 See L<DBIx::Class::Schema/"throw_exception">.
1535 sub throw_exception {
1538 if (defined $self->schema) {
1539 $self->schema->throw_exception(@_);
1542 DBIx::Class::Exception->throw(@_);
1548 Stores a hashref of per-source metadata. No specific key names
1549 have yet been standardized, the examples below are purely hypothetical
1550 and don't actually accomplish anything on their own:
1552 __PACKAGE__->source_info({
1553 "_tablespace" => 'fast_disk_array_3',
1554 "_engine" => 'InnoDB',
1561 $class->new({attribute_name => value});
1563 Creates a new ResultSource object. Not normally called directly by end users.
1565 =head2 column_info_from_storage
1569 =item Arguments: 1/0 (default: 0)
1571 =item Return value: 1/0
1575 __PACKAGE__->column_info_from_storage(1);
1577 Enables the on-demand automatic loading of the above column
1578 metadata from storage as necessary. This is *deprecated*, and
1579 should not be used. It will be removed before 1.0.
1584 Matt S. Trout <mst@shadowcatsystems.co.uk>
1588 You may distribute this code under the same terms as Perl itself.