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||[]};
524 my @pcols = $self->primary_columns
525 or $self->throw_exception (sprintf(
526 'Operation requires a primary key to be declared on %s via set_primary_key',
532 =head2 add_unique_constraint
536 =item Arguments: $name?, \@colnames
538 =item Return value: undefined
542 Declare a unique constraint on this source. Call once for each unique
545 # For UNIQUE (column1, column2)
546 __PACKAGE__->add_unique_constraint(
547 constraint_name => [ qw/column1 column2/ ],
550 Alternatively, you can specify only the columns:
552 __PACKAGE__->add_unique_constraint([ qw/column1 column2/ ]);
554 This will result in a unique constraint named
555 C<table_column1_column2>, where C<table> is replaced with the table
558 Unique constraints are used, for example, when you pass the constraint
559 name as the C<key> attribute to L<DBIx::Class::ResultSet/find>. Then
560 only columns in the constraint are searched.
562 Throws an error if any of the given column names do not yet exist on
567 sub add_unique_constraint {
572 $name ||= $self->name_unique_constraint($cols);
574 foreach my $col (@$cols) {
575 $self->throw_exception("No such column $col on table " . $self->name)
576 unless $self->has_column($col);
579 my %unique_constraints = $self->unique_constraints;
580 $unique_constraints{$name} = $cols;
581 $self->_unique_constraints(\%unique_constraints);
584 =head2 name_unique_constraint
588 =item Arguments: @colnames
590 =item Return value: Constraint name
594 $source->table('mytable');
595 $source->name_unique_constraint('col1', 'col2');
599 Return a name for a unique constraint containing the specified
600 columns. The name is created by joining the table name and each column
601 name, using an underscore character.
603 For example, a constraint on a table named C<cd> containing the columns
604 C<artist> and C<title> would result in a constraint name of C<cd_artist_title>.
606 This is used by L</add_unique_constraint> if you do not specify the
607 optional constraint name.
611 sub name_unique_constraint {
612 my ($self, $cols) = @_;
614 my $name = $self->name;
615 $name = $$name if (ref $name eq 'SCALAR');
617 return join '_', $name, @$cols;
620 =head2 unique_constraints
624 =item Arguments: None
626 =item Return value: Hash of unique constraint data
630 $source->unique_constraints();
632 Read-only accessor which returns a hash of unique constraints on this
635 The hash is keyed by constraint name, and contains an arrayref of
636 column names as values.
640 sub unique_constraints {
641 return %{shift->_unique_constraints||{}};
644 =head2 unique_constraint_names
648 =item Arguments: None
650 =item Return value: Unique constraint names
654 $source->unique_constraint_names();
656 Returns the list of unique constraint names defined on this source.
660 sub unique_constraint_names {
663 my %unique_constraints = $self->unique_constraints;
665 return keys %unique_constraints;
668 =head2 unique_constraint_columns
672 =item Arguments: $constraintname
674 =item Return value: List of constraint columns
678 $source->unique_constraint_columns('myconstraint');
680 Returns the list of columns that make up the specified unique constraint.
684 sub unique_constraint_columns {
685 my ($self, $constraint_name) = @_;
687 my %unique_constraints = $self->unique_constraints;
689 $self->throw_exception(
690 "Unknown unique constraint $constraint_name on '" . $self->name . "'"
691 ) unless exists $unique_constraints{$constraint_name};
693 return @{ $unique_constraints{$constraint_name} };
696 =head2 sqlt_deploy_callback
700 =item Arguments: $callback
704 __PACKAGE__->sqlt_deploy_callback('mycallbackmethod');
706 An accessor to set a callback to be called during deployment of
707 the schema via L<DBIx::Class::Schema/create_ddl_dir> or
708 L<DBIx::Class::Schema/deploy>.
710 The callback can be set as either a code reference or the name of a
711 method in the current result class.
713 If not set, the L</default_sqlt_deploy_hook> is called.
715 Your callback will be passed the $source object representing the
716 ResultSource instance being deployed, and the
717 L<SQL::Translator::Schema::Table> object being created from it. The
718 callback can be used to manipulate the table object or add your own
719 customised indexes. If you need to manipulate a non-table object, use
720 the L<DBIx::Class::Schema/sqlt_deploy_hook>.
722 See L<DBIx::Class::Manual::Cookbook/Adding Indexes And Functions To
723 Your SQL> for examples.
725 This sqlt deployment callback can only be used to manipulate
726 SQL::Translator objects as they get turned into SQL. To execute
727 post-deploy statements which SQL::Translator does not currently
728 handle, override L<DBIx::Class::Schema/deploy> in your Schema class
729 and call L<dbh_do|DBIx::Class::Storage::DBI/dbh_do>.
731 =head2 default_sqlt_deploy_hook
735 =item Arguments: $source, $sqlt_table
737 =item Return value: undefined
741 This is the sensible default for L</sqlt_deploy_callback>.
743 If a method named C<sqlt_deploy_hook> exists in your Result class, it
744 will be called and passed the current C<$source> and the
745 C<$sqlt_table> being deployed.
749 sub default_sqlt_deploy_hook {
752 my $class = $self->result_class;
754 if ($class and $class->can('sqlt_deploy_hook')) {
755 $class->sqlt_deploy_hook(@_);
759 sub _invoke_sqlt_deploy_hook {
761 if ( my $hook = $self->sqlt_deploy_callback) {
770 =item Arguments: None
772 =item Return value: $resultset
776 Returns a resultset for the given source. This will initially be created
779 $self->resultset_class->new($self, $self->resultset_attributes)
781 but is cached from then on unless resultset_class changes.
783 =head2 resultset_class
787 =item Arguments: $classname
789 =item Return value: $classname
793 package My::Schema::ResultSet::Artist;
794 use base 'DBIx::Class::ResultSet';
797 # In the result class
798 __PACKAGE__->resultset_class('My::Schema::ResultSet::Artist');
801 $source->resultset_class('My::Schema::ResultSet::Artist');
803 Set the class of the resultset. This is useful if you want to create your
804 own resultset methods. Create your own class derived from
805 L<DBIx::Class::ResultSet>, and set it here. If called with no arguments,
806 this method returns the name of the existing resultset class, if one
809 =head2 resultset_attributes
813 =item Arguments: \%attrs
815 =item Return value: \%attrs
819 # In the result class
820 __PACKAGE__->resultset_attributes({ order_by => [ 'id' ] });
823 $source->resultset_attributes({ order_by => [ 'id' ] });
825 Store a collection of resultset attributes, that will be set on every
826 L<DBIx::Class::ResultSet> produced from this result source. For a full
827 list see L<DBIx::Class::ResultSet/ATTRIBUTES>.
833 $self->throw_exception(
834 'resultset does not take any arguments. If you want another resultset, '.
835 'call it on the schema instead.'
838 return $self->resultset_class->new(
841 %{$self->{resultset_attributes}},
842 %{$self->schema->default_resultset_attributes}
851 =item Arguments: $source_name
853 =item Result value: $source_name
857 Set an alternate name for the result source when it is loaded into a schema.
858 This is useful if you want to refer to a result source by a name other than
861 package ArchivedBooks;
862 use base qw/DBIx::Class/;
863 __PACKAGE__->table('books_archive');
864 __PACKAGE__->source_name('Books');
866 # from your schema...
867 $schema->resultset('Books')->find(1);
873 =item Arguments: None
875 =item Return value: FROM clause
879 my $from_clause = $source->from();
881 Returns an expression of the source to be supplied to storage to specify
882 retrieval from this source. In the case of a database, the required FROM
889 =item Arguments: None
891 =item Return value: A schema object
895 my $schema = $source->schema();
897 Returns the L<DBIx::Class::Schema> object that this result source
904 =item Arguments: None
906 =item Return value: A Storage object
910 $source->storage->debug(1);
912 Returns the storage handle for the current schema.
914 See also: L<DBIx::Class::Storage>
918 sub storage { shift->schema->storage; }
920 =head2 add_relationship
924 =item Arguments: $relname, $related_source_name, \%cond, [ \%attrs ]
926 =item Return value: 1/true if it succeeded
930 $source->add_relationship('relname', 'related_source', $cond, $attrs);
932 L<DBIx::Class::Relationship> describes a series of methods which
933 create pre-defined useful types of relationships. Look there first
934 before using this method directly.
936 The relationship name can be arbitrary, but must be unique for each
937 relationship attached to this result source. 'related_source' should
938 be the name with which the related result source was registered with
939 the current schema. For example:
941 $schema->source('Book')->add_relationship('reviews', 'Review', {
942 'foreign.book_id' => 'self.id',
945 The condition C<$cond> needs to be an L<SQL::Abstract>-style
946 representation of the join between the tables. For example, if you're
947 creating a relation from Author to Book,
949 { 'foreign.author_id' => 'self.id' }
951 will result in the JOIN clause
953 author me JOIN book foreign ON foreign.author_id = me.id
955 You can specify as many foreign => self mappings as necessary.
957 Valid attributes are as follows:
963 Explicitly specifies the type of join to use in the relationship. Any
964 SQL join type is valid, e.g. C<LEFT> or C<RIGHT>. It will be placed in
965 the SQL command immediately before C<JOIN>.
969 An arrayref containing a list of accessors in the foreign class to proxy in
970 the main class. If, for example, you do the following:
972 CD->might_have(liner_notes => 'LinerNotes', undef, {
973 proxy => [ qw/notes/ ],
976 Then, assuming LinerNotes has an accessor named notes, you can do:
978 my $cd = CD->find(1);
979 # set notes -- LinerNotes object is created if it doesn't exist
980 $cd->notes('Notes go here');
984 Specifies the type of accessor that should be created for the
985 relationship. Valid values are C<single> (for when there is only a single
986 related object), C<multi> (when there can be many), and C<filter> (for
987 when there is a single related object, but you also want the relationship
988 accessor to double as a column accessor). For C<multi> accessors, an
989 add_to_* method is also created, which calls C<create_related> for the
994 Throws an exception if the condition is improperly supplied, or cannot
999 sub add_relationship {
1000 my ($self, $rel, $f_source_name, $cond, $attrs) = @_;
1001 $self->throw_exception("Can't create relationship without join condition")
1005 # Check foreign and self are right in cond
1006 if ( (ref $cond ||'') eq 'HASH') {
1008 $self->throw_exception("Keys of condition should be of form 'foreign.col', not '$_'")
1009 if /\./ && !/^foreign\./;
1013 my %rels = %{ $self->_relationships };
1014 $rels{$rel} = { class => $f_source_name,
1015 source => $f_source_name,
1018 $self->_relationships(\%rels);
1022 # XXX disabled. doesn't work properly currently. skip in tests.
1024 my $f_source = $self->schema->source($f_source_name);
1025 unless ($f_source) {
1026 $self->ensure_class_loaded($f_source_name);
1027 $f_source = $f_source_name->result_source;
1028 #my $s_class = ref($self->schema);
1029 #$f_source_name =~ m/^${s_class}::(.*)$/;
1030 #$self->schema->register_class(($1 || $f_source_name), $f_source_name);
1031 #$f_source = $self->schema->source($f_source_name);
1033 return unless $f_source; # Can't test rel without f_source
1035 eval { $self->_resolve_join($rel, 'me', {}, []) };
1037 if ($@) { # If the resolve failed, back out and re-throw the error
1038 delete $rels{$rel}; #
1039 $self->_relationships(\%rels);
1040 $self->throw_exception("Error creating relationship $rel: $@");
1045 =head2 relationships
1049 =item Arguments: None
1051 =item Return value: List of relationship names
1055 my @relnames = $source->relationships();
1057 Returns all relationship names for this source.
1062 return keys %{shift->_relationships};
1065 =head2 relationship_info
1069 =item Arguments: $relname
1071 =item Return value: Hashref of relation data,
1075 Returns a hash of relationship information for the specified relationship
1076 name. The keys/values are as specified for L</add_relationship>.
1080 sub relationship_info {
1081 my ($self, $rel) = @_;
1082 return $self->_relationships->{$rel};
1085 =head2 has_relationship
1089 =item Arguments: $rel
1091 =item Return value: 1/0 (true/false)
1095 Returns true if the source has a relationship of this name, false otherwise.
1099 sub has_relationship {
1100 my ($self, $rel) = @_;
1101 return exists $self->_relationships->{$rel};
1104 =head2 reverse_relationship_info
1108 =item Arguments: $relname
1110 =item Return value: Hashref of relationship data
1114 Looks through all the relationships on the source this relationship
1115 points to, looking for one whose condition is the reverse of the
1116 condition on this relationship.
1118 A common use of this is to find the name of the C<belongs_to> relation
1119 opposing a C<has_many> relation. For definition of these look in
1120 L<DBIx::Class::Relationship>.
1122 The returned hashref is keyed by the name of the opposing
1123 relationship, and contains its data in the same manner as
1124 L</relationship_info>.
1128 sub reverse_relationship_info {
1129 my ($self, $rel) = @_;
1130 my $rel_info = $self->relationship_info($rel);
1133 return $ret unless ((ref $rel_info->{cond}) eq 'HASH');
1135 my @cond = keys(%{$rel_info->{cond}});
1136 my @refkeys = map {/^\w+\.(\w+)$/} @cond;
1137 my @keys = map {$rel_info->{cond}->{$_} =~ /^\w+\.(\w+)$/} @cond;
1139 # Get the related result source for this relationship
1140 my $othertable = $self->related_source($rel);
1142 # Get all the relationships for that source that related to this source
1143 # whose foreign column set are our self columns on $rel and whose self
1144 # columns are our foreign columns on $rel.
1145 my @otherrels = $othertable->relationships();
1146 my $otherrelationship;
1147 foreach my $otherrel (@otherrels) {
1148 my $otherrel_info = $othertable->relationship_info($otherrel);
1150 my $back = $othertable->related_source($otherrel);
1151 next unless $back->source_name eq $self->source_name;
1155 if (ref $otherrel_info->{cond} eq 'HASH') {
1156 @othertestconds = ($otherrel_info->{cond});
1158 elsif (ref $otherrel_info->{cond} eq 'ARRAY') {
1159 @othertestconds = @{$otherrel_info->{cond}};
1165 foreach my $othercond (@othertestconds) {
1166 my @other_cond = keys(%$othercond);
1167 my @other_refkeys = map {/^\w+\.(\w+)$/} @other_cond;
1168 my @other_keys = map {$othercond->{$_} =~ /^\w+\.(\w+)$/} @other_cond;
1169 next if (!$self->_compare_relationship_keys(\@refkeys, \@other_keys) ||
1170 !$self->_compare_relationship_keys(\@other_refkeys, \@keys));
1171 $ret->{$otherrel} = $otherrel_info;
1177 sub compare_relationship_keys {
1178 carp 'compare_relationship_keys is a private method, stop calling it';
1180 $self->_compare_relationship_keys (@_);
1183 # Returns true if both sets of keynames are the same, false otherwise.
1184 sub _compare_relationship_keys {
1185 my ($self, $keys1, $keys2) = @_;
1187 # Make sure every keys1 is in keys2
1189 foreach my $key (@$keys1) {
1191 foreach my $prim (@$keys2) {
1192 if ($prim eq $key) {
1200 # Make sure every key2 is in key1
1202 foreach my $prim (@$keys2) {
1204 foreach my $key (@$keys1) {
1205 if ($prim eq $key) {
1217 # Returns the {from} structure used to express JOIN conditions
1219 my ($self, $join, $alias, $seen, $jpath, $parent_force_left) = @_;
1221 # we need a supplied one, because we do in-place modifications, no returns
1222 $self->throw_exception ('You must supply a seen hashref as the 3rd argument to _resolve_join')
1223 unless ref $seen eq 'HASH';
1225 $self->throw_exception ('You must supply a joinpath arrayref as the 4th argument to _resolve_join')
1226 unless ref $jpath eq 'ARRAY';
1228 $jpath = [@$jpath]; # copy
1230 if (not defined $join) {
1233 elsif (ref $join eq 'ARRAY') {
1236 $self->_resolve_join($_, $alias, $seen, $jpath, $parent_force_left);
1239 elsif (ref $join eq 'HASH') {
1242 for my $rel (keys %$join) {
1244 my $rel_info = $self->relationship_info($rel)
1245 or $self->throw_exception("No such relationship ${rel}");
1247 my $force_left = $parent_force_left;
1248 $force_left ||= lc($rel_info->{attrs}{join_type}||'') eq 'left';
1250 # the actual seen value will be incremented by the recursion
1251 my $as = $self->storage->relname_to_table_alias(
1252 $rel, ($seen->{$rel} && $seen->{$rel} + 1)
1256 $self->_resolve_join($rel, $alias, $seen, [@$jpath], $force_left),
1257 $self->related_source($rel)->_resolve_join(
1258 $join->{$rel}, $as, $seen, [@$jpath, { $rel => $as }], $force_left
1266 $self->throw_exception("No idea how to resolve join reftype ".ref $join);
1269 my $count = ++$seen->{$join};
1270 my $as = $self->storage->relname_to_table_alias(
1271 $join, ($count > 1 && $count)
1274 my $rel_info = $self->relationship_info($join)
1275 or $self->throw_exception("No such relationship ${join}");
1277 my $rel_src = $self->related_source($join);
1278 return [ { $as => $rel_src->from,
1279 -source_handle => $rel_src->handle,
1280 -join_type => $parent_force_left
1282 : $rel_info->{attrs}{join_type}
1284 -join_path => [@$jpath, { $join => $as } ],
1286 $rel_info->{attrs}{accessor}
1288 List::Util::first { $rel_info->{attrs}{accessor} eq $_ } (qw/single filter/)
1291 -relation_chain_depth => $seen->{-relation_chain_depth} || 0,
1293 $self->_resolve_condition($rel_info->{cond}, $as, $alias) ];
1298 carp 'pk_depends_on is a private method, stop calling it';
1300 $self->_pk_depends_on (@_);
1303 # Determines whether a relation is dependent on an object from this source
1304 # having already been inserted. Takes the name of the relationship and a
1305 # hashref of columns of the related object.
1306 sub _pk_depends_on {
1307 my ($self, $relname, $rel_data) = @_;
1309 my $relinfo = $self->relationship_info($relname);
1311 # don't assume things if the relationship direction is specified
1312 return $relinfo->{attrs}{is_foreign_key_constraint}
1313 if exists ($relinfo->{attrs}{is_foreign_key_constraint});
1315 my $cond = $relinfo->{cond};
1316 return 0 unless ref($cond) eq 'HASH';
1318 # map { foreign.foo => 'self.bar' } to { bar => 'foo' }
1319 my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond };
1321 # assume anything that references our PK probably is dependent on us
1322 # rather than vice versa, unless the far side is (a) defined or (b)
1324 my $rel_source = $self->related_source($relname);
1326 foreach my $p ($self->primary_columns) {
1327 if (exists $keyhash->{$p}) {
1328 unless (defined($rel_data->{$keyhash->{$p}})
1329 || $rel_source->column_info($keyhash->{$p})
1330 ->{is_auto_increment}) {
1339 sub resolve_condition {
1340 carp 'resolve_condition is a private method, stop calling it';
1342 $self->_resolve_condition (@_);
1345 # Resolves the passed condition to a concrete query fragment. If given an alias,
1346 # returns a join condition; if given an object, inverts that object to produce
1347 # a related conditional from that object.
1348 our $UNRESOLVABLE_CONDITION = \'1 = 0';
1350 sub _resolve_condition {
1351 my ($self, $cond, $as, $for) = @_;
1352 if (ref $cond eq 'HASH') {
1354 foreach my $k (keys %{$cond}) {
1355 my $v = $cond->{$k};
1356 # XXX should probably check these are valid columns
1357 $k =~ s/^foreign\.// ||
1358 $self->throw_exception("Invalid rel cond key ${k}");
1359 $v =~ s/^self\.// ||
1360 $self->throw_exception("Invalid rel cond val ${v}");
1361 if (ref $for) { # Object
1362 #warn "$self $k $for $v";
1363 unless ($for->has_column_loaded($v)) {
1364 if ($for->in_storage) {
1365 $self->throw_exception(sprintf
1366 "Unable to resolve relationship '%s' from object %s: column '%s' not "
1367 . 'loaded from storage (or not passed to new() prior to insert()). You '
1368 . 'probably need to call ->discard_changes to get the server-side defaults '
1369 . 'from the database.',
1375 return $UNRESOLVABLE_CONDITION;
1377 $ret{$k} = $for->get_column($v);
1378 #$ret{$k} = $for->get_column($v) if $for->has_column_loaded($v);
1380 } elsif (!defined $for) { # undef, i.e. "no object"
1382 } elsif (ref $as eq 'HASH') { # reverse hashref
1383 $ret{$v} = $as->{$k};
1384 } elsif (ref $as) { # reverse object
1385 $ret{$v} = $as->get_column($k);
1386 } elsif (!defined $as) { # undef, i.e. "no reverse object"
1389 $ret{"${as}.${k}"} = "${for}.${v}";
1393 } elsif (ref $cond eq 'ARRAY') {
1394 return [ map { $self->_resolve_condition($_, $as, $for) } @$cond ];
1396 die("Can't handle condition $cond yet :(");
1401 # Accepts one or more relationships for the current source and returns an
1402 # array of column names for each of those relationships. Column names are
1403 # prefixed relative to the current source, in accordance with where they appear
1404 # in the supplied relationships.
1406 sub _resolve_prefetch {
1407 my ($self, $pre, $alias, $alias_map, $order, $collapse, $pref_path) = @_;
1410 if (not defined $pre) {
1413 elsif( ref $pre eq 'ARRAY' ) {
1415 map { $self->_resolve_prefetch( $_, $alias, $alias_map, $order, $collapse, [ @$pref_path ] ) }
1418 elsif( ref $pre eq 'HASH' ) {
1421 $self->_resolve_prefetch($_, $alias, $alias_map, $order, $collapse, [ @$pref_path ] ),
1422 $self->related_source($_)->_resolve_prefetch(
1423 $pre->{$_}, "${alias}.$_", $alias_map, $order, $collapse, [ @$pref_path, $_] )
1428 $self->throw_exception(
1429 "don't know how to resolve prefetch reftype ".ref($pre));
1433 $p = $p->{$_} for (@$pref_path, $pre);
1435 $self->throw_exception (
1436 "Unable to resolve prefetch '$pre' - join alias map does not contain an entry for path: "
1437 . join (' -> ', @$pref_path, $pre)
1438 ) if (ref $p->{-join_aliases} ne 'ARRAY' or not @{$p->{-join_aliases}} );
1440 my $as = shift @{$p->{-join_aliases}};
1442 my $rel_info = $self->relationship_info( $pre );
1443 $self->throw_exception( $self->name . " has no such relationship '$pre'" )
1445 my $as_prefix = ($alias =~ /^.*?\.(.+)$/ ? $1.'.' : '');
1446 my $rel_source = $self->related_source($pre);
1448 if ($rel_info->{attrs}{accessor} && $rel_info->{attrs}{accessor} eq 'multi') {
1449 $self->throw_exception(
1450 "Can't prefetch has_many ${pre} (join cond too complex)")
1451 unless ref($rel_info->{cond}) eq 'HASH';
1452 my $dots = @{[$as_prefix =~ m/\./g]} + 1; # +1 to match the ".${as_prefix}"
1453 if (my ($fail) = grep { @{[$_ =~ m/\./g]} == $dots }
1454 keys %{$collapse}) {
1455 my ($last) = ($fail =~ /([^\.]+)$/);
1457 "Prefetching multiple has_many rels ${last} and ${pre} "
1458 .(length($as_prefix)
1459 ? "at the same level (${as_prefix}) "
1462 . 'will explode the number of row objects retrievable via ->next or ->all. '
1463 . 'Use at your own risk.'
1466 #my @col = map { (/^self\.(.+)$/ ? ("${as_prefix}.$1") : ()); }
1467 # values %{$rel_info->{cond}};
1468 $collapse->{".${as_prefix}${pre}"} = [ $rel_source->primary_columns ];
1469 # action at a distance. prepending the '.' allows simpler code
1470 # in ResultSet->_collapse_result
1471 my @key = map { (/^foreign\.(.+)$/ ? ($1) : ()); }
1472 keys %{$rel_info->{cond}};
1473 my @ord = (ref($rel_info->{attrs}{order_by}) eq 'ARRAY'
1474 ? @{$rel_info->{attrs}{order_by}}
1476 : (defined $rel_info->{attrs}{order_by}
1477 ? ($rel_info->{attrs}{order_by})
1479 push(@$order, map { "${as}.$_" } (@key, @ord));
1482 return map { [ "${as}.$_", "${as_prefix}${pre}.$_", ] }
1483 $rel_source->columns;
1487 =head2 related_source
1491 =item Arguments: $relname
1493 =item Return value: $source
1497 Returns the result source object for the given relationship.
1501 sub related_source {
1502 my ($self, $rel) = @_;
1503 if( !$self->has_relationship( $rel ) ) {
1504 $self->throw_exception("No such relationship '$rel'");
1506 return $self->schema->source($self->relationship_info($rel)->{source});
1509 =head2 related_class
1513 =item Arguments: $relname
1515 =item Return value: $classname
1519 Returns the class name for objects in the given relationship.
1524 my ($self, $rel) = @_;
1525 if( !$self->has_relationship( $rel ) ) {
1526 $self->throw_exception("No such relationship '$rel'");
1528 return $self->schema->class($self->relationship_info($rel)->{source});
1533 Obtain a new handle to this source. Returns an instance of a
1534 L<DBIx::Class::ResultSourceHandle>.
1539 return DBIx::Class::ResultSourceHandle->new({
1540 schema => $_[0]->schema,
1541 source_moniker => $_[0]->source_name
1545 =head2 throw_exception
1547 See L<DBIx::Class::Schema/"throw_exception">.
1551 sub throw_exception {
1554 if (defined $self->schema) {
1555 $self->schema->throw_exception(@_);
1558 DBIx::Class::Exception->throw(@_);
1564 Stores a hashref of per-source metadata. No specific key names
1565 have yet been standardized, the examples below are purely hypothetical
1566 and don't actually accomplish anything on their own:
1568 __PACKAGE__->source_info({
1569 "_tablespace" => 'fast_disk_array_3',
1570 "_engine" => 'InnoDB',
1577 $class->new({attribute_name => value});
1579 Creates a new ResultSource object. Not normally called directly by end users.
1581 =head2 column_info_from_storage
1585 =item Arguments: 1/0 (default: 0)
1587 =item Return value: 1/0
1591 __PACKAGE__->column_info_from_storage(1);
1593 Enables the on-demand automatic loading of the above column
1594 metadata from storage as necessary. This is *deprecated*, and
1595 should not be used. It will be removed before 1.0.
1600 Matt S. Trout <mst@shadowcatsystems.co.uk>
1604 You may distribute this code under the same terms as Perl itself.