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/;
13 use base qw/DBIx::Class/;
15 __PACKAGE__->mk_group_accessors('simple' => qw/_ordered_columns
16 _columns _primaries _unique_constraints name resultset_attributes
17 schema from _relationships column_info_from_storage source_info
18 source_name sqlt_deploy_callback/);
20 __PACKAGE__->mk_group_accessors('component_class' => qw/resultset_class
25 DBIx::Class::ResultSource - Result source object
29 # Create a table based result source, in a result class.
31 package MyDB::Schema::Result::Artist;
32 use base qw/DBIx::Class::Core/;
34 __PACKAGE__->table('artist');
35 __PACKAGE__->add_columns(qw/ artistid name /);
36 __PACKAGE__->set_primary_key('artistid');
37 __PACKAGE__->has_many(cds => 'MyDB::Schema::Result::CD');
41 # Create a query (view) based result source, in a result class
42 package MyDB::Schema::Result::Year2000CDs;
43 use base qw/DBIx::Class::Core/;
45 __PACKAGE__->load_components('InflateColumn::DateTime');
46 __PACKAGE__->table_class('DBIx::Class::ResultSource::View');
48 __PACKAGE__->table('year2000cds');
49 __PACKAGE__->result_source_instance->is_virtual(1);
50 __PACKAGE__->result_source_instance->view_definition(
51 "SELECT cdid, artist, title FROM cd WHERE year ='2000'"
57 A ResultSource is an object that represents a source of data for querying.
59 This class is a base class for various specialised types of result
60 sources, for example L<DBIx::Class::ResultSource::Table>. Table is the
61 default result source type, so one is created for you when defining a
62 result class as described in the synopsis above.
64 More specifically, the L<DBIx::Class::Core> base class pulls in the
65 L<DBIx::Class::ResultSourceProxy::Table> component, which defines
66 the L<table|DBIx::Class::ResultSourceProxy::Table/table> method.
67 When called, C<table> creates and stores an instance of
68 L<DBIx::Class::ResultSoure::Table>. Luckily, to use tables as result
69 sources, you don't need to remember any of this.
71 Result sources representing select queries, or views, can also be
72 created, see L<DBIx::Class::ResultSource::View> for full details.
74 =head2 Finding result source objects
76 As mentioned above, a result source instance is created and stored for
77 you when you define a L<Result Class|DBIx::Class::Manual::Glossary/Result Class>.
79 You can retrieve the result source at runtime in the following ways:
83 =item From a Schema object:
85 $schema->source($source_name);
87 =item From a Row object:
91 =item From a ResultSet object:
104 my ($class, $attrs) = @_;
105 $class = ref $class if ref $class;
107 my $new = bless { %{$attrs || {}} }, $class;
108 $new->{resultset_class} ||= 'DBIx::Class::ResultSet';
109 $new->{resultset_attributes} = { %{$new->{resultset_attributes} || {}} };
110 $new->{_ordered_columns} = [ @{$new->{_ordered_columns}||[]}];
111 $new->{_columns} = { %{$new->{_columns}||{}} };
112 $new->{_relationships} = { %{$new->{_relationships}||{}} };
113 $new->{name} ||= "!!NAME NOT SET!!";
114 $new->{_columns_info_loaded} ||= 0;
115 $new->{sqlt_deploy_callback} ||= "default_sqlt_deploy_hook";
125 =item Arguments: @columns
127 =item Return value: The ResultSource object
131 $source->add_columns(qw/col1 col2 col3/);
133 $source->add_columns('col1' => \%col1_info, 'col2' => \%col2_info, ...);
135 Adds columns to the result source. If supplied colname => hashref
136 pairs, uses the hashref as the L</column_info> for that column. Repeated
137 calls of this method will add more columns, not replace them.
139 The column names given will be created as accessor methods on your
140 L<DBIx::Class::Row> objects. You can change the name of the accessor
141 by supplying an L</accessor> in the column_info hash.
143 If a column name beginning with a plus sign ('+col1') is provided, the
144 attributes provided will be merged with any existing attributes for the
145 column, with the new attributes taking precedence in the case that an
146 attribute already exists. Using this without a hashref
147 (C<< $source->add_columns(qw/+col1 +col2/) >>) is legal, but useless --
148 it does the same thing it would do without the plus.
150 The contents of the column_info are not set in stone. The following
151 keys are currently recognised/used by DBIx::Class:
157 { accessor => '_name' }
159 # example use, replace standard accessor with one of your own:
161 my ($self, $value) = @_;
163 die "Name cannot contain digits!" if($value =~ /\d/);
164 $self->_name($value);
166 return $self->_name();
169 Use this to set the name of the accessor method for this column. If unset,
170 the name of the column will be used.
174 { data_type => 'integer' }
176 This contains the column type. It is automatically filled if you use the
177 L<SQL::Translator::Producer::DBIx::Class::File> producer, or the
178 L<DBIx::Class::Schema::Loader> module.
180 Currently there is no standard set of values for the data_type. Use
181 whatever your database supports.
187 The length of your column, if it is a column type that can have a size
188 restriction. This is currently only used to create tables from your
189 schema, see L<DBIx::Class::Schema/deploy>.
195 Set this to a true value for a columns that is allowed to contain NULL
196 values, default is false. This is currently only used to create tables
197 from your schema, see L<DBIx::Class::Schema/deploy>.
199 =item is_auto_increment
201 { is_auto_increment => 1 }
203 Set this to a true value for a column whose value is somehow
204 automatically set, defaults to false. This is used to determine which
205 columns to empty when cloning objects using
206 L<DBIx::Class::Row/copy>. It is also used by
207 L<DBIx::Class::Schema/deploy>.
213 Set this to a true or false value (not C<undef>) to explicitly specify
214 if this column contains numeric data. This controls how set_column
215 decides whether to consider a column dirty after an update: if
216 C<is_numeric> is true a numeric comparison C<< != >> will take place
217 instead of the usual C<eq>
219 If not specified the storage class will attempt to figure this out on
220 first access to the column, based on the column C<data_type>. The
221 result will be cached in this attribute.
225 { is_foreign_key => 1 }
227 Set this to a true value for a column that contains a key from a
228 foreign table, defaults to false. This is currently only used to
229 create tables from your schema, see L<DBIx::Class::Schema/deploy>.
233 { default_value => \'now()' }
235 Set this to the default value which will be inserted into a column by
236 the database. Can contain either a value or a function (use a
237 reference to a scalar e.g. C<\'now()'> if you want a function). This
238 is currently only used to create tables from your schema, see
239 L<DBIx::Class::Schema/deploy>.
241 See the note on L<DBIx::Class::Row/new> for more information about possible
242 issues related to db-side default values.
246 { sequence => 'my_table_seq' }
248 Set this on a primary key column to the name of the sequence used to
249 generate a new key value. If not specified, L<DBIx::Class::PK::Auto>
250 will attempt to retrieve the name of the sequence from the database
255 Set this to a true value for a column whose value is retrieved automatically
256 from a sequence or function (if supported by your Storage driver.) For a
257 sequence, if you do not use a trigger to get the nextval, you have to set the
258 L</sequence> value as well.
260 Also set this for MSSQL columns with the 'uniqueidentifier'
261 L<data_type|DBIx::Class::ResultSource/data_type> whose values you want to
262 automatically generate using C<NEWID()>, unless they are a primary key in which
263 case this will be done anyway.
267 This is used by L<DBIx::Class::Schema/deploy> and L<SQL::Translator>
268 to add extra non-generic data to the column. For example: C<< extra
269 => { unsigned => 1} >> is used by the MySQL producer to set an integer
270 column to unsigned. For more details, see
271 L<SQL::Translator::Producer::MySQL>.
279 =item Arguments: $colname, \%columninfo?
281 =item Return value: 1/0 (true/false)
285 $source->add_column('col' => \%info);
287 Add a single column and optional column info. Uses the same column
288 info keys as L</add_columns>.
293 my ($self, @cols) = @_;
294 $self->_ordered_columns(\@cols) unless $self->_ordered_columns;
297 my $columns = $self->_columns;
298 while (my $col = shift @cols) {
299 my $column_info = {};
300 if ($col =~ s/^\+//) {
301 $column_info = $self->column_info($col);
304 # If next entry is { ... } use that for the column info, if not
305 # use an empty hashref
307 my $new_info = shift(@cols);
308 %$column_info = (%$column_info, %$new_info);
310 push(@added, $col) unless exists $columns->{$col};
311 $columns->{$col} = $column_info;
313 push @{ $self->_ordered_columns }, @added;
317 sub add_column { shift->add_columns(@_); } # DO NOT CHANGE THIS TO GLOB
323 =item Arguments: $colname
325 =item Return value: 1/0 (true/false)
329 if ($source->has_column($colname)) { ... }
331 Returns true if the source has a column of this name, false otherwise.
336 my ($self, $column) = @_;
337 return exists $self->_columns->{$column};
344 =item Arguments: $colname
346 =item Return value: Hashref of info
350 my $info = $source->column_info($col);
352 Returns the column metadata hashref for a column, as originally passed
353 to L</add_columns>. See L</add_columns> above for information on the
354 contents of the hashref.
359 my ($self, $column) = @_;
360 $self->throw_exception("No such column $column")
361 unless exists $self->_columns->{$column};
362 #warn $self->{_columns_info_loaded}, "\n";
363 if ( ! $self->_columns->{$column}{data_type}
364 and $self->column_info_from_storage
365 and ! $self->{_columns_info_loaded}
366 and $self->schema and $self->storage )
368 $self->{_columns_info_loaded}++;
372 # try for the case of storage without table
374 $info = $self->storage->columns_info_for( $self->from );
375 for my $realcol ( keys %{$info} ) {
376 $lc_info->{lc $realcol} = $info->{$realcol};
378 foreach my $col ( keys %{$self->_columns} ) {
379 $self->_columns->{$col} = {
380 %{ $self->_columns->{$col} },
381 %{ $info->{$col} || $lc_info->{lc $col} || {} }
386 return $self->_columns->{$column};
393 =item Arguments: None
395 =item Return value: Ordered list of column names
399 my @column_names = $source->columns;
401 Returns all column names in the order they were declared to L</add_columns>.
407 $self->throw_exception(
408 "columns() is a read-only accessor, did you mean add_columns()?"
410 return @{$self->{_ordered_columns}||[]};
413 =head2 remove_columns
417 =item Arguments: @colnames
419 =item Return value: undefined
423 $source->remove_columns(qw/col1 col2 col3/);
425 Removes the given list of columns by name, from the result source.
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.
435 =item Arguments: $colname
437 =item Return value: undefined
441 $source->remove_column('col');
443 Remove a single column by name from the result source, similar to
446 B<Warning>: Removing a column that is also used in the sources primary
447 key, or in one of the sources unique constraints, B<will> result in a
448 broken result source.
453 my ($self, @to_remove) = @_;
455 my $columns = $self->_columns
460 delete $columns->{$_};
464 $self->_ordered_columns([ grep { not $to_remove{$_} } @{$self->_ordered_columns} ]);
467 sub remove_column { shift->remove_columns(@_); } # DO NOT CHANGE THIS TO GLOB
469 =head2 set_primary_key
473 =item Arguments: @cols
475 =item Return value: undefined
479 Defines one or more columns as primary key for this source. Must be
480 called after L</add_columns>.
482 Additionally, defines a L<unique constraint|add_unique_constraint>
485 Note: you normally do want to define a primary key on your sources
486 B<even if the underlying database table does not have a primary key>.
488 L<DBIx::Class::Intro/The Significance and Importance of Primary Keys>
493 sub set_primary_key {
494 my ($self, @cols) = @_;
495 # check if primary key columns are valid columns
496 foreach my $col (@cols) {
497 $self->throw_exception("No such column $col on table " . $self->name)
498 unless $self->has_column($col);
500 $self->_primaries(\@cols);
502 $self->add_unique_constraint(primary => \@cols);
505 =head2 primary_columns
509 =item Arguments: None
511 =item Return value: Ordered list of primary column names
515 Read-only accessor which returns the list of primary keys, supplied by
520 sub primary_columns {
521 return @{shift->_primaries||[]};
524 # a helper method that will automatically die with a descriptive message if
525 # no pk is defined on the source in question. For internal use to save
526 # on if @pks... boilerplate
529 my @pcols = $self->primary_columns
530 or $self->throw_exception (sprintf(
531 "Operation requires a primary key to be declared on '%s' via set_primary_key",
537 =head2 add_unique_constraint
541 =item Arguments: $name?, \@colnames
543 =item Return value: undefined
547 Declare a unique constraint on this source. Call once for each unique
550 # For UNIQUE (column1, column2)
551 __PACKAGE__->add_unique_constraint(
552 constraint_name => [ qw/column1 column2/ ],
555 Alternatively, you can specify only the columns:
557 __PACKAGE__->add_unique_constraint([ qw/column1 column2/ ]);
559 This will result in a unique constraint named
560 C<table_column1_column2>, where C<table> is replaced with the table
563 Unique constraints are used, for example, when you pass the constraint
564 name as the C<key> attribute to L<DBIx::Class::ResultSet/find>. Then
565 only columns in the constraint are searched.
567 Throws an error if any of the given column names do not yet exist on
572 sub add_unique_constraint {
577 $name ||= $self->name_unique_constraint($cols);
579 foreach my $col (@$cols) {
580 $self->throw_exception("No such column $col on table " . $self->name)
581 unless $self->has_column($col);
584 my %unique_constraints = $self->unique_constraints;
585 $unique_constraints{$name} = $cols;
586 $self->_unique_constraints(\%unique_constraints);
589 =head2 name_unique_constraint
593 =item Arguments: @colnames
595 =item Return value: Constraint name
599 $source->table('mytable');
600 $source->name_unique_constraint('col1', 'col2');
604 Return a name for a unique constraint containing the specified
605 columns. The name is created by joining the table name and each column
606 name, using an underscore character.
608 For example, a constraint on a table named C<cd> containing the columns
609 C<artist> and C<title> would result in a constraint name of C<cd_artist_title>.
611 This is used by L</add_unique_constraint> if you do not specify the
612 optional constraint name.
616 sub name_unique_constraint {
617 my ($self, $cols) = @_;
619 my $name = $self->name;
620 $name = $$name if (ref $name eq 'SCALAR');
622 return join '_', $name, @$cols;
625 =head2 unique_constraints
629 =item Arguments: None
631 =item Return value: Hash of unique constraint data
635 $source->unique_constraints();
637 Read-only accessor which returns a hash of unique constraints on this
640 The hash is keyed by constraint name, and contains an arrayref of
641 column names as values.
645 sub unique_constraints {
646 return %{shift->_unique_constraints||{}};
649 =head2 unique_constraint_names
653 =item Arguments: None
655 =item Return value: Unique constraint names
659 $source->unique_constraint_names();
661 Returns the list of unique constraint names defined on this source.
665 sub unique_constraint_names {
668 my %unique_constraints = $self->unique_constraints;
670 return keys %unique_constraints;
673 =head2 unique_constraint_columns
677 =item Arguments: $constraintname
679 =item Return value: List of constraint columns
683 $source->unique_constraint_columns('myconstraint');
685 Returns the list of columns that make up the specified unique constraint.
689 sub unique_constraint_columns {
690 my ($self, $constraint_name) = @_;
692 my %unique_constraints = $self->unique_constraints;
694 $self->throw_exception(
695 "Unknown unique constraint $constraint_name on '" . $self->name . "'"
696 ) unless exists $unique_constraints{$constraint_name};
698 return @{ $unique_constraints{$constraint_name} };
701 =head2 sqlt_deploy_callback
705 =item Arguments: $callback
709 __PACKAGE__->sqlt_deploy_callback('mycallbackmethod');
711 An accessor to set a callback to be called during deployment of
712 the schema via L<DBIx::Class::Schema/create_ddl_dir> or
713 L<DBIx::Class::Schema/deploy>.
715 The callback can be set as either a code reference or the name of a
716 method in the current result class.
718 If not set, the L</default_sqlt_deploy_hook> is called.
720 Your callback will be passed the $source object representing the
721 ResultSource instance being deployed, and the
722 L<SQL::Translator::Schema::Table> object being created from it. The
723 callback can be used to manipulate the table object or add your own
724 customised indexes. If you need to manipulate a non-table object, use
725 the L<DBIx::Class::Schema/sqlt_deploy_hook>.
727 See L<DBIx::Class::Manual::Cookbook/Adding Indexes And Functions To
728 Your SQL> for examples.
730 This sqlt deployment callback can only be used to manipulate
731 SQL::Translator objects as they get turned into SQL. To execute
732 post-deploy statements which SQL::Translator does not currently
733 handle, override L<DBIx::Class::Schema/deploy> in your Schema class
734 and call L<dbh_do|DBIx::Class::Storage::DBI/dbh_do>.
736 =head2 default_sqlt_deploy_hook
740 =item Arguments: $source, $sqlt_table
742 =item Return value: undefined
746 This is the sensible default for L</sqlt_deploy_callback>.
748 If a method named C<sqlt_deploy_hook> exists in your Result class, it
749 will be called and passed the current C<$source> and the
750 C<$sqlt_table> being deployed.
754 sub default_sqlt_deploy_hook {
757 my $class = $self->result_class;
759 if ($class and $class->can('sqlt_deploy_hook')) {
760 $class->sqlt_deploy_hook(@_);
764 sub _invoke_sqlt_deploy_hook {
766 if ( my $hook = $self->sqlt_deploy_callback) {
775 =item Arguments: None
777 =item Return value: $resultset
781 Returns a resultset for the given source. This will initially be created
784 $self->resultset_class->new($self, $self->resultset_attributes)
786 but is cached from then on unless resultset_class changes.
788 =head2 resultset_class
792 =item Arguments: $classname
794 =item Return value: $classname
798 package My::Schema::ResultSet::Artist;
799 use base 'DBIx::Class::ResultSet';
802 # In the result class
803 __PACKAGE__->resultset_class('My::Schema::ResultSet::Artist');
806 $source->resultset_class('My::Schema::ResultSet::Artist');
808 Set the class of the resultset. This is useful if you want to create your
809 own resultset methods. Create your own class derived from
810 L<DBIx::Class::ResultSet>, and set it here. If called with no arguments,
811 this method returns the name of the existing resultset class, if one
814 =head2 resultset_attributes
818 =item Arguments: \%attrs
820 =item Return value: \%attrs
824 # In the result class
825 __PACKAGE__->resultset_attributes({ order_by => [ 'id' ] });
828 $source->resultset_attributes({ order_by => [ 'id' ] });
830 Store a collection of resultset attributes, that will be set on every
831 L<DBIx::Class::ResultSet> produced from this result source. For a full
832 list see L<DBIx::Class::ResultSet/ATTRIBUTES>.
838 $self->throw_exception(
839 'resultset does not take any arguments. If you want another resultset, '.
840 'call it on the schema instead.'
843 return $self->resultset_class->new(
846 %{$self->{resultset_attributes}},
847 %{$self->schema->default_resultset_attributes}
856 =item Arguments: $source_name
858 =item Result value: $source_name
862 Set an alternate name for the result source when it is loaded into a schema.
863 This is useful if you want to refer to a result source by a name other than
866 package ArchivedBooks;
867 use base qw/DBIx::Class/;
868 __PACKAGE__->table('books_archive');
869 __PACKAGE__->source_name('Books');
871 # from your schema...
872 $schema->resultset('Books')->find(1);
878 =item Arguments: None
880 =item Return value: FROM clause
884 my $from_clause = $source->from();
886 Returns an expression of the source to be supplied to storage to specify
887 retrieval from this source. In the case of a database, the required FROM
894 =item Arguments: None
896 =item Return value: A schema object
900 my $schema = $source->schema();
902 Returns the L<DBIx::Class::Schema> object that this result source
909 =item Arguments: None
911 =item Return value: A Storage object
915 $source->storage->debug(1);
917 Returns the storage handle for the current schema.
919 See also: L<DBIx::Class::Storage>
923 sub storage { shift->schema->storage; }
925 =head2 add_relationship
929 =item Arguments: $relname, $related_source_name, \%cond, [ \%attrs ]
931 =item Return value: 1/true if it succeeded
935 $source->add_relationship('relname', 'related_source', $cond, $attrs);
937 L<DBIx::Class::Relationship> describes a series of methods which
938 create pre-defined useful types of relationships. Look there first
939 before using this method directly.
941 The relationship name can be arbitrary, but must be unique for each
942 relationship attached to this result source. 'related_source' should
943 be the name with which the related result source was registered with
944 the current schema. For example:
946 $schema->source('Book')->add_relationship('reviews', 'Review', {
947 'foreign.book_id' => 'self.id',
950 The condition C<$cond> needs to be an L<SQL::Abstract>-style
951 representation of the join between the tables. For example, if you're
952 creating a relation from Author to Book,
954 { 'foreign.author_id' => 'self.id' }
956 will result in the JOIN clause
958 author me JOIN book foreign ON foreign.author_id = me.id
960 You can specify as many foreign => self mappings as necessary.
962 Valid attributes are as follows:
968 Explicitly specifies the type of join to use in the relationship. Any
969 SQL join type is valid, e.g. C<LEFT> or C<RIGHT>. It will be placed in
970 the SQL command immediately before C<JOIN>.
974 An arrayref containing a list of accessors in the foreign class to proxy in
975 the main class. If, for example, you do the following:
977 CD->might_have(liner_notes => 'LinerNotes', undef, {
978 proxy => [ qw/notes/ ],
981 Then, assuming LinerNotes has an accessor named notes, you can do:
983 my $cd = CD->find(1);
984 # set notes -- LinerNotes object is created if it doesn't exist
985 $cd->notes('Notes go here');
989 Specifies the type of accessor that should be created for the
990 relationship. Valid values are C<single> (for when there is only a single
991 related object), C<multi> (when there can be many), and C<filter> (for
992 when there is a single related object, but you also want the relationship
993 accessor to double as a column accessor). For C<multi> accessors, an
994 add_to_* method is also created, which calls C<create_related> for the
999 Throws an exception if the condition is improperly supplied, or cannot
1004 sub add_relationship {
1005 my ($self, $rel, $f_source_name, $cond, $attrs) = @_;
1006 $self->throw_exception("Can't create relationship without join condition")
1010 # Check foreign and self are right in cond
1011 if ( (ref $cond ||'') eq 'HASH') {
1013 $self->throw_exception("Keys of condition should be of form 'foreign.col', not '$_'")
1014 if /\./ && !/^foreign\./;
1018 my %rels = %{ $self->_relationships };
1019 $rels{$rel} = { class => $f_source_name,
1020 source => $f_source_name,
1023 $self->_relationships(\%rels);
1027 # XXX disabled. doesn't work properly currently. skip in tests.
1029 my $f_source = $self->schema->source($f_source_name);
1030 unless ($f_source) {
1031 $self->ensure_class_loaded($f_source_name);
1032 $f_source = $f_source_name->result_source;
1033 #my $s_class = ref($self->schema);
1034 #$f_source_name =~ m/^${s_class}::(.*)$/;
1035 #$self->schema->register_class(($1 || $f_source_name), $f_source_name);
1036 #$f_source = $self->schema->source($f_source_name);
1038 return unless $f_source; # Can't test rel without f_source
1040 try { $self->_resolve_join($rel, 'me', {}, []) }
1042 # If the resolve failed, back out and re-throw the error
1044 $self->_relationships(\%rels);
1045 $self->throw_exception("Error creating relationship $rel: $_");
1051 =head2 relationships
1055 =item Arguments: None
1057 =item Return value: List of relationship names
1061 my @relnames = $source->relationships();
1063 Returns all relationship names for this source.
1068 return keys %{shift->_relationships};
1071 =head2 relationship_info
1075 =item Arguments: $relname
1077 =item Return value: Hashref of relation data,
1081 Returns a hash of relationship information for the specified relationship
1082 name. The keys/values are as specified for L</add_relationship>.
1086 sub relationship_info {
1087 my ($self, $rel) = @_;
1088 return $self->_relationships->{$rel};
1091 =head2 has_relationship
1095 =item Arguments: $rel
1097 =item Return value: 1/0 (true/false)
1101 Returns true if the source has a relationship of this name, false otherwise.
1105 sub has_relationship {
1106 my ($self, $rel) = @_;
1107 return exists $self->_relationships->{$rel};
1110 =head2 reverse_relationship_info
1114 =item Arguments: $relname
1116 =item Return value: Hashref of relationship data
1120 Looks through all the relationships on the source this relationship
1121 points to, looking for one whose condition is the reverse of the
1122 condition on this relationship.
1124 A common use of this is to find the name of the C<belongs_to> relation
1125 opposing a C<has_many> relation. For definition of these look in
1126 L<DBIx::Class::Relationship>.
1128 The returned hashref is keyed by the name of the opposing
1129 relationship, and contains its data in the same manner as
1130 L</relationship_info>.
1134 sub reverse_relationship_info {
1135 my ($self, $rel) = @_;
1136 my $rel_info = $self->relationship_info($rel);
1139 return $ret unless ((ref $rel_info->{cond}) eq 'HASH');
1141 my @cond = keys(%{$rel_info->{cond}});
1142 my @refkeys = map {/^\w+\.(\w+)$/} @cond;
1143 my @keys = map {$rel_info->{cond}->{$_} =~ /^\w+\.(\w+)$/} @cond;
1145 # Get the related result source for this relationship
1146 my $othertable = $self->related_source($rel);
1148 # Get all the relationships for that source that related to this source
1149 # whose foreign column set are our self columns on $rel and whose self
1150 # columns are our foreign columns on $rel.
1151 my @otherrels = $othertable->relationships();
1152 my $otherrelationship;
1153 foreach my $otherrel (@otherrels) {
1154 my $otherrel_info = $othertable->relationship_info($otherrel);
1156 my $back = $othertable->related_source($otherrel);
1157 next unless $back->source_name eq $self->source_name;
1161 if (ref $otherrel_info->{cond} eq 'HASH') {
1162 @othertestconds = ($otherrel_info->{cond});
1164 elsif (ref $otherrel_info->{cond} eq 'ARRAY') {
1165 @othertestconds = @{$otherrel_info->{cond}};
1171 foreach my $othercond (@othertestconds) {
1172 my @other_cond = keys(%$othercond);
1173 my @other_refkeys = map {/^\w+\.(\w+)$/} @other_cond;
1174 my @other_keys = map {$othercond->{$_} =~ /^\w+\.(\w+)$/} @other_cond;
1175 next if (!$self->_compare_relationship_keys(\@refkeys, \@other_keys) ||
1176 !$self->_compare_relationship_keys(\@other_refkeys, \@keys));
1177 $ret->{$otherrel} = $otherrel_info;
1183 sub compare_relationship_keys {
1184 carp 'compare_relationship_keys is a private method, stop calling it';
1186 $self->_compare_relationship_keys (@_);
1189 # Returns true if both sets of keynames are the same, false otherwise.
1190 sub _compare_relationship_keys {
1191 my ($self, $keys1, $keys2) = @_;
1193 # Make sure every keys1 is in keys2
1195 foreach my $key (@$keys1) {
1197 foreach my $prim (@$keys2) {
1198 if ($prim eq $key) {
1206 # Make sure every key2 is in key1
1208 foreach my $prim (@$keys2) {
1210 foreach my $key (@$keys1) {
1211 if ($prim eq $key) {
1223 # Returns the {from} structure used to express JOIN conditions
1225 my ($self, $join, $alias, $seen, $jpath, $parent_force_left) = @_;
1227 # we need a supplied one, because we do in-place modifications, no returns
1228 $self->throw_exception ('You must supply a seen hashref as the 3rd argument to _resolve_join')
1229 unless ref $seen eq 'HASH';
1231 $self->throw_exception ('You must supply a joinpath arrayref as the 4th argument to _resolve_join')
1232 unless ref $jpath eq 'ARRAY';
1234 $jpath = [@$jpath]; # copy
1236 if (not defined $join) {
1239 elsif (ref $join eq 'ARRAY') {
1242 $self->_resolve_join($_, $alias, $seen, $jpath, $parent_force_left);
1245 elsif (ref $join eq 'HASH') {
1248 for my $rel (keys %$join) {
1250 my $rel_info = $self->relationship_info($rel)
1251 or $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
1253 my $force_left = $parent_force_left;
1254 $force_left ||= lc($rel_info->{attrs}{join_type}||'') eq 'left';
1256 # the actual seen value will be incremented by the recursion
1257 my $as = $self->storage->relname_to_table_alias(
1258 $rel, ($seen->{$rel} && $seen->{$rel} + 1)
1262 $self->_resolve_join($rel, $alias, $seen, [@$jpath], $force_left),
1263 $self->related_source($rel)->_resolve_join(
1264 $join->{$rel}, $as, $seen, [@$jpath, { $rel => $as }], $force_left
1272 $self->throw_exception("No idea how to resolve join reftype ".ref $join);
1275 my $count = ++$seen->{$join};
1276 my $as = $self->storage->relname_to_table_alias(
1277 $join, ($count > 1 && $count)
1280 my $rel_info = $self->relationship_info($join)
1281 or $self->throw_exception("No such relationship $join on " . $self->source_name);
1283 my $rel_src = $self->related_source($join);
1284 return [ { $as => $rel_src->from,
1285 -source_handle => $rel_src->handle,
1286 -join_type => $parent_force_left
1288 : $rel_info->{attrs}{join_type}
1290 -join_path => [@$jpath, { $join => $as } ],
1292 $rel_info->{attrs}{accessor}
1294 List::Util::first { $rel_info->{attrs}{accessor} eq $_ } (qw/single filter/)
1297 -relation_chain_depth => $seen->{-relation_chain_depth} || 0,
1299 $self->_resolve_condition($rel_info->{cond}, $as, $alias) ];
1304 carp 'pk_depends_on is a private method, stop calling it';
1306 $self->_pk_depends_on (@_);
1309 # Determines whether a relation is dependent on an object from this source
1310 # having already been inserted. Takes the name of the relationship and a
1311 # hashref of columns of the related object.
1312 sub _pk_depends_on {
1313 my ($self, $relname, $rel_data) = @_;
1315 my $relinfo = $self->relationship_info($relname);
1317 # don't assume things if the relationship direction is specified
1318 return $relinfo->{attrs}{is_foreign_key_constraint}
1319 if exists ($relinfo->{attrs}{is_foreign_key_constraint});
1321 my $cond = $relinfo->{cond};
1322 return 0 unless ref($cond) eq 'HASH';
1324 # map { foreign.foo => 'self.bar' } to { bar => 'foo' }
1325 my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond };
1327 # assume anything that references our PK probably is dependent on us
1328 # rather than vice versa, unless the far side is (a) defined or (b)
1330 my $rel_source = $self->related_source($relname);
1332 foreach my $p ($self->primary_columns) {
1333 if (exists $keyhash->{$p}) {
1334 unless (defined($rel_data->{$keyhash->{$p}})
1335 || $rel_source->column_info($keyhash->{$p})
1336 ->{is_auto_increment}) {
1345 sub resolve_condition {
1346 carp 'resolve_condition is a private method, stop calling it';
1348 $self->_resolve_condition (@_);
1351 # Resolves the passed condition to a concrete query fragment. If given an alias,
1352 # returns a join condition; if given an object, inverts that object to produce
1353 # a related conditional from that object.
1354 our $UNRESOLVABLE_CONDITION = \'1 = 0';
1356 sub _resolve_condition {
1357 my ($self, $cond, $as, $for) = @_;
1358 if (ref $cond eq 'HASH') {
1360 foreach my $k (keys %{$cond}) {
1361 my $v = $cond->{$k};
1362 # XXX should probably check these are valid columns
1363 $k =~ s/^foreign\.// ||
1364 $self->throw_exception("Invalid rel cond key ${k}");
1365 $v =~ s/^self\.// ||
1366 $self->throw_exception("Invalid rel cond val ${v}");
1367 if (ref $for) { # Object
1368 #warn "$self $k $for $v";
1369 unless ($for->has_column_loaded($v)) {
1370 if ($for->in_storage) {
1371 $self->throw_exception(sprintf
1372 "Unable to resolve relationship '%s' from object %s: column '%s' not "
1373 . 'loaded from storage (or not passed to new() prior to insert()). You '
1374 . 'probably need to call ->discard_changes to get the server-side defaults '
1375 . 'from the database.',
1381 return $UNRESOLVABLE_CONDITION;
1383 $ret{$k} = $for->get_column($v);
1384 #$ret{$k} = $for->get_column($v) if $for->has_column_loaded($v);
1386 } elsif (!defined $for) { # undef, i.e. "no object"
1388 } elsif (ref $as eq 'HASH') { # reverse hashref
1389 $ret{$v} = $as->{$k};
1390 } elsif (ref $as) { # reverse object
1391 $ret{$v} = $as->get_column($k);
1392 } elsif (!defined $as) { # undef, i.e. "no reverse object"
1395 $ret{"${as}.${k}"} = "${for}.${v}";
1399 } elsif (ref $cond eq 'ARRAY') {
1400 return [ map { $self->_resolve_condition($_, $as, $for) } @$cond ];
1402 die("Can't handle condition $cond yet :(");
1407 # Accepts one or more relationships for the current source and returns an
1408 # array of column names for each of those relationships. Column names are
1409 # prefixed relative to the current source, in accordance with where they appear
1410 # in the supplied relationships.
1412 sub _resolve_prefetch {
1413 my ($self, $pre, $alias, $alias_map, $order, $collapse, $pref_path) = @_;
1416 if (not defined $pre) {
1419 elsif( ref $pre eq 'ARRAY' ) {
1421 map { $self->_resolve_prefetch( $_, $alias, $alias_map, $order, $collapse, [ @$pref_path ] ) }
1424 elsif( ref $pre eq 'HASH' ) {
1427 $self->_resolve_prefetch($_, $alias, $alias_map, $order, $collapse, [ @$pref_path ] ),
1428 $self->related_source($_)->_resolve_prefetch(
1429 $pre->{$_}, "${alias}.$_", $alias_map, $order, $collapse, [ @$pref_path, $_] )
1434 $self->throw_exception(
1435 "don't know how to resolve prefetch reftype ".ref($pre));
1439 $p = $p->{$_} for (@$pref_path, $pre);
1441 $self->throw_exception (
1442 "Unable to resolve prefetch '$pre' - join alias map does not contain an entry for path: "
1443 . join (' -> ', @$pref_path, $pre)
1444 ) if (ref $p->{-join_aliases} ne 'ARRAY' or not @{$p->{-join_aliases}} );
1446 my $as = shift @{$p->{-join_aliases}};
1448 my $rel_info = $self->relationship_info( $pre );
1449 $self->throw_exception( $self->source_name . " has no such relationship '$pre'" )
1451 my $as_prefix = ($alias =~ /^.*?\.(.+)$/ ? $1.'.' : '');
1452 my $rel_source = $self->related_source($pre);
1454 if ($rel_info->{attrs}{accessor} && $rel_info->{attrs}{accessor} eq 'multi') {
1455 $self->throw_exception(
1456 "Can't prefetch has_many ${pre} (join cond too complex)")
1457 unless ref($rel_info->{cond}) eq 'HASH';
1458 my $dots = @{[$as_prefix =~ m/\./g]} + 1; # +1 to match the ".${as_prefix}"
1459 if (my ($fail) = grep { @{[$_ =~ m/\./g]} == $dots }
1460 keys %{$collapse}) {
1461 my ($last) = ($fail =~ /([^\.]+)$/);
1463 "Prefetching multiple has_many rels ${last} and ${pre} "
1464 .(length($as_prefix)
1465 ? "at the same level (${as_prefix}) "
1468 . 'will explode the number of row objects retrievable via ->next or ->all. '
1469 . 'Use at your own risk.'
1472 #my @col = map { (/^self\.(.+)$/ ? ("${as_prefix}.$1") : ()); }
1473 # values %{$rel_info->{cond}};
1474 $collapse->{".${as_prefix}${pre}"} = [ $rel_source->_pri_cols ];
1475 # action at a distance. prepending the '.' allows simpler code
1476 # in ResultSet->_collapse_result
1477 my @key = map { (/^foreign\.(.+)$/ ? ($1) : ()); }
1478 keys %{$rel_info->{cond}};
1479 my @ord = (ref($rel_info->{attrs}{order_by}) eq 'ARRAY'
1480 ? @{$rel_info->{attrs}{order_by}}
1482 : (defined $rel_info->{attrs}{order_by}
1483 ? ($rel_info->{attrs}{order_by})
1485 push(@$order, map { "${as}.$_" } (@key, @ord));
1488 return map { [ "${as}.$_", "${as_prefix}${pre}.$_", ] }
1489 $rel_source->columns;
1493 =head2 related_source
1497 =item Arguments: $relname
1499 =item Return value: $source
1503 Returns the result source object for the given relationship.
1507 sub related_source {
1508 my ($self, $rel) = @_;
1509 if( !$self->has_relationship( $rel ) ) {
1510 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
1512 return $self->schema->source($self->relationship_info($rel)->{source});
1515 =head2 related_class
1519 =item Arguments: $relname
1521 =item Return value: $classname
1525 Returns the class name for objects in the given relationship.
1530 my ($self, $rel) = @_;
1531 if( !$self->has_relationship( $rel ) ) {
1532 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
1534 return $self->schema->class($self->relationship_info($rel)->{source});
1539 Obtain a new handle to this source. Returns an instance of a
1540 L<DBIx::Class::ResultSourceHandle>.
1545 return DBIx::Class::ResultSourceHandle->new({
1546 schema => $_[0]->schema,
1547 source_moniker => $_[0]->source_name
1551 =head2 throw_exception
1553 See L<DBIx::Class::Schema/"throw_exception">.
1557 sub throw_exception {
1560 if (defined $self->schema) {
1561 $self->schema->throw_exception(@_);
1564 DBIx::Class::Exception->throw(@_);
1570 Stores a hashref of per-source metadata. No specific key names
1571 have yet been standardized, the examples below are purely hypothetical
1572 and don't actually accomplish anything on their own:
1574 __PACKAGE__->source_info({
1575 "_tablespace" => 'fast_disk_array_3',
1576 "_engine" => 'InnoDB',
1583 $class->new({attribute_name => value});
1585 Creates a new ResultSource object. Not normally called directly by end users.
1587 =head2 column_info_from_storage
1591 =item Arguments: 1/0 (default: 0)
1593 =item Return value: 1/0
1597 __PACKAGE__->column_info_from_storage(1);
1599 Enables the on-demand automatic loading of the above column
1600 metadata from storage as necessary. This is *deprecated*, and
1601 should not be used. It will be removed before 1.0.
1606 Matt S. Trout <mst@shadowcatsystems.co.uk>
1610 You may distribute this code under the same terms as Perl itself.