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 If a column name beginning with a plus sign ('+col1') is provided, the
143 attributes provided will be merged with any existing attributes for the
144 column, with the new attributes taking precedence in the case that an
145 attribute already exists. Using this without a hashref
146 (C<< $source->add_columns(qw/+col1 +col2/) >>) is legal, but useless --
147 it does the same thing it would do without the plus.
149 The contents of the column_info are not set in stone. The following
150 keys are currently recognised/used by DBIx::Class:
156 { accessor => '_name' }
158 # example use, replace standard accessor with one of your own:
160 my ($self, $value) = @_;
162 die "Name cannot contain digits!" if($value =~ /\d/);
163 $self->_name($value);
165 return $self->_name();
168 Use this to set the name of the accessor method for this column. If unset,
169 the name of the column will be used.
173 { data_type => 'integer' }
175 This contains the column type. It is automatically filled if you use the
176 L<SQL::Translator::Producer::DBIx::Class::File> producer, or the
177 L<DBIx::Class::Schema::Loader> module.
179 Currently there is no standard set of values for the data_type. Use
180 whatever your database supports.
186 The length of your column, if it is a column type that can have a size
187 restriction. This is currently only used to create tables from your
188 schema, see L<DBIx::Class::Schema/deploy>.
194 Set this to a true value for a columns that is allowed to contain NULL
195 values, default is false. This is currently only used to create tables
196 from your schema, see L<DBIx::Class::Schema/deploy>.
198 =item is_auto_increment
200 { is_auto_increment => 1 }
202 Set this to a true value for a column whose value is somehow
203 automatically set, defaults to false. This is used to determine which
204 columns to empty when cloning objects using
205 L<DBIx::Class::Row/copy>. It is also used by
206 L<DBIx::Class::Schema/deploy>.
212 Set this to a true or false value (not C<undef>) to explicitly specify
213 if this column contains numeric data. This controls how set_column
214 decides whether to consider a column dirty after an update: if
215 C<is_numeric> is true a numeric comparison C<< != >> will take place
216 instead of the usual C<eq>
218 If not specified the storage class will attempt to figure this out on
219 first access to the column, based on the column C<data_type>. The
220 result will be cached in this attribute.
224 { is_foreign_key => 1 }
226 Set this to a true value for a column that contains a key from a
227 foreign table, defaults to false. This is currently only used to
228 create tables from your schema, see L<DBIx::Class::Schema/deploy>.
232 { default_value => \'now()' }
234 Set this to the default value which will be inserted into a column by
235 the database. Can contain either a value or a function (use a
236 reference to a scalar e.g. C<\'now()'> if you want a function). This
237 is currently only used to create tables from your schema, see
238 L<DBIx::Class::Schema/deploy>.
240 See the note on L<DBIx::Class::Row/new> for more information about possible
241 issues related to db-side default values.
245 { sequence => 'my_table_seq' }
247 Set this on a primary key column to the name of the sequence used to
248 generate a new key value. If not specified, L<DBIx::Class::PK::Auto>
249 will attempt to retrieve the name of the sequence from the database
254 Set this to a true value for a column whose value is retrieved automatically
255 from a sequence or function (if supported by your Storage driver.) For a
256 sequence, if you do not use a trigger to get the nextval, you have to set the
257 L</sequence> value as well.
259 Also set this for MSSQL columns with the 'uniqueidentifier'
260 L<data_type|DBIx::Class::ResultSource/data_type> whose values you want to
261 automatically generate using C<NEWID()>, unless they are a primary key in which
262 case this will be done anyway.
266 This is used by L<DBIx::Class::Schema/deploy> and L<SQL::Translator>
267 to add extra non-generic data to the column. For example: C<< extra
268 => { unsigned => 1} >> is used by the MySQL producer to set an integer
269 column to unsigned. For more details, see
270 L<SQL::Translator::Producer::MySQL>.
278 =item Arguments: $colname, \%columninfo?
280 =item Return value: 1/0 (true/false)
284 $source->add_column('col' => \%info);
286 Add a single column and optional column info. Uses the same column
287 info keys as L</add_columns>.
292 my ($self, @cols) = @_;
293 $self->_ordered_columns(\@cols) unless $self->_ordered_columns;
296 my $columns = $self->_columns;
297 while (my $col = shift @cols) {
298 my $column_info = {};
299 if ($col =~ s/^\+//) {
300 $column_info = $self->column_info($col);
303 # If next entry is { ... } use that for the column info, if not
304 # use an empty hashref
306 my $new_info = shift(@cols);
307 %$column_info = (%$column_info, %$new_info);
309 push(@added, $col) unless exists $columns->{$col};
310 $columns->{$col} = $column_info;
312 push @{ $self->_ordered_columns }, @added;
316 sub add_column { shift->add_columns(@_); } # DO NOT CHANGE THIS TO GLOB
322 =item Arguments: $colname
324 =item Return value: 1/0 (true/false)
328 if ($source->has_column($colname)) { ... }
330 Returns true if the source has a column of this name, false otherwise.
335 my ($self, $column) = @_;
336 return exists $self->_columns->{$column};
343 =item Arguments: $colname
345 =item Return value: Hashref of info
349 my $info = $source->column_info($col);
351 Returns the column metadata hashref for a column, as originally passed
352 to L</add_columns>. See L</add_columns> above for information on the
353 contents of the hashref.
358 my ($self, $column) = @_;
359 $self->throw_exception("No such column $column")
360 unless exists $self->_columns->{$column};
361 #warn $self->{_columns_info_loaded}, "\n";
362 if ( ! $self->_columns->{$column}{data_type}
363 and $self->column_info_from_storage
364 and ! $self->{_columns_info_loaded}
365 and $self->schema and $self->storage )
367 $self->{_columns_info_loaded}++;
370 # eval for the case of storage without table
371 eval { $info = $self->storage->columns_info_for( $self->from ) };
373 for my $realcol ( keys %{$info} ) {
374 $lc_info->{lc $realcol} = $info->{$realcol};
376 foreach my $col ( keys %{$self->_columns} ) {
377 $self->_columns->{$col} = {
378 %{ $self->_columns->{$col} },
379 %{ $info->{$col} || $lc_info->{lc $col} || {} }
384 return $self->_columns->{$column};
391 =item Arguments: None
393 =item Return value: Ordered list of column names
397 my @column_names = $source->columns;
399 Returns all column names in the order they were declared to L</add_columns>.
405 $self->throw_exception(
406 "columns() is a read-only accessor, did you mean add_columns()?"
408 return @{$self->{_ordered_columns}||[]};
411 =head2 remove_columns
415 =item Arguments: @colnames
417 =item Return value: undefined
421 $source->remove_columns(qw/col1 col2 col3/);
423 Removes the given list of columns by name, from the result source.
425 B<Warning>: Removing a column that is also used in the sources primary
426 key, or in one of the sources unique constraints, B<will> result in a
427 broken result source.
433 =item Arguments: $colname
435 =item Return value: undefined
439 $source->remove_column('col');
441 Remove a single column by name from the result source, similar to
444 B<Warning>: Removing a column that is also used in the sources primary
445 key, or in one of the sources unique constraints, B<will> result in a
446 broken result source.
451 my ($self, @to_remove) = @_;
453 my $columns = $self->_columns
458 delete $columns->{$_};
462 $self->_ordered_columns([ grep { not $to_remove{$_} } @{$self->_ordered_columns} ]);
465 sub remove_column { shift->remove_columns(@_); } # DO NOT CHANGE THIS TO GLOB
467 =head2 set_primary_key
471 =item Arguments: @cols
473 =item Return value: undefined
477 Defines one or more columns as primary key for this source. Must be
478 called after L</add_columns>.
480 Additionally, defines a L<unique constraint|add_unique_constraint>
483 Note: you normally do want to define a primary key on your sources
484 B<even if the underlying database table does not have a primary key>.
486 L<DBIx::Class::Intro/The Significance and Importance of Primary Keys>
491 sub set_primary_key {
492 my ($self, @cols) = @_;
493 # check if primary key columns are valid columns
494 foreach my $col (@cols) {
495 $self->throw_exception("No such column $col on table " . $self->name)
496 unless $self->has_column($col);
498 $self->_primaries(\@cols);
500 $self->add_unique_constraint(primary => \@cols);
503 =head2 primary_columns
507 =item Arguments: None
509 =item Return value: Ordered list of primary column names
513 Read-only accessor which returns the list of primary keys, supplied by
518 sub primary_columns {
519 return @{shift->_primaries||[]};
522 # a helper method that will automatically die with a descriptive message if
523 # no pk is defined on the source in question. For internal use to save
524 # on if @pks... boilerplate
527 my @pcols = $self->primary_columns
528 or $self->throw_exception (sprintf(
529 "Operation requires a primary key to be declared on '%s' via set_primary_key",
535 =head2 add_unique_constraint
539 =item Arguments: $name?, \@colnames
541 =item Return value: undefined
545 Declare a unique constraint on this source. Call once for each unique
548 # For UNIQUE (column1, column2)
549 __PACKAGE__->add_unique_constraint(
550 constraint_name => [ qw/column1 column2/ ],
553 Alternatively, you can specify only the columns:
555 __PACKAGE__->add_unique_constraint([ qw/column1 column2/ ]);
557 This will result in a unique constraint named
558 C<table_column1_column2>, where C<table> is replaced with the table
561 Unique constraints are used, for example, when you pass the constraint
562 name as the C<key> attribute to L<DBIx::Class::ResultSet/find>. Then
563 only columns in the constraint are searched.
565 Throws an error if any of the given column names do not yet exist on
570 sub add_unique_constraint {
575 $name ||= $self->name_unique_constraint($cols);
577 foreach my $col (@$cols) {
578 $self->throw_exception("No such column $col on table " . $self->name)
579 unless $self->has_column($col);
582 my %unique_constraints = $self->unique_constraints;
583 $unique_constraints{$name} = $cols;
584 $self->_unique_constraints(\%unique_constraints);
587 =head2 name_unique_constraint
591 =item Arguments: @colnames
593 =item Return value: Constraint name
597 $source->table('mytable');
598 $source->name_unique_constraint('col1', 'col2');
602 Return a name for a unique constraint containing the specified
603 columns. The name is created by joining the table name and each column
604 name, using an underscore character.
606 For example, a constraint on a table named C<cd> containing the columns
607 C<artist> and C<title> would result in a constraint name of C<cd_artist_title>.
609 This is used by L</add_unique_constraint> if you do not specify the
610 optional constraint name.
614 sub name_unique_constraint {
615 my ($self, $cols) = @_;
617 my $name = $self->name;
618 $name = $$name if (ref $name eq 'SCALAR');
620 return join '_', $name, @$cols;
623 =head2 unique_constraints
627 =item Arguments: None
629 =item Return value: Hash of unique constraint data
633 $source->unique_constraints();
635 Read-only accessor which returns a hash of unique constraints on this
638 The hash is keyed by constraint name, and contains an arrayref of
639 column names as values.
643 sub unique_constraints {
644 return %{shift->_unique_constraints||{}};
647 =head2 unique_constraint_names
651 =item Arguments: None
653 =item Return value: Unique constraint names
657 $source->unique_constraint_names();
659 Returns the list of unique constraint names defined on this source.
663 sub unique_constraint_names {
666 my %unique_constraints = $self->unique_constraints;
668 return keys %unique_constraints;
671 =head2 unique_constraint_columns
675 =item Arguments: $constraintname
677 =item Return value: List of constraint columns
681 $source->unique_constraint_columns('myconstraint');
683 Returns the list of columns that make up the specified unique constraint.
687 sub unique_constraint_columns {
688 my ($self, $constraint_name) = @_;
690 my %unique_constraints = $self->unique_constraints;
692 $self->throw_exception(
693 "Unknown unique constraint $constraint_name on '" . $self->name . "'"
694 ) unless exists $unique_constraints{$constraint_name};
696 return @{ $unique_constraints{$constraint_name} };
699 =head2 sqlt_deploy_callback
703 =item Arguments: $callback
707 __PACKAGE__->sqlt_deploy_callback('mycallbackmethod');
709 An accessor to set a callback to be called during deployment of
710 the schema via L<DBIx::Class::Schema/create_ddl_dir> or
711 L<DBIx::Class::Schema/deploy>.
713 The callback can be set as either a code reference or the name of a
714 method in the current result class.
716 If not set, the L</default_sqlt_deploy_hook> is called.
718 Your callback will be passed the $source object representing the
719 ResultSource instance being deployed, and the
720 L<SQL::Translator::Schema::Table> object being created from it. The
721 callback can be used to manipulate the table object or add your own
722 customised indexes. If you need to manipulate a non-table object, use
723 the L<DBIx::Class::Schema/sqlt_deploy_hook>.
725 See L<DBIx::Class::Manual::Cookbook/Adding Indexes And Functions To
726 Your SQL> for examples.
728 This sqlt deployment callback can only be used to manipulate
729 SQL::Translator objects as they get turned into SQL. To execute
730 post-deploy statements which SQL::Translator does not currently
731 handle, override L<DBIx::Class::Schema/deploy> in your Schema class
732 and call L<dbh_do|DBIx::Class::Storage::DBI/dbh_do>.
734 =head2 default_sqlt_deploy_hook
738 =item Arguments: $source, $sqlt_table
740 =item Return value: undefined
744 This is the sensible default for L</sqlt_deploy_callback>.
746 If a method named C<sqlt_deploy_hook> exists in your Result class, it
747 will be called and passed the current C<$source> and the
748 C<$sqlt_table> being deployed.
752 sub default_sqlt_deploy_hook {
755 my $class = $self->result_class;
757 if ($class and $class->can('sqlt_deploy_hook')) {
758 $class->sqlt_deploy_hook(@_);
762 sub _invoke_sqlt_deploy_hook {
764 if ( my $hook = $self->sqlt_deploy_callback) {
773 =item Arguments: None
775 =item Return value: $resultset
779 Returns a resultset for the given source. This will initially be created
782 $self->resultset_class->new($self, $self->resultset_attributes)
784 but is cached from then on unless resultset_class changes.
786 =head2 resultset_class
790 =item Arguments: $classname
792 =item Return value: $classname
796 package My::Schema::ResultSet::Artist;
797 use base 'DBIx::Class::ResultSet';
800 # In the result class
801 __PACKAGE__->resultset_class('My::Schema::ResultSet::Artist');
804 $source->resultset_class('My::Schema::ResultSet::Artist');
806 Set the class of the resultset. This is useful if you want to create your
807 own resultset methods. Create your own class derived from
808 L<DBIx::Class::ResultSet>, and set it here. If called with no arguments,
809 this method returns the name of the existing resultset class, if one
812 =head2 resultset_attributes
816 =item Arguments: \%attrs
818 =item Return value: \%attrs
822 # In the result class
823 __PACKAGE__->resultset_attributes({ order_by => [ 'id' ] });
826 $source->resultset_attributes({ order_by => [ 'id' ] });
828 Store a collection of resultset attributes, that will be set on every
829 L<DBIx::Class::ResultSet> produced from this result source. For a full
830 list see L<DBIx::Class::ResultSet/ATTRIBUTES>.
836 $self->throw_exception(
837 'resultset does not take any arguments. If you want another resultset, '.
838 'call it on the schema instead.'
841 return $self->resultset_class->new(
844 %{$self->{resultset_attributes}},
845 %{$self->schema->default_resultset_attributes}
854 =item Arguments: $source_name
856 =item Result value: $source_name
860 Set an alternate name for the result source when it is loaded into a schema.
861 This is useful if you want to refer to a result source by a name other than
864 package ArchivedBooks;
865 use base qw/DBIx::Class/;
866 __PACKAGE__->table('books_archive');
867 __PACKAGE__->source_name('Books');
869 # from your schema...
870 $schema->resultset('Books')->find(1);
876 =item Arguments: None
878 =item Return value: FROM clause
882 my $from_clause = $source->from();
884 Returns an expression of the source to be supplied to storage to specify
885 retrieval from this source. In the case of a database, the required FROM
892 =item Arguments: None
894 =item Return value: A schema object
898 my $schema = $source->schema();
900 Returns the L<DBIx::Class::Schema> object that this result source
907 =item Arguments: None
909 =item Return value: A Storage object
913 $source->storage->debug(1);
915 Returns the storage handle for the current schema.
917 See also: L<DBIx::Class::Storage>
921 sub storage { shift->schema->storage; }
923 =head2 add_relationship
927 =item Arguments: $relname, $related_source_name, \%cond, [ \%attrs ]
929 =item Return value: 1/true if it succeeded
933 $source->add_relationship('relname', 'related_source', $cond, $attrs);
935 L<DBIx::Class::Relationship> describes a series of methods which
936 create pre-defined useful types of relationships. Look there first
937 before using this method directly.
939 The relationship name can be arbitrary, but must be unique for each
940 relationship attached to this result source. 'related_source' should
941 be the name with which the related result source was registered with
942 the current schema. For example:
944 $schema->source('Book')->add_relationship('reviews', 'Review', {
945 'foreign.book_id' => 'self.id',
948 The condition C<$cond> needs to be an L<SQL::Abstract>-style
949 representation of the join between the tables. For example, if you're
950 creating a relation from Author to Book,
952 { 'foreign.author_id' => 'self.id' }
954 will result in the JOIN clause
956 author me JOIN book foreign ON foreign.author_id = me.id
958 You can specify as many foreign => self mappings as necessary.
960 Valid attributes are as follows:
966 Explicitly specifies the type of join to use in the relationship. Any
967 SQL join type is valid, e.g. C<LEFT> or C<RIGHT>. It will be placed in
968 the SQL command immediately before C<JOIN>.
972 An arrayref containing a list of accessors in the foreign class to proxy in
973 the main class. If, for example, you do the following:
975 CD->might_have(liner_notes => 'LinerNotes', undef, {
976 proxy => [ qw/notes/ ],
979 Then, assuming LinerNotes has an accessor named notes, you can do:
981 my $cd = CD->find(1);
982 # set notes -- LinerNotes object is created if it doesn't exist
983 $cd->notes('Notes go here');
987 Specifies the type of accessor that should be created for the
988 relationship. Valid values are C<single> (for when there is only a single
989 related object), C<multi> (when there can be many), and C<filter> (for
990 when there is a single related object, but you also want the relationship
991 accessor to double as a column accessor). For C<multi> accessors, an
992 add_to_* method is also created, which calls C<create_related> for the
997 Throws an exception if the condition is improperly supplied, or cannot
1002 sub add_relationship {
1003 my ($self, $rel, $f_source_name, $cond, $attrs) = @_;
1004 $self->throw_exception("Can't create relationship without join condition")
1008 # Check foreign and self are right in cond
1009 if ( (ref $cond ||'') eq 'HASH') {
1011 $self->throw_exception("Keys of condition should be of form 'foreign.col', not '$_'")
1012 if /\./ && !/^foreign\./;
1016 my %rels = %{ $self->_relationships };
1017 $rels{$rel} = { class => $f_source_name,
1018 source => $f_source_name,
1021 $self->_relationships(\%rels);
1025 # XXX disabled. doesn't work properly currently. skip in tests.
1027 my $f_source = $self->schema->source($f_source_name);
1028 unless ($f_source) {
1029 $self->ensure_class_loaded($f_source_name);
1030 $f_source = $f_source_name->result_source;
1031 #my $s_class = ref($self->schema);
1032 #$f_source_name =~ m/^${s_class}::(.*)$/;
1033 #$self->schema->register_class(($1 || $f_source_name), $f_source_name);
1034 #$f_source = $self->schema->source($f_source_name);
1036 return unless $f_source; # Can't test rel without f_source
1038 eval { $self->_resolve_join($rel, 'me', {}, []) };
1040 if ($@) { # If the resolve failed, back out and re-throw the error
1041 delete $rels{$rel}; #
1042 $self->_relationships(\%rels);
1043 $self->throw_exception("Error creating relationship $rel: $@");
1048 =head2 relationships
1052 =item Arguments: None
1054 =item Return value: List of relationship names
1058 my @relnames = $source->relationships();
1060 Returns all relationship names for this source.
1065 return keys %{shift->_relationships};
1068 =head2 relationship_info
1072 =item Arguments: $relname
1074 =item Return value: Hashref of relation data,
1078 Returns a hash of relationship information for the specified relationship
1079 name. The keys/values are as specified for L</add_relationship>.
1083 sub relationship_info {
1084 my ($self, $rel) = @_;
1085 return $self->_relationships->{$rel};
1088 =head2 has_relationship
1092 =item Arguments: $rel
1094 =item Return value: 1/0 (true/false)
1098 Returns true if the source has a relationship of this name, false otherwise.
1102 sub has_relationship {
1103 my ($self, $rel) = @_;
1104 return exists $self->_relationships->{$rel};
1107 =head2 reverse_relationship_info
1111 =item Arguments: $relname
1113 =item Return value: Hashref of relationship data
1117 Looks through all the relationships on the source this relationship
1118 points to, looking for one whose condition is the reverse of the
1119 condition on this relationship.
1121 A common use of this is to find the name of the C<belongs_to> relation
1122 opposing a C<has_many> relation. For definition of these look in
1123 L<DBIx::Class::Relationship>.
1125 The returned hashref is keyed by the name of the opposing
1126 relationship, and contains its data in the same manner as
1127 L</relationship_info>.
1131 sub reverse_relationship_info {
1132 my ($self, $rel) = @_;
1133 my $rel_info = $self->relationship_info($rel);
1136 return $ret unless ((ref $rel_info->{cond}) eq 'HASH');
1138 my @cond = keys(%{$rel_info->{cond}});
1139 my @refkeys = map {/^\w+\.(\w+)$/} @cond;
1140 my @keys = map {$rel_info->{cond}->{$_} =~ /^\w+\.(\w+)$/} @cond;
1142 # Get the related result source for this relationship
1143 my $othertable = $self->related_source($rel);
1145 # Get all the relationships for that source that related to this source
1146 # whose foreign column set are our self columns on $rel and whose self
1147 # columns are our foreign columns on $rel.
1148 my @otherrels = $othertable->relationships();
1149 my $otherrelationship;
1150 foreach my $otherrel (@otherrels) {
1151 my $otherrel_info = $othertable->relationship_info($otherrel);
1153 my $back = $othertable->related_source($otherrel);
1154 next unless $back->source_name eq $self->source_name;
1158 if (ref $otherrel_info->{cond} eq 'HASH') {
1159 @othertestconds = ($otherrel_info->{cond});
1161 elsif (ref $otherrel_info->{cond} eq 'ARRAY') {
1162 @othertestconds = @{$otherrel_info->{cond}};
1168 foreach my $othercond (@othertestconds) {
1169 my @other_cond = keys(%$othercond);
1170 my @other_refkeys = map {/^\w+\.(\w+)$/} @other_cond;
1171 my @other_keys = map {$othercond->{$_} =~ /^\w+\.(\w+)$/} @other_cond;
1172 next if (!$self->_compare_relationship_keys(\@refkeys, \@other_keys) ||
1173 !$self->_compare_relationship_keys(\@other_refkeys, \@keys));
1174 $ret->{$otherrel} = $otherrel_info;
1180 sub compare_relationship_keys {
1181 carp 'compare_relationship_keys is a private method, stop calling it';
1183 $self->_compare_relationship_keys (@_);
1186 # Returns true if both sets of keynames are the same, false otherwise.
1187 sub _compare_relationship_keys {
1188 my ($self, $keys1, $keys2) = @_;
1190 # Make sure every keys1 is in keys2
1192 foreach my $key (@$keys1) {
1194 foreach my $prim (@$keys2) {
1195 if ($prim eq $key) {
1203 # Make sure every key2 is in key1
1205 foreach my $prim (@$keys2) {
1207 foreach my $key (@$keys1) {
1208 if ($prim eq $key) {
1220 # Returns the {from} structure used to express JOIN conditions
1222 my ($self, $join, $alias, $seen, $jpath, $parent_force_left) = @_;
1224 # we need a supplied one, because we do in-place modifications, no returns
1225 $self->throw_exception ('You must supply a seen hashref as the 3rd argument to _resolve_join')
1226 unless ref $seen eq 'HASH';
1228 $self->throw_exception ('You must supply a joinpath arrayref as the 4th argument to _resolve_join')
1229 unless ref $jpath eq 'ARRAY';
1231 $jpath = [@$jpath]; # copy
1233 if (not defined $join) {
1236 elsif (ref $join eq 'ARRAY') {
1239 $self->_resolve_join($_, $alias, $seen, $jpath, $parent_force_left);
1242 elsif (ref $join eq 'HASH') {
1245 for my $rel (keys %$join) {
1247 my $rel_info = $self->relationship_info($rel)
1248 or $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
1250 my $force_left = $parent_force_left;
1251 $force_left ||= lc($rel_info->{attrs}{join_type}||'') eq 'left';
1253 # the actual seen value will be incremented by the recursion
1254 my $as = $self->storage->relname_to_table_alias(
1255 $rel, ($seen->{$rel} && $seen->{$rel} + 1)
1259 $self->_resolve_join($rel, $alias, $seen, [@$jpath], $force_left),
1260 $self->related_source($rel)->_resolve_join(
1261 $join->{$rel}, $as, $seen, [@$jpath, { $rel => $as }], $force_left
1269 $self->throw_exception("No idea how to resolve join reftype ".ref $join);
1272 my $count = ++$seen->{$join};
1273 my $as = $self->storage->relname_to_table_alias(
1274 $join, ($count > 1 && $count)
1277 my $rel_info = $self->relationship_info($join)
1278 or $self->throw_exception("No such relationship $join on " . $self->source_name);
1280 my $rel_src = $self->related_source($join);
1281 return [ { $as => $rel_src->from,
1282 -source_handle => $rel_src->handle,
1283 -join_type => $parent_force_left
1285 : $rel_info->{attrs}{join_type}
1287 -join_path => [@$jpath, { $join => $as } ],
1289 $rel_info->{attrs}{accessor}
1291 List::Util::first { $rel_info->{attrs}{accessor} eq $_ } (qw/single filter/)
1294 -relation_chain_depth => $seen->{-relation_chain_depth} || 0,
1296 $self->_resolve_condition($rel_info->{cond}, $as, $alias) ];
1301 carp 'pk_depends_on is a private method, stop calling it';
1303 $self->_pk_depends_on (@_);
1306 # Determines whether a relation is dependent on an object from this source
1307 # having already been inserted. Takes the name of the relationship and a
1308 # hashref of columns of the related object.
1309 sub _pk_depends_on {
1310 my ($self, $relname, $rel_data) = @_;
1312 my $relinfo = $self->relationship_info($relname);
1314 # don't assume things if the relationship direction is specified
1315 return $relinfo->{attrs}{is_foreign_key_constraint}
1316 if exists ($relinfo->{attrs}{is_foreign_key_constraint});
1318 my $cond = $relinfo->{cond};
1319 return 0 unless ref($cond) eq 'HASH';
1321 # map { foreign.foo => 'self.bar' } to { bar => 'foo' }
1322 my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond };
1324 # assume anything that references our PK probably is dependent on us
1325 # rather than vice versa, unless the far side is (a) defined or (b)
1327 my $rel_source = $self->related_source($relname);
1329 foreach my $p ($self->primary_columns) {
1330 if (exists $keyhash->{$p}) {
1331 unless (defined($rel_data->{$keyhash->{$p}})
1332 || $rel_source->column_info($keyhash->{$p})
1333 ->{is_auto_increment}) {
1342 sub resolve_condition {
1343 carp 'resolve_condition is a private method, stop calling it';
1345 $self->_resolve_condition (@_);
1348 # Resolves the passed condition to a concrete query fragment. If given an alias,
1349 # returns a join condition; if given an object, inverts that object to produce
1350 # a related conditional from that object.
1351 our $UNRESOLVABLE_CONDITION = \'1 = 0';
1353 sub _resolve_condition {
1354 my ($self, $cond, $as, $for) = @_;
1355 if (ref $cond eq 'HASH') {
1357 foreach my $k (keys %{$cond}) {
1358 my $v = $cond->{$k};
1359 # XXX should probably check these are valid columns
1360 $k =~ s/^foreign\.// ||
1361 $self->throw_exception("Invalid rel cond key ${k}");
1362 $v =~ s/^self\.// ||
1363 $self->throw_exception("Invalid rel cond val ${v}");
1364 if (ref $for) { # Object
1365 #warn "$self $k $for $v";
1366 unless ($for->has_column_loaded($v)) {
1367 if ($for->in_storage) {
1368 $self->throw_exception(sprintf
1369 "Unable to resolve relationship '%s' from object %s: column '%s' not "
1370 . 'loaded from storage (or not passed to new() prior to insert()). You '
1371 . 'probably need to call ->discard_changes to get the server-side defaults '
1372 . 'from the database.',
1378 return $UNRESOLVABLE_CONDITION;
1380 $ret{$k} = $for->get_column($v);
1381 #$ret{$k} = $for->get_column($v) if $for->has_column_loaded($v);
1383 } elsif (!defined $for) { # undef, i.e. "no object"
1385 } elsif (ref $as eq 'HASH') { # reverse hashref
1386 $ret{$v} = $as->{$k};
1387 } elsif (ref $as) { # reverse object
1388 $ret{$v} = $as->get_column($k);
1389 } elsif (!defined $as) { # undef, i.e. "no reverse object"
1392 $ret{"${as}.${k}"} = "${for}.${v}";
1396 } elsif (ref $cond eq 'ARRAY') {
1397 return [ map { $self->_resolve_condition($_, $as, $for) } @$cond ];
1399 die("Can't handle condition $cond yet :(");
1404 # Accepts one or more relationships for the current source and returns an
1405 # array of column names for each of those relationships. Column names are
1406 # prefixed relative to the current source, in accordance with where they appear
1407 # in the supplied relationships.
1409 sub _resolve_prefetch {
1410 my ($self, $pre, $alias, $alias_map, $order, $collapse, $pref_path) = @_;
1413 if (not defined $pre) {
1416 elsif( ref $pre eq 'ARRAY' ) {
1418 map { $self->_resolve_prefetch( $_, $alias, $alias_map, $order, $collapse, [ @$pref_path ] ) }
1421 elsif( ref $pre eq 'HASH' ) {
1424 $self->_resolve_prefetch($_, $alias, $alias_map, $order, $collapse, [ @$pref_path ] ),
1425 $self->related_source($_)->_resolve_prefetch(
1426 $pre->{$_}, "${alias}.$_", $alias_map, $order, $collapse, [ @$pref_path, $_] )
1431 $self->throw_exception(
1432 "don't know how to resolve prefetch reftype ".ref($pre));
1436 $p = $p->{$_} for (@$pref_path, $pre);
1438 $self->throw_exception (
1439 "Unable to resolve prefetch '$pre' - join alias map does not contain an entry for path: "
1440 . join (' -> ', @$pref_path, $pre)
1441 ) if (ref $p->{-join_aliases} ne 'ARRAY' or not @{$p->{-join_aliases}} );
1443 my $as = shift @{$p->{-join_aliases}};
1445 my $rel_info = $self->relationship_info( $pre );
1446 $self->throw_exception( $self->source_name . " has no such relationship '$pre'" )
1448 my $as_prefix = ($alias =~ /^.*?\.(.+)$/ ? $1.'.' : '');
1449 my $rel_source = $self->related_source($pre);
1451 if ($rel_info->{attrs}{accessor} && $rel_info->{attrs}{accessor} eq 'multi') {
1452 $self->throw_exception(
1453 "Can't prefetch has_many ${pre} (join cond too complex)")
1454 unless ref($rel_info->{cond}) eq 'HASH';
1455 my $dots = @{[$as_prefix =~ m/\./g]} + 1; # +1 to match the ".${as_prefix}"
1456 if (my ($fail) = grep { @{[$_ =~ m/\./g]} == $dots }
1457 keys %{$collapse}) {
1458 my ($last) = ($fail =~ /([^\.]+)$/);
1460 "Prefetching multiple has_many rels ${last} and ${pre} "
1461 .(length($as_prefix)
1462 ? "at the same level (${as_prefix}) "
1465 . 'will explode the number of row objects retrievable via ->next or ->all. '
1466 . 'Use at your own risk.'
1469 #my @col = map { (/^self\.(.+)$/ ? ("${as_prefix}.$1") : ()); }
1470 # values %{$rel_info->{cond}};
1471 $collapse->{".${as_prefix}${pre}"} = [ $rel_source->_pri_cols ];
1472 # action at a distance. prepending the '.' allows simpler code
1473 # in ResultSet->_collapse_result
1474 my @key = map { (/^foreign\.(.+)$/ ? ($1) : ()); }
1475 keys %{$rel_info->{cond}};
1476 my @ord = (ref($rel_info->{attrs}{order_by}) eq 'ARRAY'
1477 ? @{$rel_info->{attrs}{order_by}}
1479 : (defined $rel_info->{attrs}{order_by}
1480 ? ($rel_info->{attrs}{order_by})
1482 push(@$order, map { "${as}.$_" } (@key, @ord));
1485 return map { [ "${as}.$_", "${as_prefix}${pre}.$_", ] }
1486 $rel_source->columns;
1490 =head2 related_source
1494 =item Arguments: $relname
1496 =item Return value: $source
1500 Returns the result source object for the given relationship.
1504 sub related_source {
1505 my ($self, $rel) = @_;
1506 if( !$self->has_relationship( $rel ) ) {
1507 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
1509 return $self->schema->source($self->relationship_info($rel)->{source});
1512 =head2 related_class
1516 =item Arguments: $relname
1518 =item Return value: $classname
1522 Returns the class name for objects in the given relationship.
1527 my ($self, $rel) = @_;
1528 if( !$self->has_relationship( $rel ) ) {
1529 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
1531 return $self->schema->class($self->relationship_info($rel)->{source});
1536 Obtain a new handle to this source. Returns an instance of a
1537 L<DBIx::Class::ResultSourceHandle>.
1542 return DBIx::Class::ResultSourceHandle->new({
1543 schema => $_[0]->schema,
1544 source_moniker => $_[0]->source_name
1548 =head2 throw_exception
1550 See L<DBIx::Class::Schema/"throw_exception">.
1554 sub throw_exception {
1557 if (defined $self->schema) {
1558 $self->schema->throw_exception(@_);
1561 DBIx::Class::Exception->throw(@_);
1567 Stores a hashref of per-source metadata. No specific key names
1568 have yet been standardized, the examples below are purely hypothetical
1569 and don't actually accomplish anything on their own:
1571 __PACKAGE__->source_info({
1572 "_tablespace" => 'fast_disk_array_3',
1573 "_engine" => 'InnoDB',
1580 $class->new({attribute_name => value});
1582 Creates a new ResultSource object. Not normally called directly by end users.
1584 =head2 column_info_from_storage
1588 =item Arguments: 1/0 (default: 0)
1590 =item Return value: 1/0
1594 __PACKAGE__->column_info_from_storage(1);
1596 Enables the on-demand automatic loading of the above column
1597 metadata from storage as necessary. This is *deprecated*, and
1598 should not be used. It will be removed before 1.0.
1603 Matt S. Trout <mst@shadowcatsystems.co.uk>
1607 You may distribute this code under the same terms as Perl itself.