1 package DBIx::Class::ResultSource;
6 use DBIx::Class::ResultSet;
7 use DBIx::Class::ResultSourceHandle;
8 use Carp::Clan qw/^DBIx::Class/;
11 use base qw/DBIx::Class/;
13 __PACKAGE__->mk_group_accessors('simple' => qw/_ordered_columns
14 _columns _primaries _unique_constraints name resultset_attributes
15 schema from _relationships column_info_from_storage source_info
16 source_name sqlt_deploy_callback/);
18 __PACKAGE__->mk_group_accessors('component_class' => qw/resultset_class
23 DBIx::Class::ResultSource - Result source object
27 # Create a table based result source, in a result class.
29 package MyDB::Schema::Result::Artist;
30 use base qw/DBIx::Class/;
32 __PACKAGE__->load_components(qw/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;
43 __PACKAGE__->load_components('Core');
44 __PACKAGE__->table_class('DBIx::Class::ResultSource::View');
46 __PACKAGE__->table('year2000cds');
47 __PACKAGE__->result_source_instance->is_virtual(1);
48 __PACKAGE__->result_source_instance->view_definition(
49 "SELECT cdid, artist, title FROM cd WHERE year ='2000'"
55 A ResultSource is an object that represents a source of data for querying.
57 This class is a base class for various specialised types of result
58 sources, for example L<DBIx::Class::ResultSource::Table>. Table is the
59 default result source type, so one is created for you when defining a
60 result class as described in the synopsis above.
62 More specifically, the L<DBIx::Class::Core> component pulls in the
63 L<DBIx::Class::ResultSourceProxy::Table> as a base class, which
64 defines the L<table|DBIx::Class::ResultSourceProxy::Table/table>
65 method. When called, C<table> creates and stores an instance of
66 L<DBIx::Class::ResultSoure::Table>. Luckily, to use tables as result
67 sources, you don't need to remember any of this.
69 Result sources representing select queries, or views, can also be
70 created, see L<DBIx::Class::ResultSource::View> for full details.
72 =head2 Finding result source objects
74 As mentioned above, a result source instance is created and stored for
75 you when you define a L<Result Class|DBIx::Class::Manual::Glossary/Result Class>.
77 You can retrieve the result source at runtime in the following ways:
81 =item From a Schema object:
83 $schema->source($source_name);
85 =item From a Row object:
89 =item From a ResultSet object:
102 my ($class, $attrs) = @_;
103 $class = ref $class if ref $class;
105 my $new = bless { %{$attrs || {}} }, $class;
106 $new->{resultset_class} ||= 'DBIx::Class::ResultSet';
107 $new->{resultset_attributes} = { %{$new->{resultset_attributes} || {}} };
108 $new->{_ordered_columns} = [ @{$new->{_ordered_columns}||[]}];
109 $new->{_columns} = { %{$new->{_columns}||{}} };
110 $new->{_relationships} = { %{$new->{_relationships}||{}} };
111 $new->{name} ||= "!!NAME NOT SET!!";
112 $new->{_columns_info_loaded} ||= 0;
113 $new->{sqlt_deploy_callback} ||= "default_sqlt_deploy_hook";
123 =item Arguments: @columns
125 =item Return value: The ResultSource object
129 $source->add_columns(qw/col1 col2 col3/);
131 $source->add_columns('col1' => \%col1_info, 'col2' => \%col2_info, ...);
133 Adds columns to the result source. If supplied colname => hashref
134 pairs, uses the hashref as the L</column_info> for that column. Repeated
135 calls of this method will add more columns, not replace them.
137 The column names given will be created as accessor methods on your
138 L<DBIx::Class::Row> objects. You can change the name of the accessor
139 by supplying an L</accessor> in the column_info hash.
141 The contents of the column_info are not set in stone. The following
142 keys are currently recognised/used by DBIx::Class:
148 { accessor => '_name' }
150 # example use, replace standard accessor with one of your own:
152 my ($self, $value) = @_;
154 die "Name cannot contain digits!" if($value =~ /\d/);
155 $self->_name($value);
157 return $self->_name();
160 Use this to set the name of the accessor method for this column. If unset,
161 the name of the column will be used.
165 { data_type => 'integer' }
167 This contains the column type. It is automatically filled if you use the
168 L<SQL::Translator::Producer::DBIx::Class::File> producer, or the
169 L<DBIx::Class::Schema::Loader> module.
171 Currently there is no standard set of values for the data_type. Use
172 whatever your database supports.
178 The length of your column, if it is a column type that can have a size
179 restriction. This is currently only used to create tables from your
180 schema, see L<DBIx::Class::Schema/deploy>.
186 Set this to a true value for a columns that is allowed to contain NULL
187 values, default is false. This is currently only used to create tables
188 from your schema, see L<DBIx::Class::Schema/deploy>.
190 =item is_auto_increment
192 { is_auto_increment => 1 }
194 Set this to a true value for a column whose value is somehow
195 automatically set, defaults to false. This is used to determine which
196 columns to empty when cloning objects using
197 L<DBIx::Class::Row/copy>. It is also used by
198 L<DBIx::Class::Schema/deploy>.
204 Set this to a true or false value (not C<undef>) to explicitly specify
205 if this column contains numeric data. This controls how set_column
206 decides whether to consider a column dirty after an update: if
207 C<is_numeric> is true a numeric comparison C<< != >> will take place
208 instead of the usual C<eq>
210 If not specified the storage class will attempt to figure this out on
211 first access to the column, based on the column C<data_type>. The
212 result will be cached in this attribute.
216 { is_foreign_key => 1 }
218 Set this to a true value for a column that contains a key from a
219 foreign table, defaults to false. This is currently only used to
220 create tables from your schema, see L<DBIx::Class::Schema/deploy>.
224 { default_value => \'now()' }
226 Set this to the default value which will be inserted into a column by
227 the database. Can contain either a value or a function (use a
228 reference to a scalar e.g. C<\'now()'> if you want a function). This
229 is currently only used to create tables from your schema, see
230 L<DBIx::Class::Schema/deploy>.
232 See the note on L<DBIx::Class::Row/new> for more information about possible
233 issues related to db-side default values.
237 { sequence => 'my_table_seq' }
239 Set this on a primary key column to the name of the sequence used to
240 generate a new key value. If not specified, L<DBIx::Class::PK::Auto>
241 will attempt to retrieve the name of the sequence from the database
246 Set this to a true value for a column whose value is retrieved automatically
247 from a sequence or function (if supported by your Storage driver.) For a
248 sequence, if you do not use a trigger to get the nextval, you have to set the
249 L</sequence> value as well.
251 Also set this for MSSQL columns with the 'uniqueidentifier'
252 L<DBIx::Class::ResultSource/data_type> whose values you want to automatically
253 generate using C<NEWID()>, unless they are a primary key in which case this will
258 This is used by L<DBIx::Class::Schema/deploy> and L<SQL::Translator>
259 to add extra non-generic data to the column. For example: C<< extra
260 => { unsigned => 1} >> is used by the MySQL producer to set an integer
261 column to unsigned. For more details, see
262 L<SQL::Translator::Producer::MySQL>.
270 =item Arguments: $colname, \%columninfo?
272 =item Return value: 1/0 (true/false)
276 $source->add_column('col' => \%info);
278 Add a single column and optional column info. Uses the same column
279 info keys as L</add_columns>.
284 my ($self, @cols) = @_;
285 $self->_ordered_columns(\@cols) unless $self->_ordered_columns;
288 my $columns = $self->_columns;
289 while (my $col = shift @cols) {
290 # If next entry is { ... } use that for the column info, if not
291 # use an empty hashref
292 my $column_info = ref $cols[0] ? shift(@cols) : {};
293 push(@added, $col) unless exists $columns->{$col};
294 $columns->{$col} = $column_info;
296 push @{ $self->_ordered_columns }, @added;
300 sub add_column { shift->add_columns(@_); } # DO NOT CHANGE THIS TO GLOB
306 =item Arguments: $colname
308 =item Return value: 1/0 (true/false)
312 if ($source->has_column($colname)) { ... }
314 Returns true if the source has a column of this name, false otherwise.
319 my ($self, $column) = @_;
320 return exists $self->_columns->{$column};
327 =item Arguments: $colname
329 =item Return value: Hashref of info
333 my $info = $source->column_info($col);
335 Returns the column metadata hashref for a column, as originally passed
336 to L</add_columns>. See L</add_columns> above for information on the
337 contents of the hashref.
342 my ($self, $column) = @_;
343 $self->throw_exception("No such column $column")
344 unless exists $self->_columns->{$column};
345 #warn $self->{_columns_info_loaded}, "\n";
346 if ( ! $self->_columns->{$column}{data_type}
347 and $self->column_info_from_storage
348 and ! $self->{_columns_info_loaded}
349 and $self->schema and $self->storage )
351 $self->{_columns_info_loaded}++;
354 # eval for the case of storage without table
355 eval { $info = $self->storage->columns_info_for( $self->from ) };
357 for my $realcol ( keys %{$info} ) {
358 $lc_info->{lc $realcol} = $info->{$realcol};
360 foreach my $col ( keys %{$self->_columns} ) {
361 $self->_columns->{$col} = {
362 %{ $self->_columns->{$col} },
363 %{ $info->{$col} || $lc_info->{lc $col} || {} }
368 return $self->_columns->{$column};
375 =item Arguments: None
377 =item Return value: Ordered list of column names
381 my @column_names = $source->columns;
383 Returns all column names in the order they were declared to L</add_columns>.
389 $self->throw_exception(
390 "columns() is a read-only accessor, did you mean add_columns()?"
392 return @{$self->{_ordered_columns}||[]};
395 =head2 remove_columns
399 =item Arguments: @colnames
401 =item Return value: undefined
405 $source->remove_columns(qw/col1 col2 col3/);
407 Removes the given list of columns by name, from the result source.
409 B<Warning>: Removing a column that is also used in the sources primary
410 key, or in one of the sources unique constraints, B<will> result in a
411 broken result source.
417 =item Arguments: $colname
419 =item Return value: undefined
423 $source->remove_column('col');
425 Remove a single column by name from the result source, similar to
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.
435 my ($self, @to_remove) = @_;
437 my $columns = $self->_columns
442 delete $columns->{$_};
446 $self->_ordered_columns([ grep { not $to_remove{$_} } @{$self->_ordered_columns} ]);
449 sub remove_column { shift->remove_columns(@_); } # DO NOT CHANGE THIS TO GLOB
451 =head2 set_primary_key
455 =item Arguments: @cols
457 =item Return value: undefined
461 Defines one or more columns as primary key for this source. Must be
462 called after L</add_columns>.
464 Additionally, defines a L<unique constraint|add_unique_constraint>
467 The primary key columns are used by L<DBIx::Class::PK::Auto> to
468 retrieve automatically created values from the database. They are also
469 used as default joining columns when specifying relationships, see
470 L<DBIx::Class::Relationship>.
474 sub set_primary_key {
475 my ($self, @cols) = @_;
476 # check if primary key columns are valid columns
477 foreach my $col (@cols) {
478 $self->throw_exception("No such column $col on table " . $self->name)
479 unless $self->has_column($col);
481 $self->_primaries(\@cols);
483 $self->add_unique_constraint(primary => \@cols);
486 =head2 primary_columns
490 =item Arguments: None
492 =item Return value: Ordered list of primary column names
496 Read-only accessor which returns the list of primary keys, supplied by
501 sub primary_columns {
502 return @{shift->_primaries||[]};
505 =head2 add_unique_constraint
509 =item Arguments: $name?, \@colnames
511 =item Return value: undefined
515 Declare a unique constraint on this source. Call once for each unique
518 # For UNIQUE (column1, column2)
519 __PACKAGE__->add_unique_constraint(
520 constraint_name => [ qw/column1 column2/ ],
523 Alternatively, you can specify only the columns:
525 __PACKAGE__->add_unique_constraint([ qw/column1 column2/ ]);
527 This will result in a unique constraint named
528 C<table_column1_column2>, where C<table> is replaced with the table
531 Unique constraints are used, for example, when you pass the constraint
532 name as the C<key> attribute to L<DBIx::Class::ResultSet/find>. Then
533 only columns in the constraint are searched.
535 Throws an error if any of the given column names do not yet exist on
540 sub add_unique_constraint {
545 $name ||= $self->name_unique_constraint($cols);
547 foreach my $col (@$cols) {
548 $self->throw_exception("No such column $col on table " . $self->name)
549 unless $self->has_column($col);
552 my %unique_constraints = $self->unique_constraints;
553 $unique_constraints{$name} = $cols;
554 $self->_unique_constraints(\%unique_constraints);
557 =head2 name_unique_constraint
561 =item Arguments: @colnames
563 =item Return value: Constraint name
567 $source->table('mytable');
568 $source->name_unique_constraint('col1', 'col2');
572 Return a name for a unique constraint containing the specified
573 columns. The name is created by joining the table name and each column
574 name, using an underscore character.
576 For example, a constraint on a table named C<cd> containing the columns
577 C<artist> and C<title> would result in a constraint name of C<cd_artist_title>.
579 This is used by L</add_unique_constraint> if you do not specify the
580 optional constraint name.
584 sub name_unique_constraint {
585 my ($self, $cols) = @_;
587 return join '_', $self->name, @$cols;
590 =head2 unique_constraints
594 =item Arguments: None
596 =item Return value: Hash of unique constraint data
600 $source->unique_constraints();
602 Read-only accessor which returns a hash of unique constraints on this
605 The hash is keyed by constraint name, and contains an arrayref of
606 column names as values.
610 sub unique_constraints {
611 return %{shift->_unique_constraints||{}};
614 =head2 unique_constraint_names
618 =item Arguments: None
620 =item Return value: Unique constraint names
624 $source->unique_constraint_names();
626 Returns the list of unique constraint names defined on this source.
630 sub unique_constraint_names {
633 my %unique_constraints = $self->unique_constraints;
635 return keys %unique_constraints;
638 =head2 unique_constraint_columns
642 =item Arguments: $constraintname
644 =item Return value: List of constraint columns
648 $source->unique_constraint_columns('myconstraint');
650 Returns the list of columns that make up the specified unique constraint.
654 sub unique_constraint_columns {
655 my ($self, $constraint_name) = @_;
657 my %unique_constraints = $self->unique_constraints;
659 $self->throw_exception(
660 "Unknown unique constraint $constraint_name on '" . $self->name . "'"
661 ) unless exists $unique_constraints{$constraint_name};
663 return @{ $unique_constraints{$constraint_name} };
666 =head2 sqlt_deploy_callback
670 =item Arguments: $callback
674 __PACKAGE__->sqlt_deploy_callback('mycallbackmethod');
676 An accessor to set a callback to be called during deployment of
677 the schema via L<DBIx::Class::Schema/create_ddl_dir> or
678 L<DBIx::Class::Schema/deploy>.
680 The callback can be set as either a code reference or the name of a
681 method in the current result class.
683 If not set, the L</default_sqlt_deploy_hook> is called.
685 Your callback will be passed the $source object representing the
686 ResultSource instance being deployed, and the
687 L<SQL::Translator::Schema::Table> object being created from it. The
688 callback can be used to manipulate the table object or add your own
689 customised indexes. If you need to manipulate a non-table object, use
690 the L<DBIx::Class::Schema/sqlt_deploy_hook>.
692 See L<DBIx::Class::Manual::Cookbook/Adding Indexes And Functions To
693 Your SQL> for examples.
695 This sqlt deployment callback can only be used to manipulate
696 SQL::Translator objects as they get turned into SQL. To execute
697 post-deploy statements which SQL::Translator does not currently
698 handle, override L<DBIx::Class::Schema/deploy> in your Schema class
699 and call L<dbh_do|DBIx::Class::Storage::DBI/dbh_do>.
701 =head2 default_sqlt_deploy_hook
705 =item Arguments: $source, $sqlt_table
707 =item Return value: undefined
711 This is the sensible default for L</sqlt_deploy_callback>.
713 If a method named C<sqlt_deploy_hook> exists in your Result class, it
714 will be called and passed the current C<$source> and the
715 C<$sqlt_table> being deployed.
719 sub default_sqlt_deploy_hook {
722 my $class = $self->result_class;
724 if ($class and $class->can('sqlt_deploy_hook')) {
725 $class->sqlt_deploy_hook(@_);
729 sub _invoke_sqlt_deploy_hook {
731 if ( my $hook = $self->sqlt_deploy_callback) {
740 =item Arguments: None
742 =item Return value: $resultset
746 Returns a resultset for the given source. This will initially be created
749 $self->resultset_class->new($self, $self->resultset_attributes)
751 but is cached from then on unless resultset_class changes.
753 =head2 resultset_class
757 =item Arguments: $classname
759 =item Return value: $classname
763 package My::Schema::ResultSet::Artist;
764 use base 'DBIx::Class::ResultSet';
767 # In the result class
768 __PACKAGE__->resultset_class('My::Schema::ResultSet::Artist');
771 $source->resultset_class('My::Schema::ResultSet::Artist');
773 Set the class of the resultset. This is useful if you want to create your
774 own resultset methods. Create your own class derived from
775 L<DBIx::Class::ResultSet>, and set it here. If called with no arguments,
776 this method returns the name of the existing resultset class, if one
779 =head2 resultset_attributes
783 =item Arguments: \%attrs
785 =item Return value: \%attrs
789 # In the result class
790 __PACKAGE__->resultset_attributes({ order_by => [ 'id' ] });
793 $source->resultset_attributes({ order_by => [ 'id' ] });
795 Store a collection of resultset attributes, that will be set on every
796 L<DBIx::Class::ResultSet> produced from this result source. For a full
797 list see L<DBIx::Class::ResultSet/ATTRIBUTES>.
803 $self->throw_exception(
804 'resultset does not take any arguments. If you want another resultset, '.
805 'call it on the schema instead.'
808 return $self->resultset_class->new(
811 %{$self->{resultset_attributes}},
812 %{$self->schema->default_resultset_attributes}
821 =item Arguments: $source_name
823 =item Result value: $source_name
827 Set an alternate name for the result source when it is loaded into a schema.
828 This is useful if you want to refer to a result source by a name other than
831 package ArchivedBooks;
832 use base qw/DBIx::Class/;
833 __PACKAGE__->table('books_archive');
834 __PACKAGE__->source_name('Books');
836 # from your schema...
837 $schema->resultset('Books')->find(1);
843 =item Arguments: None
845 =item Return value: FROM clause
849 my $from_clause = $source->from();
851 Returns an expression of the source to be supplied to storage to specify
852 retrieval from this source. In the case of a database, the required FROM
859 =item Arguments: None
861 =item Return value: A schema object
865 my $schema = $source->schema();
867 Returns the L<DBIx::Class::Schema> object that this result source
874 =item Arguments: None
876 =item Return value: A Storage object
880 $source->storage->debug(1);
882 Returns the storage handle for the current schema.
884 See also: L<DBIx::Class::Storage>
888 sub storage { shift->schema->storage; }
890 =head2 add_relationship
894 =item Arguments: $relname, $related_source_name, \%cond, [ \%attrs ]
896 =item Return value: 1/true if it succeeded
900 $source->add_relationship('relname', 'related_source', $cond, $attrs);
902 L<DBIx::Class::Relationship> describes a series of methods which
903 create pre-defined useful types of relationships. Look there first
904 before using this method directly.
906 The relationship name can be arbitrary, but must be unique for each
907 relationship attached to this result source. 'related_source' should
908 be the name with which the related result source was registered with
909 the current schema. For example:
911 $schema->source('Book')->add_relationship('reviews', 'Review', {
912 'foreign.book_id' => 'self.id',
915 The condition C<$cond> needs to be an L<SQL::Abstract>-style
916 representation of the join between the tables. For example, if you're
917 creating a relation from Author to Book,
919 { 'foreign.author_id' => 'self.id' }
921 will result in the JOIN clause
923 author me JOIN book foreign ON foreign.author_id = me.id
925 You can specify as many foreign => self mappings as necessary.
927 Valid attributes are as follows:
933 Explicitly specifies the type of join to use in the relationship. Any
934 SQL join type is valid, e.g. C<LEFT> or C<RIGHT>. It will be placed in
935 the SQL command immediately before C<JOIN>.
939 An arrayref containing a list of accessors in the foreign class to proxy in
940 the main class. If, for example, you do the following:
942 CD->might_have(liner_notes => 'LinerNotes', undef, {
943 proxy => [ qw/notes/ ],
946 Then, assuming LinerNotes has an accessor named notes, you can do:
948 my $cd = CD->find(1);
949 # set notes -- LinerNotes object is created if it doesn't exist
950 $cd->notes('Notes go here');
954 Specifies the type of accessor that should be created for the
955 relationship. Valid values are C<single> (for when there is only a single
956 related object), C<multi> (when there can be many), and C<filter> (for
957 when there is a single related object, but you also want the relationship
958 accessor to double as a column accessor). For C<multi> accessors, an
959 add_to_* method is also created, which calls C<create_related> for the
964 Throws an exception if the condition is improperly supplied, or cannot
969 sub add_relationship {
970 my ($self, $rel, $f_source_name, $cond, $attrs) = @_;
971 $self->throw_exception("Can't create relationship without join condition")
975 # Check foreign and self are right in cond
976 if ( (ref $cond ||'') eq 'HASH') {
978 $self->throw_exception("Keys of condition should be of form 'foreign.col', not '$_'")
979 if /\./ && !/^foreign\./;
983 my %rels = %{ $self->_relationships };
984 $rels{$rel} = { class => $f_source_name,
985 source => $f_source_name,
988 $self->_relationships(\%rels);
992 # XXX disabled. doesn't work properly currently. skip in tests.
994 my $f_source = $self->schema->source($f_source_name);
996 $self->ensure_class_loaded($f_source_name);
997 $f_source = $f_source_name->result_source;
998 #my $s_class = ref($self->schema);
999 #$f_source_name =~ m/^${s_class}::(.*)$/;
1000 #$self->schema->register_class(($1 || $f_source_name), $f_source_name);
1001 #$f_source = $self->schema->source($f_source_name);
1003 return unless $f_source; # Can't test rel without f_source
1005 eval { $self->_resolve_join($rel, 'me', {}, []) };
1007 if ($@) { # If the resolve failed, back out and re-throw the error
1008 delete $rels{$rel}; #
1009 $self->_relationships(\%rels);
1010 $self->throw_exception("Error creating relationship $rel: $@");
1015 =head2 relationships
1019 =item Arguments: None
1021 =item Return value: List of relationship names
1025 my @relnames = $source->relationships();
1027 Returns all relationship names for this source.
1032 return keys %{shift->_relationships};
1035 =head2 relationship_info
1039 =item Arguments: $relname
1041 =item Return value: Hashref of relation data,
1045 Returns a hash of relationship information for the specified relationship
1046 name. The keys/values are as specified for L</add_relationship>.
1050 sub relationship_info {
1051 my ($self, $rel) = @_;
1052 return $self->_relationships->{$rel};
1055 =head2 has_relationship
1059 =item Arguments: $rel
1061 =item Return value: 1/0 (true/false)
1065 Returns true if the source has a relationship of this name, false otherwise.
1069 sub has_relationship {
1070 my ($self, $rel) = @_;
1071 return exists $self->_relationships->{$rel};
1074 =head2 reverse_relationship_info
1078 =item Arguments: $relname
1080 =item Return value: Hashref of relationship data
1084 Looks through all the relationships on the source this relationship
1085 points to, looking for one whose condition is the reverse of the
1086 condition on this relationship.
1088 A common use of this is to find the name of the C<belongs_to> relation
1089 opposing a C<has_many> relation. For definition of these look in
1090 L<DBIx::Class::Relationship>.
1092 The returned hashref is keyed by the name of the opposing
1093 relationship, and contains its data in the same manner as
1094 L</relationship_info>.
1098 sub reverse_relationship_info {
1099 my ($self, $rel) = @_;
1100 my $rel_info = $self->relationship_info($rel);
1103 return $ret unless ((ref $rel_info->{cond}) eq 'HASH');
1105 my @cond = keys(%{$rel_info->{cond}});
1106 my @refkeys = map {/^\w+\.(\w+)$/} @cond;
1107 my @keys = map {$rel_info->{cond}->{$_} =~ /^\w+\.(\w+)$/} @cond;
1109 # Get the related result source for this relationship
1110 my $othertable = $self->related_source($rel);
1112 # Get all the relationships for that source that related to this source
1113 # whose foreign column set are our self columns on $rel and whose self
1114 # columns are our foreign columns on $rel.
1115 my @otherrels = $othertable->relationships();
1116 my $otherrelationship;
1117 foreach my $otherrel (@otherrels) {
1118 my $otherrel_info = $othertable->relationship_info($otherrel);
1120 my $back = $othertable->related_source($otherrel);
1121 next unless $back->source_name eq $self->source_name;
1125 if (ref $otherrel_info->{cond} eq 'HASH') {
1126 @othertestconds = ($otherrel_info->{cond});
1128 elsif (ref $otherrel_info->{cond} eq 'ARRAY') {
1129 @othertestconds = @{$otherrel_info->{cond}};
1135 foreach my $othercond (@othertestconds) {
1136 my @other_cond = keys(%$othercond);
1137 my @other_refkeys = map {/^\w+\.(\w+)$/} @other_cond;
1138 my @other_keys = map {$othercond->{$_} =~ /^\w+\.(\w+)$/} @other_cond;
1139 next if (!$self->_compare_relationship_keys(\@refkeys, \@other_keys) ||
1140 !$self->_compare_relationship_keys(\@other_refkeys, \@keys));
1141 $ret->{$otherrel} = $otherrel_info;
1147 sub compare_relationship_keys {
1148 carp 'compare_relationship_keys is a private method, stop calling it';
1150 $self->_compare_relationship_keys (@_);
1153 # Returns true if both sets of keynames are the same, false otherwise.
1154 sub _compare_relationship_keys {
1155 my ($self, $keys1, $keys2) = @_;
1157 # Make sure every keys1 is in keys2
1159 foreach my $key (@$keys1) {
1161 foreach my $prim (@$keys2) {
1162 if ($prim eq $key) {
1170 # Make sure every key2 is in key1
1172 foreach my $prim (@$keys2) {
1174 foreach my $key (@$keys1) {
1175 if ($prim eq $key) {
1188 carp 'resolve_join is a private method, stop calling it';
1190 $self->_resolve_join (@_);
1193 # Returns the {from} structure used to express JOIN conditions
1195 my ($self, $join, $alias, $seen, $jpath, $force_left) = @_;
1197 # we need a supplied one, because we do in-place modifications, no returns
1198 $self->throw_exception ('You must supply a seen hashref as the 3rd argument to _resolve_join')
1199 unless ref $seen eq 'HASH';
1201 $self->throw_exception ('You must supply a joinpath arrayref as the 4th argument to _resolve_join')
1202 unless ref $jpath eq 'ARRAY';
1206 if (ref $join eq 'ARRAY') {
1209 $self->_resolve_join($_, $alias, $seen, $jpath, $force_left);
1211 } elsif (ref $join eq 'HASH') {
1214 my $as = ($seen->{$_} ? join ('_', $_, $seen->{$_} + 1) : $_); # the actual seen value will be incremented below
1215 local $force_left->{force} = $force_left->{force};
1217 $self->_resolve_join($_, $alias, $seen, [@$jpath], $force_left),
1218 $self->related_source($_)->_resolve_join(
1219 $join->{$_}, $as, $seen, [@$jpath, $_], $force_left
1223 } elsif (ref $join) {
1224 $self->throw_exception("No idea how to resolve join reftype ".ref $join);
1227 return() unless defined $join;
1229 my $count = ++$seen->{$join};
1230 my $as = ($count > 1 ? "${join}_${count}" : $join);
1232 my $rel_info = $self->relationship_info($join);
1233 $self->throw_exception("No such relationship ${join}") unless $rel_info;
1238 $type = $rel_info->{attrs}{join_type} || '';
1239 $force_left = 1 if lc($type) eq 'left';
1242 my $rel_src = $self->related_source($join);
1243 return [ { $as => $rel_src->from,
1244 -source_handle => $rel_src->handle,
1245 -join_type => $type,
1246 -join_path => [@$jpath, $join],
1248 -relation_chain_depth => $seen->{-relation_chain_depth} || 0,
1250 $self->_resolve_condition($rel_info->{cond}, $as, $alias) ];
1255 carp 'pk_depends_on is a private method, stop calling it';
1257 $self->_pk_depends_on (@_);
1260 # Determines whether a relation is dependent on an object from this source
1261 # having already been inserted. Takes the name of the relationship and a
1262 # hashref of columns of the related object.
1263 sub _pk_depends_on {
1264 my ($self, $relname, $rel_data) = @_;
1265 my $cond = $self->relationship_info($relname)->{cond};
1267 return 0 unless ref($cond) eq 'HASH';
1269 # map { foreign.foo => 'self.bar' } to { bar => 'foo' }
1271 my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond };
1273 # assume anything that references our PK probably is dependent on us
1274 # rather than vice versa, unless the far side is (a) defined or (b)
1277 my $rel_source = $self->related_source($relname);
1279 foreach my $p ($self->primary_columns) {
1280 if (exists $keyhash->{$p}) {
1281 unless (defined($rel_data->{$keyhash->{$p}})
1282 || $rel_source->column_info($keyhash->{$p})
1283 ->{is_auto_increment}) {
1292 sub resolve_condition {
1293 carp 'resolve_condition is a private method, stop calling it';
1295 $self->_resolve_condition (@_);
1298 # Resolves the passed condition to a concrete query fragment. If given an alias,
1299 # returns a join condition; if given an object, inverts that object to produce
1300 # a related conditional from that object.
1301 our $UNRESOLVABLE_CONDITION = \'1 = 0';
1303 sub _resolve_condition {
1304 my ($self, $cond, $as, $for) = @_;
1305 if (ref $cond eq 'HASH') {
1307 foreach my $k (keys %{$cond}) {
1308 my $v = $cond->{$k};
1309 # XXX should probably check these are valid columns
1310 $k =~ s/^foreign\.// ||
1311 $self->throw_exception("Invalid rel cond key ${k}");
1312 $v =~ s/^self\.// ||
1313 $self->throw_exception("Invalid rel cond val ${v}");
1314 if (ref $for) { # Object
1315 #warn "$self $k $for $v";
1316 unless ($for->has_column_loaded($v)) {
1317 if ($for->in_storage) {
1318 $self->throw_exception(
1319 "Column ${v} not loaded or not passed to new() prior to insert()"
1320 ." on ${for} trying to resolve relationship (maybe you forgot "
1321 ."to call ->discard_changes to get defaults from the db)"
1324 return $UNRESOLVABLE_CONDITION;
1326 $ret{$k} = $for->get_column($v);
1327 #$ret{$k} = $for->get_column($v) if $for->has_column_loaded($v);
1329 } elsif (!defined $for) { # undef, i.e. "no object"
1331 } elsif (ref $as eq 'HASH') { # reverse hashref
1332 $ret{$v} = $as->{$k};
1333 } elsif (ref $as) { # reverse object
1334 $ret{$v} = $as->get_column($k);
1335 } elsif (!defined $as) { # undef, i.e. "no reverse object"
1338 $ret{"${as}.${k}"} = "${for}.${v}";
1342 } elsif (ref $cond eq 'ARRAY') {
1343 return [ map { $self->_resolve_condition($_, $as, $for) } @$cond ];
1345 die("Can't handle condition $cond yet :(");
1349 # Legacy code, needs to go entirely away (fully replaced by _resolve_prefetch)
1350 sub resolve_prefetch {
1351 carp 'resolve_prefetch is a private method, stop calling it';
1353 my ($self, $pre, $alias, $seen, $order, $collapse) = @_;
1355 if( ref $pre eq 'ARRAY' ) {
1357 map { $self->resolve_prefetch( $_, $alias, $seen, $order, $collapse ) }
1360 elsif( ref $pre eq 'HASH' ) {
1363 $self->resolve_prefetch($_, $alias, $seen, $order, $collapse),
1364 $self->related_source($_)->resolve_prefetch(
1365 $pre->{$_}, "${alias}.$_", $seen, $order, $collapse)
1370 $self->throw_exception(
1371 "don't know how to resolve prefetch reftype ".ref($pre));
1374 my $count = ++$seen->{$pre};
1375 my $as = ($count > 1 ? "${pre}_${count}" : $pre);
1376 my $rel_info = $self->relationship_info( $pre );
1377 $self->throw_exception( $self->name . " has no such relationship '$pre'" )
1379 my $as_prefix = ($alias =~ /^.*?\.(.+)$/ ? $1.'.' : '');
1380 my $rel_source = $self->related_source($pre);
1382 if (exists $rel_info->{attrs}{accessor}
1383 && $rel_info->{attrs}{accessor} eq 'multi') {
1384 $self->throw_exception(
1385 "Can't prefetch has_many ${pre} (join cond too complex)")
1386 unless ref($rel_info->{cond}) eq 'HASH';
1387 my $dots = @{[$as_prefix =~ m/\./g]} + 1; # +1 to match the ".${as_prefix}"
1388 if (my ($fail) = grep { @{[$_ =~ m/\./g]} == $dots }
1389 keys %{$collapse}) {
1390 my ($last) = ($fail =~ /([^\.]+)$/);
1392 "Prefetching multiple has_many rels ${last} and ${pre} "
1393 .(length($as_prefix)
1394 ? "at the same level (${as_prefix}) "
1397 . 'will explode the number of row objects retrievable via ->next or ->all. '
1398 . 'Use at your own risk.'
1401 #my @col = map { (/^self\.(.+)$/ ? ("${as_prefix}.$1") : ()); }
1402 # values %{$rel_info->{cond}};
1403 $collapse->{".${as_prefix}${pre}"} = [ $rel_source->primary_columns ];
1404 # action at a distance. prepending the '.' allows simpler code
1405 # in ResultSet->_collapse_result
1406 my @key = map { (/^foreign\.(.+)$/ ? ($1) : ()); }
1407 keys %{$rel_info->{cond}};
1408 my @ord = (ref($rel_info->{attrs}{order_by}) eq 'ARRAY'
1409 ? @{$rel_info->{attrs}{order_by}}
1410 : (defined $rel_info->{attrs}{order_by}
1411 ? ($rel_info->{attrs}{order_by})
1413 push(@$order, map { "${as}.$_" } (@key, @ord));
1416 return map { [ "${as}.$_", "${as_prefix}${pre}.$_", ] }
1417 $rel_source->columns;
1421 # Accepts one or more relationships for the current source and returns an
1422 # array of column names for each of those relationships. Column names are
1423 # prefixed relative to the current source, in accordance with where they appear
1424 # in the supplied relationships. Needs an alias_map generated by
1425 # $rs->_joinpath_aliases
1427 sub _resolve_prefetch {
1428 my ($self, $pre, $alias, $alias_map, $order, $collapse, $pref_path) = @_;
1431 if( ref $pre eq 'ARRAY' ) {
1433 map { $self->_resolve_prefetch( $_, $alias, $alias_map, $order, $collapse, [ @$pref_path ] ) }
1436 elsif( ref $pre eq 'HASH' ) {
1439 $self->_resolve_prefetch($_, $alias, $alias_map, $order, $collapse, [ @$pref_path ] ),
1440 $self->related_source($_)->_resolve_prefetch(
1441 $pre->{$_}, "${alias}.$_", $alias_map, $order, $collapse, [ @$pref_path, $_] )
1446 $self->throw_exception(
1447 "don't know how to resolve prefetch reftype ".ref($pre));
1451 $p = $p->{$_} for (@$pref_path, $pre);
1453 $self->throw_exception (
1454 "Unable to resolve prefetch $pre - join alias map does not contain an entry for path: "
1455 . join (' -> ', @$pref_path, $pre)
1456 ) if (ref $p->{-join_aliases} ne 'ARRAY' or not @{$p->{-join_aliases}} );
1458 my $as = shift @{$p->{-join_aliases}};
1460 my $rel_info = $self->relationship_info( $pre );
1461 $self->throw_exception( $self->name . " has no such relationship '$pre'" )
1463 my $as_prefix = ($alias =~ /^.*?\.(.+)$/ ? $1.'.' : '');
1464 my $rel_source = $self->related_source($pre);
1466 if (exists $rel_info->{attrs}{accessor}
1467 && $rel_info->{attrs}{accessor} eq 'multi') {
1468 $self->throw_exception(
1469 "Can't prefetch has_many ${pre} (join cond too complex)")
1470 unless ref($rel_info->{cond}) eq 'HASH';
1471 my $dots = @{[$as_prefix =~ m/\./g]} + 1; # +1 to match the ".${as_prefix}"
1472 if (my ($fail) = grep { @{[$_ =~ m/\./g]} == $dots }
1473 keys %{$collapse}) {
1474 my ($last) = ($fail =~ /([^\.]+)$/);
1476 "Prefetching multiple has_many rels ${last} and ${pre} "
1477 .(length($as_prefix)
1478 ? "at the same level (${as_prefix}) "
1481 . 'will explode the number of row objects retrievable via ->next or ->all. '
1482 . 'Use at your own risk.'
1485 #my @col = map { (/^self\.(.+)$/ ? ("${as_prefix}.$1") : ()); }
1486 # values %{$rel_info->{cond}};
1487 $collapse->{".${as_prefix}${pre}"} = [ $rel_source->primary_columns ];
1488 # action at a distance. prepending the '.' allows simpler code
1489 # in ResultSet->_collapse_result
1490 my @key = map { (/^foreign\.(.+)$/ ? ($1) : ()); }
1491 keys %{$rel_info->{cond}};
1492 my @ord = (ref($rel_info->{attrs}{order_by}) eq 'ARRAY'
1493 ? @{$rel_info->{attrs}{order_by}}
1494 : (defined $rel_info->{attrs}{order_by}
1495 ? ($rel_info->{attrs}{order_by})
1497 push(@$order, map { "${as}.$_" } (@key, @ord));
1500 return map { [ "${as}.$_", "${as_prefix}${pre}.$_", ] }
1501 $rel_source->columns;
1505 =head2 related_source
1509 =item Arguments: $relname
1511 =item Return value: $source
1515 Returns the result source object for the given relationship.
1519 sub related_source {
1520 my ($self, $rel) = @_;
1521 if( !$self->has_relationship( $rel ) ) {
1522 $self->throw_exception("No such relationship '$rel'");
1524 return $self->schema->source($self->relationship_info($rel)->{source});
1527 =head2 related_class
1531 =item Arguments: $relname
1533 =item Return value: $classname
1537 Returns the class name for objects in the given relationship.
1542 my ($self, $rel) = @_;
1543 if( !$self->has_relationship( $rel ) ) {
1544 $self->throw_exception("No such relationship '$rel'");
1546 return $self->schema->class($self->relationship_info($rel)->{source});
1551 Obtain a new handle to this source. Returns an instance of a
1552 L<DBIx::Class::ResultSourceHandle>.
1557 return new DBIx::Class::ResultSourceHandle({
1558 schema => $_[0]->schema,
1559 source_moniker => $_[0]->source_name
1563 =head2 throw_exception
1565 See L<DBIx::Class::Schema/"throw_exception">.
1569 sub throw_exception {
1571 if (defined $self->schema) {
1572 $self->schema->throw_exception(@_);
1580 Stores a hashref of per-source metadata. No specific key names
1581 have yet been standardized, the examples below are purely hypothetical
1582 and don't actually accomplish anything on their own:
1584 __PACKAGE__->source_info({
1585 "_tablespace" => 'fast_disk_array_3',
1586 "_engine" => 'InnoDB',
1593 $class->new({attribute_name => value});
1595 Creates a new ResultSource object. Not normally called directly by end users.
1597 =head2 column_info_from_storage
1601 =item Arguments: 1/0 (default: 0)
1603 =item Return value: 1/0
1607 __PACKAGE__->column_info_from_storage(1);
1609 Enables the on-demand automatic loading of the above column
1610 metadata from storage as neccesary. This is *deprecated*, and
1611 should not be used. It will be removed before 1.0.
1616 Matt S. Trout <mst@shadowcatsystems.co.uk>
1620 You may distribute this code under the same terms as Perl itself.