1 package DBIx::Class::ResultSource;
6 use DBIx::Class::ResultSet;
7 use DBIx::Class::ResultSourceHandle;
9 use DBIx::Class::Exception;
10 use Carp::Clan qw/^DBIx::Class/;
12 use base qw/DBIx::Class/;
14 __PACKAGE__->mk_group_accessors('simple' => qw/_ordered_columns
15 _columns _primaries _unique_constraints name resultset_attributes
16 schema from _relationships column_info_from_storage source_info
17 source_name sqlt_deploy_callback/);
19 __PACKAGE__->mk_group_accessors('component_class' => qw/resultset_class
24 DBIx::Class::ResultSource - Result source object
28 # Create a table based result source, in a result class.
30 package MyDB::Schema::Result::Artist;
31 use base qw/DBIx::Class::Core/;
33 __PACKAGE__->table('artist');
34 __PACKAGE__->add_columns(qw/ artistid name /);
35 __PACKAGE__->set_primary_key('artistid');
36 __PACKAGE__->has_many(cds => 'MyDB::Schema::Result::CD');
40 # Create a query (view) based result source, in a result class
41 package MyDB::Schema::Result::Year2000CDs;
42 use base qw/DBIx::Class::Core/;
44 __PACKAGE__->load_components('InflateColumn::DateTime');
45 __PACKAGE__->table_class('DBIx::Class::ResultSource::View');
47 __PACKAGE__->table('year2000cds');
48 __PACKAGE__->result_source_instance->is_virtual(1);
49 __PACKAGE__->result_source_instance->view_definition(
50 "SELECT cdid, artist, title FROM cd WHERE year ='2000'"
56 A ResultSource is an object that represents a source of data for querying.
58 This class is a base class for various specialised types of result
59 sources, for example L<DBIx::Class::ResultSource::Table>. Table is the
60 default result source type, so one is created for you when defining a
61 result class as described in the synopsis above.
63 More specifically, the L<DBIx::Class::Core> base class pulls in the
64 L<DBIx::Class::ResultSourceProxy::Table> component, which defines
65 the L<table|DBIx::Class::ResultSourceProxy::Table/table> method.
66 When called, C<table> creates and stores an instance of
67 L<DBIx::Class::ResultSoure::Table>. Luckily, to use tables as result
68 sources, you don't need to remember any of this.
70 Result sources representing select queries, or views, can also be
71 created, see L<DBIx::Class::ResultSource::View> for full details.
73 =head2 Finding result source objects
75 As mentioned above, a result source instance is created and stored for
76 you when you define a L<Result Class|DBIx::Class::Manual::Glossary/Result Class>.
78 You can retrieve the result source at runtime in the following ways:
82 =item From a Schema object:
84 $schema->source($source_name);
86 =item From a Row object:
90 =item From a ResultSet object:
103 my ($class, $attrs) = @_;
104 $class = ref $class if ref $class;
106 my $new = bless { %{$attrs || {}} }, $class;
107 $new->{resultset_class} ||= 'DBIx::Class::ResultSet';
108 $new->{resultset_attributes} = { %{$new->{resultset_attributes} || {}} };
109 $new->{_ordered_columns} = [ @{$new->{_ordered_columns}||[]}];
110 $new->{_columns} = { %{$new->{_columns}||{}} };
111 $new->{_relationships} = { %{$new->{_relationships}||{}} };
112 $new->{name} ||= "!!NAME NOT SET!!";
113 $new->{_columns_info_loaded} ||= 0;
114 $new->{sqlt_deploy_callback} ||= "default_sqlt_deploy_hook";
124 =item Arguments: @columns
126 =item Return value: The ResultSource object
130 $source->add_columns(qw/col1 col2 col3/);
132 $source->add_columns('col1' => \%col1_info, 'col2' => \%col2_info, ...);
134 Adds columns to the result source. If supplied colname => hashref
135 pairs, uses the hashref as the L</column_info> for that column. Repeated
136 calls of this method will add more columns, not replace them.
138 The column names given will be created as accessor methods on your
139 L<DBIx::Class::Row> objects. You can change the name of the accessor
140 by supplying an L</accessor> in the column_info hash.
142 The contents of the column_info are not set in stone. The following
143 keys are currently recognised/used by DBIx::Class:
149 { accessor => '_name' }
151 # example use, replace standard accessor with one of your own:
153 my ($self, $value) = @_;
155 die "Name cannot contain digits!" if($value =~ /\d/);
156 $self->_name($value);
158 return $self->_name();
161 Use this to set the name of the accessor method for this column. If unset,
162 the name of the column will be used.
166 { data_type => 'integer' }
168 This contains the column type. It is automatically filled if you use the
169 L<SQL::Translator::Producer::DBIx::Class::File> producer, or the
170 L<DBIx::Class::Schema::Loader> module.
172 Currently there is no standard set of values for the data_type. Use
173 whatever your database supports.
179 The length of your column, if it is a column type that can have a size
180 restriction. This is currently only used to create tables from your
181 schema, see L<DBIx::Class::Schema/deploy>.
187 Set this to a true value for a columns that is allowed to contain NULL
188 values, default is false. This is currently only used to create tables
189 from your schema, see L<DBIx::Class::Schema/deploy>.
191 =item is_auto_increment
193 { is_auto_increment => 1 }
195 Set this to a true value for a column whose value is somehow
196 automatically set, defaults to false. This is used to determine which
197 columns to empty when cloning objects using
198 L<DBIx::Class::Row/copy>. It is also used by
199 L<DBIx::Class::Schema/deploy>.
205 Set this to a true or false value (not C<undef>) to explicitly specify
206 if this column contains numeric data. This controls how set_column
207 decides whether to consider a column dirty after an update: if
208 C<is_numeric> is true a numeric comparison C<< != >> will take place
209 instead of the usual C<eq>
211 If not specified the storage class will attempt to figure this out on
212 first access to the column, based on the column C<data_type>. The
213 result will be cached in this attribute.
217 { is_foreign_key => 1 }
219 Set this to a true value for a column that contains a key from a
220 foreign table, defaults to false. This is currently only used to
221 create tables from your schema, see L<DBIx::Class::Schema/deploy>.
225 { default_value => \'now()' }
227 Set this to the default value which will be inserted into a column by
228 the database. Can contain either a value or a function (use a
229 reference to a scalar e.g. C<\'now()'> if you want a function). This
230 is currently only used to create tables from your schema, see
231 L<DBIx::Class::Schema/deploy>.
233 See the note on L<DBIx::Class::Row/new> for more information about possible
234 issues related to db-side default values.
238 { sequence => 'my_table_seq' }
240 Set this on a primary key column to the name of the sequence used to
241 generate a new key value. If not specified, L<DBIx::Class::PK::Auto>
242 will attempt to retrieve the name of the sequence from the database
247 Set this to a true value for a column whose value is retrieved automatically
248 from a sequence or function (if supported by your Storage driver.) For a
249 sequence, if you do not use a trigger to get the nextval, you have to set the
250 L</sequence> value as well.
252 Also set this for MSSQL columns with the 'uniqueidentifier'
253 L<DBIx::Class::ResultSource/data_type> whose values you want to automatically
254 generate using C<NEWID()>, unless they are a primary key in which case this will
259 This is used by L<DBIx::Class::Schema/deploy> and L<SQL::Translator>
260 to add extra non-generic data to the column. For example: C<< extra
261 => { unsigned => 1} >> is used by the MySQL producer to set an integer
262 column to unsigned. For more details, see
263 L<SQL::Translator::Producer::MySQL>.
271 =item Arguments: $colname, \%columninfo?
273 =item Return value: 1/0 (true/false)
277 $source->add_column('col' => \%info);
279 Add a single column and optional column info. Uses the same column
280 info keys as L</add_columns>.
285 my ($self, @cols) = @_;
286 $self->_ordered_columns(\@cols) unless $self->_ordered_columns;
289 my $columns = $self->_columns;
290 while (my $col = shift @cols) {
291 # If next entry is { ... } use that for the column info, if not
292 # use an empty hashref
293 my $column_info = ref $cols[0] ? shift(@cols) : {};
294 push(@added, $col) unless exists $columns->{$col};
295 $columns->{$col} = $column_info;
297 push @{ $self->_ordered_columns }, @added;
301 sub add_column { shift->add_columns(@_); } # DO NOT CHANGE THIS TO GLOB
307 =item Arguments: $colname
309 =item Return value: 1/0 (true/false)
313 if ($source->has_column($colname)) { ... }
315 Returns true if the source has a column of this name, false otherwise.
320 my ($self, $column) = @_;
321 return exists $self->_columns->{$column};
328 =item Arguments: $colname
330 =item Return value: Hashref of info
334 my $info = $source->column_info($col);
336 Returns the column metadata hashref for a column, as originally passed
337 to L</add_columns>. See L</add_columns> above for information on the
338 contents of the hashref.
343 my ($self, $column) = @_;
344 $self->throw_exception("No such column $column")
345 unless exists $self->_columns->{$column};
346 #warn $self->{_columns_info_loaded}, "\n";
347 if ( ! $self->_columns->{$column}{data_type}
348 and $self->column_info_from_storage
349 and ! $self->{_columns_info_loaded}
350 and $self->schema and $self->storage )
352 $self->{_columns_info_loaded}++;
355 # eval for the case of storage without table
356 eval { $info = $self->storage->columns_info_for( $self->from ) };
358 for my $realcol ( keys %{$info} ) {
359 $lc_info->{lc $realcol} = $info->{$realcol};
361 foreach my $col ( keys %{$self->_columns} ) {
362 $self->_columns->{$col} = {
363 %{ $self->_columns->{$col} },
364 %{ $info->{$col} || $lc_info->{lc $col} || {} }
369 return $self->_columns->{$column};
376 =item Arguments: None
378 =item Return value: Ordered list of column names
382 my @column_names = $source->columns;
384 Returns all column names in the order they were declared to L</add_columns>.
390 $self->throw_exception(
391 "columns() is a read-only accessor, did you mean add_columns()?"
393 return @{$self->{_ordered_columns}||[]};
396 =head2 remove_columns
400 =item Arguments: @colnames
402 =item Return value: undefined
406 $source->remove_columns(qw/col1 col2 col3/);
408 Removes the given list of columns by name, from the result source.
410 B<Warning>: Removing a column that is also used in the sources primary
411 key, or in one of the sources unique constraints, B<will> result in a
412 broken result source.
418 =item Arguments: $colname
420 =item Return value: undefined
424 $source->remove_column('col');
426 Remove a single column by name from the result source, similar to
429 B<Warning>: Removing a column that is also used in the sources primary
430 key, or in one of the sources unique constraints, B<will> result in a
431 broken result source.
436 my ($self, @to_remove) = @_;
438 my $columns = $self->_columns
443 delete $columns->{$_};
447 $self->_ordered_columns([ grep { not $to_remove{$_} } @{$self->_ordered_columns} ]);
450 sub remove_column { shift->remove_columns(@_); } # DO NOT CHANGE THIS TO GLOB
452 =head2 set_primary_key
456 =item Arguments: @cols
458 =item Return value: undefined
462 Defines one or more columns as primary key for this source. Must be
463 called after L</add_columns>.
465 Additionally, defines a L<unique constraint|add_unique_constraint>
468 Note: you normally do want to define a primary key on your sources
469 B<even if the underlying database table does not have a primary key>.
471 L<DBIx::Class::Intro/The Significance and Importance of Primary Keys>
476 sub set_primary_key {
477 my ($self, @cols) = @_;
478 # check if primary key columns are valid columns
479 foreach my $col (@cols) {
480 $self->throw_exception("No such column $col on table " . $self->name)
481 unless $self->has_column($col);
483 $self->_primaries(\@cols);
485 $self->add_unique_constraint(primary => \@cols);
488 =head2 primary_columns
492 =item Arguments: None
494 =item Return value: Ordered list of primary column names
498 Read-only accessor which returns the list of primary keys, supplied by
503 sub primary_columns {
504 return @{shift->_primaries||[]};
509 my @pcols = $self->primary_columns
510 or $self->throw_exception (sprintf(
511 'Operation requires a primary key to be declared on %s via set_primary_key',
517 =head2 add_unique_constraint
521 =item Arguments: $name?, \@colnames
523 =item Return value: undefined
527 Declare a unique constraint on this source. Call once for each unique
530 # For UNIQUE (column1, column2)
531 __PACKAGE__->add_unique_constraint(
532 constraint_name => [ qw/column1 column2/ ],
535 Alternatively, you can specify only the columns:
537 __PACKAGE__->add_unique_constraint([ qw/column1 column2/ ]);
539 This will result in a unique constraint named
540 C<table_column1_column2>, where C<table> is replaced with the table
543 Unique constraints are used, for example, when you pass the constraint
544 name as the C<key> attribute to L<DBIx::Class::ResultSet/find>. Then
545 only columns in the constraint are searched.
547 Throws an error if any of the given column names do not yet exist on
552 sub add_unique_constraint {
557 $name ||= $self->name_unique_constraint($cols);
559 foreach my $col (@$cols) {
560 $self->throw_exception("No such column $col on table " . $self->name)
561 unless $self->has_column($col);
564 my %unique_constraints = $self->unique_constraints;
565 $unique_constraints{$name} = $cols;
566 $self->_unique_constraints(\%unique_constraints);
569 =head2 name_unique_constraint
573 =item Arguments: @colnames
575 =item Return value: Constraint name
579 $source->table('mytable');
580 $source->name_unique_constraint('col1', 'col2');
584 Return a name for a unique constraint containing the specified
585 columns. The name is created by joining the table name and each column
586 name, using an underscore character.
588 For example, a constraint on a table named C<cd> containing the columns
589 C<artist> and C<title> would result in a constraint name of C<cd_artist_title>.
591 This is used by L</add_unique_constraint> if you do not specify the
592 optional constraint name.
596 sub name_unique_constraint {
597 my ($self, $cols) = @_;
599 my $name = $self->name;
600 $name = $$name if (ref $name eq 'SCALAR');
602 return join '_', $name, @$cols;
605 =head2 unique_constraints
609 =item Arguments: None
611 =item Return value: Hash of unique constraint data
615 $source->unique_constraints();
617 Read-only accessor which returns a hash of unique constraints on this
620 The hash is keyed by constraint name, and contains an arrayref of
621 column names as values.
625 sub unique_constraints {
626 return %{shift->_unique_constraints||{}};
629 =head2 unique_constraint_names
633 =item Arguments: None
635 =item Return value: Unique constraint names
639 $source->unique_constraint_names();
641 Returns the list of unique constraint names defined on this source.
645 sub unique_constraint_names {
648 my %unique_constraints = $self->unique_constraints;
650 return keys %unique_constraints;
653 =head2 unique_constraint_columns
657 =item Arguments: $constraintname
659 =item Return value: List of constraint columns
663 $source->unique_constraint_columns('myconstraint');
665 Returns the list of columns that make up the specified unique constraint.
669 sub unique_constraint_columns {
670 my ($self, $constraint_name) = @_;
672 my %unique_constraints = $self->unique_constraints;
674 $self->throw_exception(
675 "Unknown unique constraint $constraint_name on '" . $self->name . "'"
676 ) unless exists $unique_constraints{$constraint_name};
678 return @{ $unique_constraints{$constraint_name} };
681 =head2 sqlt_deploy_callback
685 =item Arguments: $callback
689 __PACKAGE__->sqlt_deploy_callback('mycallbackmethod');
691 An accessor to set a callback to be called during deployment of
692 the schema via L<DBIx::Class::Schema/create_ddl_dir> or
693 L<DBIx::Class::Schema/deploy>.
695 The callback can be set as either a code reference or the name of a
696 method in the current result class.
698 If not set, the L</default_sqlt_deploy_hook> is called.
700 Your callback will be passed the $source object representing the
701 ResultSource instance being deployed, and the
702 L<SQL::Translator::Schema::Table> object being created from it. The
703 callback can be used to manipulate the table object or add your own
704 customised indexes. If you need to manipulate a non-table object, use
705 the L<DBIx::Class::Schema/sqlt_deploy_hook>.
707 See L<DBIx::Class::Manual::Cookbook/Adding Indexes And Functions To
708 Your SQL> for examples.
710 This sqlt deployment callback can only be used to manipulate
711 SQL::Translator objects as they get turned into SQL. To execute
712 post-deploy statements which SQL::Translator does not currently
713 handle, override L<DBIx::Class::Schema/deploy> in your Schema class
714 and call L<dbh_do|DBIx::Class::Storage::DBI/dbh_do>.
716 =head2 default_sqlt_deploy_hook
720 =item Arguments: $source, $sqlt_table
722 =item Return value: undefined
726 This is the sensible default for L</sqlt_deploy_callback>.
728 If a method named C<sqlt_deploy_hook> exists in your Result class, it
729 will be called and passed the current C<$source> and the
730 C<$sqlt_table> being deployed.
734 sub default_sqlt_deploy_hook {
737 my $class = $self->result_class;
739 if ($class and $class->can('sqlt_deploy_hook')) {
740 $class->sqlt_deploy_hook(@_);
744 sub _invoke_sqlt_deploy_hook {
746 if ( my $hook = $self->sqlt_deploy_callback) {
755 =item Arguments: None
757 =item Return value: $resultset
761 Returns a resultset for the given source. This will initially be created
764 $self->resultset_class->new($self, $self->resultset_attributes)
766 but is cached from then on unless resultset_class changes.
768 =head2 resultset_class
772 =item Arguments: $classname
774 =item Return value: $classname
778 package My::Schema::ResultSet::Artist;
779 use base 'DBIx::Class::ResultSet';
782 # In the result class
783 __PACKAGE__->resultset_class('My::Schema::ResultSet::Artist');
786 $source->resultset_class('My::Schema::ResultSet::Artist');
788 Set the class of the resultset. This is useful if you want to create your
789 own resultset methods. Create your own class derived from
790 L<DBIx::Class::ResultSet>, and set it here. If called with no arguments,
791 this method returns the name of the existing resultset class, if one
794 =head2 resultset_attributes
798 =item Arguments: \%attrs
800 =item Return value: \%attrs
804 # In the result class
805 __PACKAGE__->resultset_attributes({ order_by => [ 'id' ] });
808 $source->resultset_attributes({ order_by => [ 'id' ] });
810 Store a collection of resultset attributes, that will be set on every
811 L<DBIx::Class::ResultSet> produced from this result source. For a full
812 list see L<DBIx::Class::ResultSet/ATTRIBUTES>.
818 $self->throw_exception(
819 'resultset does not take any arguments. If you want another resultset, '.
820 'call it on the schema instead.'
823 return $self->resultset_class->new(
826 %{$self->{resultset_attributes}},
827 %{$self->schema->default_resultset_attributes}
836 =item Arguments: $source_name
838 =item Result value: $source_name
842 Set an alternate name for the result source when it is loaded into a schema.
843 This is useful if you want to refer to a result source by a name other than
846 package ArchivedBooks;
847 use base qw/DBIx::Class/;
848 __PACKAGE__->table('books_archive');
849 __PACKAGE__->source_name('Books');
851 # from your schema...
852 $schema->resultset('Books')->find(1);
858 =item Arguments: None
860 =item Return value: FROM clause
864 my $from_clause = $source->from();
866 Returns an expression of the source to be supplied to storage to specify
867 retrieval from this source. In the case of a database, the required FROM
874 =item Arguments: None
876 =item Return value: A schema object
880 my $schema = $source->schema();
882 Returns the L<DBIx::Class::Schema> object that this result source
889 =item Arguments: None
891 =item Return value: A Storage object
895 $source->storage->debug(1);
897 Returns the storage handle for the current schema.
899 See also: L<DBIx::Class::Storage>
903 sub storage { shift->schema->storage; }
905 =head2 add_relationship
909 =item Arguments: $relname, $related_source_name, \%cond, [ \%attrs ]
911 =item Return value: 1/true if it succeeded
915 $source->add_relationship('relname', 'related_source', $cond, $attrs);
917 L<DBIx::Class::Relationship> describes a series of methods which
918 create pre-defined useful types of relationships. Look there first
919 before using this method directly.
921 The relationship name can be arbitrary, but must be unique for each
922 relationship attached to this result source. 'related_source' should
923 be the name with which the related result source was registered with
924 the current schema. For example:
926 $schema->source('Book')->add_relationship('reviews', 'Review', {
927 'foreign.book_id' => 'self.id',
930 The condition C<$cond> needs to be an L<SQL::Abstract>-style
931 representation of the join between the tables. For example, if you're
932 creating a relation from Author to Book,
934 { 'foreign.author_id' => 'self.id' }
936 will result in the JOIN clause
938 author me JOIN book foreign ON foreign.author_id = me.id
940 You can specify as many foreign => self mappings as necessary.
942 Valid attributes are as follows:
948 Explicitly specifies the type of join to use in the relationship. Any
949 SQL join type is valid, e.g. C<LEFT> or C<RIGHT>. It will be placed in
950 the SQL command immediately before C<JOIN>.
954 An arrayref containing a list of accessors in the foreign class to proxy in
955 the main class. If, for example, you do the following:
957 CD->might_have(liner_notes => 'LinerNotes', undef, {
958 proxy => [ qw/notes/ ],
961 Then, assuming LinerNotes has an accessor named notes, you can do:
963 my $cd = CD->find(1);
964 # set notes -- LinerNotes object is created if it doesn't exist
965 $cd->notes('Notes go here');
969 Specifies the type of accessor that should be created for the
970 relationship. Valid values are C<single> (for when there is only a single
971 related object), C<multi> (when there can be many), and C<filter> (for
972 when there is a single related object, but you also want the relationship
973 accessor to double as a column accessor). For C<multi> accessors, an
974 add_to_* method is also created, which calls C<create_related> for the
979 Throws an exception if the condition is improperly supplied, or cannot
984 sub add_relationship {
985 my ($self, $rel, $f_source_name, $cond, $attrs) = @_;
986 $self->throw_exception("Can't create relationship without join condition")
990 # Check foreign and self are right in cond
991 if ( (ref $cond ||'') eq 'HASH') {
993 $self->throw_exception("Keys of condition should be of form 'foreign.col', not '$_'")
994 if /\./ && !/^foreign\./;
998 my %rels = %{ $self->_relationships };
999 $rels{$rel} = { class => $f_source_name,
1000 source => $f_source_name,
1003 $self->_relationships(\%rels);
1007 # XXX disabled. doesn't work properly currently. skip in tests.
1009 my $f_source = $self->schema->source($f_source_name);
1010 unless ($f_source) {
1011 $self->ensure_class_loaded($f_source_name);
1012 $f_source = $f_source_name->result_source;
1013 #my $s_class = ref($self->schema);
1014 #$f_source_name =~ m/^${s_class}::(.*)$/;
1015 #$self->schema->register_class(($1 || $f_source_name), $f_source_name);
1016 #$f_source = $self->schema->source($f_source_name);
1018 return unless $f_source; # Can't test rel without f_source
1020 eval { $self->_resolve_join($rel, 'me', {}, []) };
1022 if ($@) { # If the resolve failed, back out and re-throw the error
1023 delete $rels{$rel}; #
1024 $self->_relationships(\%rels);
1025 $self->throw_exception("Error creating relationship $rel: $@");
1030 =head2 relationships
1034 =item Arguments: None
1036 =item Return value: List of relationship names
1040 my @relnames = $source->relationships();
1042 Returns all relationship names for this source.
1047 return keys %{shift->_relationships};
1050 =head2 relationship_info
1054 =item Arguments: $relname
1056 =item Return value: Hashref of relation data,
1060 Returns a hash of relationship information for the specified relationship
1061 name. The keys/values are as specified for L</add_relationship>.
1065 sub relationship_info {
1066 my ($self, $rel) = @_;
1067 return $self->_relationships->{$rel};
1070 =head2 has_relationship
1074 =item Arguments: $rel
1076 =item Return value: 1/0 (true/false)
1080 Returns true if the source has a relationship of this name, false otherwise.
1084 sub has_relationship {
1085 my ($self, $rel) = @_;
1086 return exists $self->_relationships->{$rel};
1089 =head2 reverse_relationship_info
1093 =item Arguments: $relname
1095 =item Return value: Hashref of relationship data
1099 Looks through all the relationships on the source this relationship
1100 points to, looking for one whose condition is the reverse of the
1101 condition on this relationship.
1103 A common use of this is to find the name of the C<belongs_to> relation
1104 opposing a C<has_many> relation. For definition of these look in
1105 L<DBIx::Class::Relationship>.
1107 The returned hashref is keyed by the name of the opposing
1108 relationship, and contains its data in the same manner as
1109 L</relationship_info>.
1113 sub reverse_relationship_info {
1114 my ($self, $rel) = @_;
1115 my $rel_info = $self->relationship_info($rel);
1118 return $ret unless ((ref $rel_info->{cond}) eq 'HASH');
1120 my @cond = keys(%{$rel_info->{cond}});
1121 my @refkeys = map {/^\w+\.(\w+)$/} @cond;
1122 my @keys = map {$rel_info->{cond}->{$_} =~ /^\w+\.(\w+)$/} @cond;
1124 # Get the related result source for this relationship
1125 my $othertable = $self->related_source($rel);
1127 # Get all the relationships for that source that related to this source
1128 # whose foreign column set are our self columns on $rel and whose self
1129 # columns are our foreign columns on $rel.
1130 my @otherrels = $othertable->relationships();
1131 my $otherrelationship;
1132 foreach my $otherrel (@otherrels) {
1133 my $otherrel_info = $othertable->relationship_info($otherrel);
1135 my $back = $othertable->related_source($otherrel);
1136 next unless $back->source_name eq $self->source_name;
1140 if (ref $otherrel_info->{cond} eq 'HASH') {
1141 @othertestconds = ($otherrel_info->{cond});
1143 elsif (ref $otherrel_info->{cond} eq 'ARRAY') {
1144 @othertestconds = @{$otherrel_info->{cond}};
1150 foreach my $othercond (@othertestconds) {
1151 my @other_cond = keys(%$othercond);
1152 my @other_refkeys = map {/^\w+\.(\w+)$/} @other_cond;
1153 my @other_keys = map {$othercond->{$_} =~ /^\w+\.(\w+)$/} @other_cond;
1154 next if (!$self->_compare_relationship_keys(\@refkeys, \@other_keys) ||
1155 !$self->_compare_relationship_keys(\@other_refkeys, \@keys));
1156 $ret->{$otherrel} = $otherrel_info;
1162 sub compare_relationship_keys {
1163 carp 'compare_relationship_keys is a private method, stop calling it';
1165 $self->_compare_relationship_keys (@_);
1168 # Returns true if both sets of keynames are the same, false otherwise.
1169 sub _compare_relationship_keys {
1170 my ($self, $keys1, $keys2) = @_;
1172 # Make sure every keys1 is in keys2
1174 foreach my $key (@$keys1) {
1176 foreach my $prim (@$keys2) {
1177 if ($prim eq $key) {
1185 # Make sure every key2 is in key1
1187 foreach my $prim (@$keys2) {
1189 foreach my $key (@$keys1) {
1190 if ($prim eq $key) {
1202 # Returns the {from} structure used to express JOIN conditions
1204 my ($self, $join, $alias, $seen, $jpath, $parent_force_left) = @_;
1206 # we need a supplied one, because we do in-place modifications, no returns
1207 $self->throw_exception ('You must supply a seen hashref as the 3rd argument to _resolve_join')
1208 unless ref $seen eq 'HASH';
1210 $self->throw_exception ('You must supply a joinpath arrayref as the 4th argument to _resolve_join')
1211 unless ref $jpath eq 'ARRAY';
1213 $jpath = [@$jpath]; # copy
1215 if (not defined $join) {
1218 elsif (ref $join eq 'ARRAY') {
1221 $self->_resolve_join($_, $alias, $seen, $jpath, $parent_force_left);
1224 elsif (ref $join eq 'HASH') {
1227 for my $rel (keys %$join) {
1229 my $rel_info = $self->relationship_info($rel)
1230 or $self->throw_exception("No such relationship ${rel}");
1232 my $force_left = $parent_force_left;
1233 $force_left ||= lc($rel_info->{attrs}{join_type}||'') eq 'left';
1235 # the actual seen value will be incremented by the recursion
1236 my $as = $self->storage->relname_to_table_alias(
1237 $rel, ($seen->{$rel} && $seen->{$rel} + 1)
1241 $self->_resolve_join($rel, $alias, $seen, [@$jpath], $force_left),
1242 $self->related_source($rel)->_resolve_join(
1243 $join->{$rel}, $as, $seen, [@$jpath, { $rel => $as }], $force_left
1251 $self->throw_exception("No idea how to resolve join reftype ".ref $join);
1254 my $count = ++$seen->{$join};
1255 my $as = $self->storage->relname_to_table_alias(
1256 $join, ($count > 1 && $count)
1259 my $rel_info = $self->relationship_info($join)
1260 or $self->throw_exception("No such relationship ${join}");
1262 my $rel_src = $self->related_source($join);
1263 return [ { $as => $rel_src->from,
1264 -source_handle => $rel_src->handle,
1265 -join_type => $parent_force_left
1267 : $rel_info->{attrs}{join_type}
1269 -join_path => [@$jpath, { $join => $as } ],
1271 $rel_info->{attrs}{accessor}
1273 List::Util::first { $rel_info->{attrs}{accessor} eq $_ } (qw/single filter/)
1276 -relation_chain_depth => $seen->{-relation_chain_depth} || 0,
1278 $self->_resolve_condition($rel_info->{cond}, $as, $alias) ];
1283 carp 'pk_depends_on is a private method, stop calling it';
1285 $self->_pk_depends_on (@_);
1288 # Determines whether a relation is dependent on an object from this source
1289 # having already been inserted. Takes the name of the relationship and a
1290 # hashref of columns of the related object.
1291 sub _pk_depends_on {
1292 my ($self, $relname, $rel_data) = @_;
1294 my $relinfo = $self->relationship_info($relname);
1296 # don't assume things if the relationship direction is specified
1297 return $relinfo->{attrs}{is_foreign_key_constraint}
1298 if exists ($relinfo->{attrs}{is_foreign_key_constraint});
1300 my $cond = $relinfo->{cond};
1301 return 0 unless ref($cond) eq 'HASH';
1303 # map { foreign.foo => 'self.bar' } to { bar => 'foo' }
1304 my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond };
1306 # assume anything that references our PK probably is dependent on us
1307 # rather than vice versa, unless the far side is (a) defined or (b)
1309 my $rel_source = $self->related_source($relname);
1311 foreach my $p ($self->primary_columns) {
1312 if (exists $keyhash->{$p}) {
1313 unless (defined($rel_data->{$keyhash->{$p}})
1314 || $rel_source->column_info($keyhash->{$p})
1315 ->{is_auto_increment}) {
1324 sub resolve_condition {
1325 carp 'resolve_condition is a private method, stop calling it';
1327 $self->_resolve_condition (@_);
1330 # Resolves the passed condition to a concrete query fragment. If given an alias,
1331 # returns a join condition; if given an object, inverts that object to produce
1332 # a related conditional from that object.
1333 our $UNRESOLVABLE_CONDITION = \'1 = 0';
1335 sub _resolve_condition {
1336 my ($self, $cond, $as, $for) = @_;
1337 if (ref $cond eq 'HASH') {
1339 foreach my $k (keys %{$cond}) {
1340 my $v = $cond->{$k};
1341 # XXX should probably check these are valid columns
1342 $k =~ s/^foreign\.// ||
1343 $self->throw_exception("Invalid rel cond key ${k}");
1344 $v =~ s/^self\.// ||
1345 $self->throw_exception("Invalid rel cond val ${v}");
1346 if (ref $for) { # Object
1347 #warn "$self $k $for $v";
1348 unless ($for->has_column_loaded($v)) {
1349 if ($for->in_storage) {
1350 $self->throw_exception(sprintf
1351 "Unable to resolve relationship '%s' from object %s: column '%s' not "
1352 . 'loaded from storage (or not passed to new() prior to insert()). You '
1353 . 'probably need to call ->discard_changes to get the server-side defaults '
1354 . 'from the database.',
1360 return $UNRESOLVABLE_CONDITION;
1362 $ret{$k} = $for->get_column($v);
1363 #$ret{$k} = $for->get_column($v) if $for->has_column_loaded($v);
1365 } elsif (!defined $for) { # undef, i.e. "no object"
1367 } elsif (ref $as eq 'HASH') { # reverse hashref
1368 $ret{$v} = $as->{$k};
1369 } elsif (ref $as) { # reverse object
1370 $ret{$v} = $as->get_column($k);
1371 } elsif (!defined $as) { # undef, i.e. "no reverse object"
1374 $ret{"${as}.${k}"} = "${for}.${v}";
1378 } elsif (ref $cond eq 'ARRAY') {
1379 return [ map { $self->_resolve_condition($_, $as, $for) } @$cond ];
1381 die("Can't handle condition $cond yet :(");
1386 # Accepts one or more relationships for the current source and returns an
1387 # array of column names for each of those relationships. Column names are
1388 # prefixed relative to the current source, in accordance with where they appear
1389 # in the supplied relationships.
1391 sub _resolve_prefetch {
1392 my ($self, $pre, $alias, $alias_map, $order, $collapse, $pref_path) = @_;
1395 if (not defined $pre) {
1398 elsif( ref $pre eq 'ARRAY' ) {
1400 map { $self->_resolve_prefetch( $_, $alias, $alias_map, $order, $collapse, [ @$pref_path ] ) }
1403 elsif( ref $pre eq 'HASH' ) {
1406 $self->_resolve_prefetch($_, $alias, $alias_map, $order, $collapse, [ @$pref_path ] ),
1407 $self->related_source($_)->_resolve_prefetch(
1408 $pre->{$_}, "${alias}.$_", $alias_map, $order, $collapse, [ @$pref_path, $_] )
1413 $self->throw_exception(
1414 "don't know how to resolve prefetch reftype ".ref($pre));
1418 $p = $p->{$_} for (@$pref_path, $pre);
1420 $self->throw_exception (
1421 "Unable to resolve prefetch '$pre' - join alias map does not contain an entry for path: "
1422 . join (' -> ', @$pref_path, $pre)
1423 ) if (ref $p->{-join_aliases} ne 'ARRAY' or not @{$p->{-join_aliases}} );
1425 my $as = shift @{$p->{-join_aliases}};
1427 my $rel_info = $self->relationship_info( $pre );
1428 $self->throw_exception( $self->name . " has no such relationship '$pre'" )
1430 my $as_prefix = ($alias =~ /^.*?\.(.+)$/ ? $1.'.' : '');
1431 my $rel_source = $self->related_source($pre);
1433 if ($rel_info->{attrs}{accessor} && $rel_info->{attrs}{accessor} eq 'multi') {
1434 $self->throw_exception(
1435 "Can't prefetch has_many ${pre} (join cond too complex)")
1436 unless ref($rel_info->{cond}) eq 'HASH';
1437 my $dots = @{[$as_prefix =~ m/\./g]} + 1; # +1 to match the ".${as_prefix}"
1438 if (my ($fail) = grep { @{[$_ =~ m/\./g]} == $dots }
1439 keys %{$collapse}) {
1440 my ($last) = ($fail =~ /([^\.]+)$/);
1442 "Prefetching multiple has_many rels ${last} and ${pre} "
1443 .(length($as_prefix)
1444 ? "at the same level (${as_prefix}) "
1447 . 'will explode the number of row objects retrievable via ->next or ->all. '
1448 . 'Use at your own risk.'
1451 #my @col = map { (/^self\.(.+)$/ ? ("${as_prefix}.$1") : ()); }
1452 # values %{$rel_info->{cond}};
1453 $collapse->{".${as_prefix}${pre}"} = [ $rel_source->primary_columns ];
1454 # action at a distance. prepending the '.' allows simpler code
1455 # in ResultSet->_collapse_result
1456 my @key = map { (/^foreign\.(.+)$/ ? ($1) : ()); }
1457 keys %{$rel_info->{cond}};
1458 my @ord = (ref($rel_info->{attrs}{order_by}) eq 'ARRAY'
1459 ? @{$rel_info->{attrs}{order_by}}
1461 : (defined $rel_info->{attrs}{order_by}
1462 ? ($rel_info->{attrs}{order_by})
1464 push(@$order, map { "${as}.$_" } (@key, @ord));
1467 return map { [ "${as}.$_", "${as_prefix}${pre}.$_", ] }
1468 $rel_source->columns;
1472 =head2 related_source
1476 =item Arguments: $relname
1478 =item Return value: $source
1482 Returns the result source object for the given relationship.
1486 sub related_source {
1487 my ($self, $rel) = @_;
1488 if( !$self->has_relationship( $rel ) ) {
1489 $self->throw_exception("No such relationship '$rel'");
1491 return $self->schema->source($self->relationship_info($rel)->{source});
1494 =head2 related_class
1498 =item Arguments: $relname
1500 =item Return value: $classname
1504 Returns the class name for objects in the given relationship.
1509 my ($self, $rel) = @_;
1510 if( !$self->has_relationship( $rel ) ) {
1511 $self->throw_exception("No such relationship '$rel'");
1513 return $self->schema->class($self->relationship_info($rel)->{source});
1518 Obtain a new handle to this source. Returns an instance of a
1519 L<DBIx::Class::ResultSourceHandle>.
1524 return DBIx::Class::ResultSourceHandle->new({
1525 schema => $_[0]->schema,
1526 source_moniker => $_[0]->source_name
1530 =head2 throw_exception
1532 See L<DBIx::Class::Schema/"throw_exception">.
1536 sub throw_exception {
1539 if (defined $self->schema) {
1540 $self->schema->throw_exception(@_);
1543 DBIx::Class::Exception->throw(@_);
1549 Stores a hashref of per-source metadata. No specific key names
1550 have yet been standardized, the examples below are purely hypothetical
1551 and don't actually accomplish anything on their own:
1553 __PACKAGE__->source_info({
1554 "_tablespace" => 'fast_disk_array_3',
1555 "_engine" => 'InnoDB',
1562 $class->new({attribute_name => value});
1564 Creates a new ResultSource object. Not normally called directly by end users.
1566 =head2 column_info_from_storage
1570 =item Arguments: 1/0 (default: 0)
1572 =item Return value: 1/0
1576 __PACKAGE__->column_info_from_storage(1);
1578 Enables the on-demand automatic loading of the above column
1579 metadata from storage as necessary. This is *deprecated*, and
1580 should not be used. It will be removed before 1.0.
1585 Matt S. Trout <mst@shadowcatsystems.co.uk>
1589 You may distribute this code under the same terms as Perl itself.