1 package DBIx::Class::ResultSource;
6 use DBIx::Class::ResultSet;
7 use DBIx::Class::ResultSourceHandle;
9 use DBIx::Class::Exception;
10 use DBIx::Class::Carp;
12 use List::Util 'first';
13 use Scalar::Util qw/blessed weaken isweak/;
16 use base qw/DBIx::Class/;
18 __PACKAGE__->mk_group_accessors(simple => qw/
19 source_name name source_info
20 _ordered_columns _columns _primaries _unique_constraints
21 _relationships resultset_attributes
22 column_info_from_storage
25 __PACKAGE__->mk_group_accessors(component_class => qw/
30 __PACKAGE__->mk_classdata( sqlt_deploy_callback => 'default_sqlt_deploy_hook' );
34 DBIx::Class::ResultSource - Result source object
38 # Create a table based result source, in a result class.
40 package MyApp::Schema::Result::Artist;
41 use base qw/DBIx::Class::Core/;
43 __PACKAGE__->table('artist');
44 __PACKAGE__->add_columns(qw/ artistid name /);
45 __PACKAGE__->set_primary_key('artistid');
46 __PACKAGE__->has_many(cds => 'MyApp::Schema::Result::CD');
50 # Create a query (view) based result source, in a result class
51 package MyApp::Schema::Result::Year2000CDs;
52 use base qw/DBIx::Class::Core/;
54 __PACKAGE__->load_components('InflateColumn::DateTime');
55 __PACKAGE__->table_class('DBIx::Class::ResultSource::View');
57 __PACKAGE__->table('year2000cds');
58 __PACKAGE__->result_source_instance->is_virtual(1);
59 __PACKAGE__->result_source_instance->view_definition(
60 "SELECT cdid, artist, title FROM cd WHERE year ='2000'"
66 A ResultSource is an object that represents a source of data for querying.
68 This class is a base class for various specialised types of result
69 sources, for example L<DBIx::Class::ResultSource::Table>. Table is the
70 default result source type, so one is created for you when defining a
71 result class as described in the synopsis above.
73 More specifically, the L<DBIx::Class::Core> base class pulls in the
74 L<DBIx::Class::ResultSourceProxy::Table> component, which defines
75 the L<table|DBIx::Class::ResultSourceProxy::Table/table> method.
76 When called, C<table> creates and stores an instance of
77 L<DBIx::Class::ResultSoure::Table>. Luckily, to use tables as result
78 sources, you don't need to remember any of this.
80 Result sources representing select queries, or views, can also be
81 created, see L<DBIx::Class::ResultSource::View> for full details.
83 =head2 Finding result source objects
85 As mentioned above, a result source instance is created and stored for
86 you when you define a L<Result Class|DBIx::Class::Manual::Glossary/Result Class>.
88 You can retrieve the result source at runtime in the following ways:
92 =item From a Schema object:
94 $schema->source($source_name);
96 =item From a Row object:
100 =item From a ResultSet object:
113 my ($class, $attrs) = @_;
114 $class = ref $class if ref $class;
116 my $new = bless { %{$attrs || {}} }, $class;
117 $new->{resultset_class} ||= 'DBIx::Class::ResultSet';
118 $new->{resultset_attributes} = { %{$new->{resultset_attributes} || {}} };
119 $new->{_ordered_columns} = [ @{$new->{_ordered_columns}||[]}];
120 $new->{_columns} = { %{$new->{_columns}||{}} };
121 $new->{_relationships} = { %{$new->{_relationships}||{}} };
122 $new->{name} ||= "!!NAME NOT SET!!";
123 $new->{_columns_info_loaded} ||= 0;
133 =item Arguments: @columns
135 =item Return value: The ResultSource object
139 $source->add_columns(qw/col1 col2 col3/);
141 $source->add_columns('col1' => \%col1_info, 'col2' => \%col2_info, ...);
143 Adds columns to the result source. If supplied colname => hashref
144 pairs, uses the hashref as the L</column_info> for that column. Repeated
145 calls of this method will add more columns, not replace them.
147 The column names given will be created as accessor methods on your
148 L<DBIx::Class::Row> objects. You can change the name of the accessor
149 by supplying an L</accessor> in the column_info hash.
151 If a column name beginning with a plus sign ('+col1') is provided, the
152 attributes provided will be merged with any existing attributes for the
153 column, with the new attributes taking precedence in the case that an
154 attribute already exists. Using this without a hashref
155 (C<< $source->add_columns(qw/+col1 +col2/) >>) is legal, but useless --
156 it does the same thing it would do without the plus.
158 The contents of the column_info are not set in stone. The following
159 keys are currently recognised/used by DBIx::Class:
165 { accessor => '_name' }
167 # example use, replace standard accessor with one of your own:
169 my ($self, $value) = @_;
171 die "Name cannot contain digits!" if($value =~ /\d/);
172 $self->_name($value);
174 return $self->_name();
177 Use this to set the name of the accessor method for this column. If unset,
178 the name of the column will be used.
182 { data_type => 'integer' }
184 This contains the column type. It is automatically filled if you use the
185 L<SQL::Translator::Producer::DBIx::Class::File> producer, or the
186 L<DBIx::Class::Schema::Loader> module.
188 Currently there is no standard set of values for the data_type. Use
189 whatever your database supports.
195 The length of your column, if it is a column type that can have a size
196 restriction. This is currently only used to create tables from your
197 schema, see L<DBIx::Class::Schema/deploy>.
203 Set this to a true value for a columns that is allowed to contain NULL
204 values, default is false. This is currently only used to create tables
205 from your schema, see L<DBIx::Class::Schema/deploy>.
207 =item is_auto_increment
209 { is_auto_increment => 1 }
211 Set this to a true value for a column whose value is somehow
212 automatically set, defaults to false. This is used to determine which
213 columns to empty when cloning objects using
214 L<DBIx::Class::Row/copy>. It is also used by
215 L<DBIx::Class::Schema/deploy>.
221 Set this to a true or false value (not C<undef>) to explicitly specify
222 if this column contains numeric data. This controls how set_column
223 decides whether to consider a column dirty after an update: if
224 C<is_numeric> is true a numeric comparison C<< != >> will take place
225 instead of the usual C<eq>
227 If not specified the storage class will attempt to figure this out on
228 first access to the column, based on the column C<data_type>. The
229 result will be cached in this attribute.
233 { is_foreign_key => 1 }
235 Set this to a true value for a column that contains a key from a
236 foreign table, defaults to false. This is currently only used to
237 create tables from your schema, see L<DBIx::Class::Schema/deploy>.
241 { default_value => \'now()' }
243 Set this to the default value which will be inserted into a column by
244 the database. Can contain either a value or a function (use a
245 reference to a scalar e.g. C<\'now()'> if you want a function). This
246 is currently only used to create tables from your schema, see
247 L<DBIx::Class::Schema/deploy>.
249 See the note on L<DBIx::Class::Row/new> for more information about possible
250 issues related to db-side default values.
254 { sequence => 'my_table_seq' }
256 Set this on a primary key column to the name of the sequence used to
257 generate a new key value. If not specified, L<DBIx::Class::PK::Auto>
258 will attempt to retrieve the name of the sequence from the database
261 =item retrieve_on_insert
263 { retrieve_on_insert => 1 }
265 For every column where this is set to true, DBIC will retrieve the RDBMS-side
266 value upon a new row insertion (normally only the autoincrement PK is
267 retrieved on insert). C<INSERT ... RETURNING> is used automatically if
268 supported by the underlying storage, otherwise an extra SELECT statement is
269 executed to retrieve the missing data.
273 { auto_nextval => 1 }
275 Set this to a true value for a column whose value is retrieved automatically
276 from a sequence or function (if supported by your Storage driver.) For a
277 sequence, if you do not use a trigger to get the nextval, you have to set the
278 L</sequence> value as well.
280 Also set this for MSSQL columns with the 'uniqueidentifier'
281 L<data_type|DBIx::Class::ResultSource/data_type> whose values you want to
282 automatically generate using C<NEWID()>, unless they are a primary key in which
283 case this will be done anyway.
287 This is used by L<DBIx::Class::Schema/deploy> and L<SQL::Translator>
288 to add extra non-generic data to the column. For example: C<< extra
289 => { unsigned => 1} >> is used by the MySQL producer to set an integer
290 column to unsigned. For more details, see
291 L<SQL::Translator::Producer::MySQL>.
299 =item Arguments: $colname, \%columninfo?
301 =item Return value: 1/0 (true/false)
305 $source->add_column('col' => \%info);
307 Add a single column and optional column info. Uses the same column
308 info keys as L</add_columns>.
313 my ($self, @cols) = @_;
314 $self->_ordered_columns(\@cols) unless $self->_ordered_columns;
317 my $columns = $self->_columns;
318 while (my $col = shift @cols) {
319 my $column_info = {};
320 if ($col =~ s/^\+//) {
321 $column_info = $self->column_info($col);
324 # If next entry is { ... } use that for the column info, if not
325 # use an empty hashref
327 my $new_info = shift(@cols);
328 %$column_info = (%$column_info, %$new_info);
330 push(@added, $col) unless exists $columns->{$col};
331 $columns->{$col} = $column_info;
333 push @{ $self->_ordered_columns }, @added;
337 sub add_column { shift->add_columns(@_); } # DO NOT CHANGE THIS TO GLOB
343 =item Arguments: $colname
345 =item Return value: 1/0 (true/false)
349 if ($source->has_column($colname)) { ... }
351 Returns true if the source has a column of this name, false otherwise.
356 my ($self, $column) = @_;
357 return exists $self->_columns->{$column};
364 =item Arguments: $colname
366 =item Return value: Hashref of info
370 my $info = $source->column_info($col);
372 Returns the column metadata hashref for a column, as originally passed
373 to L</add_columns>. See L</add_columns> above for information on the
374 contents of the hashref.
379 my ($self, $column) = @_;
380 $self->throw_exception("No such column $column")
381 unless exists $self->_columns->{$column};
383 if ( ! $self->_columns->{$column}{data_type}
384 and ! $self->{_columns_info_loaded}
385 and $self->column_info_from_storage
386 and my $stor = try { $self->storage } )
388 $self->{_columns_info_loaded}++;
390 # try for the case of storage without table
392 my $info = $stor->columns_info_for( $self->from );
394 { (lc $_) => $info->{$_} }
398 foreach my $col ( keys %{$self->_columns} ) {
399 $self->_columns->{$col} = {
400 %{ $self->_columns->{$col} },
401 %{ $info->{$col} || $lc_info->{lc $col} || {} }
407 return $self->_columns->{$column};
414 =item Arguments: None
416 =item Return value: Ordered list of column names
420 my @column_names = $source->columns;
422 Returns all column names in the order they were declared to L</add_columns>.
428 $self->throw_exception(
429 "columns() is a read-only accessor, did you mean add_columns()?"
431 return @{$self->{_ordered_columns}||[]};
438 =item Arguments: \@colnames ?
440 =item Return value: Hashref of column name/info pairs
444 my $columns_info = $source->columns_info;
446 Like L</column_info> but returns information for the requested columns. If
447 the optional column-list arrayref is omitted it returns info on all columns
448 currently defined on the ResultSource via L</add_columns>.
453 my ($self, $columns) = @_;
455 my $colinfo = $self->_columns;
458 first { ! $_->{data_type} } values %$colinfo
460 ! $self->{_columns_info_loaded}
462 $self->column_info_from_storage
464 my $stor = try { $self->storage }
466 $self->{_columns_info_loaded}++;
468 # try for the case of storage without table
470 my $info = $stor->columns_info_for( $self->from );
472 { (lc $_) => $info->{$_} }
476 foreach my $col ( keys %$colinfo ) {
478 %{ $colinfo->{$col} },
479 %{ $info->{$col} || $lc_info->{lc $col} || {} }
489 if (my $inf = $colinfo->{$_}) {
493 $self->throw_exception( sprintf (
494 "No such column '%s' on source %s",
508 =head2 remove_columns
512 =item Arguments: @colnames
514 =item Return value: undefined
518 $source->remove_columns(qw/col1 col2 col3/);
520 Removes the given list of columns by name, from the result source.
522 B<Warning>: Removing a column that is also used in the sources primary
523 key, or in one of the sources unique constraints, B<will> result in a
524 broken result source.
530 =item Arguments: $colname
532 =item Return value: undefined
536 $source->remove_column('col');
538 Remove a single column by name from the result source, similar to
541 B<Warning>: Removing a column that is also used in the sources primary
542 key, or in one of the sources unique constraints, B<will> result in a
543 broken result source.
548 my ($self, @to_remove) = @_;
550 my $columns = $self->_columns
555 delete $columns->{$_};
559 $self->_ordered_columns([ grep { not $to_remove{$_} } @{$self->_ordered_columns} ]);
562 sub remove_column { shift->remove_columns(@_); } # DO NOT CHANGE THIS TO GLOB
564 =head2 set_primary_key
568 =item Arguments: @cols
570 =item Return value: undefined
574 Defines one or more columns as primary key for this source. Must be
575 called after L</add_columns>.
577 Additionally, defines a L<unique constraint|add_unique_constraint>
580 Note: you normally do want to define a primary key on your sources
581 B<even if the underlying database table does not have a primary key>.
583 L<DBIx::Class::Manual::Intro/The Significance and Importance of Primary Keys>
588 sub set_primary_key {
589 my ($self, @cols) = @_;
590 # check if primary key columns are valid columns
591 foreach my $col (@cols) {
592 $self->throw_exception("No such column $col on table " . $self->name)
593 unless $self->has_column($col);
595 $self->_primaries(\@cols);
597 $self->add_unique_constraint(primary => \@cols);
600 =head2 primary_columns
604 =item Arguments: None
606 =item Return value: Ordered list of primary column names
610 Read-only accessor which returns the list of primary keys, supplied by
615 sub primary_columns {
616 return @{shift->_primaries||[]};
619 # a helper method that will automatically die with a descriptive message if
620 # no pk is defined on the source in question. For internal use to save
621 # on if @pks... boilerplate
624 my @pcols = $self->primary_columns
625 or $self->throw_exception (sprintf(
626 "Operation requires a primary key to be declared on '%s' via set_primary_key",
627 # source_name is set only after schema-registration
628 $self->source_name || $self->result_class || $self->name || 'Unknown source...?',
635 Manually define the correct sequence for your table, to avoid the overhead
636 associated with looking up the sequence automatically. The supplied sequence
637 will be applied to the L</column_info> of each L<primary_key|/set_primary_key>
641 =item Arguments: $sequence_name
643 =item Return value: undefined
650 my ($self,$seq) = @_;
652 my @pks = $self->primary_columns
655 $_->{sequence} = $seq
656 for values %{ $self->columns_info (\@pks) };
660 =head2 add_unique_constraint
664 =item Arguments: $name?, \@colnames
666 =item Return value: undefined
670 Declare a unique constraint on this source. Call once for each unique
673 # For UNIQUE (column1, column2)
674 __PACKAGE__->add_unique_constraint(
675 constraint_name => [ qw/column1 column2/ ],
678 Alternatively, you can specify only the columns:
680 __PACKAGE__->add_unique_constraint([ qw/column1 column2/ ]);
682 This will result in a unique constraint named
683 C<table_column1_column2>, where C<table> is replaced with the table
686 Unique constraints are used, for example, when you pass the constraint
687 name as the C<key> attribute to L<DBIx::Class::ResultSet/find>. Then
688 only columns in the constraint are searched.
690 Throws an error if any of the given column names do not yet exist on
695 sub add_unique_constraint {
699 $self->throw_exception(
700 'add_unique_constraint() does not accept multiple constraints, use '
701 . 'add_unique_constraints() instead'
706 if (ref $cols ne 'ARRAY') {
707 $self->throw_exception (
708 'Expecting an arrayref of constraint columns, got ' . ($cols||'NOTHING')
714 $name ||= $self->name_unique_constraint($cols);
716 foreach my $col (@$cols) {
717 $self->throw_exception("No such column $col on table " . $self->name)
718 unless $self->has_column($col);
721 my %unique_constraints = $self->unique_constraints;
722 $unique_constraints{$name} = $cols;
723 $self->_unique_constraints(\%unique_constraints);
726 =head2 add_unique_constraints
730 =item Arguments: @constraints
732 =item Return value: undefined
736 Declare multiple unique constraints on this source.
738 __PACKAGE__->add_unique_constraints(
739 constraint_name1 => [ qw/column1 column2/ ],
740 constraint_name2 => [ qw/column2 column3/ ],
743 Alternatively, you can specify only the columns:
745 __PACKAGE__->add_unique_constraints(
746 [ qw/column1 column2/ ],
747 [ qw/column3 column4/ ]
750 This will result in unique constraints named C<table_column1_column2> and
751 C<table_column3_column4>, where C<table> is replaced with the table name.
753 Throws an error if any of the given column names do not yet exist on
756 See also L</add_unique_constraint>.
760 sub add_unique_constraints {
762 my @constraints = @_;
764 if ( !(@constraints % 2) && first { ref $_ ne 'ARRAY' } @constraints ) {
765 # with constraint name
766 while (my ($name, $constraint) = splice @constraints, 0, 2) {
767 $self->add_unique_constraint($name => $constraint);
772 foreach my $constraint (@constraints) {
773 $self->add_unique_constraint($constraint);
778 =head2 name_unique_constraint
782 =item Arguments: \@colnames
784 =item Return value: Constraint name
788 $source->table('mytable');
789 $source->name_unique_constraint(['col1', 'col2']);
793 Return a name for a unique constraint containing the specified
794 columns. The name is created by joining the table name and each column
795 name, using an underscore character.
797 For example, a constraint on a table named C<cd> containing the columns
798 C<artist> and C<title> would result in a constraint name of C<cd_artist_title>.
800 This is used by L</add_unique_constraint> if you do not specify the
801 optional constraint name.
805 sub name_unique_constraint {
806 my ($self, $cols) = @_;
808 my $name = $self->name;
809 $name = $$name if (ref $name eq 'SCALAR');
811 return join '_', $name, @$cols;
814 =head2 unique_constraints
818 =item Arguments: None
820 =item Return value: Hash of unique constraint data
824 $source->unique_constraints();
826 Read-only accessor which returns a hash of unique constraints on this
829 The hash is keyed by constraint name, and contains an arrayref of
830 column names as values.
834 sub unique_constraints {
835 return %{shift->_unique_constraints||{}};
838 =head2 unique_constraint_names
842 =item Arguments: None
844 =item Return value: Unique constraint names
848 $source->unique_constraint_names();
850 Returns the list of unique constraint names defined on this source.
854 sub unique_constraint_names {
857 my %unique_constraints = $self->unique_constraints;
859 return keys %unique_constraints;
862 =head2 unique_constraint_columns
866 =item Arguments: $constraintname
868 =item Return value: List of constraint columns
872 $source->unique_constraint_columns('myconstraint');
874 Returns the list of columns that make up the specified unique constraint.
878 sub unique_constraint_columns {
879 my ($self, $constraint_name) = @_;
881 my %unique_constraints = $self->unique_constraints;
883 $self->throw_exception(
884 "Unknown unique constraint $constraint_name on '" . $self->name . "'"
885 ) unless exists $unique_constraints{$constraint_name};
887 return @{ $unique_constraints{$constraint_name} };
890 =head2 sqlt_deploy_callback
894 =item Arguments: $callback_name | \&callback_code
896 =item Return value: $callback_name | \&callback_code
900 __PACKAGE__->sqlt_deploy_callback('mycallbackmethod');
904 __PACKAGE__->sqlt_deploy_callback(sub {
905 my ($source_instance, $sqlt_table) = @_;
909 An accessor to set a callback to be called during deployment of
910 the schema via L<DBIx::Class::Schema/create_ddl_dir> or
911 L<DBIx::Class::Schema/deploy>.
913 The callback can be set as either a code reference or the name of a
914 method in the current result class.
916 Defaults to L</default_sqlt_deploy_hook>.
918 Your callback will be passed the $source object representing the
919 ResultSource instance being deployed, and the
920 L<SQL::Translator::Schema::Table> object being created from it. The
921 callback can be used to manipulate the table object or add your own
922 customised indexes. If you need to manipulate a non-table object, use
923 the L<DBIx::Class::Schema/sqlt_deploy_hook>.
925 See L<DBIx::Class::Manual::Cookbook/Adding Indexes And Functions To
926 Your SQL> for examples.
928 This sqlt deployment callback can only be used to manipulate
929 SQL::Translator objects as they get turned into SQL. To execute
930 post-deploy statements which SQL::Translator does not currently
931 handle, override L<DBIx::Class::Schema/deploy> in your Schema class
932 and call L<dbh_do|DBIx::Class::Storage::DBI/dbh_do>.
934 =head2 default_sqlt_deploy_hook
936 This is the default deploy hook implementation which checks if your
937 current Result class has a C<sqlt_deploy_hook> method, and if present
938 invokes it B<on the Result class directly>. This is to preserve the
939 semantics of C<sqlt_deploy_hook> which was originally designed to expect
940 the Result class name and the
941 L<$sqlt_table instance|SQL::Translator::Schema::Table> of the table being
946 sub default_sqlt_deploy_hook {
949 my $class = $self->result_class;
951 if ($class and $class->can('sqlt_deploy_hook')) {
952 $class->sqlt_deploy_hook(@_);
956 sub _invoke_sqlt_deploy_hook {
958 if ( my $hook = $self->sqlt_deploy_callback) {
967 =item Arguments: None
969 =item Return value: $resultset
973 Returns a resultset for the given source. This will initially be created
976 $self->resultset_class->new($self, $self->resultset_attributes)
978 but is cached from then on unless resultset_class changes.
980 =head2 resultset_class
984 =item Arguments: $classname
986 =item Return value: $classname
990 package My::Schema::ResultSet::Artist;
991 use base 'DBIx::Class::ResultSet';
994 # In the result class
995 __PACKAGE__->resultset_class('My::Schema::ResultSet::Artist');
998 $source->resultset_class('My::Schema::ResultSet::Artist');
1000 Set the class of the resultset. This is useful if you want to create your
1001 own resultset methods. Create your own class derived from
1002 L<DBIx::Class::ResultSet>, and set it here. If called with no arguments,
1003 this method returns the name of the existing resultset class, if one
1006 =head2 resultset_attributes
1010 =item Arguments: \%attrs
1012 =item Return value: \%attrs
1016 # In the result class
1017 __PACKAGE__->resultset_attributes({ order_by => [ 'id' ] });
1020 $source->resultset_attributes({ order_by => [ 'id' ] });
1022 Store a collection of resultset attributes, that will be set on every
1023 L<DBIx::Class::ResultSet> produced from this result source. For a full
1024 list see L<DBIx::Class::ResultSet/ATTRIBUTES>.
1030 $self->throw_exception(
1031 'resultset does not take any arguments. If you want another resultset, '.
1032 'call it on the schema instead.'
1035 $self->resultset_class->new(
1038 try { %{$self->schema->default_resultset_attributes} },
1039 %{$self->{resultset_attributes}},
1048 =item Arguments: $source_name
1050 =item Result value: $source_name
1054 Set an alternate name for the result source when it is loaded into a schema.
1055 This is useful if you want to refer to a result source by a name other than
1058 package ArchivedBooks;
1059 use base qw/DBIx::Class/;
1060 __PACKAGE__->table('books_archive');
1061 __PACKAGE__->source_name('Books');
1063 # from your schema...
1064 $schema->resultset('Books')->find(1);
1070 =item Arguments: None
1072 =item Return value: FROM clause
1076 my $from_clause = $source->from();
1078 Returns an expression of the source to be supplied to storage to specify
1079 retrieval from this source. In the case of a database, the required FROM
1084 sub from { die 'Virtual method!' }
1090 =item Arguments: $schema
1092 =item Return value: A schema object
1096 my $schema = $source->schema();
1098 Sets and/or returns the L<DBIx::Class::Schema> object to which this
1099 result source instance has been attached to.
1105 $_[0]->{schema} = $_[1];
1108 $_[0]->{schema} || do {
1109 my $name = $_[0]->{source_name} || '_unnamed_';
1110 my $err = 'Unable to perform storage-dependent operations with a detached result source '
1111 . "(source '$name' is not associated with a schema).";
1113 $err .= ' You need to use $schema->thaw() or manually set'
1114 . ' $DBIx::Class::ResultSourceHandle::thaw_schema while thawing.'
1115 if $_[0]->{_detached_thaw};
1117 DBIx::Class::Exception->throw($err);
1126 =item Arguments: None
1128 =item Return value: A Storage object
1132 $source->storage->debug(1);
1134 Returns the storage handle for the current schema.
1136 See also: L<DBIx::Class::Storage>
1140 sub storage { shift->schema->storage; }
1142 =head2 add_relationship
1146 =item Arguments: $relname, $related_source_name, \%cond, [ \%attrs ]
1148 =item Return value: 1/true if it succeeded
1152 $source->add_relationship('relname', 'related_source', $cond, $attrs);
1154 L<DBIx::Class::Relationship> describes a series of methods which
1155 create pre-defined useful types of relationships. Look there first
1156 before using this method directly.
1158 The relationship name can be arbitrary, but must be unique for each
1159 relationship attached to this result source. 'related_source' should
1160 be the name with which the related result source was registered with
1161 the current schema. For example:
1163 $schema->source('Book')->add_relationship('reviews', 'Review', {
1164 'foreign.book_id' => 'self.id',
1167 The condition C<$cond> needs to be an L<SQL::Abstract>-style
1168 representation of the join between the tables. For example, if you're
1169 creating a relation from Author to Book,
1171 { 'foreign.author_id' => 'self.id' }
1173 will result in the JOIN clause
1175 author me JOIN book foreign ON foreign.author_id = me.id
1177 You can specify as many foreign => self mappings as necessary.
1179 Valid attributes are as follows:
1185 Explicitly specifies the type of join to use in the relationship. Any
1186 SQL join type is valid, e.g. C<LEFT> or C<RIGHT>. It will be placed in
1187 the SQL command immediately before C<JOIN>.
1191 An arrayref containing a list of accessors in the foreign class to proxy in
1192 the main class. If, for example, you do the following:
1194 CD->might_have(liner_notes => 'LinerNotes', undef, {
1195 proxy => [ qw/notes/ ],
1198 Then, assuming LinerNotes has an accessor named notes, you can do:
1200 my $cd = CD->find(1);
1201 # set notes -- LinerNotes object is created if it doesn't exist
1202 $cd->notes('Notes go here');
1206 Specifies the type of accessor that should be created for the
1207 relationship. Valid values are C<single> (for when there is only a single
1208 related object), C<multi> (when there can be many), and C<filter> (for
1209 when there is a single related object, but you also want the relationship
1210 accessor to double as a column accessor). For C<multi> accessors, an
1211 add_to_* method is also created, which calls C<create_related> for the
1216 Throws an exception if the condition is improperly supplied, or cannot
1221 sub add_relationship {
1222 my ($self, $rel, $f_source_name, $cond, $attrs) = @_;
1223 $self->throw_exception("Can't create relationship without join condition")
1227 # Check foreign and self are right in cond
1228 if ( (ref $cond ||'') eq 'HASH') {
1230 $self->throw_exception("Keys of condition should be of form 'foreign.col', not '$_'")
1231 if /\./ && !/^foreign\./;
1235 my %rels = %{ $self->_relationships };
1236 $rels{$rel} = { class => $f_source_name,
1237 source => $f_source_name,
1240 $self->_relationships(\%rels);
1244 # XXX disabled. doesn't work properly currently. skip in tests.
1246 my $f_source = $self->schema->source($f_source_name);
1247 unless ($f_source) {
1248 $self->ensure_class_loaded($f_source_name);
1249 $f_source = $f_source_name->result_source;
1250 #my $s_class = ref($self->schema);
1251 #$f_source_name =~ m/^${s_class}::(.*)$/;
1252 #$self->schema->register_class(($1 || $f_source_name), $f_source_name);
1253 #$f_source = $self->schema->source($f_source_name);
1255 return unless $f_source; # Can't test rel without f_source
1257 try { $self->_resolve_join($rel, 'me', {}, []) }
1259 # If the resolve failed, back out and re-throw the error
1261 $self->_relationships(\%rels);
1262 $self->throw_exception("Error creating relationship $rel: $_");
1268 =head2 relationships
1272 =item Arguments: None
1274 =item Return value: List of relationship names
1278 my @relnames = $source->relationships();
1280 Returns all relationship names for this source.
1285 return keys %{shift->_relationships};
1288 =head2 relationship_info
1292 =item Arguments: $relname
1294 =item Return value: Hashref of relation data,
1298 Returns a hash of relationship information for the specified relationship
1299 name. The keys/values are as specified for L</add_relationship>.
1303 sub relationship_info {
1304 my ($self, $rel) = @_;
1305 return $self->_relationships->{$rel};
1308 =head2 has_relationship
1312 =item Arguments: $rel
1314 =item Return value: 1/0 (true/false)
1318 Returns true if the source has a relationship of this name, false otherwise.
1322 sub has_relationship {
1323 my ($self, $rel) = @_;
1324 return exists $self->_relationships->{$rel};
1327 =head2 reverse_relationship_info
1331 =item Arguments: $relname
1333 =item Return value: Hashref of relationship data
1337 Looks through all the relationships on the source this relationship
1338 points to, looking for one whose condition is the reverse of the
1339 condition on this relationship.
1341 A common use of this is to find the name of the C<belongs_to> relation
1342 opposing a C<has_many> relation. For definition of these look in
1343 L<DBIx::Class::Relationship>.
1345 The returned hashref is keyed by the name of the opposing
1346 relationship, and contains its data in the same manner as
1347 L</relationship_info>.
1351 sub reverse_relationship_info {
1352 my ($self, $rel) = @_;
1354 my $rel_info = $self->relationship_info($rel)
1355 or $self->throw_exception("No such relationship '$rel'");
1359 return $ret unless ((ref $rel_info->{cond}) eq 'HASH');
1361 my $stripped_cond = $self->__strip_relcond ($rel_info->{cond});
1363 my $rsrc_schema_moniker = $self->source_name
1364 if try { $self->schema };
1366 # this may be a partial schema or something else equally esoteric
1367 my $other_rsrc = try { $self->related_source($rel) }
1370 # Get all the relationships for that source that related to this source
1371 # whose foreign column set are our self columns on $rel and whose self
1372 # columns are our foreign columns on $rel
1373 foreach my $other_rel ($other_rsrc->relationships) {
1375 # only consider stuff that points back to us
1376 # "us" here is tricky - if we are in a schema registration, we want
1377 # to use the source_names, otherwise we will use the actual classes
1379 # the schema may be partial
1380 my $roundtrip_rsrc = try { $other_rsrc->related_source($other_rel) }
1383 if ($rsrc_schema_moniker and try { $roundtrip_rsrc->schema } ) {
1384 next unless $rsrc_schema_moniker eq $roundtrip_rsrc->source_name;
1387 next unless $self->result_class eq $roundtrip_rsrc->result_class;
1390 my $other_rel_info = $other_rsrc->relationship_info($other_rel);
1392 # this can happen when we have a self-referential class
1393 next if $other_rel_info eq $rel_info;
1395 next unless ref $other_rel_info->{cond} eq 'HASH';
1396 my $other_stripped_cond = $self->__strip_relcond($other_rel_info->{cond});
1398 $ret->{$other_rel} = $other_rel_info if (
1399 $self->_compare_relationship_keys (
1400 [ keys %$stripped_cond ], [ values %$other_stripped_cond ]
1403 $self->_compare_relationship_keys (
1404 [ values %$stripped_cond ], [ keys %$other_stripped_cond ]
1412 # all this does is removes the foreign/self prefix from a condition
1413 sub __strip_relcond {
1416 { map { /^ (?:foreign|self) \. (\w+) $/x } ($_, $_[1]{$_}) }
1421 sub compare_relationship_keys {
1422 carp 'compare_relationship_keys is a private method, stop calling it';
1424 $self->_compare_relationship_keys (@_);
1427 # Returns true if both sets of keynames are the same, false otherwise.
1428 sub _compare_relationship_keys {
1429 # my ($self, $keys1, $keys2) = @_;
1431 join ("\x00", sort @{$_[1]})
1433 join ("\x00", sort @{$_[2]})
1437 # Returns the {from} structure used to express JOIN conditions
1439 my ($self, $join, $alias, $seen, $jpath, $parent_force_left) = @_;
1441 # we need a supplied one, because we do in-place modifications, no returns
1442 $self->throw_exception ('You must supply a seen hashref as the 3rd argument to _resolve_join')
1443 unless ref $seen eq 'HASH';
1445 $self->throw_exception ('You must supply a joinpath arrayref as the 4th argument to _resolve_join')
1446 unless ref $jpath eq 'ARRAY';
1448 $jpath = [@$jpath]; # copy
1450 if (not defined $join) {
1453 elsif (ref $join eq 'ARRAY') {
1456 $self->_resolve_join($_, $alias, $seen, $jpath, $parent_force_left);
1459 elsif (ref $join eq 'HASH') {
1462 for my $rel (keys %$join) {
1464 my $rel_info = $self->relationship_info($rel)
1465 or $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
1467 my $force_left = $parent_force_left;
1468 $force_left ||= lc($rel_info->{attrs}{join_type}||'') eq 'left';
1470 # the actual seen value will be incremented by the recursion
1471 my $as = $self->storage->relname_to_table_alias(
1472 $rel, ($seen->{$rel} && $seen->{$rel} + 1)
1476 $self->_resolve_join($rel, $alias, $seen, [@$jpath], $force_left),
1477 $self->related_source($rel)->_resolve_join(
1478 $join->{$rel}, $as, $seen, [@$jpath, { $rel => $as }], $force_left
1486 $self->throw_exception("No idea how to resolve join reftype ".ref $join);
1489 my $count = ++$seen->{$join};
1490 my $as = $self->storage->relname_to_table_alias(
1491 $join, ($count > 1 && $count)
1494 my $rel_info = $self->relationship_info($join)
1495 or $self->throw_exception("No such relationship $join on " . $self->source_name);
1497 my $rel_src = $self->related_source($join);
1498 return [ { $as => $rel_src->from,
1500 -join_type => $parent_force_left
1502 : $rel_info->{attrs}{join_type}
1504 -join_path => [@$jpath, { $join => $as } ],
1506 $rel_info->{attrs}{accessor}
1508 first { $rel_info->{attrs}{accessor} eq $_ } (qw/single filter/)
1511 -relation_chain_depth => $seen->{-relation_chain_depth} || 0,
1513 scalar $self->_resolve_condition($rel_info->{cond}, $as, $alias, $join)
1519 carp 'pk_depends_on is a private method, stop calling it';
1521 $self->_pk_depends_on (@_);
1524 # Determines whether a relation is dependent on an object from this source
1525 # having already been inserted. Takes the name of the relationship and a
1526 # hashref of columns of the related object.
1527 sub _pk_depends_on {
1528 my ($self, $relname, $rel_data) = @_;
1530 my $relinfo = $self->relationship_info($relname);
1532 # don't assume things if the relationship direction is specified
1533 return $relinfo->{attrs}{is_foreign_key_constraint}
1534 if exists ($relinfo->{attrs}{is_foreign_key_constraint});
1536 my $cond = $relinfo->{cond};
1537 return 0 unless ref($cond) eq 'HASH';
1539 # map { foreign.foo => 'self.bar' } to { bar => 'foo' }
1540 my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond };
1542 # assume anything that references our PK probably is dependent on us
1543 # rather than vice versa, unless the far side is (a) defined or (b)
1545 my $rel_source = $self->related_source($relname);
1547 foreach my $p ($self->primary_columns) {
1548 if (exists $keyhash->{$p}) {
1549 unless (defined($rel_data->{$keyhash->{$p}})
1550 || $rel_source->column_info($keyhash->{$p})
1551 ->{is_auto_increment}) {
1560 sub resolve_condition {
1561 carp 'resolve_condition is a private method, stop calling it';
1563 $self->_resolve_condition (@_);
1566 our $UNRESOLVABLE_CONDITION = \ '1 = 0';
1568 # Resolves the passed condition to a concrete query fragment and a flag
1569 # indicating whether this is a cross-table condition. Also an optional
1570 # list of non-triviail values (notmally conditions) returned as a part
1571 # of a joinfree condition hash
1572 sub _resolve_condition {
1573 my ($self, $cond, $as, $for, $relname) = @_;
1575 my $obj_rel = !!blessed $for;
1577 if (ref $cond eq 'CODE') {
1578 my $relalias = $obj_rel ? 'me' : $as;
1580 my ($crosstable_cond, $joinfree_cond) = $cond->({
1581 self_alias => $obj_rel ? $as : $for,
1582 foreign_alias => $relalias,
1583 self_resultsource => $self,
1584 foreign_relname => $relname || ($obj_rel ? $as : $for),
1585 self_rowobj => $obj_rel ? $for : undef
1589 if ($joinfree_cond) {
1591 # FIXME sanity check until things stabilize, remove at some point
1592 $self->throw_exception (
1593 "A join-free condition returned for relationship '$relname' without a row-object to chain from"
1596 # FIXME another sanity check
1598 ref $joinfree_cond ne 'HASH'
1600 first { $_ !~ /^\Q$relalias.\E.+/ } keys %$joinfree_cond
1602 $self->throw_exception (
1603 "The join-free condition returned for relationship '$relname' must be a hash "
1604 .'reference with all keys being valid columns on the related result source'
1609 for (values %$joinfree_cond) {
1619 # see which parts of the joinfree cond are conditionals
1620 my $relcol_list = { map { $_ => 1 } $self->related_source($relname)->columns };
1622 for my $c (keys %$joinfree_cond) {
1623 my ($colname) = $c =~ /^ (?: \Q$relalias.\E )? (.+)/x;
1625 unless ($relcol_list->{$colname}) {
1626 push @$cond_cols, $colname;
1631 ref $joinfree_cond->{$c}
1633 ref $joinfree_cond->{$c} ne 'SCALAR'
1635 ref $joinfree_cond->{$c} ne 'REF'
1637 push @$cond_cols, $colname;
1642 return wantarray ? ($joinfree_cond, 0, $cond_cols) : $joinfree_cond;
1645 return wantarray ? ($crosstable_cond, 1) : $crosstable_cond;
1648 elsif (ref $cond eq 'HASH') {
1650 foreach my $k (keys %{$cond}) {
1651 my $v = $cond->{$k};
1652 # XXX should probably check these are valid columns
1653 $k =~ s/^foreign\.// ||
1654 $self->throw_exception("Invalid rel cond key ${k}");
1655 $v =~ s/^self\.// ||
1656 $self->throw_exception("Invalid rel cond val ${v}");
1657 if (ref $for) { # Object
1658 #warn "$self $k $for $v";
1659 unless ($for->has_column_loaded($v)) {
1660 if ($for->in_storage) {
1661 $self->throw_exception(sprintf
1662 "Unable to resolve relationship '%s' from object %s: column '%s' not "
1663 . 'loaded from storage (or not passed to new() prior to insert()). You '
1664 . 'probably need to call ->discard_changes to get the server-side defaults '
1665 . 'from the database.',
1671 return $UNRESOLVABLE_CONDITION;
1673 $ret{$k} = $for->get_column($v);
1674 #$ret{$k} = $for->get_column($v) if $for->has_column_loaded($v);
1676 } elsif (!defined $for) { # undef, i.e. "no object"
1678 } elsif (ref $as eq 'HASH') { # reverse hashref
1679 $ret{$v} = $as->{$k};
1680 } elsif (ref $as) { # reverse object
1681 $ret{$v} = $as->get_column($k);
1682 } elsif (!defined $as) { # undef, i.e. "no reverse object"
1685 $ret{"${as}.${k}"} = { -ident => "${for}.${v}" };
1690 ? ( \%ret, ($obj_rel || !defined $as || ref $as) ? 0 : 1 )
1694 elsif (ref $cond eq 'ARRAY') {
1695 my (@ret, $crosstable);
1697 my ($cond, $crosstab) = $self->_resolve_condition($_, $as, $for, $relname);
1699 $crosstable ||= $crosstab;
1701 return wantarray ? (\@ret, $crosstable) : \@ret;
1704 $self->throw_exception ("Can't handle condition $cond for relationship '$relname' yet :(");
1708 # Accepts one or more relationships for the current source and returns an
1709 # array of column names for each of those relationships. Column names are
1710 # prefixed relative to the current source, in accordance with where they appear
1711 # in the supplied relationships.
1713 sub _resolve_prefetch {
1714 my ($self, $pre, $alias, $alias_map, $order, $collapse, $pref_path) = @_;
1717 if (not defined $pre) {
1720 elsif( ref $pre eq 'ARRAY' ) {
1722 map { $self->_resolve_prefetch( $_, $alias, $alias_map, $order, $collapse, [ @$pref_path ] ) }
1725 elsif( ref $pre eq 'HASH' ) {
1728 $self->_resolve_prefetch($_, $alias, $alias_map, $order, $collapse, [ @$pref_path ] ),
1729 $self->related_source($_)->_resolve_prefetch(
1730 $pre->{$_}, "${alias}.$_", $alias_map, $order, $collapse, [ @$pref_path, $_] )
1735 $self->throw_exception(
1736 "don't know how to resolve prefetch reftype ".ref($pre));
1740 $p = $p->{$_} for (@$pref_path, $pre);
1742 $self->throw_exception (
1743 "Unable to resolve prefetch '$pre' - join alias map does not contain an entry for path: "
1744 . join (' -> ', @$pref_path, $pre)
1745 ) if (ref $p->{-join_aliases} ne 'ARRAY' or not @{$p->{-join_aliases}} );
1747 my $as = shift @{$p->{-join_aliases}};
1749 my $rel_info = $self->relationship_info( $pre );
1750 $self->throw_exception( $self->source_name . " has no such relationship '$pre'" )
1752 my $as_prefix = ($alias =~ /^.*?\.(.+)$/ ? $1.'.' : '');
1753 my $rel_source = $self->related_source($pre);
1755 if ($rel_info->{attrs}{accessor} && $rel_info->{attrs}{accessor} eq 'multi') {
1756 $self->throw_exception(
1757 "Can't prefetch has_many ${pre} (join cond too complex)")
1758 unless ref($rel_info->{cond}) eq 'HASH';
1759 my $dots = @{[$as_prefix =~ m/\./g]} + 1; # +1 to match the ".${as_prefix}"
1761 if (my ($fail) = grep { @{[$_ =~ m/\./g]} == $dots }
1762 keys %{$collapse}) {
1763 my ($last) = ($fail =~ /([^\.]+)$/);
1765 "Prefetching multiple has_many rels ${last} and ${pre} "
1766 .(length($as_prefix)
1767 ? "at the same level (${as_prefix}) "
1770 . 'will explode the number of row objects retrievable via ->next or ->all. '
1771 . 'Use at your own risk.'
1775 #my @col = map { (/^self\.(.+)$/ ? ("${as_prefix}.$1") : ()); }
1776 # values %{$rel_info->{cond}};
1777 $collapse->{".${as_prefix}${pre}"} = [ $rel_source->_pri_cols ];
1778 # action at a distance. prepending the '.' allows simpler code
1779 # in ResultSet->_collapse_result
1780 my @key = map { (/^foreign\.(.+)$/ ? ($1) : ()); }
1781 keys %{$rel_info->{cond}};
1782 push @$order, map { "${as}.$_" } @key;
1784 if (my $rel_order = $rel_info->{attrs}{order_by}) {
1785 # this is kludgy and incomplete, I am well aware
1786 # but the parent method is going away entirely anyway
1788 my $sql_maker = $self->storage->sql_maker;
1789 my ($orig_ql, $orig_qr) = $sql_maker->_quote_chars;
1790 my $sep = $sql_maker->name_sep;
1792 # install our own quoter, so we can catch unqualified stuff
1793 local $sql_maker->{quote_char} = ["\x00", "\xFF"];
1795 my $quoted_prefix = "\x00${as}\xFF";
1797 for my $chunk ( $sql_maker->_order_by_chunks ($rel_order) ) {
1799 ($chunk, @bind) = @$chunk if ref $chunk;
1801 $chunk = "${quoted_prefix}${sep}${chunk}"
1802 unless $chunk =~ /\Q$sep/;
1804 $chunk =~ s/\x00/$orig_ql/g;
1805 $chunk =~ s/\xFF/$orig_qr/g;
1806 push @$order, \[$chunk, @bind];
1811 return map { [ "${as}.$_", "${as_prefix}${pre}.$_", ] }
1812 $rel_source->columns;
1816 =head2 related_source
1820 =item Arguments: $relname
1822 =item Return value: $source
1826 Returns the result source object for the given relationship.
1830 sub related_source {
1831 my ($self, $rel) = @_;
1832 if( !$self->has_relationship( $rel ) ) {
1833 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
1836 # if we are not registered with a schema - just use the prototype
1837 # however if we do have a schema - ask for the source by name (and
1838 # throw in the process if all fails)
1839 if (my $schema = try { $self->schema }) {
1840 $schema->source($self->relationship_info($rel)->{source});
1843 my $class = $self->relationship_info($rel)->{class};
1844 $self->ensure_class_loaded($class);
1845 $class->result_source_instance;
1849 =head2 related_class
1853 =item Arguments: $relname
1855 =item Return value: $classname
1859 Returns the class name for objects in the given relationship.
1864 my ($self, $rel) = @_;
1865 if( !$self->has_relationship( $rel ) ) {
1866 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
1868 return $self->schema->class($self->relationship_info($rel)->{source});
1875 =item Arguments: None
1877 =item Return value: $source_handle
1881 Obtain a new L<result source handle instance|DBIx::Class::ResultSourceHandle>
1882 for this source. Used as a serializable pointer to this resultsource, as it is not
1883 easy (nor advisable) to serialize CODErefs which may very well be present in e.g.
1884 relationship definitions.
1889 return DBIx::Class::ResultSourceHandle->new({
1890 source_moniker => $_[0]->source_name,
1892 # so that a detached thaw can be re-frozen
1893 $_[0]->{_detached_thaw}
1894 ? ( _detached_source => $_[0] )
1895 : ( schema => $_[0]->schema )
1901 my $global_phase_destroy;
1903 # SpeedyCGI runs END blocks every cycle but keeps object instances
1904 # hence we have to disable the globaldestroy hatch, and rely on the
1905 # eval trap below (which appears to work, but is risky done so late)
1906 END { $global_phase_destroy = 1 unless $CGI::SpeedyCGI::i_am_speedy }
1909 return if $global_phase_destroy;
1915 # Under no circumstances shall $_[0] be stored anywhere else (like copied to
1916 # a lexical variable, or shifted, or anything else). Doing so will mess up
1917 # the refcount of this particular result source, and will allow the $schema
1918 # we are trying to save to reattach back to the source we are destroying.
1919 # The relevant code checking refcounts is in ::Schema::DESTROY()
1921 # if we are not a schema instance holder - we don't matter
1923 ! ref $_[0]->{schema}
1925 isweak $_[0]->{schema}
1928 # weaken our schema hold forcing the schema to find somewhere else to live
1929 # during global destruction (if we have not yet bailed out) this will throw
1930 # which will serve as a signal to not try doing anything else
1933 weaken $_[0]->{schema};
1936 $global_phase_destroy = 1;
1941 # if schema is still there reintroduce ourselves with strong refs back to us
1942 if ($_[0]->{schema}) {
1943 my $srcregs = $_[0]->{schema}->source_registrations;
1944 for (keys %$srcregs) {
1945 next unless $srcregs->{$_};
1946 $srcregs->{$_} = $_[0] if $srcregs->{$_} == $_[0];
1952 sub STORABLE_freeze { Storable::nfreeze($_[0]->handle) }
1955 my ($self, $cloning, $ice) = @_;
1956 %$self = %{ (Storable::thaw($ice))->resolve };
1959 =head2 throw_exception
1961 See L<DBIx::Class::Schema/"throw_exception">.
1965 sub throw_exception {
1969 ? $self->{schema}->throw_exception(@_)
1970 : DBIx::Class::Exception->throw(@_)
1976 Stores a hashref of per-source metadata. No specific key names
1977 have yet been standardized, the examples below are purely hypothetical
1978 and don't actually accomplish anything on their own:
1980 __PACKAGE__->source_info({
1981 "_tablespace" => 'fast_disk_array_3',
1982 "_engine" => 'InnoDB',
1989 $class->new({attribute_name => value});
1991 Creates a new ResultSource object. Not normally called directly by end users.
1993 =head2 column_info_from_storage
1997 =item Arguments: 1/0 (default: 0)
1999 =item Return value: 1/0
2003 __PACKAGE__->column_info_from_storage(1);
2005 Enables the on-demand automatic loading of the above column
2006 metadata from storage as necessary. This is *deprecated*, and
2007 should not be used. It will be removed before 1.0.
2012 Matt S. Trout <mst@shadowcatsystems.co.uk>
2016 You may distribute this code under the same terms as Perl itself.