1 package DBIx::Class::ResultSource;
6 use base qw/DBIx::Class::ResultSource::RowParser DBIx::Class/;
8 use DBIx::Class::ResultSet;
9 use DBIx::Class::ResultSourceHandle;
11 use DBIx::Class::Carp;
12 use DBIx::Class::_Util 'UNRESOLVABLE_CONDITION';
13 use SQL::Abstract 'is_literal_value';
14 use Devel::GlobalDestruction;
16 use List::Util 'first';
17 use Scalar::Util qw/blessed weaken isweak/;
21 __PACKAGE__->mk_group_accessors(simple => qw/
22 source_name name source_info
23 _ordered_columns _columns _primaries _unique_constraints
24 _relationships resultset_attributes
25 column_info_from_storage
28 __PACKAGE__->mk_group_accessors(component_class => qw/
33 __PACKAGE__->mk_classdata( sqlt_deploy_callback => 'default_sqlt_deploy_hook' );
37 DBIx::Class::ResultSource - Result source object
41 # Create a table based result source, in a result class.
43 package MyApp::Schema::Result::Artist;
44 use base qw/DBIx::Class::Core/;
46 __PACKAGE__->table('artist');
47 __PACKAGE__->add_columns(qw/ artistid name /);
48 __PACKAGE__->set_primary_key('artistid');
49 __PACKAGE__->has_many(cds => 'MyApp::Schema::Result::CD');
53 # Create a query (view) based result source, in a result class
54 package MyApp::Schema::Result::Year2000CDs;
55 use base qw/DBIx::Class::Core/;
57 __PACKAGE__->load_components('InflateColumn::DateTime');
58 __PACKAGE__->table_class('DBIx::Class::ResultSource::View');
60 __PACKAGE__->table('year2000cds');
61 __PACKAGE__->result_source_instance->is_virtual(1);
62 __PACKAGE__->result_source_instance->view_definition(
63 "SELECT cdid, artist, title FROM cd WHERE year ='2000'"
69 A ResultSource is an object that represents a source of data for querying.
71 This class is a base class for various specialised types of result
72 sources, for example L<DBIx::Class::ResultSource::Table>. Table is the
73 default result source type, so one is created for you when defining a
74 result class as described in the synopsis above.
76 More specifically, the L<DBIx::Class::Core> base class pulls in the
77 L<DBIx::Class::ResultSourceProxy::Table> component, which defines
78 the L<table|DBIx::Class::ResultSourceProxy::Table/table> method.
79 When called, C<table> creates and stores an instance of
80 L<DBIx::Class::ResultSource::Table>. Luckily, to use tables as result
81 sources, you don't need to remember any of this.
83 Result sources representing select queries, or views, can also be
84 created, see L<DBIx::Class::ResultSource::View> for full details.
86 =head2 Finding result source objects
88 As mentioned above, a result source instance is created and stored for
90 L<Result Class|DBIx::Class::Manual::Glossary/Result Class>.
92 You can retrieve the result source at runtime in the following ways:
96 =item From a Schema object:
98 $schema->source($source_name);
100 =item From a Result object:
102 $result->result_source;
104 =item From a ResultSet object:
116 $class->new({attribute_name => value});
118 Creates a new ResultSource object. Not normally called directly by end users.
123 my ($class, $attrs) = @_;
124 $class = ref $class if ref $class;
126 my $new = bless { %{$attrs || {}} }, $class;
127 $new->{resultset_class} ||= 'DBIx::Class::ResultSet';
128 $new->{resultset_attributes} = { %{$new->{resultset_attributes} || {}} };
129 $new->{_ordered_columns} = [ @{$new->{_ordered_columns}||[]}];
130 $new->{_columns} = { %{$new->{_columns}||{}} };
131 $new->{_relationships} = { %{$new->{_relationships}||{}} };
132 $new->{name} ||= "!!NAME NOT SET!!";
133 $new->{_columns_info_loaded} ||= 0;
143 =item Arguments: @columns
145 =item Return Value: L<$result_source|/new>
149 $source->add_columns(qw/col1 col2 col3/);
151 $source->add_columns('col1' => \%col1_info, 'col2' => \%col2_info, ...);
153 $source->add_columns(
154 'col1' => { data_type => 'integer', is_nullable => 1, ... },
155 'col2' => { data_type => 'text', is_auto_increment => 1, ... },
158 Adds columns to the result source. If supplied colname => hashref
159 pairs, uses the hashref as the L</column_info> for that column. Repeated
160 calls of this method will add more columns, not replace them.
162 The column names given will be created as accessor methods on your
163 L<Result|DBIx::Class::Manual::ResultClass> objects. You can change the name of the accessor
164 by supplying an L</accessor> in the column_info hash.
166 If a column name beginning with a plus sign ('+col1') is provided, the
167 attributes provided will be merged with any existing attributes for the
168 column, with the new attributes taking precedence in the case that an
169 attribute already exists. Using this without a hashref
170 (C<< $source->add_columns(qw/+col1 +col2/) >>) is legal, but useless --
171 it does the same thing it would do without the plus.
173 The contents of the column_info are not set in stone. The following
174 keys are currently recognised/used by DBIx::Class:
180 { accessor => '_name' }
182 # example use, replace standard accessor with one of your own:
184 my ($self, $value) = @_;
186 die "Name cannot contain digits!" if($value =~ /\d/);
187 $self->_name($value);
189 return $self->_name();
192 Use this to set the name of the accessor method for this column. If unset,
193 the name of the column will be used.
197 { data_type => 'integer' }
199 This contains the column type. It is automatically filled if you use the
200 L<SQL::Translator::Producer::DBIx::Class::File> producer, or the
201 L<DBIx::Class::Schema::Loader> module.
203 Currently there is no standard set of values for the data_type. Use
204 whatever your database supports.
210 The length of your column, if it is a column type that can have a size
211 restriction. This is currently only used to create tables from your
212 schema, see L<DBIx::Class::Schema/deploy>.
218 Set this to a true value for a column that is allowed to contain NULL
219 values, default is false. This is currently only used to create tables
220 from your schema, see L<DBIx::Class::Schema/deploy>.
222 =item is_auto_increment
224 { is_auto_increment => 1 }
226 Set this to a true value for a column whose value is somehow
227 automatically set, defaults to false. This is used to determine which
228 columns to empty when cloning objects using
229 L<DBIx::Class::Row/copy>. It is also used by
230 L<DBIx::Class::Schema/deploy>.
236 Set this to a true or false value (not C<undef>) to explicitly specify
237 if this column contains numeric data. This controls how set_column
238 decides whether to consider a column dirty after an update: if
239 C<is_numeric> is true a numeric comparison C<< != >> will take place
240 instead of the usual C<eq>
242 If not specified the storage class will attempt to figure this out on
243 first access to the column, based on the column C<data_type>. The
244 result will be cached in this attribute.
248 { is_foreign_key => 1 }
250 Set this to a true value for a column that contains a key from a
251 foreign table, defaults to false. This is currently only used to
252 create tables from your schema, see L<DBIx::Class::Schema/deploy>.
256 { default_value => \'now()' }
258 Set this to the default value which will be inserted into a column by
259 the database. Can contain either a value or a function (use a
260 reference to a scalar e.g. C<\'now()'> if you want a function). This
261 is currently only used to create tables from your schema, see
262 L<DBIx::Class::Schema/deploy>.
264 See the note on L<DBIx::Class::Row/new> for more information about possible
265 issues related to db-side default values.
269 { sequence => 'my_table_seq' }
271 Set this on a primary key column to the name of the sequence used to
272 generate a new key value. If not specified, L<DBIx::Class::PK::Auto>
273 will attempt to retrieve the name of the sequence from the database
276 =item retrieve_on_insert
278 { retrieve_on_insert => 1 }
280 For every column where this is set to true, DBIC will retrieve the RDBMS-side
281 value upon a new row insertion (normally only the autoincrement PK is
282 retrieved on insert). C<INSERT ... RETURNING> is used automatically if
283 supported by the underlying storage, otherwise an extra SELECT statement is
284 executed to retrieve the missing data.
288 { auto_nextval => 1 }
290 Set this to a true value for a column whose value is retrieved automatically
291 from a sequence or function (if supported by your Storage driver.) For a
292 sequence, if you do not use a trigger to get the nextval, you have to set the
293 L</sequence> value as well.
295 Also set this for MSSQL columns with the 'uniqueidentifier'
296 L<data_type|DBIx::Class::ResultSource/data_type> whose values you want to
297 automatically generate using C<NEWID()>, unless they are a primary key in which
298 case this will be done anyway.
302 This is used by L<DBIx::Class::Schema/deploy> and L<SQL::Translator>
303 to add extra non-generic data to the column. For example: C<< extra
304 => { unsigned => 1} >> is used by the MySQL producer to set an integer
305 column to unsigned. For more details, see
306 L<SQL::Translator::Producer::MySQL>.
314 =item Arguments: $colname, \%columninfo?
316 =item Return Value: 1/0 (true/false)
320 $source->add_column('col' => \%info);
322 Add a single column and optional column info. Uses the same column
323 info keys as L</add_columns>.
328 my ($self, @cols) = @_;
329 $self->_ordered_columns(\@cols) unless $self->_ordered_columns;
332 my $columns = $self->_columns;
333 while (my $col = shift @cols) {
334 my $column_info = {};
335 if ($col =~ s/^\+//) {
336 $column_info = $self->column_info($col);
339 # If next entry is { ... } use that for the column info, if not
340 # use an empty hashref
342 my $new_info = shift(@cols);
343 %$column_info = (%$column_info, %$new_info);
345 push(@added, $col) unless exists $columns->{$col};
346 $columns->{$col} = $column_info;
348 push @{ $self->_ordered_columns }, @added;
352 sub add_column { shift->add_columns(@_); } # DO NOT CHANGE THIS TO GLOB
358 =item Arguments: $colname
360 =item Return Value: 1/0 (true/false)
364 if ($source->has_column($colname)) { ... }
366 Returns true if the source has a column of this name, false otherwise.
371 my ($self, $column) = @_;
372 return exists $self->_columns->{$column};
379 =item Arguments: $colname
381 =item Return Value: Hashref of info
385 my $info = $source->column_info($col);
387 Returns the column metadata hashref for a column, as originally passed
388 to L</add_columns>. See L</add_columns> above for information on the
389 contents of the hashref.
394 my ($self, $column) = @_;
395 $self->throw_exception("No such column $column")
396 unless exists $self->_columns->{$column};
398 if ( ! $self->_columns->{$column}{data_type}
399 and ! $self->{_columns_info_loaded}
400 and $self->column_info_from_storage
401 and my $stor = try { $self->storage } )
403 $self->{_columns_info_loaded}++;
405 # try for the case of storage without table
407 my $info = $stor->columns_info_for( $self->from );
409 { (lc $_) => $info->{$_} }
413 foreach my $col ( keys %{$self->_columns} ) {
414 $self->_columns->{$col} = {
415 %{ $self->_columns->{$col} },
416 %{ $info->{$col} || $lc_info->{lc $col} || {} }
422 return $self->_columns->{$column};
429 =item Arguments: none
431 =item Return Value: Ordered list of column names
435 my @column_names = $source->columns;
437 Returns all column names in the order they were declared to L</add_columns>.
443 $self->throw_exception(
444 "columns() is a read-only accessor, did you mean add_columns()?"
446 return @{$self->{_ordered_columns}||[]};
453 =item Arguments: \@colnames ?
455 =item Return Value: Hashref of column name/info pairs
459 my $columns_info = $source->columns_info;
461 Like L</column_info> but returns information for the requested columns. If
462 the optional column-list arrayref is omitted it returns info on all columns
463 currently defined on the ResultSource via L</add_columns>.
468 my ($self, $columns) = @_;
470 my $colinfo = $self->_columns;
473 first { ! $_->{data_type} } values %$colinfo
475 ! $self->{_columns_info_loaded}
477 $self->column_info_from_storage
479 my $stor = try { $self->storage }
481 $self->{_columns_info_loaded}++;
483 # try for the case of storage without table
485 my $info = $stor->columns_info_for( $self->from );
487 { (lc $_) => $info->{$_} }
491 foreach my $col ( keys %$colinfo ) {
493 %{ $colinfo->{$col} },
494 %{ $info->{$col} || $lc_info->{lc $col} || {} }
504 if (my $inf = $colinfo->{$_}) {
508 $self->throw_exception( sprintf (
509 "No such column '%s' on source '%s'",
511 $self->source_name || $self->name || 'Unknown source...?',
523 =head2 remove_columns
527 =item Arguments: @colnames
529 =item Return Value: not defined
533 $source->remove_columns(qw/col1 col2 col3/);
535 Removes the given list of columns by name, from the result source.
537 B<Warning>: Removing a column that is also used in the sources primary
538 key, or in one of the sources unique constraints, B<will> result in a
539 broken result source.
545 =item Arguments: $colname
547 =item Return Value: not defined
551 $source->remove_column('col');
553 Remove a single column by name from the result source, similar to
556 B<Warning>: Removing a column that is also used in the sources primary
557 key, or in one of the sources unique constraints, B<will> result in a
558 broken result source.
563 my ($self, @to_remove) = @_;
565 my $columns = $self->_columns
570 delete $columns->{$_};
574 $self->_ordered_columns([ grep { not $to_remove{$_} } @{$self->_ordered_columns} ]);
577 sub remove_column { shift->remove_columns(@_); } # DO NOT CHANGE THIS TO GLOB
579 =head2 set_primary_key
583 =item Arguments: @cols
585 =item Return Value: not defined
589 Defines one or more columns as primary key for this source. Must be
590 called after L</add_columns>.
592 Additionally, defines a L<unique constraint|/add_unique_constraint>
595 Note: you normally do want to define a primary key on your sources
596 B<even if the underlying database table does not have a primary key>.
598 L<DBIx::Class::Manual::Intro/The Significance and Importance of Primary Keys>
603 sub set_primary_key {
604 my ($self, @cols) = @_;
606 my $colinfo = $self->columns_info(\@cols);
607 for my $col (@cols) {
608 carp_unique(sprintf (
609 "Primary key of source '%s' includes the column '%s' which has its "
610 . "'is_nullable' attribute set to true. This is a mistake and will cause "
611 . 'various Result-object operations to fail',
612 $self->source_name || $self->name || 'Unknown source...?',
614 )) if $colinfo->{$col}{is_nullable};
617 $self->_primaries(\@cols);
619 $self->add_unique_constraint(primary => \@cols);
622 =head2 primary_columns
626 =item Arguments: none
628 =item Return Value: Ordered list of primary column names
632 Read-only accessor which returns the list of primary keys, supplied by
637 sub primary_columns {
638 return @{shift->_primaries||[]};
641 # a helper method that will automatically die with a descriptive message if
642 # no pk is defined on the source in question. For internal use to save
643 # on if @pks... boilerplate
644 sub _pri_cols_or_die {
646 my @pcols = $self->primary_columns
647 or $self->throw_exception (sprintf(
648 "Operation requires a primary key to be declared on '%s' via set_primary_key",
649 # source_name is set only after schema-registration
650 $self->source_name || $self->result_class || $self->name || 'Unknown source...?',
655 # same as above but mandating single-column PK (used by relationship condition
657 sub _single_pri_col_or_die {
659 my ($pri, @too_many) = $self->_pri_cols_or_die;
661 $self->throw_exception( sprintf(
662 "Operation requires a single-column primary key declared on '%s'",
663 $self->source_name || $self->result_class || $self->name || 'Unknown source...?',
671 Manually define the correct sequence for your table, to avoid the overhead
672 associated with looking up the sequence automatically. The supplied sequence
673 will be applied to the L</column_info> of each L<primary_key|/set_primary_key>
677 =item Arguments: $sequence_name
679 =item Return Value: not defined
686 my ($self,$seq) = @_;
688 my @pks = $self->primary_columns
691 $_->{sequence} = $seq
692 for values %{ $self->columns_info (\@pks) };
696 =head2 add_unique_constraint
700 =item Arguments: $name?, \@colnames
702 =item Return Value: not defined
706 Declare a unique constraint on this source. Call once for each unique
709 # For UNIQUE (column1, column2)
710 __PACKAGE__->add_unique_constraint(
711 constraint_name => [ qw/column1 column2/ ],
714 Alternatively, you can specify only the columns:
716 __PACKAGE__->add_unique_constraint([ qw/column1 column2/ ]);
718 This will result in a unique constraint named
719 C<table_column1_column2>, where C<table> is replaced with the table
722 Unique constraints are used, for example, when you pass the constraint
723 name as the C<key> attribute to L<DBIx::Class::ResultSet/find>. Then
724 only columns in the constraint are searched.
726 Throws an error if any of the given column names do not yet exist on
731 sub add_unique_constraint {
735 $self->throw_exception(
736 'add_unique_constraint() does not accept multiple constraints, use '
737 . 'add_unique_constraints() instead'
742 if (ref $cols ne 'ARRAY') {
743 $self->throw_exception (
744 'Expecting an arrayref of constraint columns, got ' . ($cols||'NOTHING')
750 $name ||= $self->name_unique_constraint($cols);
752 foreach my $col (@$cols) {
753 $self->throw_exception("No such column $col on table " . $self->name)
754 unless $self->has_column($col);
757 my %unique_constraints = $self->unique_constraints;
758 $unique_constraints{$name} = $cols;
759 $self->_unique_constraints(\%unique_constraints);
762 =head2 add_unique_constraints
766 =item Arguments: @constraints
768 =item Return Value: not defined
772 Declare multiple unique constraints on this source.
774 __PACKAGE__->add_unique_constraints(
775 constraint_name1 => [ qw/column1 column2/ ],
776 constraint_name2 => [ qw/column2 column3/ ],
779 Alternatively, you can specify only the columns:
781 __PACKAGE__->add_unique_constraints(
782 [ qw/column1 column2/ ],
783 [ qw/column3 column4/ ]
786 This will result in unique constraints named C<table_column1_column2> and
787 C<table_column3_column4>, where C<table> is replaced with the table name.
789 Throws an error if any of the given column names do not yet exist on
792 See also L</add_unique_constraint>.
796 sub add_unique_constraints {
798 my @constraints = @_;
800 if ( !(@constraints % 2) && first { ref $_ ne 'ARRAY' } @constraints ) {
801 # with constraint name
802 while (my ($name, $constraint) = splice @constraints, 0, 2) {
803 $self->add_unique_constraint($name => $constraint);
808 foreach my $constraint (@constraints) {
809 $self->add_unique_constraint($constraint);
814 =head2 name_unique_constraint
818 =item Arguments: \@colnames
820 =item Return Value: Constraint name
824 $source->table('mytable');
825 $source->name_unique_constraint(['col1', 'col2']);
829 Return a name for a unique constraint containing the specified
830 columns. The name is created by joining the table name and each column
831 name, using an underscore character.
833 For example, a constraint on a table named C<cd> containing the columns
834 C<artist> and C<title> would result in a constraint name of C<cd_artist_title>.
836 This is used by L</add_unique_constraint> if you do not specify the
837 optional constraint name.
841 sub name_unique_constraint {
842 my ($self, $cols) = @_;
844 my $name = $self->name;
845 $name = $$name if (ref $name eq 'SCALAR');
846 $name =~ s/ ^ [^\.]+ \. //x; # strip possible schema qualifier
848 return join '_', $name, @$cols;
851 =head2 unique_constraints
855 =item Arguments: none
857 =item Return Value: Hash of unique constraint data
861 $source->unique_constraints();
863 Read-only accessor which returns a hash of unique constraints on this
866 The hash is keyed by constraint name, and contains an arrayref of
867 column names as values.
871 sub unique_constraints {
872 return %{shift->_unique_constraints||{}};
875 =head2 unique_constraint_names
879 =item Arguments: none
881 =item Return Value: Unique constraint names
885 $source->unique_constraint_names();
887 Returns the list of unique constraint names defined on this source.
891 sub unique_constraint_names {
894 my %unique_constraints = $self->unique_constraints;
896 return keys %unique_constraints;
899 =head2 unique_constraint_columns
903 =item Arguments: $constraintname
905 =item Return Value: List of constraint columns
909 $source->unique_constraint_columns('myconstraint');
911 Returns the list of columns that make up the specified unique constraint.
915 sub unique_constraint_columns {
916 my ($self, $constraint_name) = @_;
918 my %unique_constraints = $self->unique_constraints;
920 $self->throw_exception(
921 "Unknown unique constraint $constraint_name on '" . $self->name . "'"
922 ) unless exists $unique_constraints{$constraint_name};
924 return @{ $unique_constraints{$constraint_name} };
927 =head2 sqlt_deploy_callback
931 =item Arguments: $callback_name | \&callback_code
933 =item Return Value: $callback_name | \&callback_code
937 __PACKAGE__->sqlt_deploy_callback('mycallbackmethod');
941 __PACKAGE__->sqlt_deploy_callback(sub {
942 my ($source_instance, $sqlt_table) = @_;
946 An accessor to set a callback to be called during deployment of
947 the schema via L<DBIx::Class::Schema/create_ddl_dir> or
948 L<DBIx::Class::Schema/deploy>.
950 The callback can be set as either a code reference or the name of a
951 method in the current result class.
953 Defaults to L</default_sqlt_deploy_hook>.
955 Your callback will be passed the $source object representing the
956 ResultSource instance being deployed, and the
957 L<SQL::Translator::Schema::Table> object being created from it. The
958 callback can be used to manipulate the table object or add your own
959 customised indexes. If you need to manipulate a non-table object, use
960 the L<DBIx::Class::Schema/sqlt_deploy_hook>.
962 See L<DBIx::Class::Manual::Cookbook/Adding Indexes And Functions To
963 Your SQL> for examples.
965 This sqlt deployment callback can only be used to manipulate
966 SQL::Translator objects as they get turned into SQL. To execute
967 post-deploy statements which SQL::Translator does not currently
968 handle, override L<DBIx::Class::Schema/deploy> in your Schema class
969 and call L<dbh_do|DBIx::Class::Storage::DBI/dbh_do>.
971 =head2 default_sqlt_deploy_hook
973 This is the default deploy hook implementation which checks if your
974 current Result class has a C<sqlt_deploy_hook> method, and if present
975 invokes it B<on the Result class directly>. This is to preserve the
976 semantics of C<sqlt_deploy_hook> which was originally designed to expect
977 the Result class name and the
978 L<$sqlt_table instance|SQL::Translator::Schema::Table> of the table being
983 sub default_sqlt_deploy_hook {
986 my $class = $self->result_class;
988 if ($class and $class->can('sqlt_deploy_hook')) {
989 $class->sqlt_deploy_hook(@_);
993 sub _invoke_sqlt_deploy_hook {
995 if ( my $hook = $self->sqlt_deploy_callback) {
1004 =item Arguments: $classname
1006 =item Return Value: $classname
1010 use My::Schema::ResultClass::Inflator;
1013 use My::Schema::Artist;
1015 __PACKAGE__->result_class('My::Schema::ResultClass::Inflator');
1017 Set the default result class for this source. You can use this to create
1018 and use your own result inflator. See L<DBIx::Class::ResultSet/result_class>
1021 Please note that setting this to something like
1022 L<DBIx::Class::ResultClass::HashRefInflator> will make every result unblessed
1023 and make life more difficult. Inflators like those are better suited to
1024 temporary usage via L<DBIx::Class::ResultSet/result_class>.
1030 =item Arguments: none
1032 =item Return Value: L<$resultset|DBIx::Class::ResultSet>
1036 Returns a resultset for the given source. This will initially be created
1037 on demand by calling
1039 $self->resultset_class->new($self, $self->resultset_attributes)
1041 but is cached from then on unless resultset_class changes.
1043 =head2 resultset_class
1047 =item Arguments: $classname
1049 =item Return Value: $classname
1053 package My::Schema::ResultSet::Artist;
1054 use base 'DBIx::Class::ResultSet';
1057 # In the result class
1058 __PACKAGE__->resultset_class('My::Schema::ResultSet::Artist');
1061 $source->resultset_class('My::Schema::ResultSet::Artist');
1063 Set the class of the resultset. This is useful if you want to create your
1064 own resultset methods. Create your own class derived from
1065 L<DBIx::Class::ResultSet>, and set it here. If called with no arguments,
1066 this method returns the name of the existing resultset class, if one
1069 =head2 resultset_attributes
1073 =item Arguments: L<\%attrs|DBIx::Class::ResultSet/ATTRIBUTES>
1075 =item Return Value: L<\%attrs|DBIx::Class::ResultSet/ATTRIBUTES>
1079 # In the result class
1080 __PACKAGE__->resultset_attributes({ order_by => [ 'id' ] });
1083 $source->resultset_attributes({ order_by => [ 'id' ] });
1085 Store a collection of resultset attributes, that will be set on every
1086 L<DBIx::Class::ResultSet> produced from this result source.
1088 B<CAVEAT>: C<resultset_attributes> comes with its own set of issues and
1089 bugs! While C<resultset_attributes> isn't deprecated per se, its usage is
1092 Since relationships use attributes to link tables together, the "default"
1093 attributes you set may cause unpredictable and undesired behavior. Furthermore,
1094 the defaults cannot be turned off, so you are stuck with them.
1096 In most cases, what you should actually be using are project-specific methods:
1098 package My::Schema::ResultSet::Artist;
1099 use base 'DBIx::Class::ResultSet';
1103 #__PACKAGE__->resultset_attributes({ prefetch => 'tracks' });
1106 sub with_tracks { shift->search({}, { prefetch => 'tracks' }) }
1109 $schema->resultset('Artist')->with_tracks->...
1111 This gives you the flexibility of not using it when you don't need it.
1113 For more complex situations, another solution would be to use a virtual view
1114 via L<DBIx::Class::ResultSource::View>.
1120 $self->throw_exception(
1121 'resultset does not take any arguments. If you want another resultset, '.
1122 'call it on the schema instead.'
1125 $self->resultset_class->new(
1128 try { %{$self->schema->default_resultset_attributes} },
1129 %{$self->{resultset_attributes}},
1138 =item Arguments: none
1140 =item Result value: $name
1144 Returns the name of the result source, which will typically be the table
1145 name. This may be a scalar reference if the result source has a non-standard
1152 =item Arguments: $source_name
1154 =item Result value: $source_name
1158 Set an alternate name for the result source when it is loaded into a schema.
1159 This is useful if you want to refer to a result source by a name other than
1162 package ArchivedBooks;
1163 use base qw/DBIx::Class/;
1164 __PACKAGE__->table('books_archive');
1165 __PACKAGE__->source_name('Books');
1167 # from your schema...
1168 $schema->resultset('Books')->find(1);
1174 =item Arguments: none
1176 =item Return Value: FROM clause
1180 my $from_clause = $source->from();
1182 Returns an expression of the source to be supplied to storage to specify
1183 retrieval from this source. In the case of a database, the required FROM
1188 sub from { die 'Virtual method!' }
1192 Stores a hashref of per-source metadata. No specific key names
1193 have yet been standardized, the examples below are purely hypothetical
1194 and don't actually accomplish anything on their own:
1196 __PACKAGE__->source_info({
1197 "_tablespace" => 'fast_disk_array_3',
1198 "_engine" => 'InnoDB',
1205 =item Arguments: L<$schema?|DBIx::Class::Schema>
1207 =item Return Value: L<$schema|DBIx::Class::Schema>
1211 my $schema = $source->schema();
1213 Sets and/or returns the L<DBIx::Class::Schema> object to which this
1214 result source instance has been attached to.
1220 $_[0]->{schema} = $_[1];
1223 $_[0]->{schema} || do {
1224 my $name = $_[0]->{source_name} || '_unnamed_';
1225 my $err = 'Unable to perform storage-dependent operations with a detached result source '
1226 . "(source '$name' is not associated with a schema).";
1228 $err .= ' You need to use $schema->thaw() or manually set'
1229 . ' $DBIx::Class::ResultSourceHandle::thaw_schema while thawing.'
1230 if $_[0]->{_detached_thaw};
1232 DBIx::Class::Exception->throw($err);
1241 =item Arguments: none
1243 =item Return Value: L<$storage|DBIx::Class::Storage>
1247 $source->storage->debug(1);
1249 Returns the L<storage handle|DBIx::Class::Storage> for the current schema.
1253 sub storage { shift->schema->storage; }
1255 =head2 add_relationship
1259 =item Arguments: $rel_name, $related_source_name, \%cond, \%attrs?
1261 =item Return Value: 1/true if it succeeded
1265 $source->add_relationship('rel_name', 'related_source', $cond, $attrs);
1267 L<DBIx::Class::Relationship> describes a series of methods which
1268 create pre-defined useful types of relationships. Look there first
1269 before using this method directly.
1271 The relationship name can be arbitrary, but must be unique for each
1272 relationship attached to this result source. 'related_source' should
1273 be the name with which the related result source was registered with
1274 the current schema. For example:
1276 $schema->source('Book')->add_relationship('reviews', 'Review', {
1277 'foreign.book_id' => 'self.id',
1280 The condition C<$cond> needs to be an L<SQL::Abstract>-style
1281 representation of the join between the tables. For example, if you're
1282 creating a relation from Author to Book,
1284 { 'foreign.author_id' => 'self.id' }
1286 will result in the JOIN clause
1288 author me JOIN book foreign ON foreign.author_id = me.id
1290 You can specify as many foreign => self mappings as necessary.
1292 Valid attributes are as follows:
1298 Explicitly specifies the type of join to use in the relationship. Any
1299 SQL join type is valid, e.g. C<LEFT> or C<RIGHT>. It will be placed in
1300 the SQL command immediately before C<JOIN>.
1304 An arrayref containing a list of accessors in the foreign class to proxy in
1305 the main class. If, for example, you do the following:
1307 CD->might_have(liner_notes => 'LinerNotes', undef, {
1308 proxy => [ qw/notes/ ],
1311 Then, assuming LinerNotes has an accessor named notes, you can do:
1313 my $cd = CD->find(1);
1314 # set notes -- LinerNotes object is created if it doesn't exist
1315 $cd->notes('Notes go here');
1319 Specifies the type of accessor that should be created for the
1320 relationship. Valid values are C<single> (for when there is only a single
1321 related object), C<multi> (when there can be many), and C<filter> (for
1322 when there is a single related object, but you also want the relationship
1323 accessor to double as a column accessor). For C<multi> accessors, an
1324 add_to_* method is also created, which calls C<create_related> for the
1329 Throws an exception if the condition is improperly supplied, or cannot
1334 sub add_relationship {
1335 my ($self, $rel, $f_source_name, $cond, $attrs) = @_;
1336 $self->throw_exception("Can't create relationship without join condition")
1340 # Check foreign and self are right in cond
1341 if ( (ref $cond ||'') eq 'HASH') {
1342 $_ =~ /^foreign\./ or $self->throw_exception("Malformed relationship condition key '$_': must be prefixed with 'foreign.'")
1345 $_ =~ /^self\./ or $self->throw_exception("Malformed relationship condition value '$_': must be prefixed with 'self.'")
1349 my %rels = %{ $self->_relationships };
1350 $rels{$rel} = { class => $f_source_name,
1351 source => $f_source_name,
1354 $self->_relationships(\%rels);
1358 # XXX disabled. doesn't work properly currently. skip in tests.
1360 my $f_source = $self->schema->source($f_source_name);
1361 unless ($f_source) {
1362 $self->ensure_class_loaded($f_source_name);
1363 $f_source = $f_source_name->result_source;
1364 #my $s_class = ref($self->schema);
1365 #$f_source_name =~ m/^${s_class}::(.*)$/;
1366 #$self->schema->register_class(($1 || $f_source_name), $f_source_name);
1367 #$f_source = $self->schema->source($f_source_name);
1369 return unless $f_source; # Can't test rel without f_source
1371 try { $self->_resolve_join($rel, 'me', {}, []) }
1373 # If the resolve failed, back out and re-throw the error
1375 $self->_relationships(\%rels);
1376 $self->throw_exception("Error creating relationship $rel: $_");
1382 =head2 relationships
1386 =item Arguments: none
1388 =item Return Value: L<@rel_names|DBIx::Class::Relationship>
1392 my @rel_names = $source->relationships();
1394 Returns all relationship names for this source.
1399 return keys %{shift->_relationships};
1402 =head2 relationship_info
1406 =item Arguments: L<$rel_name|DBIx::Class::Relationship>
1408 =item Return Value: L<\%rel_data|DBIx::Class::Relationship::Base/add_relationship>
1412 Returns a hash of relationship information for the specified relationship
1413 name. The keys/values are as specified for L<DBIx::Class::Relationship::Base/add_relationship>.
1417 sub relationship_info {
1418 #my ($self, $rel) = @_;
1419 return shift->_relationships->{+shift};
1422 =head2 has_relationship
1426 =item Arguments: L<$rel_name|DBIx::Class::Relationship>
1428 =item Return Value: 1/0 (true/false)
1432 Returns true if the source has a relationship of this name, false otherwise.
1436 sub has_relationship {
1437 #my ($self, $rel) = @_;
1438 return exists shift->_relationships->{+shift};
1441 =head2 reverse_relationship_info
1445 =item Arguments: L<$rel_name|DBIx::Class::Relationship>
1447 =item Return Value: L<\%rel_data|DBIx::Class::Relationship::Base/add_relationship>
1451 Looks through all the relationships on the source this relationship
1452 points to, looking for one whose condition is the reverse of the
1453 condition on this relationship.
1455 A common use of this is to find the name of the C<belongs_to> relation
1456 opposing a C<has_many> relation. For definition of these look in
1457 L<DBIx::Class::Relationship>.
1459 The returned hashref is keyed by the name of the opposing
1460 relationship, and contains its data in the same manner as
1461 L</relationship_info>.
1465 sub reverse_relationship_info {
1466 my ($self, $rel) = @_;
1468 my $rel_info = $self->relationship_info($rel)
1469 or $self->throw_exception("No such relationship '$rel'");
1473 return $ret unless ((ref $rel_info->{cond}) eq 'HASH');
1475 my $stripped_cond = $self->__strip_relcond ($rel_info->{cond});
1477 my $registered_source_name = $self->source_name;
1479 # this may be a partial schema or something else equally esoteric
1480 my $other_rsrc = $self->related_source($rel);
1482 # Get all the relationships for that source that related to this source
1483 # whose foreign column set are our self columns on $rel and whose self
1484 # columns are our foreign columns on $rel
1485 foreach my $other_rel ($other_rsrc->relationships) {
1487 # only consider stuff that points back to us
1488 # "us" here is tricky - if we are in a schema registration, we want
1489 # to use the source_names, otherwise we will use the actual classes
1491 # the schema may be partial
1492 my $roundtrip_rsrc = try { $other_rsrc->related_source($other_rel) }
1495 if ($registered_source_name) {
1496 next if $registered_source_name ne ($roundtrip_rsrc->source_name || '')
1499 next if $self->result_class ne $roundtrip_rsrc->result_class;
1502 my $other_rel_info = $other_rsrc->relationship_info($other_rel);
1504 # this can happen when we have a self-referential class
1505 next if $other_rel_info eq $rel_info;
1507 next unless ref $other_rel_info->{cond} eq 'HASH';
1508 my $other_stripped_cond = $self->__strip_relcond($other_rel_info->{cond});
1510 $ret->{$other_rel} = $other_rel_info if (
1511 $self->_compare_relationship_keys (
1512 [ keys %$stripped_cond ], [ values %$other_stripped_cond ]
1515 $self->_compare_relationship_keys (
1516 [ values %$stripped_cond ], [ keys %$other_stripped_cond ]
1524 # all this does is removes the foreign/self prefix from a condition
1525 sub __strip_relcond {
1528 { map { /^ (?:foreign|self) \. (\w+) $/x } ($_, $_[1]{$_}) }
1533 sub compare_relationship_keys {
1534 carp 'compare_relationship_keys is a private method, stop calling it';
1536 $self->_compare_relationship_keys (@_);
1539 # Returns true if both sets of keynames are the same, false otherwise.
1540 sub _compare_relationship_keys {
1541 # my ($self, $keys1, $keys2) = @_;
1543 join ("\x00", sort @{$_[1]})
1545 join ("\x00", sort @{$_[2]})
1549 # optionally takes either an arrayref of column names, or a hashref of already
1550 # retrieved colinfos
1551 # returns an arrayref of column names of the shortest unique constraint
1552 # (matching some of the input if any), giving preference to the PK
1553 sub _identifying_column_set {
1554 my ($self, $cols) = @_;
1556 my %unique = $self->unique_constraints;
1557 my $colinfos = ref $cols eq 'HASH' ? $cols : $self->columns_info($cols||());
1559 # always prefer the PK first, and then shortest constraints first
1561 for my $set (delete $unique{primary}, sort { @$a <=> @$b } (values %unique) ) {
1562 next unless $set && @$set;
1565 next USET unless ($colinfos->{$_} && !$colinfos->{$_}{is_nullable} );
1568 # copy so we can mangle it at will
1575 sub _minimal_valueset_satisfying_constraint {
1577 my $args = { ref $_[0] eq 'HASH' ? %{ $_[0] } : @_ };
1579 $args->{columns_info} ||= $self->columns_info;
1581 my $vals = $self->storage->_extract_fixed_condition_columns(
1583 ($args->{carp_on_nulls} ? 'consider_nulls' : undef ),
1587 for my $col ($self->unique_constraint_columns($args->{constraint_name}) ) {
1588 if( ! exists $vals->{$col} or ( $vals->{$col}||'' ) eq UNRESOLVABLE_CONDITION ) {
1589 $cols->{missing}{$col} = undef;
1591 elsif( ! defined $vals->{$col} ) {
1592 $cols->{$args->{carp_on_nulls} ? 'undefined' : 'missing'}{$col} = undef;
1595 # we need to inject back the '=' as _extract_fixed_condition_columns
1596 # will strip it from literals and values alike, resulting in an invalid
1597 # condition in the end
1598 $cols->{present}{$col} = { '=' => $vals->{$col} };
1601 $cols->{fc}{$col} = 1 if (
1602 ( ! $cols->{missing} or ! exists $cols->{missing}{$col} )
1604 keys %{ $args->{columns_info}{$col}{_filter_info} || {} }
1608 $self->throw_exception( sprintf ( "Unable to satisfy requested constraint '%s', missing values for column(s): %s",
1609 $args->{constraint_name},
1610 join (', ', map { "'$_'" } sort keys %{$cols->{missing}} ),
1611 ) ) if $cols->{missing};
1613 $self->throw_exception( sprintf (
1614 "Unable to satisfy requested constraint '%s', FilterColumn values not usable for column(s): %s",
1615 $args->{constraint_name},
1616 join (', ', map { "'$_'" } sort keys %{$cols->{fc}}),
1622 !$ENV{DBIC_NULLABLE_KEY_NOWARN}
1624 carp_unique ( sprintf (
1625 "NULL/undef values supplied for requested unique constraint '%s' (NULL "
1626 . 'values in column(s): %s). This is almost certainly not what you wanted, '
1627 . 'though you can set DBIC_NULLABLE_KEY_NOWARN to disable this warning.',
1628 $args->{constraint_name},
1629 join (', ', map { "'$_'" } sort keys %{$cols->{undefined}}),
1633 return { map { %{ $cols->{$_}||{} } } qw(present undefined) };
1636 # Returns the {from} structure used to express JOIN conditions
1638 my ($self, $join, $alias, $seen, $jpath, $parent_force_left) = @_;
1640 # we need a supplied one, because we do in-place modifications, no returns
1641 $self->throw_exception ('You must supply a seen hashref as the 3rd argument to _resolve_join')
1642 unless ref $seen eq 'HASH';
1644 $self->throw_exception ('You must supply a joinpath arrayref as the 4th argument to _resolve_join')
1645 unless ref $jpath eq 'ARRAY';
1647 $jpath = [@$jpath]; # copy
1649 if (not defined $join or not length $join) {
1652 elsif (ref $join eq 'ARRAY') {
1655 $self->_resolve_join($_, $alias, $seen, $jpath, $parent_force_left);
1658 elsif (ref $join eq 'HASH') {
1661 for my $rel (keys %$join) {
1663 my $rel_info = $self->relationship_info($rel)
1664 or $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
1666 my $force_left = $parent_force_left;
1667 $force_left ||= lc($rel_info->{attrs}{join_type}||'') eq 'left';
1669 # the actual seen value will be incremented by the recursion
1670 my $as = $self->storage->relname_to_table_alias(
1671 $rel, ($seen->{$rel} && $seen->{$rel} + 1)
1675 $self->_resolve_join($rel, $alias, $seen, [@$jpath], $force_left),
1676 $self->related_source($rel)->_resolve_join(
1677 $join->{$rel}, $as, $seen, [@$jpath, { $rel => $as }], $force_left
1685 $self->throw_exception("No idea how to resolve join reftype ".ref $join);
1688 my $count = ++$seen->{$join};
1689 my $as = $self->storage->relname_to_table_alias(
1690 $join, ($count > 1 && $count)
1693 my $rel_info = $self->relationship_info($join)
1694 or $self->throw_exception("No such relationship $join on " . $self->source_name);
1696 my $rel_src = $self->related_source($join);
1697 return [ { $as => $rel_src->from,
1699 -join_type => $parent_force_left
1701 : $rel_info->{attrs}{join_type}
1703 -join_path => [@$jpath, { $join => $as } ],
1705 (! $rel_info->{attrs}{accessor})
1707 first { $rel_info->{attrs}{accessor} eq $_ } (qw/single filter/)
1710 -relation_chain_depth => ( $seen->{-relation_chain_depth} || 0 ) + 1,
1712 scalar $self->_resolve_condition($rel_info->{cond}, $as, $alias, $join)
1718 carp 'pk_depends_on is a private method, stop calling it';
1720 $self->_pk_depends_on (@_);
1723 # Determines whether a relation is dependent on an object from this source
1724 # having already been inserted. Takes the name of the relationship and a
1725 # hashref of columns of the related object.
1726 sub _pk_depends_on {
1727 my ($self, $rel_name, $rel_data) = @_;
1729 my $relinfo = $self->relationship_info($rel_name);
1731 # don't assume things if the relationship direction is specified
1732 return $relinfo->{attrs}{is_foreign_key_constraint}
1733 if exists ($relinfo->{attrs}{is_foreign_key_constraint});
1735 my $cond = $relinfo->{cond};
1736 return 0 unless ref($cond) eq 'HASH';
1738 # map { foreign.foo => 'self.bar' } to { bar => 'foo' }
1739 my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond };
1741 # assume anything that references our PK probably is dependent on us
1742 # rather than vice versa, unless the far side is (a) defined or (b)
1744 my $rel_source = $self->related_source($rel_name);
1746 foreach my $p ($self->primary_columns) {
1747 if (exists $keyhash->{$p}) {
1748 unless (defined($rel_data->{$keyhash->{$p}})
1749 || $rel_source->column_info($keyhash->{$p})
1750 ->{is_auto_increment}) {
1759 sub resolve_condition {
1760 carp 'resolve_condition is a private method, stop calling it';
1761 shift->_resolve_condition (@_);
1764 sub _resolve_condition {
1765 # carp_unique sprintf
1766 # '_resolve_condition is a private method, and moreover is about to go '
1767 # . 'away. Please contact the development team at %s if you believe you '
1768 # . 'have a genuine use for this method, in order to discuss alternatives.',
1769 # DBIx::Class::_ENV_::HELP_URL,
1772 #######################
1773 ### API Design? What's that...? (a backwards compatible shim, kill me now)
1775 my ($self, $cond, @res_args, $rel_name);
1777 # we *SIMPLY DON'T KNOW YET* which arg is which, yay
1778 ($self, $cond, $res_args[0], $res_args[1], $rel_name) = @_;
1780 # assume that an undef is an object-like unset (set_from_related(undef))
1781 my @is_objlike = map { ! defined $_ or length ref $_ } (@res_args);
1783 # turn objlike into proper objects for saner code further down
1785 next unless $is_objlike[$_];
1787 if ( defined blessed $res_args[$_] ) {
1789 # but wait - there is more!!! WHAT THE FUCK?!?!?!?!
1790 if ($res_args[$_]->isa('DBIx::Class::ResultSet')) {
1791 carp('Passing a resultset for relationship resolution makes no sense - invoking __gremlins__');
1792 $is_objlike[$_] = 0;
1793 $res_args[$_] = '__gremlins__';
1797 $res_args[$_] ||= {};
1799 # hate everywhere - have to pass in as a plain hash
1800 # pretending to be an object at least for now
1801 $self->throw_exception("Unsupported object-like structure encountered: $res_args[$_]")
1802 unless ref $res_args[$_] eq 'HASH';
1809 # where-is-waldo block guesses relname, then further down we override it if available
1811 $is_objlike[1] ? ( rel_name => $res_args[0], self_alias => $res_args[0], foreign_alias => 'me', self_result_object => $res_args[1] )
1812 : $is_objlike[0] ? ( rel_name => $res_args[1], self_alias => 'me', foreign_alias => $res_args[1], foreign_values => $res_args[0] )
1813 : ( rel_name => $res_args[0], self_alias => $res_args[1], foreign_alias => $res_args[0] )
1816 ( $rel_name ? ( rel_name => $rel_name ) : () ),
1818 #######################
1820 # now it's fucking easy isn't it?!
1821 my $rc = $self->_resolve_relationship_condition( $args );
1824 ( $rc->{join_free_condition} || $rc->{condition} ),
1825 ! $rc->{join_free_condition},
1828 # _resolve_relationship_condition always returns qualified cols even in the
1829 # case of join_free_condition, but nothing downstream expects this
1830 if ($rc->{join_free_condition} and ref $res[0] eq 'HASH') {
1832 { ($_ =~ /\.(.+)/) => $res[0]{$_} }
1838 return wantarray ? @res : $res[0];
1841 # Keep this indefinitely. There is evidence of both CPAN and
1842 # darkpan using it, and there isn't much harm in an extra var
1844 our $UNRESOLVABLE_CONDITION = UNRESOLVABLE_CONDITION;
1845 # YES I KNOW THIS IS EVIL
1846 # it is there to save darkpan from themselves, since internally
1847 # we are moving to a constant
1848 Internals::SvREADONLY($UNRESOLVABLE_CONDITION => 1);
1850 # Resolves the passed condition to a concrete query fragment and extra
1853 ## self-explanatory API, modeled on the custom cond coderef:
1854 # rel_name => (scalar)
1855 # foreign_alias => (scalar)
1856 # foreign_values => (either not supplied, or a hashref, or a foreign ResultObject (to be ->get_columns()ed), or plain undef )
1857 # self_alias => (scalar)
1858 # self_result_object => (either not supplied or a result object)
1859 # require_join_free_condition => (boolean, throws on failure to construct a JF-cond)
1860 # infer_values_based_on => (either not supplied or a hashref, implies require_join_free_condition)
1861 # condition => (sqla cond struct, optional, defeaults to from $self->rel_info(rel_name)->{cond})
1864 # condition => (a valid *likely fully qualified* sqla cond structure)
1865 # identity_map => (a hashref of foreign-to-self *unqualified* column equality names)
1866 # join_free_condition => (a valid *fully qualified* sqla cond structure, maybe unset)
1867 # inferred_values => (in case of an available join_free condition, this is a hashref of
1868 # *unqualified* column/value *EQUALITY* pairs, representing an amalgamation
1869 # of the JF-cond parse and infer_values_based_on
1870 # always either complete or unset)
1872 sub _resolve_relationship_condition {
1875 my $args = { ref $_[0] eq 'HASH' ? %{ $_[0] } : @_ };
1877 for ( qw( rel_name self_alias foreign_alias ) ) {
1878 $self->throw_exception("Mandatory argument '$_' to _resolve_relationship_condition() is not a plain string")
1879 if !defined $args->{$_} or length ref $args->{$_};
1882 $self->throw_exception("Arguments 'self_alias' and 'foreign_alias' may not be identical")
1883 if $args->{self_alias} eq $args->{foreign_alias};
1886 my $exception_rel_id = "relationship '$args->{rel_name}' on source '@{[ $self->source_name ]}'";
1888 my $rel_info = $self->relationship_info($args->{rel_name})
1890 # or $self->throw_exception( "No such $exception_rel_id" );
1891 or carp_unique("Requesting resolution on non-existent relationship '$args->{rel_name}' on source '@{[ $self->source_name ]}': fix your code *soon*, as it will break with the next major version");
1894 $exception_rel_id = "relationship '$rel_info->{_original_name}' on source '@{[ $self->source_name ]}'"
1895 if $rel_info and exists $rel_info->{_original_name};
1897 $self->throw_exception("No practical way to resolve $exception_rel_id between two data structures")
1898 if exists $args->{self_result_object} and exists $args->{foreign_values};
1900 $self->throw_exception( "Argument to infer_values_based_on must be a hash" )
1901 if exists $args->{infer_values_based_on} and ref $args->{infer_values_based_on} ne 'HASH';
1903 $args->{require_join_free_condition} ||= !!$args->{infer_values_based_on};
1905 $args->{condition} ||= $rel_info->{cond};
1907 $self->throw_exception( "Argument 'self_result_object' must be an object inheriting from DBIx::Class::Row" )
1909 exists $args->{self_result_object}
1911 ( ! defined blessed $args->{self_result_object} or ! $args->{self_result_object}->isa('DBIx::Class::Row') )
1916 my $rel_rsrc;# = $self->related_source($args->{rel_name});
1918 if (exists $args->{foreign_values}) {
1920 $rel_rsrc ||= $self->related_source($args->{rel_name});
1922 if (defined blessed $args->{foreign_values}) {
1924 $self->throw_exception( "Objects supplied as 'foreign_values' ($args->{foreign_values}) must inherit from DBIx::Class::Row" )
1925 unless $args->{foreign_values}->isa('DBIx::Class::Row');
1928 "Objects supplied as 'foreign_values' ($args->{foreign_values}) "
1929 . "usually should inherit from the related ResultClass ('@{[ $rel_rsrc->result_class ]}'), "
1930 . "perhaps you've made a mistake invoking the condition resolver?"
1931 ) unless $args->{foreign_values}->isa($rel_rsrc->result_class);
1933 $args->{foreign_values} = { $args->{foreign_values}->get_columns };
1935 elsif (! defined $args->{foreign_values} or ref $args->{foreign_values} eq 'HASH') {
1936 my $ri = { map { $_ => 1 } $rel_rsrc->relationships };
1937 my $ci = $rel_rsrc->columns_info;
1938 ! exists $ci->{$_} and ! exists $ri->{$_} and $self->throw_exception(
1939 "Key '$_' supplied as 'foreign_values' is not a column on related source '@{[ $rel_rsrc->source_name ]}'"
1940 ) for keys %{ $args->{foreign_values} ||= {} };
1943 $self->throw_exception(
1944 "Argument 'foreign_values' must be either an object inheriting from '@{[ $rel_rsrc->result_class ]}', "
1945 . "or a hash reference, or undef"
1952 if (ref $args->{condition} eq 'CODE') {
1955 rel_name => $args->{rel_name},
1956 self_resultsource => $self,
1957 self_alias => $args->{self_alias},
1958 foreign_alias => $args->{foreign_alias},
1960 { (exists $args->{$_}) ? ( $_ => $args->{$_} ) : () }
1961 qw( self_result_object foreign_values )
1965 # legacy - never remove these!!!
1966 $cref_args->{foreign_relname} = $cref_args->{rel_name};
1968 $cref_args->{self_rowobj} = $cref_args->{self_result_object}
1969 if exists $cref_args->{self_result_object};
1971 ($ret->{condition}, $ret->{join_free_condition}, my @extra) = $args->{condition}->($cref_args);
1974 $self->throw_exception("A custom condition coderef can return at most 2 conditions, but $exception_rel_id returned extra values: @extra")
1977 if (my $jfc = $ret->{join_free_condition}) {
1979 $self->throw_exception (
1980 "The join-free condition returned for $exception_rel_id must be a hash reference"
1981 ) unless ref $jfc eq 'HASH';
1984 $rel_rsrc ||= $self->related_source($args->{rel_name});
1986 my ($joinfree_alias, $joinfree_source);
1987 if (defined $args->{self_result_object}) {
1988 $joinfree_alias = $args->{foreign_alias};
1989 $joinfree_source = $rel_rsrc;
1991 elsif (defined $args->{foreign_values}) {
1992 $joinfree_alias = $args->{self_alias};
1993 $joinfree_source = $self;
1996 # FIXME sanity check until things stabilize, remove at some point
1997 $self->throw_exception (
1998 "A join-free condition returned for $exception_rel_id without a result object to chain from"
1999 ) unless $joinfree_alias;
2001 my $fq_col_list = { map
2002 { ( "$joinfree_alias.$_" => 1 ) }
2003 $joinfree_source->columns
2006 exists $fq_col_list->{$_} or $self->throw_exception (
2007 "The join-free condition returned for $exception_rel_id may only "
2008 . 'contain keys that are fully qualified column names of the corresponding source '
2009 . "(it returned '$_')"
2017 $_->isa('DBIx::Class::Row')
2019 $self->throw_exception (
2020 "The join-free condition returned for $exception_rel_id may not "
2021 . 'contain result objects as values - perhaps instead of invoking '
2022 . '->$something you meant to return ->get_column($something)'
2028 elsif (ref $args->{condition} eq 'HASH') {
2030 # the condition is static - use parallel arrays
2031 # for a "pivot" depending on which side of the
2032 # rel did we get as an object
2033 my (@f_cols, @l_cols);
2034 for my $fc (keys %{$args->{condition}}) {
2035 my $lc = $args->{condition}{$fc};
2037 # FIXME STRICTMODE should probably check these are valid columns
2038 $fc =~ s/^foreign\.// ||
2039 $self->throw_exception("Invalid rel cond key '$fc'");
2041 $lc =~ s/^self\.// ||
2042 $self->throw_exception("Invalid rel cond val '$lc'");
2048 # construct the crosstable condition and the identity map
2050 $ret->{condition}{"$args->{foreign_alias}.$f_cols[$_]"} = { -ident => "$args->{self_alias}.$l_cols[$_]" };
2051 $ret->{identity_map}{$l_cols[$_]} = $f_cols[$_];
2054 if ($args->{foreign_values}) {
2055 $ret->{join_free_condition}{"$args->{self_alias}.$l_cols[$_]"} = $args->{foreign_values}{$f_cols[$_]}
2058 elsif (defined $args->{self_result_object}) {
2060 for my $i (0..$#l_cols) {
2061 if ( $args->{self_result_object}->has_column_loaded($l_cols[$i]) ) {
2062 $ret->{join_free_condition}{"$args->{foreign_alias}.$f_cols[$i]"} = $args->{self_result_object}->get_column($l_cols[$i]);
2065 $self->throw_exception(sprintf
2066 "Unable to resolve relationship '%s' from object '%s': column '%s' not "
2067 . 'loaded from storage (or not passed to new() prior to insert()). You '
2068 . 'probably need to call ->discard_changes to get the server-side defaults '
2069 . 'from the database.',
2071 $args->{self_result_object},
2073 ) if $args->{self_result_object}->in_storage;
2075 # FIXME - temporarly force-override
2076 delete $args->{require_join_free_condition};
2077 $ret->{join_free_condition} = UNRESOLVABLE_CONDITION;
2083 elsif (ref $args->{condition} eq 'ARRAY') {
2084 if (@{$args->{condition}} == 0) {
2086 condition => UNRESOLVABLE_CONDITION,
2087 join_free_condition => UNRESOLVABLE_CONDITION,
2090 elsif (@{$args->{condition}} == 1) {
2091 $ret = $self->_resolve_relationship_condition({
2093 condition => $args->{condition}[0],
2097 # we are discarding inferred values here... likely incorrect...
2098 # then again - the entire thing is an OR, so we *can't* use them anyway
2099 for my $subcond ( map
2100 { $self->_resolve_relationship_condition({ %$args, condition => $_ }) }
2101 @{$args->{condition}}
2103 $self->throw_exception('Either all or none of the OR-condition members must resolve to a join-free condition')
2104 if ( $ret and ( $ret->{join_free_condition} xor $subcond->{join_free_condition} ) );
2106 $subcond->{$_} and push @{$ret->{$_}}, $subcond->{$_} for (qw(condition join_free_condition));
2111 $self->throw_exception ("Can't handle condition $args->{condition} for $exception_rel_id yet :(");
2114 $self->throw_exception(ucfirst "$exception_rel_id does not resolve to a join-free condition fragment") if (
2115 $args->{require_join_free_condition}
2117 ( ! $ret->{join_free_condition} or $ret->{join_free_condition} eq UNRESOLVABLE_CONDITION )
2120 my $storage = $self->schema->storage;
2122 # we got something back - sanity check and infer values if we can
2124 if ( my $jfc = $ret->{join_free_condition} and $ret->{join_free_condition} ne UNRESOLVABLE_CONDITION ) {
2126 my $jfc_eqs = $storage->_extract_fixed_condition_columns($jfc, 'consider_nulls');
2128 if (keys %$jfc_eqs) {
2131 # $jfc is fully qualified by definition
2132 my ($col) = $_ =~ /\.(.+)/;
2134 if (exists $jfc_eqs->{$_} and ($jfc_eqs->{$_}||'') ne UNRESOLVABLE_CONDITION) {
2135 $ret->{inferred_values}{$col} = $jfc_eqs->{$_};
2137 elsif ( !$args->{infer_values_based_on} or ! exists $args->{infer_values_based_on}{$col} ) {
2138 push @nonvalues, $col;
2143 delete $ret->{inferred_values} if @nonvalues;
2147 # did the user explicitly ask
2148 if ($args->{infer_values_based_on}) {
2150 $self->throw_exception(sprintf (
2151 "Unable to complete value inferrence - custom $exception_rel_id returns conditions instead of values for column(s): %s",
2152 map { "'$_'" } @nonvalues
2156 $ret->{inferred_values} ||= {};
2158 $ret->{inferred_values}{$_} = $args->{infer_values_based_on}{$_}
2159 for keys %{$args->{infer_values_based_on}};
2162 # add the identities based on the main condition
2163 # (may already be there, since easy to calculate on the fly in the HASH case)
2164 if ( ! $ret->{identity_map} ) {
2166 my $col_eqs = $storage->_extract_fixed_condition_columns($ret->{condition});
2169 for my $lhs (keys %$col_eqs) {
2171 next if $col_eqs->{$lhs} eq UNRESOLVABLE_CONDITION;
2174 $rel_rsrc ||= $self->related_source($args->{rel_name});
2176 # there is no way to know who is right and who is left in a cref
2177 # therefore a full blown resolution call, and figure out the
2178 # direction a bit further below
2179 $colinfos ||= $storage->_resolve_column_info([
2180 { -alias => $args->{self_alias}, -rsrc => $self },
2181 { -alias => $args->{foreign_alias}, -rsrc => $rel_rsrc },
2184 next unless $colinfos->{$lhs}; # someone is engaging in witchcraft
2186 if ( my $rhs_ref = is_literal_value( $col_eqs->{$lhs} ) ) {
2189 $colinfos->{$rhs_ref->[0]}
2191 $colinfos->{$lhs}{-source_alias} ne $colinfos->{$rhs_ref->[0]}{-source_alias}
2193 ( $colinfos->{$lhs}{-source_alias} eq $args->{self_alias} )
2194 ? ( $ret->{identity_map}{$colinfos->{$lhs}{-colname}} = $colinfos->{$rhs_ref->[0]}{-colname} )
2195 : ( $ret->{identity_map}{$colinfos->{$rhs_ref->[0]}{-colname}} = $colinfos->{$lhs}{-colname} )
2200 $col_eqs->{$lhs} =~ /^ ( \Q$args->{self_alias}\E \. .+ ) /x
2202 ($colinfos->{$1}||{})->{-result_source} == $rel_rsrc
2204 my ($lcol, $rcol) = map
2205 { $colinfos->{$_}{-colname} }
2209 "The $exception_rel_id specifies equality of column '$lcol' and the "
2210 . "*VALUE* '$rcol' (you did not use the { -ident => ... } operator)"
2216 # FIXME - temporary, to fool the idiotic check in SQLMaker::_join_condition
2217 $ret->{condition} = { -and => [ $ret->{condition} ] }
2218 unless $ret->{condition} eq UNRESOLVABLE_CONDITION;
2223 =head2 related_source
2227 =item Arguments: $rel_name
2229 =item Return Value: $source
2233 Returns the result source object for the given relationship.
2237 sub related_source {
2238 my ($self, $rel) = @_;
2239 if( !$self->has_relationship( $rel ) ) {
2240 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
2243 # if we are not registered with a schema - just use the prototype
2244 # however if we do have a schema - ask for the source by name (and
2245 # throw in the process if all fails)
2246 if (my $schema = try { $self->schema }) {
2247 $schema->source($self->relationship_info($rel)->{source});
2250 my $class = $self->relationship_info($rel)->{class};
2251 $self->ensure_class_loaded($class);
2252 $class->result_source_instance;
2256 =head2 related_class
2260 =item Arguments: $rel_name
2262 =item Return Value: $classname
2266 Returns the class name for objects in the given relationship.
2271 my ($self, $rel) = @_;
2272 if( !$self->has_relationship( $rel ) ) {
2273 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
2275 return $self->schema->class($self->relationship_info($rel)->{source});
2282 =item Arguments: none
2284 =item Return Value: L<$source_handle|DBIx::Class::ResultSourceHandle>
2288 Obtain a new L<result source handle instance|DBIx::Class::ResultSourceHandle>
2289 for this source. Used as a serializable pointer to this resultsource, as it is not
2290 easy (nor advisable) to serialize CODErefs which may very well be present in e.g.
2291 relationship definitions.
2296 return DBIx::Class::ResultSourceHandle->new({
2297 source_moniker => $_[0]->source_name,
2299 # so that a detached thaw can be re-frozen
2300 $_[0]->{_detached_thaw}
2301 ? ( _detached_source => $_[0] )
2302 : ( schema => $_[0]->schema )
2307 my $global_phase_destroy;
2309 ### NO detected_reinvoked_destructor check
2310 ### This code very much relies on being called multuple times
2312 return if $global_phase_destroy ||= in_global_destruction;
2318 # Under no circumstances shall $_[0] be stored anywhere else (like copied to
2319 # a lexical variable, or shifted, or anything else). Doing so will mess up
2320 # the refcount of this particular result source, and will allow the $schema
2321 # we are trying to save to reattach back to the source we are destroying.
2322 # The relevant code checking refcounts is in ::Schema::DESTROY()
2324 # if we are not a schema instance holder - we don't matter
2326 ! ref $_[0]->{schema}
2328 isweak $_[0]->{schema}
2331 # weaken our schema hold forcing the schema to find somewhere else to live
2332 # during global destruction (if we have not yet bailed out) this will throw
2333 # which will serve as a signal to not try doing anything else
2334 # however beware - on older perls the exception seems randomly untrappable
2335 # due to some weird race condition during thread joining :(((
2338 weaken $_[0]->{schema};
2340 # if schema is still there reintroduce ourselves with strong refs back to us
2341 if ($_[0]->{schema}) {
2342 my $srcregs = $_[0]->{schema}->source_registrations;
2343 for (keys %$srcregs) {
2344 next unless $srcregs->{$_};
2345 $srcregs->{$_} = $_[0] if $srcregs->{$_} == $_[0];
2351 $global_phase_destroy = 1;
2357 sub STORABLE_freeze { Storable::nfreeze($_[0]->handle) }
2360 my ($self, $cloning, $ice) = @_;
2361 %$self = %{ (Storable::thaw($ice))->resolve };
2364 =head2 throw_exception
2366 See L<DBIx::Class::Schema/"throw_exception">.
2370 sub throw_exception {
2374 ? $self->{schema}->throw_exception(@_)
2375 : DBIx::Class::Exception->throw(@_)
2379 =head2 column_info_from_storage
2383 =item Arguments: 1/0 (default: 0)
2385 =item Return Value: 1/0
2389 __PACKAGE__->column_info_from_storage(1);
2391 Enables the on-demand automatic loading of the above column
2392 metadata from storage as necessary. This is *deprecated*, and
2393 should not be used. It will be removed before 1.0.
2395 =head1 FURTHER QUESTIONS?
2397 Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
2399 =head1 COPYRIGHT AND LICENSE
2401 This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
2402 by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
2403 redistribute it and/or modify it under the same terms as the
2404 L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.