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: None
1050 =item Result value: $name
1054 Returns the name of the result source, which will typically be the table
1055 name. This may be a scalar reference if the result source has a non-standard
1062 =item Arguments: $source_name
1064 =item Result value: $source_name
1068 Set an alternate name for the result source when it is loaded into a schema.
1069 This is useful if you want to refer to a result source by a name other than
1072 package ArchivedBooks;
1073 use base qw/DBIx::Class/;
1074 __PACKAGE__->table('books_archive');
1075 __PACKAGE__->source_name('Books');
1077 # from your schema...
1078 $schema->resultset('Books')->find(1);
1084 =item Arguments: None
1086 =item Return value: FROM clause
1090 my $from_clause = $source->from();
1092 Returns an expression of the source to be supplied to storage to specify
1093 retrieval from this source. In the case of a database, the required FROM
1098 sub from { die 'Virtual method!' }
1104 =item Arguments: $schema
1106 =item Return value: A schema object
1110 my $schema = $source->schema();
1112 Sets and/or returns the L<DBIx::Class::Schema> object to which this
1113 result source instance has been attached to.
1119 $_[0]->{schema} = $_[1];
1122 $_[0]->{schema} || do {
1123 my $name = $_[0]->{source_name} || '_unnamed_';
1124 my $err = 'Unable to perform storage-dependent operations with a detached result source '
1125 . "(source '$name' is not associated with a schema).";
1127 $err .= ' You need to use $schema->thaw() or manually set'
1128 . ' $DBIx::Class::ResultSourceHandle::thaw_schema while thawing.'
1129 if $_[0]->{_detached_thaw};
1131 DBIx::Class::Exception->throw($err);
1140 =item Arguments: None
1142 =item Return value: A Storage object
1146 $source->storage->debug(1);
1148 Returns the storage handle for the current schema.
1150 See also: L<DBIx::Class::Storage>
1154 sub storage { shift->schema->storage; }
1156 =head2 add_relationship
1160 =item Arguments: $relname, $related_source_name, \%cond, [ \%attrs ]
1162 =item Return value: 1/true if it succeeded
1166 $source->add_relationship('relname', 'related_source', $cond, $attrs);
1168 L<DBIx::Class::Relationship> describes a series of methods which
1169 create pre-defined useful types of relationships. Look there first
1170 before using this method directly.
1172 The relationship name can be arbitrary, but must be unique for each
1173 relationship attached to this result source. 'related_source' should
1174 be the name with which the related result source was registered with
1175 the current schema. For example:
1177 $schema->source('Book')->add_relationship('reviews', 'Review', {
1178 'foreign.book_id' => 'self.id',
1181 The condition C<$cond> needs to be an L<SQL::Abstract>-style
1182 representation of the join between the tables. For example, if you're
1183 creating a relation from Author to Book,
1185 { 'foreign.author_id' => 'self.id' }
1187 will result in the JOIN clause
1189 author me JOIN book foreign ON foreign.author_id = me.id
1191 You can specify as many foreign => self mappings as necessary.
1193 Valid attributes are as follows:
1199 Explicitly specifies the type of join to use in the relationship. Any
1200 SQL join type is valid, e.g. C<LEFT> or C<RIGHT>. It will be placed in
1201 the SQL command immediately before C<JOIN>.
1205 An arrayref containing a list of accessors in the foreign class to proxy in
1206 the main class. If, for example, you do the following:
1208 CD->might_have(liner_notes => 'LinerNotes', undef, {
1209 proxy => [ qw/notes/ ],
1212 Then, assuming LinerNotes has an accessor named notes, you can do:
1214 my $cd = CD->find(1);
1215 # set notes -- LinerNotes object is created if it doesn't exist
1216 $cd->notes('Notes go here');
1220 Specifies the type of accessor that should be created for the
1221 relationship. Valid values are C<single> (for when there is only a single
1222 related object), C<multi> (when there can be many), and C<filter> (for
1223 when there is a single related object, but you also want the relationship
1224 accessor to double as a column accessor). For C<multi> accessors, an
1225 add_to_* method is also created, which calls C<create_related> for the
1230 Throws an exception if the condition is improperly supplied, or cannot
1235 sub add_relationship {
1236 my ($self, $rel, $f_source_name, $cond, $attrs) = @_;
1237 $self->throw_exception("Can't create relationship without join condition")
1241 # Check foreign and self are right in cond
1242 if ( (ref $cond ||'') eq 'HASH') {
1244 $self->throw_exception("Keys of condition should be of form 'foreign.col', not '$_'")
1245 if /\./ && !/^foreign\./;
1249 my %rels = %{ $self->_relationships };
1250 $rels{$rel} = { class => $f_source_name,
1251 source => $f_source_name,
1254 $self->_relationships(\%rels);
1258 # XXX disabled. doesn't work properly currently. skip in tests.
1260 my $f_source = $self->schema->source($f_source_name);
1261 unless ($f_source) {
1262 $self->ensure_class_loaded($f_source_name);
1263 $f_source = $f_source_name->result_source;
1264 #my $s_class = ref($self->schema);
1265 #$f_source_name =~ m/^${s_class}::(.*)$/;
1266 #$self->schema->register_class(($1 || $f_source_name), $f_source_name);
1267 #$f_source = $self->schema->source($f_source_name);
1269 return unless $f_source; # Can't test rel without f_source
1271 try { $self->_resolve_join($rel, 'me', {}, []) }
1273 # If the resolve failed, back out and re-throw the error
1275 $self->_relationships(\%rels);
1276 $self->throw_exception("Error creating relationship $rel: $_");
1282 =head2 relationships
1286 =item Arguments: None
1288 =item Return value: List of relationship names
1292 my @relnames = $source->relationships();
1294 Returns all relationship names for this source.
1299 return keys %{shift->_relationships};
1302 =head2 relationship_info
1306 =item Arguments: $relname
1308 =item Return value: Hashref of relation data,
1312 Returns a hash of relationship information for the specified relationship
1313 name. The keys/values are as specified for L</add_relationship>.
1317 sub relationship_info {
1318 my ($self, $rel) = @_;
1319 return $self->_relationships->{$rel};
1322 =head2 has_relationship
1326 =item Arguments: $rel
1328 =item Return value: 1/0 (true/false)
1332 Returns true if the source has a relationship of this name, false otherwise.
1336 sub has_relationship {
1337 my ($self, $rel) = @_;
1338 return exists $self->_relationships->{$rel};
1341 =head2 reverse_relationship_info
1345 =item Arguments: $relname
1347 =item Return value: Hashref of relationship data
1351 Looks through all the relationships on the source this relationship
1352 points to, looking for one whose condition is the reverse of the
1353 condition on this relationship.
1355 A common use of this is to find the name of the C<belongs_to> relation
1356 opposing a C<has_many> relation. For definition of these look in
1357 L<DBIx::Class::Relationship>.
1359 The returned hashref is keyed by the name of the opposing
1360 relationship, and contains its data in the same manner as
1361 L</relationship_info>.
1365 sub reverse_relationship_info {
1366 my ($self, $rel) = @_;
1368 my $rel_info = $self->relationship_info($rel)
1369 or $self->throw_exception("No such relationship '$rel'");
1373 return $ret unless ((ref $rel_info->{cond}) eq 'HASH');
1375 my $stripped_cond = $self->__strip_relcond ($rel_info->{cond});
1377 my $rsrc_schema_moniker = $self->source_name
1378 if try { $self->schema };
1380 # this may be a partial schema or something else equally esoteric
1381 my $other_rsrc = try { $self->related_source($rel) }
1384 # Get all the relationships for that source that related to this source
1385 # whose foreign column set are our self columns on $rel and whose self
1386 # columns are our foreign columns on $rel
1387 foreach my $other_rel ($other_rsrc->relationships) {
1389 # only consider stuff that points back to us
1390 # "us" here is tricky - if we are in a schema registration, we want
1391 # to use the source_names, otherwise we will use the actual classes
1393 # the schema may be partial
1394 my $roundtrip_rsrc = try { $other_rsrc->related_source($other_rel) }
1397 if ($rsrc_schema_moniker and try { $roundtrip_rsrc->schema } ) {
1398 next unless $rsrc_schema_moniker eq $roundtrip_rsrc->source_name;
1401 next unless $self->result_class eq $roundtrip_rsrc->result_class;
1404 my $other_rel_info = $other_rsrc->relationship_info($other_rel);
1406 # this can happen when we have a self-referential class
1407 next if $other_rel_info eq $rel_info;
1409 next unless ref $other_rel_info->{cond} eq 'HASH';
1410 my $other_stripped_cond = $self->__strip_relcond($other_rel_info->{cond});
1412 $ret->{$other_rel} = $other_rel_info if (
1413 $self->_compare_relationship_keys (
1414 [ keys %$stripped_cond ], [ values %$other_stripped_cond ]
1417 $self->_compare_relationship_keys (
1418 [ values %$stripped_cond ], [ keys %$other_stripped_cond ]
1426 # all this does is removes the foreign/self prefix from a condition
1427 sub __strip_relcond {
1430 { map { /^ (?:foreign|self) \. (\w+) $/x } ($_, $_[1]{$_}) }
1435 sub compare_relationship_keys {
1436 carp 'compare_relationship_keys is a private method, stop calling it';
1438 $self->_compare_relationship_keys (@_);
1441 # Returns true if both sets of keynames are the same, false otherwise.
1442 sub _compare_relationship_keys {
1443 # my ($self, $keys1, $keys2) = @_;
1445 join ("\x00", sort @{$_[1]})
1447 join ("\x00", sort @{$_[2]})
1451 # Returns the {from} structure used to express JOIN conditions
1453 my ($self, $join, $alias, $seen, $jpath, $parent_force_left) = @_;
1455 # we need a supplied one, because we do in-place modifications, no returns
1456 $self->throw_exception ('You must supply a seen hashref as the 3rd argument to _resolve_join')
1457 unless ref $seen eq 'HASH';
1459 $self->throw_exception ('You must supply a joinpath arrayref as the 4th argument to _resolve_join')
1460 unless ref $jpath eq 'ARRAY';
1462 $jpath = [@$jpath]; # copy
1464 if (not defined $join) {
1467 elsif (ref $join eq 'ARRAY') {
1470 $self->_resolve_join($_, $alias, $seen, $jpath, $parent_force_left);
1473 elsif (ref $join eq 'HASH') {
1476 for my $rel (keys %$join) {
1478 my $rel_info = $self->relationship_info($rel)
1479 or $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
1481 my $force_left = $parent_force_left;
1482 $force_left ||= lc($rel_info->{attrs}{join_type}||'') eq 'left';
1484 # the actual seen value will be incremented by the recursion
1485 my $as = $self->storage->relname_to_table_alias(
1486 $rel, ($seen->{$rel} && $seen->{$rel} + 1)
1490 $self->_resolve_join($rel, $alias, $seen, [@$jpath], $force_left),
1491 $self->related_source($rel)->_resolve_join(
1492 $join->{$rel}, $as, $seen, [@$jpath, { $rel => $as }], $force_left
1500 $self->throw_exception("No idea how to resolve join reftype ".ref $join);
1503 my $count = ++$seen->{$join};
1504 my $as = $self->storage->relname_to_table_alias(
1505 $join, ($count > 1 && $count)
1508 my $rel_info = $self->relationship_info($join)
1509 or $self->throw_exception("No such relationship $join on " . $self->source_name);
1511 my $rel_src = $self->related_source($join);
1512 return [ { $as => $rel_src->from,
1514 -join_type => $parent_force_left
1516 : $rel_info->{attrs}{join_type}
1518 -join_path => [@$jpath, { $join => $as } ],
1520 $rel_info->{attrs}{accessor}
1522 first { $rel_info->{attrs}{accessor} eq $_ } (qw/single filter/)
1525 -relation_chain_depth => $seen->{-relation_chain_depth} || 0,
1527 scalar $self->_resolve_condition($rel_info->{cond}, $as, $alias, $join)
1533 carp 'pk_depends_on is a private method, stop calling it';
1535 $self->_pk_depends_on (@_);
1538 # Determines whether a relation is dependent on an object from this source
1539 # having already been inserted. Takes the name of the relationship and a
1540 # hashref of columns of the related object.
1541 sub _pk_depends_on {
1542 my ($self, $relname, $rel_data) = @_;
1544 my $relinfo = $self->relationship_info($relname);
1546 # don't assume things if the relationship direction is specified
1547 return $relinfo->{attrs}{is_foreign_key_constraint}
1548 if exists ($relinfo->{attrs}{is_foreign_key_constraint});
1550 my $cond = $relinfo->{cond};
1551 return 0 unless ref($cond) eq 'HASH';
1553 # map { foreign.foo => 'self.bar' } to { bar => 'foo' }
1554 my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond };
1556 # assume anything that references our PK probably is dependent on us
1557 # rather than vice versa, unless the far side is (a) defined or (b)
1559 my $rel_source = $self->related_source($relname);
1561 foreach my $p ($self->primary_columns) {
1562 if (exists $keyhash->{$p}) {
1563 unless (defined($rel_data->{$keyhash->{$p}})
1564 || $rel_source->column_info($keyhash->{$p})
1565 ->{is_auto_increment}) {
1574 sub resolve_condition {
1575 carp 'resolve_condition is a private method, stop calling it';
1577 $self->_resolve_condition (@_);
1580 our $UNRESOLVABLE_CONDITION = \ '1 = 0';
1582 # Resolves the passed condition to a concrete query fragment and a flag
1583 # indicating whether this is a cross-table condition. Also an optional
1584 # list of non-triviail values (notmally conditions) returned as a part
1585 # of a joinfree condition hash
1586 sub _resolve_condition {
1587 my ($self, $cond, $as, $for, $relname) = @_;
1589 my $obj_rel = !!blessed $for;
1591 if (ref $cond eq 'CODE') {
1592 my $relalias = $obj_rel ? 'me' : $as;
1594 my ($crosstable_cond, $joinfree_cond) = $cond->({
1595 self_alias => $obj_rel ? $as : $for,
1596 foreign_alias => $relalias,
1597 self_resultsource => $self,
1598 foreign_relname => $relname || ($obj_rel ? $as : $for),
1599 self_rowobj => $obj_rel ? $for : undef
1603 if ($joinfree_cond) {
1605 # FIXME sanity check until things stabilize, remove at some point
1606 $self->throw_exception (
1607 "A join-free condition returned for relationship '$relname' without a row-object to chain from"
1610 # FIXME another sanity check
1612 ref $joinfree_cond ne 'HASH'
1614 first { $_ !~ /^\Q$relalias.\E.+/ } keys %$joinfree_cond
1616 $self->throw_exception (
1617 "The join-free condition returned for relationship '$relname' must be a hash "
1618 .'reference with all keys being valid columns on the related result source'
1623 for (values %$joinfree_cond) {
1633 # see which parts of the joinfree cond are conditionals
1634 my $relcol_list = { map { $_ => 1 } $self->related_source($relname)->columns };
1636 for my $c (keys %$joinfree_cond) {
1637 my ($colname) = $c =~ /^ (?: \Q$relalias.\E )? (.+)/x;
1639 unless ($relcol_list->{$colname}) {
1640 push @$cond_cols, $colname;
1645 ref $joinfree_cond->{$c}
1647 ref $joinfree_cond->{$c} ne 'SCALAR'
1649 ref $joinfree_cond->{$c} ne 'REF'
1651 push @$cond_cols, $colname;
1656 return wantarray ? ($joinfree_cond, 0, $cond_cols) : $joinfree_cond;
1659 return wantarray ? ($crosstable_cond, 1) : $crosstable_cond;
1662 elsif (ref $cond eq 'HASH') {
1664 foreach my $k (keys %{$cond}) {
1665 my $v = $cond->{$k};
1666 # XXX should probably check these are valid columns
1667 $k =~ s/^foreign\.// ||
1668 $self->throw_exception("Invalid rel cond key ${k}");
1669 $v =~ s/^self\.// ||
1670 $self->throw_exception("Invalid rel cond val ${v}");
1671 if (ref $for) { # Object
1672 #warn "$self $k $for $v";
1673 unless ($for->has_column_loaded($v)) {
1674 if ($for->in_storage) {
1675 $self->throw_exception(sprintf
1676 "Unable to resolve relationship '%s' from object %s: column '%s' not "
1677 . 'loaded from storage (or not passed to new() prior to insert()). You '
1678 . 'probably need to call ->discard_changes to get the server-side defaults '
1679 . 'from the database.',
1685 return $UNRESOLVABLE_CONDITION;
1687 $ret{$k} = $for->get_column($v);
1688 #$ret{$k} = $for->get_column($v) if $for->has_column_loaded($v);
1690 } elsif (!defined $for) { # undef, i.e. "no object"
1692 } elsif (ref $as eq 'HASH') { # reverse hashref
1693 $ret{$v} = $as->{$k};
1694 } elsif (ref $as) { # reverse object
1695 $ret{$v} = $as->get_column($k);
1696 } elsif (!defined $as) { # undef, i.e. "no reverse object"
1699 $ret{"${as}.${k}"} = { -ident => "${for}.${v}" };
1704 ? ( \%ret, ($obj_rel || !defined $as || ref $as) ? 0 : 1 )
1708 elsif (ref $cond eq 'ARRAY') {
1709 my (@ret, $crosstable);
1711 my ($cond, $crosstab) = $self->_resolve_condition($_, $as, $for, $relname);
1713 $crosstable ||= $crosstab;
1715 return wantarray ? (\@ret, $crosstable) : \@ret;
1718 $self->throw_exception ("Can't handle condition $cond for relationship '$relname' yet :(");
1722 # Accepts one or more relationships for the current source and returns an
1723 # array of column names for each of those relationships. Column names are
1724 # prefixed relative to the current source, in accordance with where they appear
1725 # in the supplied relationships.
1727 sub _resolve_prefetch {
1728 my ($self, $pre, $alias, $alias_map, $order, $collapse, $pref_path) = @_;
1731 if (not defined $pre) {
1734 elsif( ref $pre eq 'ARRAY' ) {
1736 map { $self->_resolve_prefetch( $_, $alias, $alias_map, $order, $collapse, [ @$pref_path ] ) }
1739 elsif( ref $pre eq 'HASH' ) {
1742 $self->_resolve_prefetch($_, $alias, $alias_map, $order, $collapse, [ @$pref_path ] ),
1743 $self->related_source($_)->_resolve_prefetch(
1744 $pre->{$_}, "${alias}.$_", $alias_map, $order, $collapse, [ @$pref_path, $_] )
1749 $self->throw_exception(
1750 "don't know how to resolve prefetch reftype ".ref($pre));
1754 $p = $p->{$_} for (@$pref_path, $pre);
1756 $self->throw_exception (
1757 "Unable to resolve prefetch '$pre' - join alias map does not contain an entry for path: "
1758 . join (' -> ', @$pref_path, $pre)
1759 ) if (ref $p->{-join_aliases} ne 'ARRAY' or not @{$p->{-join_aliases}} );
1761 my $as = shift @{$p->{-join_aliases}};
1763 my $rel_info = $self->relationship_info( $pre );
1764 $self->throw_exception( $self->source_name . " has no such relationship '$pre'" )
1766 my $as_prefix = ($alias =~ /^.*?\.(.+)$/ ? $1.'.' : '');
1767 my $rel_source = $self->related_source($pre);
1769 if ($rel_info->{attrs}{accessor} && $rel_info->{attrs}{accessor} eq 'multi') {
1770 $self->throw_exception(
1771 "Can't prefetch has_many ${pre} (join cond too complex)")
1772 unless ref($rel_info->{cond}) eq 'HASH';
1773 my $dots = @{[$as_prefix =~ m/\./g]} + 1; # +1 to match the ".${as_prefix}"
1775 if (my ($fail) = grep { @{[$_ =~ m/\./g]} == $dots }
1776 keys %{$collapse}) {
1777 my ($last) = ($fail =~ /([^\.]+)$/);
1779 "Prefetching multiple has_many rels ${last} and ${pre} "
1780 .(length($as_prefix)
1781 ? "at the same level (${as_prefix}) "
1784 . 'will explode the number of row objects retrievable via ->next or ->all. '
1785 . 'Use at your own risk.'
1789 #my @col = map { (/^self\.(.+)$/ ? ("${as_prefix}.$1") : ()); }
1790 # values %{$rel_info->{cond}};
1791 $collapse->{".${as_prefix}${pre}"} = [ $rel_source->_pri_cols ];
1792 # action at a distance. prepending the '.' allows simpler code
1793 # in ResultSet->_collapse_result
1794 my @key = map { (/^foreign\.(.+)$/ ? ($1) : ()); }
1795 keys %{$rel_info->{cond}};
1796 push @$order, map { "${as}.$_" } @key;
1798 if (my $rel_order = $rel_info->{attrs}{order_by}) {
1799 # this is kludgy and incomplete, I am well aware
1800 # but the parent method is going away entirely anyway
1802 my $sql_maker = $self->storage->sql_maker;
1803 my ($orig_ql, $orig_qr) = $sql_maker->_quote_chars;
1804 my $sep = $sql_maker->name_sep;
1806 # install our own quoter, so we can catch unqualified stuff
1807 local $sql_maker->{quote_char} = ["\x00", "\xFF"];
1809 my $quoted_prefix = "\x00${as}\xFF";
1811 for my $chunk ( $sql_maker->_order_by_chunks ($rel_order) ) {
1813 ($chunk, @bind) = @$chunk if ref $chunk;
1815 $chunk = "${quoted_prefix}${sep}${chunk}"
1816 unless $chunk =~ /\Q$sep/;
1818 $chunk =~ s/\x00/$orig_ql/g;
1819 $chunk =~ s/\xFF/$orig_qr/g;
1820 push @$order, \[$chunk, @bind];
1825 return map { [ "${as}.$_", "${as_prefix}${pre}.$_", ] }
1826 $rel_source->columns;
1830 =head2 related_source
1834 =item Arguments: $relname
1836 =item Return value: $source
1840 Returns the result source object for the given relationship.
1844 sub related_source {
1845 my ($self, $rel) = @_;
1846 if( !$self->has_relationship( $rel ) ) {
1847 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
1850 # if we are not registered with a schema - just use the prototype
1851 # however if we do have a schema - ask for the source by name (and
1852 # throw in the process if all fails)
1853 if (my $schema = try { $self->schema }) {
1854 $schema->source($self->relationship_info($rel)->{source});
1857 my $class = $self->relationship_info($rel)->{class};
1858 $self->ensure_class_loaded($class);
1859 $class->result_source_instance;
1863 =head2 related_class
1867 =item Arguments: $relname
1869 =item Return value: $classname
1873 Returns the class name for objects in the given relationship.
1878 my ($self, $rel) = @_;
1879 if( !$self->has_relationship( $rel ) ) {
1880 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
1882 return $self->schema->class($self->relationship_info($rel)->{source});
1889 =item Arguments: None
1891 =item Return value: $source_handle
1895 Obtain a new L<result source handle instance|DBIx::Class::ResultSourceHandle>
1896 for this source. Used as a serializable pointer to this resultsource, as it is not
1897 easy (nor advisable) to serialize CODErefs which may very well be present in e.g.
1898 relationship definitions.
1903 return DBIx::Class::ResultSourceHandle->new({
1904 source_moniker => $_[0]->source_name,
1906 # so that a detached thaw can be re-frozen
1907 $_[0]->{_detached_thaw}
1908 ? ( _detached_source => $_[0] )
1909 : ( schema => $_[0]->schema )
1915 my $global_phase_destroy;
1917 # SpeedyCGI runs END blocks every cycle but keeps object instances
1918 # hence we have to disable the globaldestroy hatch, and rely on the
1919 # eval trap below (which appears to work, but is risky done so late)
1920 END { $global_phase_destroy = 1 unless $CGI::SpeedyCGI::i_am_speedy }
1923 return if $global_phase_destroy;
1929 # Under no circumstances shall $_[0] be stored anywhere else (like copied to
1930 # a lexical variable, or shifted, or anything else). Doing so will mess up
1931 # the refcount of this particular result source, and will allow the $schema
1932 # we are trying to save to reattach back to the source we are destroying.
1933 # The relevant code checking refcounts is in ::Schema::DESTROY()
1935 # if we are not a schema instance holder - we don't matter
1937 ! ref $_[0]->{schema}
1939 isweak $_[0]->{schema}
1942 # weaken our schema hold forcing the schema to find somewhere else to live
1943 # during global destruction (if we have not yet bailed out) this will throw
1944 # which will serve as a signal to not try doing anything else
1947 weaken $_[0]->{schema};
1950 $global_phase_destroy = 1;
1955 # if schema is still there reintroduce ourselves with strong refs back to us
1956 if ($_[0]->{schema}) {
1957 my $srcregs = $_[0]->{schema}->source_registrations;
1958 for (keys %$srcregs) {
1959 next unless $srcregs->{$_};
1960 $srcregs->{$_} = $_[0] if $srcregs->{$_} == $_[0];
1966 sub STORABLE_freeze { Storable::nfreeze($_[0]->handle) }
1969 my ($self, $cloning, $ice) = @_;
1970 %$self = %{ (Storable::thaw($ice))->resolve };
1973 =head2 throw_exception
1975 See L<DBIx::Class::Schema/"throw_exception">.
1979 sub throw_exception {
1983 ? $self->{schema}->throw_exception(@_)
1984 : DBIx::Class::Exception->throw(@_)
1990 Stores a hashref of per-source metadata. No specific key names
1991 have yet been standardized, the examples below are purely hypothetical
1992 and don't actually accomplish anything on their own:
1994 __PACKAGE__->source_info({
1995 "_tablespace" => 'fast_disk_array_3',
1996 "_engine" => 'InnoDB',
2003 $class->new({attribute_name => value});
2005 Creates a new ResultSource object. Not normally called directly by end users.
2007 =head2 column_info_from_storage
2011 =item Arguments: 1/0 (default: 0)
2013 =item Return value: 1/0
2017 __PACKAGE__->column_info_from_storage(1);
2019 Enables the on-demand automatic loading of the above column
2020 metadata from storage as necessary. This is *deprecated*, and
2021 should not be used. It will be removed before 1.0.
2026 Matt S. Trout <mst@shadowcatsystems.co.uk>
2030 You may distribute this code under the same terms as Perl itself.