1 package DBIx::Class::ResultSource;
6 use DBIx::Class::ResultSet;
7 use DBIx::Class::ResultSourceHandle;
8 use Carp::Clan qw/^DBIx::Class/;
10 use base qw/DBIx::Class/;
12 __PACKAGE__->mk_group_accessors('simple' => qw/_ordered_columns
13 _columns _primaries _unique_constraints name resultset_attributes
14 schema from _relationships column_info_from_storage source_info
15 source_name sqlt_deploy_callback/);
17 __PACKAGE__->mk_group_accessors('component_class' => qw/resultset_class
22 DBIx::Class::ResultSource - Result source object
26 # Create a table based result source, in a result class.
28 package MyDB::Schema::Result::Artist;
29 use base qw/DBIx::Class/;
31 __PACKAGE__->load_components(qw/Core/);
32 __PACKAGE__->table('artist');
33 __PACKAGE__->add_columns(qw/ artistid name /);
34 __PACKAGE__->set_primary_key('artistid');
35 __PACKAGE__->has_many(cds => 'MyDB::Schema::Result::CD');
39 # Create a query (view) based result source, in a result class
40 package MyDB::Schema::Result::Year2000CDs;
42 __PACKAGE__->load_components('Core');
43 __PACKAGE__->table_class('DBIx::Class::ResultSource::View');
45 __PACKAGE__->table('year2000cds');
46 __PACKAGE__->result_source_instance->is_virtual(1);
47 __PACKAGE__->result_source_instance->view_definition(
48 "SELECT cdid, artist, title FROM cd WHERE year ='2000'"
54 A ResultSource is an object that represents a source of data for querying.
56 This class is a base class for various specialised types of result
57 sources, for example L<DBIx::Class::ResultSource::Table>. Table is the
58 default result source type, so one is created for you when defining a
59 result class as described in the synopsis above.
61 More specifically, the L<DBIx::Class::Core> component pulls in the
62 L<DBIx::Class::ResultSourceProxy::Table> as a base class, which
63 defines the L<table|DBIx::Class::ResultSourceProxy::Table/table>
64 method. When called, C<table> creates and stores an instance of
65 L<DBIx::Class::ResultSoure::Table>. Luckily, to use tables as result
66 sources, you don't need to remember any of this.
68 Result sources representing select queries, or views, can also be
69 created, see L<DBIx::Class::ResultSource::View> for full details.
71 =head2 Finding result source objects
73 As mentioned above, a result source instance is created and stored for
74 you when you define a L<Result Class|DBIx::Class::Manual::Glossary/Result Class>.
76 You can retrieve the result source at runtime in the following ways:
80 =item From a Schema object:
82 $schema->source($source_name);
84 =item From a Row object:
88 =item From a ResultSet object:
101 my ($class, $attrs) = @_;
102 $class = ref $class if ref $class;
104 my $new = bless { %{$attrs || {}} }, $class;
105 $new->{resultset_class} ||= 'DBIx::Class::ResultSet';
106 $new->{resultset_attributes} = { %{$new->{resultset_attributes} || {}} };
107 $new->{_ordered_columns} = [ @{$new->{_ordered_columns}||[]}];
108 $new->{_columns} = { %{$new->{_columns}||{}} };
109 $new->{_relationships} = { %{$new->{_relationships}||{}} };
110 $new->{name} ||= "!!NAME NOT SET!!";
111 $new->{_columns_info_loaded} ||= 0;
112 $new->{sqlt_deploy_callback} ||= "default_sqlt_deploy_hook";
122 =item Arguments: @columns
124 =item Return value: The ResultSource object
128 $source->add_columns(qw/col1 col2 col3/);
130 $source->add_columns('col1' => \%col1_info, 'col2' => \%col2_info, ...);
132 Adds columns to the result source. If supplied colname => hashref
133 pairs, uses the hashref as the L</column_info> for that column. Repeated
134 calls of this method will add more columns, not replace them.
136 The column names given will be created as accessor methods on your
137 L<DBIx::Class::Row> objects. You can change the name of the accessor
138 by supplying an L</accessor> in the column_info hash.
140 The contents of the column_info are not set in stone. The following
141 keys are currently recognised/used by DBIx::Class:
147 { accessor => '_name' }
149 # example use, replace standard accessor with one of your own:
151 my ($self, $value) = @_;
153 die "Name cannot contain digits!" if($value =~ /\d/);
154 $self->_name($value);
156 return $self->_name();
159 Use this to set the name of the accessor method for this column. If unset,
160 the name of the column will be used.
164 { data_type => 'integer' }
166 This contains the column type. It is automatically filled if you use the
167 L<SQL::Translator::Producer::DBIx::Class::File> producer, or the
168 L<DBIx::Class::Schema::Loader> module.
170 Currently there is no standard set of values for the data_type. Use
171 whatever your database supports.
177 The length of your column, if it is a column type that can have a size
178 restriction. This is currently only used to create tables from your
179 schema, see L<DBIx::Class::Schema/deploy>.
185 Set this to a true value for a columns that is allowed to contain NULL
186 values, default is false. This is currently only used to create tables
187 from your schema, see L<DBIx::Class::Schema/deploy>.
189 =item is_auto_increment
191 { is_auto_increment => 1 }
193 Set this to a true value for a column whose value is somehow
194 automatically set, defaults to false. This is used to determine which
195 columns to empty when cloning objects using
196 L<DBIx::Class::Row/copy>. It is also used by
197 L<DBIx::Class::Schema/deploy>.
203 Set this to a true or false value (not C<undef>) to explicitly specify
204 if this column contains numeric data. This controls how set_column
205 decides whether to consider a column dirty after an update: if
206 C<is_numeric> is true a numeric comparison C<< != >> will take place
207 instead of the usual C<eq>
209 If not specified the storage class will attempt to figure this out on
210 first access to the column, based on the column C<data_type>. The
211 result will be cached in this attribute.
215 { is_foreign_key => 1 }
217 Set this to a true value for a column that contains a key from a
218 foreign table, defaults to false. This is currently only used to
219 create tables from your schema, see L<DBIx::Class::Schema/deploy>.
223 { default_value => \'now()' }
225 Set this to the default value which will be inserted into a column by
226 the database. Can contain either a value or a function (use a
227 reference to a scalar e.g. C<\'now()'> if you want a function). This
228 is currently only used to create tables from your schema, see
229 L<DBIx::Class::Schema/deploy>.
231 See the note on L<DBIx::Class::Row/new> for more information about possible
232 issues related to db-side default values.
236 { sequence => 'my_table_seq' }
238 Set this on a primary key column to the name of the sequence used to
239 generate a new key value. If not specified, L<DBIx::Class::PK::Auto>
240 will attempt to retrieve the name of the sequence from the database
245 Set this to a true value for a column whose value is retrieved automatically
246 from a sequence or function (if supported by your Storage driver.) For a
247 sequence, if you do not use a trigger to get the nextval, you have to set the
248 L</sequence> value as well.
250 Also set this for MSSQL columns with the 'uniqueidentifier'
251 L<DBIx::Class::ResultSource/data_type> whose values you want to automatically
252 generate using C<NEWID()>, unless they are a primary key in which case this will
257 This is used by L<DBIx::Class::Schema/deploy> and L<SQL::Translator>
258 to add extra non-generic data to the column. For example: C<< extra
259 => { unsigned => 1} >> is used by the MySQL producer to set an integer
260 column to unsigned. For more details, see
261 L<SQL::Translator::Producer::MySQL>.
269 =item Arguments: $colname, \%columninfo?
271 =item Return value: 1/0 (true/false)
275 $source->add_column('col' => \%info);
277 Add a single column and optional column info. Uses the same column
278 info keys as L</add_columns>.
283 my ($self, @cols) = @_;
284 $self->_ordered_columns(\@cols) unless $self->_ordered_columns;
287 my $columns = $self->_columns;
288 while (my $col = shift @cols) {
289 # If next entry is { ... } use that for the column info, if not
290 # use an empty hashref
291 my $column_info = ref $cols[0] ? shift(@cols) : {};
292 push(@added, $col) unless exists $columns->{$col};
293 $columns->{$col} = $column_info;
295 push @{ $self->_ordered_columns }, @added;
299 sub add_column { shift->add_columns(@_); } # DO NOT CHANGE THIS TO GLOB
305 =item Arguments: $colname
307 =item Return value: 1/0 (true/false)
311 if ($source->has_column($colname)) { ... }
313 Returns true if the source has a column of this name, false otherwise.
318 my ($self, $column) = @_;
319 return exists $self->_columns->{$column};
326 =item Arguments: $colname
328 =item Return value: Hashref of info
332 my $info = $source->column_info($col);
334 Returns the column metadata hashref for a column, as originally passed
335 to L</add_columns>. See L</add_columns> above for information on the
336 contents of the hashref.
341 my ($self, $column) = @_;
342 $self->throw_exception("No such column $column")
343 unless exists $self->_columns->{$column};
344 #warn $self->{_columns_info_loaded}, "\n";
345 if ( ! $self->_columns->{$column}{data_type}
346 and $self->column_info_from_storage
347 and ! $self->{_columns_info_loaded}
348 and $self->schema and $self->storage )
350 $self->{_columns_info_loaded}++;
353 # eval for the case of storage without table
354 eval { $info = $self->storage->columns_info_for( $self->from ) };
356 for my $realcol ( keys %{$info} ) {
357 $lc_info->{lc $realcol} = $info->{$realcol};
359 foreach my $col ( keys %{$self->_columns} ) {
360 $self->_columns->{$col} = {
361 %{ $self->_columns->{$col} },
362 %{ $info->{$col} || $lc_info->{lc $col} || {} }
367 return $self->_columns->{$column};
374 =item Arguments: None
376 =item Return value: Ordered list of column names
380 my @column_names = $source->columns;
382 Returns all column names in the order they were declared to L</add_columns>.
388 $self->throw_exception(
389 "columns() is a read-only accessor, did you mean add_columns()?"
391 return @{$self->{_ordered_columns}||[]};
394 =head2 remove_columns
398 =item Arguments: @colnames
400 =item Return value: undefined
404 $source->remove_columns(qw/col1 col2 col3/);
406 Removes the given list of columns by name, from the result source.
408 B<Warning>: Removing a column that is also used in the sources primary
409 key, or in one of the sources unique constraints, B<will> result in a
410 broken result source.
416 =item Arguments: $colname
418 =item Return value: undefined
422 $source->remove_column('col');
424 Remove a single column by name from the result source, similar to
427 B<Warning>: Removing a column that is also used in the sources primary
428 key, or in one of the sources unique constraints, B<will> result in a
429 broken result source.
434 my ($self, @to_remove) = @_;
436 my $columns = $self->_columns
441 delete $columns->{$_};
445 $self->_ordered_columns([ grep { not $to_remove{$_} } @{$self->_ordered_columns} ]);
448 sub remove_column { shift->remove_columns(@_); } # DO NOT CHANGE THIS TO GLOB
450 =head2 set_primary_key
454 =item Arguments: @cols
456 =item Return value: undefined
460 Defines one or more columns as primary key for this source. Must be
461 called after L</add_columns>.
463 Additionally, defines a L<unique constraint|add_unique_constraint>
466 The primary key columns are used by L<DBIx::Class::PK::Auto> to
467 retrieve automatically created values from the database. They are also
468 used as default joining columns when specifying relationships, see
469 L<DBIx::Class::Relationship>.
473 sub set_primary_key {
474 my ($self, @cols) = @_;
475 # check if primary key columns are valid columns
476 foreach my $col (@cols) {
477 $self->throw_exception("No such column $col on table " . $self->name)
478 unless $self->has_column($col);
480 $self->_primaries(\@cols);
482 $self->add_unique_constraint(primary => \@cols);
485 =head2 primary_columns
489 =item Arguments: None
491 =item Return value: Ordered list of primary column names
495 Read-only accessor which returns the list of primary keys, supplied by
500 sub primary_columns {
501 return @{shift->_primaries||[]};
504 =head2 add_unique_constraint
508 =item Arguments: $name?, \@colnames
510 =item Return value: undefined
514 Declare a unique constraint on this source. Call once for each unique
517 # For UNIQUE (column1, column2)
518 __PACKAGE__->add_unique_constraint(
519 constraint_name => [ qw/column1 column2/ ],
522 Alternatively, you can specify only the columns:
524 __PACKAGE__->add_unique_constraint([ qw/column1 column2/ ]);
526 This will result in a unique constraint named
527 C<table_column1_column2>, where C<table> is replaced with the table
530 Unique constraints are used, for example, when you pass the constraint
531 name as the C<key> attribute to L<DBIx::Class::ResultSet/find>. Then
532 only columns in the constraint are searched.
534 Throws an error if any of the given column names do not yet exist on
539 sub add_unique_constraint {
544 $name ||= $self->name_unique_constraint($cols);
546 foreach my $col (@$cols) {
547 $self->throw_exception("No such column $col on table " . $self->name)
548 unless $self->has_column($col);
551 my %unique_constraints = $self->unique_constraints;
552 $unique_constraints{$name} = $cols;
553 $self->_unique_constraints(\%unique_constraints);
556 =head2 name_unique_constraint
560 =item Arguments: @colnames
562 =item Return value: Constraint name
566 $source->table('mytable');
567 $source->name_unique_constraint('col1', 'col2');
571 Return a name for a unique constraint containing the specified
572 columns. The name is created by joining the table name and each column
573 name, using an underscore character.
575 For example, a constraint on a table named C<cd> containing the columns
576 C<artist> and C<title> would result in a constraint name of C<cd_artist_title>.
578 This is used by L</add_unique_constraint> if you do not specify the
579 optional constraint name.
583 sub name_unique_constraint {
584 my ($self, $cols) = @_;
586 my $name = $self->name;
587 $name = $$name if (ref $name eq 'SCALAR');
589 return join '_', $name, @$cols;
592 =head2 unique_constraints
596 =item Arguments: None
598 =item Return value: Hash of unique constraint data
602 $source->unique_constraints();
604 Read-only accessor which returns a hash of unique constraints on this
607 The hash is keyed by constraint name, and contains an arrayref of
608 column names as values.
612 sub unique_constraints {
613 return %{shift->_unique_constraints||{}};
616 =head2 unique_constraint_names
620 =item Arguments: None
622 =item Return value: Unique constraint names
626 $source->unique_constraint_names();
628 Returns the list of unique constraint names defined on this source.
632 sub unique_constraint_names {
635 my %unique_constraints = $self->unique_constraints;
637 return keys %unique_constraints;
640 =head2 unique_constraint_columns
644 =item Arguments: $constraintname
646 =item Return value: List of constraint columns
650 $source->unique_constraint_columns('myconstraint');
652 Returns the list of columns that make up the specified unique constraint.
656 sub unique_constraint_columns {
657 my ($self, $constraint_name) = @_;
659 my %unique_constraints = $self->unique_constraints;
661 $self->throw_exception(
662 "Unknown unique constraint $constraint_name on '" . $self->name . "'"
663 ) unless exists $unique_constraints{$constraint_name};
665 return @{ $unique_constraints{$constraint_name} };
668 =head2 sqlt_deploy_callback
672 =item Arguments: $callback
676 __PACKAGE__->sqlt_deploy_callback('mycallbackmethod');
678 An accessor to set a callback to be called during deployment of
679 the schema via L<DBIx::Class::Schema/create_ddl_dir> or
680 L<DBIx::Class::Schema/deploy>.
682 The callback can be set as either a code reference or the name of a
683 method in the current result class.
685 If not set, the L</default_sqlt_deploy_hook> is called.
687 Your callback will be passed the $source object representing the
688 ResultSource instance being deployed, and the
689 L<SQL::Translator::Schema::Table> object being created from it. The
690 callback can be used to manipulate the table object or add your own
691 customised indexes. If you need to manipulate a non-table object, use
692 the L<DBIx::Class::Schema/sqlt_deploy_hook>.
694 See L<DBIx::Class::Manual::Cookbook/Adding Indexes And Functions To
695 Your SQL> for examples.
697 This sqlt deployment callback can only be used to manipulate
698 SQL::Translator objects as they get turned into SQL. To execute
699 post-deploy statements which SQL::Translator does not currently
700 handle, override L<DBIx::Class::Schema/deploy> in your Schema class
701 and call L<dbh_do|DBIx::Class::Storage::DBI/dbh_do>.
703 =head2 default_sqlt_deploy_hook
707 =item Arguments: $source, $sqlt_table
709 =item Return value: undefined
713 This is the sensible default for L</sqlt_deploy_callback>.
715 If a method named C<sqlt_deploy_hook> exists in your Result class, it
716 will be called and passed the current C<$source> and the
717 C<$sqlt_table> being deployed.
721 sub default_sqlt_deploy_hook {
724 my $class = $self->result_class;
726 if ($class and $class->can('sqlt_deploy_hook')) {
727 $class->sqlt_deploy_hook(@_);
731 sub _invoke_sqlt_deploy_hook {
733 if ( my $hook = $self->sqlt_deploy_callback) {
742 =item Arguments: None
744 =item Return value: $resultset
748 Returns a resultset for the given source. This will initially be created
751 $self->resultset_class->new($self, $self->resultset_attributes)
753 but is cached from then on unless resultset_class changes.
755 =head2 resultset_class
759 =item Arguments: $classname
761 =item Return value: $classname
765 package My::Schema::ResultSet::Artist;
766 use base 'DBIx::Class::ResultSet';
769 # In the result class
770 __PACKAGE__->resultset_class('My::Schema::ResultSet::Artist');
773 $source->resultset_class('My::Schema::ResultSet::Artist');
775 Set the class of the resultset. This is useful if you want to create your
776 own resultset methods. Create your own class derived from
777 L<DBIx::Class::ResultSet>, and set it here. If called with no arguments,
778 this method returns the name of the existing resultset class, if one
781 =head2 resultset_attributes
785 =item Arguments: \%attrs
787 =item Return value: \%attrs
791 # In the result class
792 __PACKAGE__->resultset_attributes({ order_by => [ 'id' ] });
795 $source->resultset_attributes({ order_by => [ 'id' ] });
797 Store a collection of resultset attributes, that will be set on every
798 L<DBIx::Class::ResultSet> produced from this result source. For a full
799 list see L<DBIx::Class::ResultSet/ATTRIBUTES>.
805 $self->throw_exception(
806 'resultset does not take any arguments. If you want another resultset, '.
807 'call it on the schema instead.'
810 return $self->resultset_class->new(
813 %{$self->{resultset_attributes}},
814 %{$self->schema->default_resultset_attributes}
823 =item Arguments: $source_name
825 =item Result value: $source_name
829 Set an alternate name for the result source when it is loaded into a schema.
830 This is useful if you want to refer to a result source by a name other than
833 package ArchivedBooks;
834 use base qw/DBIx::Class/;
835 __PACKAGE__->table('books_archive');
836 __PACKAGE__->source_name('Books');
838 # from your schema...
839 $schema->resultset('Books')->find(1);
845 =item Arguments: None
847 =item Return value: FROM clause
851 my $from_clause = $source->from();
853 Returns an expression of the source to be supplied to storage to specify
854 retrieval from this source. In the case of a database, the required FROM
861 =item Arguments: None
863 =item Return value: A schema object
867 my $schema = $source->schema();
869 Returns the L<DBIx::Class::Schema> object that this result source
876 =item Arguments: None
878 =item Return value: A Storage object
882 $source->storage->debug(1);
884 Returns the storage handle for the current schema.
886 See also: L<DBIx::Class::Storage>
890 sub storage { shift->schema->storage; }
892 =head2 add_relationship
896 =item Arguments: $relname, $related_source_name, \%cond, [ \%attrs ]
898 =item Return value: 1/true if it succeeded
902 $source->add_relationship('relname', 'related_source', $cond, $attrs);
904 L<DBIx::Class::Relationship> describes a series of methods which
905 create pre-defined useful types of relationships. Look there first
906 before using this method directly.
908 The relationship name can be arbitrary, but must be unique for each
909 relationship attached to this result source. 'related_source' should
910 be the name with which the related result source was registered with
911 the current schema. For example:
913 $schema->source('Book')->add_relationship('reviews', 'Review', {
914 'foreign.book_id' => 'self.id',
917 The condition C<$cond> needs to be an L<SQL::Abstract>-style
918 representation of the join between the tables. For example, if you're
919 creating a relation from Author to Book,
921 { 'foreign.author_id' => 'self.id' }
923 will result in the JOIN clause
925 author me JOIN book foreign ON foreign.author_id = me.id
927 You can specify as many foreign => self mappings as necessary.
929 Valid attributes are as follows:
935 Explicitly specifies the type of join to use in the relationship. Any
936 SQL join type is valid, e.g. C<LEFT> or C<RIGHT>. It will be placed in
937 the SQL command immediately before C<JOIN>.
941 An arrayref containing a list of accessors in the foreign class to proxy in
942 the main class. If, for example, you do the following:
944 CD->might_have(liner_notes => 'LinerNotes', undef, {
945 proxy => [ qw/notes/ ],
948 Then, assuming LinerNotes has an accessor named notes, you can do:
950 my $cd = CD->find(1);
951 # set notes -- LinerNotes object is created if it doesn't exist
952 $cd->notes('Notes go here');
956 Specifies the type of accessor that should be created for the
957 relationship. Valid values are C<single> (for when there is only a single
958 related object), C<multi> (when there can be many), and C<filter> (for
959 when there is a single related object, but you also want the relationship
960 accessor to double as a column accessor). For C<multi> accessors, an
961 add_to_* method is also created, which calls C<create_related> for the
966 Throws an exception if the condition is improperly supplied, or cannot
971 sub add_relationship {
972 my ($self, $rel, $f_source_name, $cond, $attrs) = @_;
973 $self->throw_exception("Can't create relationship without join condition")
977 # Check foreign and self are right in cond
978 if ( (ref $cond ||'') eq 'HASH') {
980 $self->throw_exception("Keys of condition should be of form 'foreign.col', not '$_'")
981 if /\./ && !/^foreign\./;
985 my %rels = %{ $self->_relationships };
986 $rels{$rel} = { class => $f_source_name,
987 source => $f_source_name,
990 $self->_relationships(\%rels);
994 # XXX disabled. doesn't work properly currently. skip in tests.
996 my $f_source = $self->schema->source($f_source_name);
998 $self->ensure_class_loaded($f_source_name);
999 $f_source = $f_source_name->result_source;
1000 #my $s_class = ref($self->schema);
1001 #$f_source_name =~ m/^${s_class}::(.*)$/;
1002 #$self->schema->register_class(($1 || $f_source_name), $f_source_name);
1003 #$f_source = $self->schema->source($f_source_name);
1005 return unless $f_source; # Can't test rel without f_source
1007 eval { $self->_resolve_join($rel, 'me', {}, []) };
1009 if ($@) { # If the resolve failed, back out and re-throw the error
1010 delete $rels{$rel}; #
1011 $self->_relationships(\%rels);
1012 $self->throw_exception("Error creating relationship $rel: $@");
1017 =head2 relationships
1021 =item Arguments: None
1023 =item Return value: List of relationship names
1027 my @relnames = $source->relationships();
1029 Returns all relationship names for this source.
1034 return keys %{shift->_relationships};
1037 =head2 relationship_info
1041 =item Arguments: $relname
1043 =item Return value: Hashref of relation data,
1047 Returns a hash of relationship information for the specified relationship
1048 name. The keys/values are as specified for L</add_relationship>.
1052 sub relationship_info {
1053 my ($self, $rel) = @_;
1054 return $self->_relationships->{$rel};
1057 =head2 has_relationship
1061 =item Arguments: $rel
1063 =item Return value: 1/0 (true/false)
1067 Returns true if the source has a relationship of this name, false otherwise.
1071 sub has_relationship {
1072 my ($self, $rel) = @_;
1073 return exists $self->_relationships->{$rel};
1076 =head2 reverse_relationship_info
1080 =item Arguments: $relname
1082 =item Return value: Hashref of relationship data
1086 Looks through all the relationships on the source this relationship
1087 points to, looking for one whose condition is the reverse of the
1088 condition on this relationship.
1090 A common use of this is to find the name of the C<belongs_to> relation
1091 opposing a C<has_many> relation. For definition of these look in
1092 L<DBIx::Class::Relationship>.
1094 The returned hashref is keyed by the name of the opposing
1095 relationship, and contains its data in the same manner as
1096 L</relationship_info>.
1100 sub reverse_relationship_info {
1101 my ($self, $rel) = @_;
1102 my $rel_info = $self->relationship_info($rel);
1105 return $ret unless ((ref $rel_info->{cond}) eq 'HASH');
1107 my @cond = keys(%{$rel_info->{cond}});
1108 my @refkeys = map {/^\w+\.(\w+)$/} @cond;
1109 my @keys = map {$rel_info->{cond}->{$_} =~ /^\w+\.(\w+)$/} @cond;
1111 # Get the related result source for this relationship
1112 my $othertable = $self->related_source($rel);
1114 # Get all the relationships for that source that related to this source
1115 # whose foreign column set are our self columns on $rel and whose self
1116 # columns are our foreign columns on $rel.
1117 my @otherrels = $othertable->relationships();
1118 my $otherrelationship;
1119 foreach my $otherrel (@otherrels) {
1120 my $otherrel_info = $othertable->relationship_info($otherrel);
1122 my $back = $othertable->related_source($otherrel);
1123 next unless $back->source_name eq $self->source_name;
1127 if (ref $otherrel_info->{cond} eq 'HASH') {
1128 @othertestconds = ($otherrel_info->{cond});
1130 elsif (ref $otherrel_info->{cond} eq 'ARRAY') {
1131 @othertestconds = @{$otherrel_info->{cond}};
1137 foreach my $othercond (@othertestconds) {
1138 my @other_cond = keys(%$othercond);
1139 my @other_refkeys = map {/^\w+\.(\w+)$/} @other_cond;
1140 my @other_keys = map {$othercond->{$_} =~ /^\w+\.(\w+)$/} @other_cond;
1141 next if (!$self->_compare_relationship_keys(\@refkeys, \@other_keys) ||
1142 !$self->_compare_relationship_keys(\@other_refkeys, \@keys));
1143 $ret->{$otherrel} = $otherrel_info;
1149 sub compare_relationship_keys {
1150 carp 'compare_relationship_keys is a private method, stop calling it';
1152 $self->_compare_relationship_keys (@_);
1155 # Returns true if both sets of keynames are the same, false otherwise.
1156 sub _compare_relationship_keys {
1157 my ($self, $keys1, $keys2) = @_;
1159 # Make sure every keys1 is in keys2
1161 foreach my $key (@$keys1) {
1163 foreach my $prim (@$keys2) {
1164 if ($prim eq $key) {
1172 # Make sure every key2 is in key1
1174 foreach my $prim (@$keys2) {
1176 foreach my $key (@$keys1) {
1177 if ($prim eq $key) {
1190 carp 'resolve_join is a private method, stop calling it';
1192 $self->_resolve_join (@_);
1195 # Returns the {from} structure used to express JOIN conditions
1197 my ($self, $join, $alias, $seen, $jpath, $force_left) = @_;
1199 # we need a supplied one, because we do in-place modifications, no returns
1200 $self->throw_exception ('You must supply a seen hashref as the 3rd argument to _resolve_join')
1201 unless ref $seen eq 'HASH';
1203 $self->throw_exception ('You must supply a joinpath arrayref as the 4th argument to _resolve_join')
1204 unless ref $jpath eq 'ARRAY';
1208 if (ref $join eq 'ARRAY') {
1211 $self->_resolve_join($_, $alias, $seen, $jpath, $force_left);
1213 } elsif (ref $join eq 'HASH') {
1216 my $as = ($seen->{$_} ? join ('_', $_, $seen->{$_} + 1) : $_); # the actual seen value will be incremented below
1217 local $force_left->{force} = $force_left->{force};
1219 $self->_resolve_join($_, $alias, $seen, [@$jpath], $force_left),
1220 $self->related_source($_)->_resolve_join(
1221 $join->{$_}, $as, $seen, [@$jpath, $_], $force_left
1225 } elsif (ref $join) {
1226 $self->throw_exception("No idea how to resolve join reftype ".ref $join);
1229 return() unless defined $join;
1231 my $count = ++$seen->{$join};
1232 my $as = ($count > 1 ? "${join}_${count}" : $join);
1234 my $rel_info = $self->relationship_info($join);
1235 $self->throw_exception("No such relationship ${join}") unless $rel_info;
1241 $type = $rel_info->{attrs}{join_type};
1242 $force_left = 1 if lc($type||'') eq 'left';
1245 my $rel_src = $self->related_source($join);
1246 return [ { $as => $rel_src->from,
1247 -source_handle => $rel_src->handle,
1248 -join_type => $type,
1249 -join_path => [@$jpath, $join],
1251 -relation_chain_depth => $seen->{-relation_chain_depth} || 0,
1253 $self->_resolve_condition($rel_info->{cond}, $as, $alias) ];
1258 carp 'pk_depends_on is a private method, stop calling it';
1260 $self->_pk_depends_on (@_);
1263 # Determines whether a relation is dependent on an object from this source
1264 # having already been inserted. Takes the name of the relationship and a
1265 # hashref of columns of the related object.
1266 sub _pk_depends_on {
1267 my ($self, $relname, $rel_data) = @_;
1269 my $relinfo = $self->relationship_info($relname);
1271 # don't assume things if the relationship direction is specified
1272 return $relinfo->{attrs}{is_foreign_key_constraint}
1273 if exists ($relinfo->{attrs}{is_foreign_key_constraint});
1275 my $cond = $relinfo->{cond};
1276 return 0 unless ref($cond) eq 'HASH';
1278 # map { foreign.foo => 'self.bar' } to { bar => 'foo' }
1279 my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond };
1281 # assume anything that references our PK probably is dependent on us
1282 # rather than vice versa, unless the far side is (a) defined or (b)
1284 my $rel_source = $self->related_source($relname);
1286 foreach my $p ($self->primary_columns) {
1287 if (exists $keyhash->{$p}) {
1288 unless (defined($rel_data->{$keyhash->{$p}})
1289 || $rel_source->column_info($keyhash->{$p})
1290 ->{is_auto_increment}) {
1299 sub resolve_condition {
1300 carp 'resolve_condition is a private method, stop calling it';
1302 $self->_resolve_condition (@_);
1305 # Resolves the passed condition to a concrete query fragment. If given an alias,
1306 # returns a join condition; if given an object, inverts that object to produce
1307 # a related conditional from that object.
1308 our $UNRESOLVABLE_CONDITION = \'1 = 0';
1310 sub _resolve_condition {
1311 my ($self, $cond, $as, $for) = @_;
1312 if (ref $cond eq 'HASH') {
1314 foreach my $k (keys %{$cond}) {
1315 my $v = $cond->{$k};
1316 # XXX should probably check these are valid columns
1317 $k =~ s/^foreign\.// ||
1318 $self->throw_exception("Invalid rel cond key ${k}");
1319 $v =~ s/^self\.// ||
1320 $self->throw_exception("Invalid rel cond val ${v}");
1321 if (ref $for) { # Object
1322 #warn "$self $k $for $v";
1323 unless ($for->has_column_loaded($v)) {
1324 if ($for->in_storage) {
1325 $self->throw_exception(sprintf
1326 'Unable to resolve relationship from %s to %s: column %s.%s not '
1327 . 'loaded from storage (or not passed to new() prior to insert()). '
1328 . 'Maybe you forgot to call ->discard_changes to get defaults from the db.',
1330 $for->result_source->source_name,
1335 return $UNRESOLVABLE_CONDITION;
1337 $ret{$k} = $for->get_column($v);
1338 #$ret{$k} = $for->get_column($v) if $for->has_column_loaded($v);
1340 } elsif (!defined $for) { # undef, i.e. "no object"
1342 } elsif (ref $as eq 'HASH') { # reverse hashref
1343 $ret{$v} = $as->{$k};
1344 } elsif (ref $as) { # reverse object
1345 $ret{$v} = $as->get_column($k);
1346 } elsif (!defined $as) { # undef, i.e. "no reverse object"
1349 $ret{"${as}.${k}"} = "${for}.${v}";
1353 } elsif (ref $cond eq 'ARRAY') {
1354 return [ map { $self->_resolve_condition($_, $as, $for) } @$cond ];
1356 die("Can't handle condition $cond yet :(");
1360 # Legacy code, needs to go entirely away (fully replaced by _resolve_prefetch)
1361 sub resolve_prefetch {
1362 carp 'resolve_prefetch is a private method, stop calling it';
1364 my ($self, $pre, $alias, $seen, $order, $collapse) = @_;
1366 if( ref $pre eq 'ARRAY' ) {
1368 map { $self->resolve_prefetch( $_, $alias, $seen, $order, $collapse ) }
1371 elsif( ref $pre eq 'HASH' ) {
1374 $self->resolve_prefetch($_, $alias, $seen, $order, $collapse),
1375 $self->related_source($_)->resolve_prefetch(
1376 $pre->{$_}, "${alias}.$_", $seen, $order, $collapse)
1381 $self->throw_exception(
1382 "don't know how to resolve prefetch reftype ".ref($pre));
1385 my $count = ++$seen->{$pre};
1386 my $as = ($count > 1 ? "${pre}_${count}" : $pre);
1387 my $rel_info = $self->relationship_info( $pre );
1388 $self->throw_exception( $self->name . " has no such relationship '$pre'" )
1390 my $as_prefix = ($alias =~ /^.*?\.(.+)$/ ? $1.'.' : '');
1391 my $rel_source = $self->related_source($pre);
1393 if (exists $rel_info->{attrs}{accessor}
1394 && $rel_info->{attrs}{accessor} eq 'multi') {
1395 $self->throw_exception(
1396 "Can't prefetch has_many ${pre} (join cond too complex)")
1397 unless ref($rel_info->{cond}) eq 'HASH';
1398 my $dots = @{[$as_prefix =~ m/\./g]} + 1; # +1 to match the ".${as_prefix}"
1399 if (my ($fail) = grep { @{[$_ =~ m/\./g]} == $dots }
1400 keys %{$collapse}) {
1401 my ($last) = ($fail =~ /([^\.]+)$/);
1403 "Prefetching multiple has_many rels ${last} and ${pre} "
1404 .(length($as_prefix)
1405 ? "at the same level (${as_prefix}) "
1408 . 'will explode the number of row objects retrievable via ->next or ->all. '
1409 . 'Use at your own risk.'
1412 #my @col = map { (/^self\.(.+)$/ ? ("${as_prefix}.$1") : ()); }
1413 # values %{$rel_info->{cond}};
1414 $collapse->{".${as_prefix}${pre}"} = [ $rel_source->primary_columns ];
1415 # action at a distance. prepending the '.' allows simpler code
1416 # in ResultSet->_collapse_result
1417 my @key = map { (/^foreign\.(.+)$/ ? ($1) : ()); }
1418 keys %{$rel_info->{cond}};
1419 my @ord = (ref($rel_info->{attrs}{order_by}) eq 'ARRAY'
1420 ? @{$rel_info->{attrs}{order_by}}
1421 : (defined $rel_info->{attrs}{order_by}
1422 ? ($rel_info->{attrs}{order_by})
1424 push(@$order, map { "${as}.$_" } (@key, @ord));
1427 return map { [ "${as}.$_", "${as_prefix}${pre}.$_", ] }
1428 $rel_source->columns;
1432 # Accepts one or more relationships for the current source and returns an
1433 # array of column names for each of those relationships. Column names are
1434 # prefixed relative to the current source, in accordance with where they appear
1435 # in the supplied relationships. Needs an alias_map generated by
1436 # $rs->_joinpath_aliases
1438 sub _resolve_prefetch {
1439 my ($self, $pre, $alias, $alias_map, $order, $collapse, $pref_path) = @_;
1442 if( ref $pre eq 'ARRAY' ) {
1444 map { $self->_resolve_prefetch( $_, $alias, $alias_map, $order, $collapse, [ @$pref_path ] ) }
1447 elsif( ref $pre eq 'HASH' ) {
1450 $self->_resolve_prefetch($_, $alias, $alias_map, $order, $collapse, [ @$pref_path ] ),
1451 $self->related_source($_)->_resolve_prefetch(
1452 $pre->{$_}, "${alias}.$_", $alias_map, $order, $collapse, [ @$pref_path, $_] )
1457 $self->throw_exception(
1458 "don't know how to resolve prefetch reftype ".ref($pre));
1462 $p = $p->{$_} for (@$pref_path, $pre);
1464 $self->throw_exception (
1465 "Unable to resolve prefetch '$pre' - join alias map does not contain an entry for path: "
1466 . join (' -> ', @$pref_path, $pre)
1467 ) if (ref $p->{-join_aliases} ne 'ARRAY' or not @{$p->{-join_aliases}} );
1469 my $as = shift @{$p->{-join_aliases}};
1471 my $rel_info = $self->relationship_info( $pre );
1472 $self->throw_exception( $self->name . " has no such relationship '$pre'" )
1474 my $as_prefix = ($alias =~ /^.*?\.(.+)$/ ? $1.'.' : '');
1475 my $rel_source = $self->related_source($pre);
1477 if (exists $rel_info->{attrs}{accessor}
1478 && $rel_info->{attrs}{accessor} eq 'multi') {
1479 $self->throw_exception(
1480 "Can't prefetch has_many ${pre} (join cond too complex)")
1481 unless ref($rel_info->{cond}) eq 'HASH';
1482 my $dots = @{[$as_prefix =~ m/\./g]} + 1; # +1 to match the ".${as_prefix}"
1483 if (my ($fail) = grep { @{[$_ =~ m/\./g]} == $dots }
1484 keys %{$collapse}) {
1485 my ($last) = ($fail =~ /([^\.]+)$/);
1487 "Prefetching multiple has_many rels ${last} and ${pre} "
1488 .(length($as_prefix)
1489 ? "at the same level (${as_prefix}) "
1492 . 'will explode the number of row objects retrievable via ->next or ->all. '
1493 . 'Use at your own risk.'
1496 #my @col = map { (/^self\.(.+)$/ ? ("${as_prefix}.$1") : ()); }
1497 # values %{$rel_info->{cond}};
1498 $collapse->{".${as_prefix}${pre}"} = [ $rel_source->primary_columns ];
1499 # action at a distance. prepending the '.' allows simpler code
1500 # in ResultSet->_collapse_result
1501 my @key = map { (/^foreign\.(.+)$/ ? ($1) : ()); }
1502 keys %{$rel_info->{cond}};
1503 my @ord = (ref($rel_info->{attrs}{order_by}) eq 'ARRAY'
1504 ? @{$rel_info->{attrs}{order_by}}
1505 : (defined $rel_info->{attrs}{order_by}
1506 ? ($rel_info->{attrs}{order_by})
1508 push(@$order, map { "${as}.$_" } (@key, @ord));
1511 return map { [ "${as}.$_", "${as_prefix}${pre}.$_", ] }
1512 $rel_source->columns;
1516 =head2 related_source
1520 =item Arguments: $relname
1522 =item Return value: $source
1526 Returns the result source object for the given relationship.
1530 sub related_source {
1531 my ($self, $rel) = @_;
1532 if( !$self->has_relationship( $rel ) ) {
1533 $self->throw_exception("No such relationship '$rel'");
1535 return $self->schema->source($self->relationship_info($rel)->{source});
1538 =head2 related_class
1542 =item Arguments: $relname
1544 =item Return value: $classname
1548 Returns the class name for objects in the given relationship.
1553 my ($self, $rel) = @_;
1554 if( !$self->has_relationship( $rel ) ) {
1555 $self->throw_exception("No such relationship '$rel'");
1557 return $self->schema->class($self->relationship_info($rel)->{source});
1562 Obtain a new handle to this source. Returns an instance of a
1563 L<DBIx::Class::ResultSourceHandle>.
1568 return new DBIx::Class::ResultSourceHandle({
1569 schema => $_[0]->schema,
1570 source_moniker => $_[0]->source_name
1574 =head2 throw_exception
1576 See L<DBIx::Class::Schema/"throw_exception">.
1580 sub throw_exception {
1582 if (defined $self->schema) {
1583 $self->schema->throw_exception(@_);
1591 Stores a hashref of per-source metadata. No specific key names
1592 have yet been standardized, the examples below are purely hypothetical
1593 and don't actually accomplish anything on their own:
1595 __PACKAGE__->source_info({
1596 "_tablespace" => 'fast_disk_array_3',
1597 "_engine" => 'InnoDB',
1604 $class->new({attribute_name => value});
1606 Creates a new ResultSource object. Not normally called directly by end users.
1608 =head2 column_info_from_storage
1612 =item Arguments: 1/0 (default: 0)
1614 =item Return value: 1/0
1618 __PACKAGE__->column_info_from_storage(1);
1620 Enables the on-demand automatic loading of the above column
1621 metadata from storage as neccesary. This is *deprecated*, and
1622 should not be used. It will be removed before 1.0.
1627 Matt S. Trout <mst@shadowcatsystems.co.uk>
1631 You may distribute this code under the same terms as Perl itself.