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/;
14 use base qw/DBIx::Class/;
16 __PACKAGE__->mk_group_accessors('simple' => qw/_ordered_columns
17 _columns _primaries _unique_constraints name resultset_attributes
18 schema from _relationships column_info_from_storage source_info
19 source_name sqlt_deploy_callback/);
21 __PACKAGE__->mk_group_accessors('component_class' => qw/resultset_class
26 DBIx::Class::ResultSource - Result source object
30 # Create a table based result source, in a result class.
32 package MyDB::Schema::Result::Artist;
33 use base qw/DBIx::Class::Core/;
35 __PACKAGE__->table('artist');
36 __PACKAGE__->add_columns(qw/ artistid name /);
37 __PACKAGE__->set_primary_key('artistid');
38 __PACKAGE__->has_many(cds => 'MyDB::Schema::Result::CD');
42 # Create a query (view) based result source, in a result class
43 package MyDB::Schema::Result::Year2000CDs;
44 use base qw/DBIx::Class::Core/;
46 __PACKAGE__->load_components('InflateColumn::DateTime');
47 __PACKAGE__->table_class('DBIx::Class::ResultSource::View');
49 __PACKAGE__->table('year2000cds');
50 __PACKAGE__->result_source_instance->is_virtual(1);
51 __PACKAGE__->result_source_instance->view_definition(
52 "SELECT cdid, artist, title FROM cd WHERE year ='2000'"
58 A ResultSource is an object that represents a source of data for querying.
60 This class is a base class for various specialised types of result
61 sources, for example L<DBIx::Class::ResultSource::Table>. Table is the
62 default result source type, so one is created for you when defining a
63 result class as described in the synopsis above.
65 More specifically, the L<DBIx::Class::Core> base class pulls in the
66 L<DBIx::Class::ResultSourceProxy::Table> component, which defines
67 the L<table|DBIx::Class::ResultSourceProxy::Table/table> method.
68 When called, C<table> creates and stores an instance of
69 L<DBIx::Class::ResultSoure::Table>. Luckily, to use tables as result
70 sources, you don't need to remember any of this.
72 Result sources representing select queries, or views, can also be
73 created, see L<DBIx::Class::ResultSource::View> for full details.
75 =head2 Finding result source objects
77 As mentioned above, a result source instance is created and stored for
78 you when you define a L<Result Class|DBIx::Class::Manual::Glossary/Result Class>.
80 You can retrieve the result source at runtime in the following ways:
84 =item From a Schema object:
86 $schema->source($source_name);
88 =item From a Row object:
92 =item From a ResultSet object:
105 my ($class, $attrs) = @_;
106 $class = ref $class if ref $class;
108 my $new = bless { %{$attrs || {}} }, $class;
109 $new->{resultset_class} ||= 'DBIx::Class::ResultSet';
110 $new->{resultset_attributes} = { %{$new->{resultset_attributes} || {}} };
111 $new->{_ordered_columns} = [ @{$new->{_ordered_columns}||[]}];
112 $new->{_columns} = { %{$new->{_columns}||{}} };
113 $new->{_relationships} = { %{$new->{_relationships}||{}} };
114 $new->{name} ||= "!!NAME NOT SET!!";
115 $new->{_columns_info_loaded} ||= 0;
116 $new->{sqlt_deploy_callback} ||= "default_sqlt_deploy_hook";
126 =item Arguments: @columns
128 =item Return value: The ResultSource object
132 $source->add_columns(qw/col1 col2 col3/);
134 $source->add_columns('col1' => \%col1_info, 'col2' => \%col2_info, ...);
136 Adds columns to the result source. If supplied colname => hashref
137 pairs, uses the hashref as the L</column_info> for that column. Repeated
138 calls of this method will add more columns, not replace them.
140 The column names given will be created as accessor methods on your
141 L<DBIx::Class::Row> objects. You can change the name of the accessor
142 by supplying an L</accessor> in the column_info hash.
144 If a column name beginning with a plus sign ('+col1') is provided, the
145 attributes provided will be merged with any existing attributes for the
146 column, with the new attributes taking precedence in the case that an
147 attribute already exists. Using this without a hashref
148 (C<< $source->add_columns(qw/+col1 +col2/) >>) is legal, but useless --
149 it does the same thing it would do without the plus.
151 The contents of the column_info are not set in stone. The following
152 keys are currently recognised/used by DBIx::Class:
158 { accessor => '_name' }
160 # example use, replace standard accessor with one of your own:
162 my ($self, $value) = @_;
164 die "Name cannot contain digits!" if($value =~ /\d/);
165 $self->_name($value);
167 return $self->_name();
170 Use this to set the name of the accessor method for this column. If unset,
171 the name of the column will be used.
175 { data_type => 'integer' }
177 This contains the column type. It is automatically filled if you use the
178 L<SQL::Translator::Producer::DBIx::Class::File> producer, or the
179 L<DBIx::Class::Schema::Loader> module.
181 Currently there is no standard set of values for the data_type. Use
182 whatever your database supports.
188 The length of your column, if it is a column type that can have a size
189 restriction. This is currently only used to create tables from your
190 schema, see L<DBIx::Class::Schema/deploy>.
196 Set this to a true value for a columns that is allowed to contain NULL
197 values, default is false. This is currently only used to create tables
198 from your schema, see L<DBIx::Class::Schema/deploy>.
200 =item is_auto_increment
202 { is_auto_increment => 1 }
204 Set this to a true value for a column whose value is somehow
205 automatically set, defaults to false. This is used to determine which
206 columns to empty when cloning objects using
207 L<DBIx::Class::Row/copy>. It is also used by
208 L<DBIx::Class::Schema/deploy>.
214 Set this to a true or false value (not C<undef>) to explicitly specify
215 if this column contains numeric data. This controls how set_column
216 decides whether to consider a column dirty after an update: if
217 C<is_numeric> is true a numeric comparison C<< != >> will take place
218 instead of the usual C<eq>
220 If not specified the storage class will attempt to figure this out on
221 first access to the column, based on the column C<data_type>. The
222 result will be cached in this attribute.
226 { is_foreign_key => 1 }
228 Set this to a true value for a column that contains a key from a
229 foreign table, defaults to false. This is currently only used to
230 create tables from your schema, see L<DBIx::Class::Schema/deploy>.
234 { default_value => \'now()' }
236 Set this to the default value which will be inserted into a column by
237 the database. Can contain either a value or a function (use a
238 reference to a scalar e.g. C<\'now()'> if you want a function). This
239 is currently only used to create tables from your schema, see
240 L<DBIx::Class::Schema/deploy>.
242 See the note on L<DBIx::Class::Row/new> for more information about possible
243 issues related to db-side default values.
247 { sequence => 'my_table_seq' }
249 Set this on a primary key column to the name of the sequence used to
250 generate a new key value. If not specified, L<DBIx::Class::PK::Auto>
251 will attempt to retrieve the name of the sequence from the database
256 Set this to a true value for a column whose value is retrieved automatically
257 from a sequence or function (if supported by your Storage driver.) For a
258 sequence, if you do not use a trigger to get the nextval, you have to set the
259 L</sequence> value as well.
261 Also set this for MSSQL columns with the 'uniqueidentifier'
262 L<data_type|DBIx::Class::ResultSource/data_type> whose values you want to
263 automatically generate using C<NEWID()>, unless they are a primary key in which
264 case this will be done anyway.
268 This is used by L<DBIx::Class::Schema/deploy> and L<SQL::Translator>
269 to add extra non-generic data to the column. For example: C<< extra
270 => { unsigned => 1} >> is used by the MySQL producer to set an integer
271 column to unsigned. For more details, see
272 L<SQL::Translator::Producer::MySQL>.
280 =item Arguments: $colname, \%columninfo?
282 =item Return value: 1/0 (true/false)
286 $source->add_column('col' => \%info);
288 Add a single column and optional column info. Uses the same column
289 info keys as L</add_columns>.
294 my ($self, @cols) = @_;
295 $self->_ordered_columns(\@cols) unless $self->_ordered_columns;
298 my $columns = $self->_columns;
299 while (my $col = shift @cols) {
300 my $column_info = {};
301 if ($col =~ s/^\+//) {
302 $column_info = $self->column_info($col);
305 # If next entry is { ... } use that for the column info, if not
306 # use an empty hashref
308 my $new_info = shift(@cols);
309 %$column_info = (%$column_info, %$new_info);
311 push(@added, $col) unless exists $columns->{$col};
312 $columns->{$col} = $column_info;
314 push @{ $self->_ordered_columns }, @added;
318 sub add_column { shift->add_columns(@_); } # DO NOT CHANGE THIS TO GLOB
324 =item Arguments: $colname
326 =item Return value: 1/0 (true/false)
330 if ($source->has_column($colname)) { ... }
332 Returns true if the source has a column of this name, false otherwise.
337 my ($self, $column) = @_;
338 return exists $self->_columns->{$column};
345 =item Arguments: $colname
347 =item Return value: Hashref of info
351 my $info = $source->column_info($col);
353 Returns the column metadata hashref for a column, as originally passed
354 to L</add_columns>. See L</add_columns> above for information on the
355 contents of the hashref.
360 my ($self, $column) = @_;
361 $self->throw_exception("No such column $column")
362 unless exists $self->_columns->{$column};
363 #warn $self->{_columns_info_loaded}, "\n";
364 if ( ! $self->_columns->{$column}{data_type}
365 and $self->column_info_from_storage
366 and ! $self->{_columns_info_loaded}
367 and $self->schema and $self->storage )
369 $self->{_columns_info_loaded}++;
373 # try for the case of storage without table
375 $info = $self->storage->columns_info_for( $self->from );
376 for my $realcol ( keys %{$info} ) {
377 $lc_info->{lc $realcol} = $info->{$realcol};
379 foreach my $col ( keys %{$self->_columns} ) {
380 $self->_columns->{$col} = {
381 %{ $self->_columns->{$col} },
382 %{ $info->{$col} || $lc_info->{lc $col} || {} }
387 return $self->_columns->{$column};
394 =item Arguments: None
396 =item Return value: Ordered list of column names
400 my @column_names = $source->columns;
402 Returns all column names in the order they were declared to L</add_columns>.
408 $self->throw_exception(
409 "columns() is a read-only accessor, did you mean add_columns()?"
411 return @{$self->{_ordered_columns}||[]};
414 =head2 remove_columns
418 =item Arguments: @colnames
420 =item Return value: undefined
424 $source->remove_columns(qw/col1 col2 col3/);
426 Removes the given list of columns by name, from the result source.
428 B<Warning>: Removing a column that is also used in the sources primary
429 key, or in one of the sources unique constraints, B<will> result in a
430 broken result source.
436 =item Arguments: $colname
438 =item Return value: undefined
442 $source->remove_column('col');
444 Remove a single column by name from the result source, similar to
447 B<Warning>: Removing a column that is also used in the sources primary
448 key, or in one of the sources unique constraints, B<will> result in a
449 broken result source.
454 my ($self, @to_remove) = @_;
456 my $columns = $self->_columns
461 delete $columns->{$_};
465 $self->_ordered_columns([ grep { not $to_remove{$_} } @{$self->_ordered_columns} ]);
468 sub remove_column { shift->remove_columns(@_); } # DO NOT CHANGE THIS TO GLOB
470 =head2 set_primary_key
474 =item Arguments: @cols
476 =item Return value: undefined
480 Defines one or more columns as primary key for this source. Must be
481 called after L</add_columns>.
483 Additionally, defines a L<unique constraint|add_unique_constraint>
486 Note: you normally do want to define a primary key on your sources
487 B<even if the underlying database table does not have a primary key>.
489 L<DBIx::Class::Intro/The Significance and Importance of Primary Keys>
494 sub set_primary_key {
495 my ($self, @cols) = @_;
496 # check if primary key columns are valid columns
497 foreach my $col (@cols) {
498 $self->throw_exception("No such column $col on table " . $self->name)
499 unless $self->has_column($col);
501 $self->_primaries(\@cols);
503 $self->add_unique_constraint(primary => \@cols);
506 =head2 primary_columns
510 =item Arguments: None
512 =item Return value: Ordered list of primary column names
516 Read-only accessor which returns the list of primary keys, supplied by
521 sub primary_columns {
522 return @{shift->_primaries||[]};
525 # a helper method that will automatically die with a descriptive message if
526 # no pk is defined on the source in question. For internal use to save
527 # on if @pks... boilerplate
530 my @pcols = $self->primary_columns
531 or $self->throw_exception (sprintf(
532 "Operation requires a primary key to be declared on '%s' via set_primary_key",
538 =head2 add_unique_constraint
542 =item Arguments: $name?, \@colnames
544 =item Return value: undefined
548 Declare a unique constraint on this source. Call once for each unique
551 # For UNIQUE (column1, column2)
552 __PACKAGE__->add_unique_constraint(
553 constraint_name => [ qw/column1 column2/ ],
556 Alternatively, you can specify only the columns:
558 __PACKAGE__->add_unique_constraint([ qw/column1 column2/ ]);
560 This will result in a unique constraint named
561 C<table_column1_column2>, where C<table> is replaced with the table
564 Unique constraints are used, for example, when you pass the constraint
565 name as the C<key> attribute to L<DBIx::Class::ResultSet/find>. Then
566 only columns in the constraint are searched.
568 Throws an error if any of the given column names do not yet exist on
573 sub add_unique_constraint {
578 $name ||= $self->name_unique_constraint($cols);
580 foreach my $col (@$cols) {
581 $self->throw_exception("No such column $col on table " . $self->name)
582 unless $self->has_column($col);
585 my %unique_constraints = $self->unique_constraints;
586 $unique_constraints{$name} = $cols;
587 $self->_unique_constraints(\%unique_constraints);
590 =head2 name_unique_constraint
594 =item Arguments: @colnames
596 =item Return value: Constraint name
600 $source->table('mytable');
601 $source->name_unique_constraint('col1', 'col2');
605 Return a name for a unique constraint containing the specified
606 columns. The name is created by joining the table name and each column
607 name, using an underscore character.
609 For example, a constraint on a table named C<cd> containing the columns
610 C<artist> and C<title> would result in a constraint name of C<cd_artist_title>.
612 This is used by L</add_unique_constraint> if you do not specify the
613 optional constraint name.
617 sub name_unique_constraint {
618 my ($self, $cols) = @_;
620 my $name = $self->name;
621 $name = $$name if (ref $name eq 'SCALAR');
623 return join '_', $name, @$cols;
626 =head2 unique_constraints
630 =item Arguments: None
632 =item Return value: Hash of unique constraint data
636 $source->unique_constraints();
638 Read-only accessor which returns a hash of unique constraints on this
641 The hash is keyed by constraint name, and contains an arrayref of
642 column names as values.
646 sub unique_constraints {
647 return %{shift->_unique_constraints||{}};
650 =head2 unique_constraint_names
654 =item Arguments: None
656 =item Return value: Unique constraint names
660 $source->unique_constraint_names();
662 Returns the list of unique constraint names defined on this source.
666 sub unique_constraint_names {
669 my %unique_constraints = $self->unique_constraints;
671 return keys %unique_constraints;
674 =head2 unique_constraint_columns
678 =item Arguments: $constraintname
680 =item Return value: List of constraint columns
684 $source->unique_constraint_columns('myconstraint');
686 Returns the list of columns that make up the specified unique constraint.
690 sub unique_constraint_columns {
691 my ($self, $constraint_name) = @_;
693 my %unique_constraints = $self->unique_constraints;
695 $self->throw_exception(
696 "Unknown unique constraint $constraint_name on '" . $self->name . "'"
697 ) unless exists $unique_constraints{$constraint_name};
699 return @{ $unique_constraints{$constraint_name} };
702 =head2 sqlt_deploy_callback
706 =item Arguments: $callback
710 __PACKAGE__->sqlt_deploy_callback('mycallbackmethod');
712 An accessor to set a callback to be called during deployment of
713 the schema via L<DBIx::Class::Schema/create_ddl_dir> or
714 L<DBIx::Class::Schema/deploy>.
716 The callback can be set as either a code reference or the name of a
717 method in the current result class.
719 If not set, the L</default_sqlt_deploy_hook> is called.
721 Your callback will be passed the $source object representing the
722 ResultSource instance being deployed, and the
723 L<SQL::Translator::Schema::Table> object being created from it. The
724 callback can be used to manipulate the table object or add your own
725 customised indexes. If you need to manipulate a non-table object, use
726 the L<DBIx::Class::Schema/sqlt_deploy_hook>.
728 See L<DBIx::Class::Manual::Cookbook/Adding Indexes And Functions To
729 Your SQL> for examples.
731 This sqlt deployment callback can only be used to manipulate
732 SQL::Translator objects as they get turned into SQL. To execute
733 post-deploy statements which SQL::Translator does not currently
734 handle, override L<DBIx::Class::Schema/deploy> in your Schema class
735 and call L<dbh_do|DBIx::Class::Storage::DBI/dbh_do>.
737 =head2 default_sqlt_deploy_hook
741 =item Arguments: $source, $sqlt_table
743 =item Return value: undefined
747 This is the sensible default for L</sqlt_deploy_callback>.
749 If a method named C<sqlt_deploy_hook> exists in your Result class, it
750 will be called and passed the current C<$source> and the
751 C<$sqlt_table> being deployed.
755 sub default_sqlt_deploy_hook {
758 my $class = $self->result_class;
760 if ($class and $class->can('sqlt_deploy_hook')) {
761 $class->sqlt_deploy_hook(@_);
765 sub _invoke_sqlt_deploy_hook {
767 if ( my $hook = $self->sqlt_deploy_callback) {
776 =item Arguments: None
778 =item Return value: $resultset
782 Returns a resultset for the given source. This will initially be created
785 $self->resultset_class->new($self, $self->resultset_attributes)
787 but is cached from then on unless resultset_class changes.
789 =head2 resultset_class
793 =item Arguments: $classname
795 =item Return value: $classname
799 package My::Schema::ResultSet::Artist;
800 use base 'DBIx::Class::ResultSet';
803 # In the result class
804 __PACKAGE__->resultset_class('My::Schema::ResultSet::Artist');
807 $source->resultset_class('My::Schema::ResultSet::Artist');
809 Set the class of the resultset. This is useful if you want to create your
810 own resultset methods. Create your own class derived from
811 L<DBIx::Class::ResultSet>, and set it here. If called with no arguments,
812 this method returns the name of the existing resultset class, if one
815 =head2 resultset_attributes
819 =item Arguments: \%attrs
821 =item Return value: \%attrs
825 # In the result class
826 __PACKAGE__->resultset_attributes({ order_by => [ 'id' ] });
829 $source->resultset_attributes({ order_by => [ 'id' ] });
831 Store a collection of resultset attributes, that will be set on every
832 L<DBIx::Class::ResultSet> produced from this result source. For a full
833 list see L<DBIx::Class::ResultSet/ATTRIBUTES>.
839 $self->throw_exception(
840 'resultset does not take any arguments. If you want another resultset, '.
841 'call it on the schema instead.'
844 return $self->resultset_class->new(
847 %{$self->{resultset_attributes}},
848 %{$self->schema->default_resultset_attributes}
857 =item Arguments: $source_name
859 =item Result value: $source_name
863 Set an alternate name for the result source when it is loaded into a schema.
864 This is useful if you want to refer to a result source by a name other than
867 package ArchivedBooks;
868 use base qw/DBIx::Class/;
869 __PACKAGE__->table('books_archive');
870 __PACKAGE__->source_name('Books');
872 # from your schema...
873 $schema->resultset('Books')->find(1);
879 =item Arguments: None
881 =item Return value: FROM clause
885 my $from_clause = $source->from();
887 Returns an expression of the source to be supplied to storage to specify
888 retrieval from this source. In the case of a database, the required FROM
895 =item Arguments: None
897 =item Return value: A schema object
901 my $schema = $source->schema();
903 Returns the L<DBIx::Class::Schema> object that this result source
910 =item Arguments: None
912 =item Return value: A Storage object
916 $source->storage->debug(1);
918 Returns the storage handle for the current schema.
920 See also: L<DBIx::Class::Storage>
924 sub storage { shift->schema->storage; }
926 =head2 add_relationship
930 =item Arguments: $relname, $related_source_name, \%cond, [ \%attrs ]
932 =item Return value: 1/true if it succeeded
936 $source->add_relationship('relname', 'related_source', $cond, $attrs);
938 L<DBIx::Class::Relationship> describes a series of methods which
939 create pre-defined useful types of relationships. Look there first
940 before using this method directly.
942 The relationship name can be arbitrary, but must be unique for each
943 relationship attached to this result source. 'related_source' should
944 be the name with which the related result source was registered with
945 the current schema. For example:
947 $schema->source('Book')->add_relationship('reviews', 'Review', {
948 'foreign.book_id' => 'self.id',
951 The condition C<$cond> needs to be an L<SQL::Abstract>-style
952 representation of the join between the tables. For example, if you're
953 creating a relation from Author to Book,
955 { 'foreign.author_id' => 'self.id' }
957 will result in the JOIN clause
959 author me JOIN book foreign ON foreign.author_id = me.id
961 You can specify as many foreign => self mappings as necessary.
963 Valid attributes are as follows:
969 Explicitly specifies the type of join to use in the relationship. Any
970 SQL join type is valid, e.g. C<LEFT> or C<RIGHT>. It will be placed in
971 the SQL command immediately before C<JOIN>.
975 An arrayref containing a list of accessors in the foreign class to proxy in
976 the main class. If, for example, you do the following:
978 CD->might_have(liner_notes => 'LinerNotes', undef, {
979 proxy => [ qw/notes/ ],
982 Then, assuming LinerNotes has an accessor named notes, you can do:
984 my $cd = CD->find(1);
985 # set notes -- LinerNotes object is created if it doesn't exist
986 $cd->notes('Notes go here');
990 Specifies the type of accessor that should be created for the
991 relationship. Valid values are C<single> (for when there is only a single
992 related object), C<multi> (when there can be many), and C<filter> (for
993 when there is a single related object, but you also want the relationship
994 accessor to double as a column accessor). For C<multi> accessors, an
995 add_to_* method is also created, which calls C<create_related> for the
1000 Throws an exception if the condition is improperly supplied, or cannot
1005 sub add_relationship {
1006 my ($self, $rel, $f_source_name, $cond, $attrs) = @_;
1007 $self->throw_exception("Can't create relationship without join condition")
1011 # Check foreign and self are right in cond
1012 if ( (ref $cond ||'') eq 'HASH') {
1014 $self->throw_exception("Keys of condition should be of form 'foreign.col', not '$_'")
1015 if /\./ && !/^foreign\./;
1019 my %rels = %{ $self->_relationships };
1020 $rels{$rel} = { class => $f_source_name,
1021 source => $f_source_name,
1024 $self->_relationships(\%rels);
1028 # XXX disabled. doesn't work properly currently. skip in tests.
1030 my $f_source = $self->schema->source($f_source_name);
1031 unless ($f_source) {
1032 $self->ensure_class_loaded($f_source_name);
1033 $f_source = $f_source_name->result_source;
1034 #my $s_class = ref($self->schema);
1035 #$f_source_name =~ m/^${s_class}::(.*)$/;
1036 #$self->schema->register_class(($1 || $f_source_name), $f_source_name);
1037 #$f_source = $self->schema->source($f_source_name);
1039 return unless $f_source; # Can't test rel without f_source
1041 try { $self->_resolve_join($rel, 'me', {}, []) }
1043 # If the resolve failed, back out and re-throw the error
1045 $self->_relationships(\%rels);
1046 $self->throw_exception("Error creating relationship $rel: $_");
1052 =head2 relationships
1056 =item Arguments: None
1058 =item Return value: List of relationship names
1062 my @relnames = $source->relationships();
1064 Returns all relationship names for this source.
1069 return keys %{shift->_relationships};
1072 =head2 relationship_info
1076 =item Arguments: $relname
1078 =item Return value: Hashref of relation data,
1082 Returns a hash of relationship information for the specified relationship
1083 name. The keys/values are as specified for L</add_relationship>.
1087 sub relationship_info {
1088 my ($self, $rel) = @_;
1089 return $self->_relationships->{$rel};
1092 =head2 has_relationship
1096 =item Arguments: $rel
1098 =item Return value: 1/0 (true/false)
1102 Returns true if the source has a relationship of this name, false otherwise.
1106 sub has_relationship {
1107 my ($self, $rel) = @_;
1108 return exists $self->_relationships->{$rel};
1111 =head2 reverse_relationship_info
1115 =item Arguments: $relname
1117 =item Return value: Hashref of relationship data
1121 Looks through all the relationships on the source this relationship
1122 points to, looking for one whose condition is the reverse of the
1123 condition on this relationship.
1125 A common use of this is to find the name of the C<belongs_to> relation
1126 opposing a C<has_many> relation. For definition of these look in
1127 L<DBIx::Class::Relationship>.
1129 The returned hashref is keyed by the name of the opposing
1130 relationship, and contains its data in the same manner as
1131 L</relationship_info>.
1135 sub reverse_relationship_info {
1136 my ($self, $rel) = @_;
1137 my $rel_info = $self->relationship_info($rel);
1140 return $ret unless ((ref $rel_info->{cond}) eq 'HASH');
1142 my @cond = keys(%{$rel_info->{cond}});
1143 my @refkeys = map {/^\w+\.(\w+)$/} @cond;
1144 my @keys = map {$rel_info->{cond}->{$_} =~ /^\w+\.(\w+)$/} @cond;
1146 # Get the related result source for this relationship
1147 my $othertable = $self->related_source($rel);
1149 # Get all the relationships for that source that related to this source
1150 # whose foreign column set are our self columns on $rel and whose self
1151 # columns are our foreign columns on $rel.
1152 my @otherrels = $othertable->relationships();
1153 my $otherrelationship;
1154 foreach my $otherrel (@otherrels) {
1155 my $otherrel_info = $othertable->relationship_info($otherrel);
1157 my $back = $othertable->related_source($otherrel);
1158 next unless $back->source_name eq $self->source_name;
1162 if (ref $otherrel_info->{cond} eq 'HASH') {
1163 @othertestconds = ($otherrel_info->{cond});
1165 elsif (ref $otherrel_info->{cond} eq 'ARRAY') {
1166 @othertestconds = @{$otherrel_info->{cond}};
1172 foreach my $othercond (@othertestconds) {
1173 my @other_cond = keys(%$othercond);
1174 my @other_refkeys = map {/^\w+\.(\w+)$/} @other_cond;
1175 my @other_keys = map {$othercond->{$_} =~ /^\w+\.(\w+)$/} @other_cond;
1176 next if (!$self->_compare_relationship_keys(\@refkeys, \@other_keys) ||
1177 !$self->_compare_relationship_keys(\@other_refkeys, \@keys));
1178 $ret->{$otherrel} = $otherrel_info;
1184 sub compare_relationship_keys {
1185 carp 'compare_relationship_keys is a private method, stop calling it';
1187 $self->_compare_relationship_keys (@_);
1190 # Returns true if both sets of keynames are the same, false otherwise.
1191 sub _compare_relationship_keys {
1192 my ($self, $keys1, $keys2) = @_;
1194 # Make sure every keys1 is in keys2
1196 foreach my $key (@$keys1) {
1198 foreach my $prim (@$keys2) {
1199 if ($prim eq $key) {
1207 # Make sure every key2 is in key1
1209 foreach my $prim (@$keys2) {
1211 foreach my $key (@$keys1) {
1212 if ($prim eq $key) {
1224 # Returns the {from} structure used to express JOIN conditions
1226 my ($self, $join, $alias, $seen, $jpath, $parent_force_left) = @_;
1228 # we need a supplied one, because we do in-place modifications, no returns
1229 $self->throw_exception ('You must supply a seen hashref as the 3rd argument to _resolve_join')
1230 unless ref $seen eq 'HASH';
1232 $self->throw_exception ('You must supply a joinpath arrayref as the 4th argument to _resolve_join')
1233 unless ref $jpath eq 'ARRAY';
1235 $jpath = [@$jpath]; # copy
1237 if (not defined $join) {
1240 elsif (ref $join eq 'ARRAY') {
1243 $self->_resolve_join($_, $alias, $seen, $jpath, $parent_force_left);
1246 elsif (ref $join eq 'HASH') {
1249 for my $rel (keys %$join) {
1251 my $rel_info = $self->relationship_info($rel)
1252 or $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
1254 my $force_left = $parent_force_left;
1255 $force_left ||= lc($rel_info->{attrs}{join_type}||'') eq 'left';
1257 # the actual seen value will be incremented by the recursion
1258 my $as = $self->storage->relname_to_table_alias(
1259 $rel, ($seen->{$rel} && $seen->{$rel} + 1)
1263 $self->_resolve_join($rel, $alias, $seen, [@$jpath], $force_left),
1264 $self->related_source($rel)->_resolve_join(
1265 $join->{$rel}, $as, $seen, [@$jpath, { $rel => $as }], $force_left
1273 $self->throw_exception("No idea how to resolve join reftype ".ref $join);
1276 my $count = ++$seen->{$join};
1277 my $as = $self->storage->relname_to_table_alias(
1278 $join, ($count > 1 && $count)
1281 my $rel_info = $self->relationship_info($join)
1282 or $self->throw_exception("No such relationship $join on " . $self->source_name);
1284 my $rel_src = $self->related_source($join);
1285 return [ { $as => $rel_src->from,
1286 -source_handle => $rel_src->handle,
1287 -join_type => $parent_force_left
1289 : $rel_info->{attrs}{join_type}
1291 -join_path => [@$jpath, { $join => $as } ],
1293 $rel_info->{attrs}{accessor}
1295 List::Util::first { $rel_info->{attrs}{accessor} eq $_ } (qw/single filter/)
1298 -relation_chain_depth => $seen->{-relation_chain_depth} || 0,
1300 $self->_resolve_condition($rel_info->{cond}, $as, $alias) ];
1305 carp 'pk_depends_on is a private method, stop calling it';
1307 $self->_pk_depends_on (@_);
1310 # Determines whether a relation is dependent on an object from this source
1311 # having already been inserted. Takes the name of the relationship and a
1312 # hashref of columns of the related object.
1313 sub _pk_depends_on {
1314 my ($self, $relname, $rel_data) = @_;
1316 my $relinfo = $self->relationship_info($relname);
1318 # don't assume things if the relationship direction is specified
1319 return $relinfo->{attrs}{is_foreign_key_constraint}
1320 if exists ($relinfo->{attrs}{is_foreign_key_constraint});
1322 my $cond = $relinfo->{cond};
1323 return 0 unless ref($cond) eq 'HASH';
1325 # map { foreign.foo => 'self.bar' } to { bar => 'foo' }
1326 my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond };
1328 # assume anything that references our PK probably is dependent on us
1329 # rather than vice versa, unless the far side is (a) defined or (b)
1331 my $rel_source = $self->related_source($relname);
1333 foreach my $p ($self->primary_columns) {
1334 if (exists $keyhash->{$p}) {
1335 unless (defined($rel_data->{$keyhash->{$p}})
1336 || $rel_source->column_info($keyhash->{$p})
1337 ->{is_auto_increment}) {
1346 sub resolve_condition {
1347 carp 'resolve_condition is a private method, stop calling it';
1349 $self->_resolve_condition (@_);
1352 # Resolves the passed condition to a concrete query fragment. If given an alias,
1353 # returns a join condition; if given an object, inverts that object to produce
1354 # a related conditional from that object.
1355 our $UNRESOLVABLE_CONDITION = \'1 = 0';
1357 sub _resolve_condition {
1358 my ($self, $cond, $as, $for) = @_;
1359 if (ref $cond eq 'HASH') {
1361 foreach my $k (keys %{$cond}) {
1362 my $v = $cond->{$k};
1363 # XXX should probably check these are valid columns
1364 $k =~ s/^foreign\.// ||
1365 $self->throw_exception("Invalid rel cond key ${k}");
1366 $v =~ s/^self\.// ||
1367 $self->throw_exception("Invalid rel cond val ${v}");
1368 if (ref $for) { # Object
1369 #warn "$self $k $for $v";
1370 unless ($for->has_column_loaded($v)) {
1371 if ($for->in_storage) {
1372 $self->throw_exception(sprintf
1373 "Unable to resolve relationship '%s' from object %s: column '%s' not "
1374 . 'loaded from storage (or not passed to new() prior to insert()). You '
1375 . 'probably need to call ->discard_changes to get the server-side defaults '
1376 . 'from the database.',
1382 return $UNRESOLVABLE_CONDITION;
1384 $ret{$k} = $for->get_column($v);
1385 #$ret{$k} = $for->get_column($v) if $for->has_column_loaded($v);
1387 } elsif (!defined $for) { # undef, i.e. "no object"
1389 } elsif (ref $as eq 'HASH') { # reverse hashref
1390 $ret{$v} = $as->{$k};
1391 } elsif (ref $as) { # reverse object
1392 $ret{$v} = $as->get_column($k);
1393 } elsif (!defined $as) { # undef, i.e. "no reverse object"
1396 $ret{"${as}.${k}"} = "${for}.${v}";
1400 } elsif (ref $cond eq 'ARRAY') {
1401 return [ map { $self->_resolve_condition($_, $as, $for) } @$cond ];
1403 die("Can't handle condition $cond yet :(");
1408 # Accepts one or more relationships for the current source and returns an
1409 # array of column names for each of those relationships. Column names are
1410 # prefixed relative to the current source, in accordance with where they appear
1411 # in the supplied relationships.
1413 sub _resolve_prefetch {
1414 my ($self, $pre, $alias, $alias_map, $order, $collapse, $pref_path) = @_;
1417 if (not defined $pre) {
1420 elsif( ref $pre eq 'ARRAY' ) {
1422 map { $self->_resolve_prefetch( $_, $alias, $alias_map, $order, $collapse, [ @$pref_path ] ) }
1425 elsif( ref $pre eq 'HASH' ) {
1428 $self->_resolve_prefetch($_, $alias, $alias_map, $order, $collapse, [ @$pref_path ] ),
1429 $self->related_source($_)->_resolve_prefetch(
1430 $pre->{$_}, "${alias}.$_", $alias_map, $order, $collapse, [ @$pref_path, $_] )
1435 $self->throw_exception(
1436 "don't know how to resolve prefetch reftype ".ref($pre));
1440 $p = $p->{$_} for (@$pref_path, $pre);
1442 $self->throw_exception (
1443 "Unable to resolve prefetch '$pre' - join alias map does not contain an entry for path: "
1444 . join (' -> ', @$pref_path, $pre)
1445 ) if (ref $p->{-join_aliases} ne 'ARRAY' or not @{$p->{-join_aliases}} );
1447 my $as = shift @{$p->{-join_aliases}};
1449 my $rel_info = $self->relationship_info( $pre );
1450 $self->throw_exception( $self->source_name . " has no such relationship '$pre'" )
1452 my $as_prefix = ($alias =~ /^.*?\.(.+)$/ ? $1.'.' : '');
1453 my $rel_source = $self->related_source($pre);
1455 if ($rel_info->{attrs}{accessor} && $rel_info->{attrs}{accessor} eq 'multi') {
1456 $self->throw_exception(
1457 "Can't prefetch has_many ${pre} (join cond too complex)")
1458 unless ref($rel_info->{cond}) eq 'HASH';
1459 my $dots = @{[$as_prefix =~ m/\./g]} + 1; # +1 to match the ".${as_prefix}"
1460 if (my ($fail) = grep { @{[$_ =~ m/\./g]} == $dots }
1461 keys %{$collapse}) {
1462 my ($last) = ($fail =~ /([^\.]+)$/);
1464 "Prefetching multiple has_many rels ${last} and ${pre} "
1465 .(length($as_prefix)
1466 ? "at the same level (${as_prefix}) "
1469 . 'will explode the number of row objects retrievable via ->next or ->all. '
1470 . 'Use at your own risk.'
1473 #my @col = map { (/^self\.(.+)$/ ? ("${as_prefix}.$1") : ()); }
1474 # values %{$rel_info->{cond}};
1475 $collapse->{".${as_prefix}${pre}"} = [ $rel_source->_pri_cols ];
1476 # action at a distance. prepending the '.' allows simpler code
1477 # in ResultSet->_collapse_result
1478 my @key = map { (/^foreign\.(.+)$/ ? ($1) : ()); }
1479 keys %{$rel_info->{cond}};
1480 my @ord = (ref($rel_info->{attrs}{order_by}) eq 'ARRAY'
1481 ? @{$rel_info->{attrs}{order_by}}
1483 : (defined $rel_info->{attrs}{order_by}
1484 ? ($rel_info->{attrs}{order_by})
1486 push(@$order, map { "${as}.$_" } (@key, @ord));
1489 return map { [ "${as}.$_", "${as_prefix}${pre}.$_", ] }
1490 $rel_source->columns;
1494 =head2 related_source
1498 =item Arguments: $relname
1500 =item Return value: $source
1504 Returns the result source object for the given relationship.
1508 sub related_source {
1509 my ($self, $rel) = @_;
1510 if( !$self->has_relationship( $rel ) ) {
1511 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
1513 return $self->schema->source($self->relationship_info($rel)->{source});
1516 =head2 related_class
1520 =item Arguments: $relname
1522 =item Return value: $classname
1526 Returns the class name for objects in the given relationship.
1531 my ($self, $rel) = @_;
1532 if( !$self->has_relationship( $rel ) ) {
1533 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
1535 return $self->schema->class($self->relationship_info($rel)->{source});
1540 Obtain a new handle to this source. Returns an instance of a
1541 L<DBIx::Class::ResultSourceHandle>.
1546 return DBIx::Class::ResultSourceHandle->new({
1547 schema => $_[0]->schema,
1548 source_moniker => $_[0]->source_name
1552 =head2 throw_exception
1554 See L<DBIx::Class::Schema/"throw_exception">.
1558 sub throw_exception {
1561 if (defined $self->schema) {
1562 $self->schema->throw_exception(@_);
1565 DBIx::Class::Exception->throw(@_);
1571 Stores a hashref of per-source metadata. No specific key names
1572 have yet been standardized, the examples below are purely hypothetical
1573 and don't actually accomplish anything on their own:
1575 __PACKAGE__->source_info({
1576 "_tablespace" => 'fast_disk_array_3',
1577 "_engine" => 'InnoDB',
1584 $class->new({attribute_name => value});
1586 Creates a new ResultSource object. Not normally called directly by end users.
1588 =head2 column_info_from_storage
1592 =item Arguments: 1/0 (default: 0)
1594 =item Return value: 1/0
1598 __PACKAGE__->column_info_from_storage(1);
1600 Enables the on-demand automatic loading of the above column
1601 metadata from storage as necessary. This is *deprecated*, and
1602 should not be used. It will be removed before 1.0.
1607 Matt S. Trout <mst@shadowcatsystems.co.uk>
1611 You may distribute this code under the same terms as Perl itself.