1 package DBIx::Class::ResultSource;
6 use base 'DBIx::Class::ResultSource::RowParser';
9 use DBIx::Class::_Util qw( UNRESOLVABLE_CONDITION dbic_internal_try fail_on_internal_call );
10 use SQL::Abstract 'is_literal_value';
11 use Devel::GlobalDestruction;
12 use Scalar::Util qw/blessed weaken isweak/;
14 # FIXME - somehow breaks ResultSetManager, do not remove until investigated
15 use DBIx::Class::ResultSet;
19 __PACKAGE__->mk_group_accessors(simple => qw/
20 source_name name source_info
21 _ordered_columns _columns _primaries _unique_constraints
22 _relationships resultset_attributes
23 column_info_from_storage sqlt_deploy_callback
26 __PACKAGE__->mk_group_accessors(component_class => qw/
33 DBIx::Class::ResultSource - Result source object
37 # Create a table based result source, in a result class.
39 package MyApp::Schema::Result::Artist;
40 use base qw/DBIx::Class::Core/;
42 __PACKAGE__->table('artist');
43 __PACKAGE__->add_columns(qw/ artistid name /);
44 __PACKAGE__->set_primary_key('artistid');
45 __PACKAGE__->has_many(cds => 'MyApp::Schema::Result::CD');
49 # Create a query (view) based result source, in a result class
50 package MyApp::Schema::Result::Year2000CDs;
51 use base qw/DBIx::Class::Core/;
53 __PACKAGE__->load_components('InflateColumn::DateTime');
54 __PACKAGE__->table_class('DBIx::Class::ResultSource::View');
56 __PACKAGE__->table('year2000cds');
57 __PACKAGE__->result_source_instance->is_virtual(1);
58 __PACKAGE__->result_source_instance->view_definition(
59 "SELECT cdid, artist, title FROM cd WHERE year ='2000'"
65 A ResultSource is an object that represents a source of data for querying.
67 This class is a base class for various specialised types of result
68 sources, for example L<DBIx::Class::ResultSource::Table>. Table is the
69 default result source type, so one is created for you when defining a
70 result class as described in the synopsis above.
72 More specifically, the L<DBIx::Class::Core> base class pulls in the
73 L<DBIx::Class::ResultSourceProxy::Table> component, which defines
74 the L<table|DBIx::Class::ResultSourceProxy::Table/table> method.
75 When called, C<table> creates and stores an instance of
76 L<DBIx::Class::ResultSource::Table>. Luckily, to use tables as result
77 sources, you don't need to remember any of this.
79 Result sources representing select queries, or views, can also be
80 created, see L<DBIx::Class::ResultSource::View> for full details.
82 =head2 Finding result source objects
84 As mentioned above, a result source instance is created and stored for
86 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 Result object:
98 $result->result_source;
100 =item From a ResultSet object:
112 $class->new({attribute_name => value});
114 Creates a new ResultSource object. Not normally called directly by end users.
119 my ($class, $attrs) = @_;
120 $class = ref $class if ref $class;
122 my $new = bless { %{$attrs || {}} }, $class;
123 $new->{resultset_class} ||= 'DBIx::Class::ResultSet';
124 $new->{resultset_attributes} = { %{$new->{resultset_attributes} || {}} };
125 $new->{_ordered_columns} = [ @{$new->{_ordered_columns}||[]}];
126 $new->{_columns} = { %{$new->{_columns}||{}} };
127 $new->{_relationships} = { %{$new->{_relationships}||{}} };
128 $new->{name} ||= "!!NAME NOT SET!!";
129 $new->{_columns_info_loaded} ||= 0;
130 $new->{sqlt_deploy_callback} ||= 'default_sqlt_deploy_hook';
140 =item Arguments: @columns
142 =item Return Value: L<$result_source|/new>
146 $source->add_columns(qw/col1 col2 col3/);
148 $source->add_columns('col1' => \%col1_info, 'col2' => \%col2_info, ...);
150 $source->add_columns(
151 'col1' => { data_type => 'integer', is_nullable => 1, ... },
152 'col2' => { data_type => 'text', is_auto_increment => 1, ... },
155 Adds columns to the result source. If supplied colname => hashref
156 pairs, uses the hashref as the L</column_info> for that column. Repeated
157 calls of this method will add more columns, not replace them.
159 The column names given will be created as accessor methods on your
160 L<Result|DBIx::Class::Manual::ResultClass> objects. You can change the name of the accessor
161 by supplying an L</accessor> in the column_info hash.
163 If a column name beginning with a plus sign ('+col1') is provided, the
164 attributes provided will be merged with any existing attributes for the
165 column, with the new attributes taking precedence in the case that an
166 attribute already exists. Using this without a hashref
167 (C<< $source->add_columns(qw/+col1 +col2/) >>) is legal, but useless --
168 it does the same thing it would do without the plus.
170 The contents of the column_info are not set in stone. The following
171 keys are currently recognised/used by DBIx::Class:
177 { accessor => '_name' }
179 # example use, replace standard accessor with one of your own:
181 my ($self, $value) = @_;
183 die "Name cannot contain digits!" if($value =~ /\d/);
184 $self->_name($value);
186 return $self->_name();
189 Use this to set the name of the accessor method for this column. If unset,
190 the name of the column will be used.
194 { data_type => 'integer' }
196 This contains the column type. It is automatically filled if you use the
197 L<SQL::Translator::Producer::DBIx::Class::File> producer, or the
198 L<DBIx::Class::Schema::Loader> module.
200 Currently there is no standard set of values for the data_type. Use
201 whatever your database supports.
207 The length of your column, if it is a column type that can have a size
208 restriction. This is currently only used to create tables from your
209 schema, see L<DBIx::Class::Schema/deploy>.
213 For decimal or float values you can specify an ArrayRef in order to
214 control precision, assuming your database's
215 L<SQL::Translator::Producer> supports it.
221 Set this to a true value for a column that is allowed to contain NULL
222 values, default is false. This is currently only used to create tables
223 from your schema, see L<DBIx::Class::Schema/deploy>.
225 =item is_auto_increment
227 { is_auto_increment => 1 }
229 Set this to a true value for a column whose value is somehow
230 automatically set, defaults to false. This is used to determine which
231 columns to empty when cloning objects using
232 L<DBIx::Class::Row/copy>. It is also used by
233 L<DBIx::Class::Schema/deploy>.
239 Set this to a true or false value (not C<undef>) to explicitly specify
240 if this column contains numeric data. This controls how set_column
241 decides whether to consider a column dirty after an update: if
242 C<is_numeric> is true a numeric comparison C<< != >> will take place
243 instead of the usual C<eq>
245 If not specified the storage class will attempt to figure this out on
246 first access to the column, based on the column C<data_type>. The
247 result will be cached in this attribute.
251 { is_foreign_key => 1 }
253 Set this to a true value for a column that contains a key from a
254 foreign table, defaults to false. This is currently only used to
255 create tables from your schema, see L<DBIx::Class::Schema/deploy>.
259 { default_value => \'now()' }
261 Set this to the default value which will be inserted into a column by
262 the database. Can contain either a value or a function (use a
263 reference to a scalar e.g. C<\'now()'> if you want a function). This
264 is currently only used to create tables from your schema, see
265 L<DBIx::Class::Schema/deploy>.
267 See the note on L<DBIx::Class::Row/new> for more information about possible
268 issues related to db-side default values.
272 { sequence => 'my_table_seq' }
274 Set this on a primary key column to the name of the sequence used to
275 generate a new key value. If not specified, L<DBIx::Class::PK::Auto>
276 will attempt to retrieve the name of the sequence from the database
279 =item retrieve_on_insert
281 { retrieve_on_insert => 1 }
283 For every column where this is set to true, DBIC will retrieve the RDBMS-side
284 value upon a new row insertion (normally only the autoincrement PK is
285 retrieved on insert). C<INSERT ... RETURNING> is used automatically if
286 supported by the underlying storage, otherwise an extra SELECT statement is
287 executed to retrieve the missing data.
291 { auto_nextval => 1 }
293 Set this to a true value for a column whose value is retrieved automatically
294 from a sequence or function (if supported by your Storage driver.) For a
295 sequence, if you do not use a trigger to get the nextval, you have to set the
296 L</sequence> value as well.
298 Also set this for MSSQL columns with the 'uniqueidentifier'
299 L<data_type|DBIx::Class::ResultSource/data_type> whose values you want to
300 automatically generate using C<NEWID()>, unless they are a primary key in which
301 case this will be done anyway.
305 This is used by L<DBIx::Class::Schema/deploy> and L<SQL::Translator>
306 to add extra non-generic data to the column. For example: C<< extra
307 => { unsigned => 1} >> is used by the MySQL producer to set an integer
308 column to unsigned. For more details, see
309 L<SQL::Translator::Producer::MySQL>.
317 =item Arguments: $colname, \%columninfo?
319 =item Return Value: 1/0 (true/false)
323 $source->add_column('col' => \%info);
325 Add a single column and optional column info. Uses the same column
326 info keys as L</add_columns>.
331 my ($self, @cols) = @_;
332 $self->_ordered_columns(\@cols) unless $self->_ordered_columns;
335 my $columns = $self->_columns;
336 while (my $col = shift @cols) {
337 my $column_info = {};
338 if ($col =~ s/^\+//) {
339 $column_info = $self->column_info($col);
342 # If next entry is { ... } use that for the column info, if not
343 # use an empty hashref
345 my $new_info = shift(@cols);
346 %$column_info = (%$column_info, %$new_info);
348 push(@added, $col) unless exists $columns->{$col};
349 $columns->{$col} = $column_info;
351 push @{ $self->_ordered_columns }, @added;
356 DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
357 shift->add_columns(@_)
364 =item Arguments: $colname
366 =item Return Value: 1/0 (true/false)
370 if ($source->has_column($colname)) { ... }
372 Returns true if the source has a column of this name, false otherwise.
377 my ($self, $column) = @_;
378 return exists $self->_columns->{$column};
385 =item Arguments: $colname
387 =item Return Value: Hashref of info
391 my $info = $source->column_info($col);
393 Returns the column metadata hashref for a column, as originally passed
394 to L</add_columns>. See L</add_columns> above for information on the
395 contents of the hashref.
400 my ($self, $column) = @_;
401 $self->throw_exception("No such column $column")
402 unless exists $self->_columns->{$column};
404 if ( ! $self->_columns->{$column}{data_type}
405 and ! $self->{_columns_info_loaded}
406 and $self->column_info_from_storage
407 and my $stor = dbic_internal_try { $self->schema->storage } )
409 $self->{_columns_info_loaded}++;
411 # try for the case of storage without table
413 my $info = $stor->columns_info_for( $self->from );
415 { (lc $_) => $info->{$_} }
419 foreach my $col ( keys %{$self->_columns} ) {
420 $self->_columns->{$col} = {
421 %{ $self->_columns->{$col} },
422 %{ $info->{$col} || $lc_info->{lc $col} || {} }
428 return $self->_columns->{$column};
435 =item Arguments: none
437 =item Return Value: Ordered list of column names
441 my @column_names = $source->columns;
443 Returns all column names in the order they were declared to L</add_columns>.
449 $self->throw_exception(
450 "columns() is a read-only accessor, did you mean add_columns()?"
452 return @{$self->{_ordered_columns}||[]};
459 =item Arguments: \@colnames ?
461 =item Return Value: Hashref of column name/info pairs
465 my $columns_info = $source->columns_info;
467 Like L</column_info> but returns information for the requested columns. If
468 the optional column-list arrayref is omitted it returns info on all columns
469 currently defined on the ResultSource via L</add_columns>.
474 my ($self, $columns) = @_;
476 my $colinfo = $self->_columns;
479 ! $self->{_columns_info_loaded}
481 $self->column_info_from_storage
483 grep { ! $_->{data_type} } values %$colinfo
485 my $stor = dbic_internal_try { $self->schema->storage }
487 $self->{_columns_info_loaded}++;
489 # try for the case of storage without table
491 my $info = $stor->columns_info_for( $self->from );
493 { (lc $_) => $info->{$_} }
497 foreach my $col ( keys %$colinfo ) {
499 %{ $colinfo->{$col} },
500 %{ $info->{$col} || $lc_info->{lc $col} || {} }
510 if (my $inf = $colinfo->{$_}) {
514 $self->throw_exception( sprintf (
515 "No such column '%s' on source '%s'",
517 $self->source_name || $self->name || 'Unknown source...?',
529 =head2 remove_columns
533 =item Arguments: @colnames
535 =item Return Value: not defined
539 $source->remove_columns(qw/col1 col2 col3/);
541 Removes the given list of columns by name, from the result source.
543 B<Warning>: Removing a column that is also used in the sources primary
544 key, or in one of the sources unique constraints, B<will> result in a
545 broken result source.
551 =item Arguments: $colname
553 =item Return Value: not defined
557 $source->remove_column('col');
559 Remove a single column by name from the result source, similar to
562 B<Warning>: Removing a column that is also used in the sources primary
563 key, or in one of the sources unique constraints, B<will> result in a
564 broken result source.
569 my ($self, @to_remove) = @_;
571 my $columns = $self->_columns
576 delete $columns->{$_};
580 $self->_ordered_columns([ grep { not $to_remove{$_} } @{$self->_ordered_columns} ]);
584 DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
585 shift->remove_columns(@_)
588 =head2 set_primary_key
592 =item Arguments: @cols
594 =item Return Value: not defined
598 Defines one or more columns as primary key for this source. Must be
599 called after L</add_columns>.
601 Additionally, defines a L<unique constraint|/add_unique_constraint>
604 Note: you normally do want to define a primary key on your sources
605 B<even if the underlying database table does not have a primary key>.
607 L<DBIx::Class::Manual::Intro/The Significance and Importance of Primary Keys>
612 sub set_primary_key {
613 my ($self, @cols) = @_;
615 my $colinfo = $self->columns_info(\@cols);
616 for my $col (@cols) {
617 carp_unique(sprintf (
618 "Primary key of source '%s' includes the column '%s' which has its "
619 . "'is_nullable' attribute set to true. This is a mistake and will cause "
620 . 'various Result-object operations to fail',
621 $self->source_name || $self->name || 'Unknown source...?',
623 )) if $colinfo->{$col}{is_nullable};
626 $self->_primaries(\@cols);
628 $self->add_unique_constraint(primary => \@cols);
631 =head2 primary_columns
635 =item Arguments: none
637 =item Return Value: Ordered list of primary column names
641 Read-only accessor which returns the list of primary keys, supplied by
646 sub primary_columns {
647 return @{shift->_primaries||[]};
650 # a helper method that will automatically die with a descriptive message if
651 # no pk is defined on the source in question. For internal use to save
652 # on if @pks... boilerplate
653 sub _pri_cols_or_die {
655 my @pcols = $self->primary_columns
656 or $self->throw_exception (sprintf(
657 "Operation requires a primary key to be declared on '%s' via set_primary_key",
658 # source_name is set only after schema-registration
659 $self->source_name || $self->result_class || $self->name || 'Unknown source...?',
664 # same as above but mandating single-column PK (used by relationship condition
666 sub _single_pri_col_or_die {
668 my ($pri, @too_many) = $self->_pri_cols_or_die;
670 $self->throw_exception( sprintf(
671 "Operation requires a single-column primary key declared on '%s'",
672 $self->source_name || $self->result_class || $self->name || 'Unknown source...?',
680 Manually define the correct sequence for your table, to avoid the overhead
681 associated with looking up the sequence automatically. The supplied sequence
682 will be applied to the L</column_info> of each L<primary_key|/set_primary_key>
686 =item Arguments: $sequence_name
688 =item Return Value: not defined
695 my ($self,$seq) = @_;
697 my @pks = $self->primary_columns
700 $_->{sequence} = $seq
701 for values %{ $self->columns_info (\@pks) };
705 =head2 add_unique_constraint
709 =item Arguments: $name?, \@colnames
711 =item Return Value: not defined
715 Declare a unique constraint on this source. Call once for each unique
718 # For UNIQUE (column1, column2)
719 __PACKAGE__->add_unique_constraint(
720 constraint_name => [ qw/column1 column2/ ],
723 Alternatively, you can specify only the columns:
725 __PACKAGE__->add_unique_constraint([ qw/column1 column2/ ]);
727 This will result in a unique constraint named
728 C<table_column1_column2>, where C<table> is replaced with the table
731 Unique constraints are used, for example, when you pass the constraint
732 name as the C<key> attribute to L<DBIx::Class::ResultSet/find>. Then
733 only columns in the constraint are searched.
735 Throws an error if any of the given column names do not yet exist on
740 sub add_unique_constraint {
744 $self->throw_exception(
745 'add_unique_constraint() does not accept multiple constraints, use '
746 . 'add_unique_constraints() instead'
751 if (ref $cols ne 'ARRAY') {
752 $self->throw_exception (
753 'Expecting an arrayref of constraint columns, got ' . ($cols||'NOTHING')
759 $name ||= $self->name_unique_constraint($cols);
761 foreach my $col (@$cols) {
762 $self->throw_exception("No such column $col on table " . $self->name)
763 unless $self->has_column($col);
766 my %unique_constraints = $self->unique_constraints;
767 $unique_constraints{$name} = $cols;
768 $self->_unique_constraints(\%unique_constraints);
771 =head2 add_unique_constraints
775 =item Arguments: @constraints
777 =item Return Value: not defined
781 Declare multiple unique constraints on this source.
783 __PACKAGE__->add_unique_constraints(
784 constraint_name1 => [ qw/column1 column2/ ],
785 constraint_name2 => [ qw/column2 column3/ ],
788 Alternatively, you can specify only the columns:
790 __PACKAGE__->add_unique_constraints(
791 [ qw/column1 column2/ ],
792 [ qw/column3 column4/ ]
795 This will result in unique constraints named C<table_column1_column2> and
796 C<table_column3_column4>, where C<table> is replaced with the table name.
798 Throws an error if any of the given column names do not yet exist on
801 See also L</add_unique_constraint>.
805 sub add_unique_constraints {
806 DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
809 my @constraints = @_;
811 if ( !(@constraints % 2) && grep { ref $_ ne 'ARRAY' } @constraints ) {
812 # with constraint name
813 while (my ($name, $constraint) = splice @constraints, 0, 2) {
814 $self->add_unique_constraint($name => $constraint);
819 foreach my $constraint (@constraints) {
820 $self->add_unique_constraint($constraint);
825 =head2 name_unique_constraint
829 =item Arguments: \@colnames
831 =item Return Value: Constraint name
835 $source->table('mytable');
836 $source->name_unique_constraint(['col1', 'col2']);
840 Return a name for a unique constraint containing the specified
841 columns. The name is created by joining the table name and each column
842 name, using an underscore character.
844 For example, a constraint on a table named C<cd> containing the columns
845 C<artist> and C<title> would result in a constraint name of C<cd_artist_title>.
847 This is used by L</add_unique_constraint> if you do not specify the
848 optional constraint name.
852 sub name_unique_constraint {
853 my ($self, $cols) = @_;
855 my $name = $self->name;
856 $name = $$name if (ref $name eq 'SCALAR');
857 $name =~ s/ ^ [^\.]+ \. //x; # strip possible schema qualifier
859 return join '_', $name, @$cols;
862 =head2 unique_constraints
866 =item Arguments: none
868 =item Return Value: Hash of unique constraint data
872 $source->unique_constraints();
874 Read-only accessor which returns a hash of unique constraints on this
877 The hash is keyed by constraint name, and contains an arrayref of
878 column names as values.
882 sub unique_constraints {
883 return %{shift->_unique_constraints||{}};
886 =head2 unique_constraint_names
890 =item Arguments: none
892 =item Return Value: Unique constraint names
896 $source->unique_constraint_names();
898 Returns the list of unique constraint names defined on this source.
902 sub unique_constraint_names {
905 my %unique_constraints = $self->unique_constraints;
907 return keys %unique_constraints;
910 =head2 unique_constraint_columns
914 =item Arguments: $constraintname
916 =item Return Value: List of constraint columns
920 $source->unique_constraint_columns('myconstraint');
922 Returns the list of columns that make up the specified unique constraint.
926 sub unique_constraint_columns {
927 my ($self, $constraint_name) = @_;
929 my %unique_constraints = $self->unique_constraints;
931 $self->throw_exception(
932 "Unknown unique constraint $constraint_name on '" . $self->name . "'"
933 ) unless exists $unique_constraints{$constraint_name};
935 return @{ $unique_constraints{$constraint_name} };
938 =head2 sqlt_deploy_callback
942 =item Arguments: $callback_name | \&callback_code
944 =item Return Value: $callback_name | \&callback_code
948 __PACKAGE__->result_source_instance->sqlt_deploy_callback('mycallbackmethod');
952 __PACKAGE__->result_source_instance->sqlt_deploy_callback(sub {
953 my ($source_instance, $sqlt_table) = @_;
957 An accessor to set a callback to be called during deployment of
958 the schema via L<DBIx::Class::Schema/create_ddl_dir> or
959 L<DBIx::Class::Schema/deploy>.
961 The callback can be set as either a code reference or the name of a
962 method in the current result class.
964 Defaults to L</default_sqlt_deploy_hook>.
966 Your callback will be passed the $source object representing the
967 ResultSource instance being deployed, and the
968 L<SQL::Translator::Schema::Table> object being created from it. The
969 callback can be used to manipulate the table object or add your own
970 customised indexes. If you need to manipulate a non-table object, use
971 the L<DBIx::Class::Schema/sqlt_deploy_hook>.
973 See L<DBIx::Class::Manual::Cookbook/Adding Indexes And Functions To
974 Your SQL> for examples.
976 This sqlt deployment callback can only be used to manipulate
977 SQL::Translator objects as they get turned into SQL. To execute
978 post-deploy statements which SQL::Translator does not currently
979 handle, override L<DBIx::Class::Schema/deploy> in your Schema class
980 and call L<dbh_do|DBIx::Class::Storage::DBI/dbh_do>.
982 =head2 default_sqlt_deploy_hook
984 This is the default deploy hook implementation which checks if your
985 current Result class has a C<sqlt_deploy_hook> method, and if present
986 invokes it B<on the Result class directly>. This is to preserve the
987 semantics of C<sqlt_deploy_hook> which was originally designed to expect
988 the Result class name and the
989 L<$sqlt_table instance|SQL::Translator::Schema::Table> of the table being
994 sub default_sqlt_deploy_hook {
997 my $class = $self->result_class;
999 if ($class and $class->can('sqlt_deploy_hook')) {
1000 $class->sqlt_deploy_hook(@_);
1004 sub _invoke_sqlt_deploy_hook {
1006 if ( my $hook = $self->sqlt_deploy_callback) {
1015 =item Arguments: $classname
1017 =item Return Value: $classname
1021 use My::Schema::ResultClass::Inflator;
1024 use My::Schema::Artist;
1026 __PACKAGE__->result_class('My::Schema::ResultClass::Inflator');
1028 Set the default result class for this source. You can use this to create
1029 and use your own result inflator. See L<DBIx::Class::ResultSet/result_class>
1032 Please note that setting this to something like
1033 L<DBIx::Class::ResultClass::HashRefInflator> will make every result unblessed
1034 and make life more difficult. Inflators like those are better suited to
1035 temporary usage via L<DBIx::Class::ResultSet/result_class>.
1041 =item Arguments: none
1043 =item Return Value: L<$resultset|DBIx::Class::ResultSet>
1047 Returns a resultset for the given source. This will initially be created
1048 on demand by calling
1050 $self->resultset_class->new($self, $self->resultset_attributes)
1052 but is cached from then on unless resultset_class changes.
1054 =head2 resultset_class
1058 =item Arguments: $classname
1060 =item Return Value: $classname
1064 package My::Schema::ResultSet::Artist;
1065 use base 'DBIx::Class::ResultSet';
1068 # In the result class
1069 __PACKAGE__->resultset_class('My::Schema::ResultSet::Artist');
1072 $source->resultset_class('My::Schema::ResultSet::Artist');
1074 Set the class of the resultset. This is useful if you want to create your
1075 own resultset methods. Create your own class derived from
1076 L<DBIx::Class::ResultSet>, and set it here. If called with no arguments,
1077 this method returns the name of the existing resultset class, if one
1080 =head2 resultset_attributes
1084 =item Arguments: L<\%attrs|DBIx::Class::ResultSet/ATTRIBUTES>
1086 =item Return Value: L<\%attrs|DBIx::Class::ResultSet/ATTRIBUTES>
1090 # In the result class
1091 __PACKAGE__->resultset_attributes({ order_by => [ 'id' ] });
1094 $source->resultset_attributes({ order_by => [ 'id' ] });
1096 Store a collection of resultset attributes, that will be set on every
1097 L<DBIx::Class::ResultSet> produced from this result source.
1099 B<CAVEAT>: C<resultset_attributes> comes with its own set of issues and
1100 bugs! Notably the contents of the attributes are B<entirely static>, which
1101 greatly hinders composability (things like L<current_source_alias
1102 |DBIx::Class::ResultSet/current_source_alias> can not possibly be respected).
1103 While C<resultset_attributes> isn't deprecated per se, you are strongly urged
1104 to seek alternatives.
1106 Since relationships use attributes to link tables together, the "default"
1107 attributes you set may cause unpredictable and undesired behavior. Furthermore,
1108 the defaults B<cannot be turned off>, so you are stuck with them.
1110 In most cases, what you should actually be using are project-specific methods:
1112 package My::Schema::ResultSet::Artist;
1113 use base 'DBIx::Class::ResultSet';
1117 #__PACKAGE__->resultset_attributes({ prefetch => 'tracks' });
1120 sub with_tracks { shift->search({}, { prefetch => 'tracks' }) }
1123 $schema->resultset('Artist')->with_tracks->...
1125 This gives you the flexibility of not using it when you don't need it.
1127 For more complex situations, another solution would be to use a virtual view
1128 via L<DBIx::Class::ResultSource::View>.
1134 $self->throw_exception(
1135 'resultset does not take any arguments. If you want another resultset, '.
1136 'call it on the schema instead.'
1139 $self->resultset_class->new(
1142 ( dbic_internal_try { %{$self->schema->default_resultset_attributes} } ),
1143 %{$self->{resultset_attributes}},
1152 =item Arguments: none
1154 =item Result value: $name
1158 Returns the name of the result source, which will typically be the table
1159 name. This may be a scalar reference if the result source has a non-standard
1166 =item Arguments: $source_name
1168 =item Result value: $source_name
1172 Set an alternate name for the result source when it is loaded into a schema.
1173 This is useful if you want to refer to a result source by a name other than
1176 package ArchivedBooks;
1177 use base qw/DBIx::Class/;
1178 __PACKAGE__->table('books_archive');
1179 __PACKAGE__->source_name('Books');
1181 # from your schema...
1182 $schema->resultset('Books')->find(1);
1188 =item Arguments: none
1190 =item Return Value: FROM clause
1194 my $from_clause = $source->from();
1196 Returns an expression of the source to be supplied to storage to specify
1197 retrieval from this source. In the case of a database, the required FROM
1202 sub from { die 'Virtual method!' }
1206 Stores a hashref of per-source metadata. No specific key names
1207 have yet been standardized, the examples below are purely hypothetical
1208 and don't actually accomplish anything on their own:
1210 __PACKAGE__->source_info({
1211 "_tablespace" => 'fast_disk_array_3',
1212 "_engine" => 'InnoDB',
1219 =item Arguments: L<$schema?|DBIx::Class::Schema>
1221 =item Return Value: L<$schema|DBIx::Class::Schema>
1225 my $schema = $source->schema();
1227 Sets and/or returns the L<DBIx::Class::Schema> object to which this
1228 result source instance has been attached to.
1234 $_[0]->{schema} = $_[1];
1237 $_[0]->{schema} || do {
1238 my $name = $_[0]->{source_name} || '_unnamed_';
1239 my $err = 'Unable to perform storage-dependent operations with a detached result source '
1240 . "(source '$name' is not associated with a schema).";
1242 $err .= ' You need to use $schema->thaw() or manually set'
1243 . ' $DBIx::Class::ResultSourceHandle::thaw_schema while thawing.'
1244 if $_[0]->{_detached_thaw};
1246 DBIx::Class::Exception->throw($err);
1255 =item Arguments: none
1257 =item Return Value: L<$storage|DBIx::Class::Storage>
1261 $source->storage->debug(1);
1263 Returns the L<storage handle|DBIx::Class::Storage> for the current schema.
1268 DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
1269 $_[0]->schema->storage
1272 =head2 add_relationship
1276 =item Arguments: $rel_name, $related_source_name, \%cond, \%attrs?
1278 =item Return Value: 1/true if it succeeded
1282 $source->add_relationship('rel_name', 'related_source', $cond, $attrs);
1284 L<DBIx::Class::Relationship> describes a series of methods which
1285 create pre-defined useful types of relationships. Look there first
1286 before using this method directly.
1288 The relationship name can be arbitrary, but must be unique for each
1289 relationship attached to this result source. 'related_source' should
1290 be the name with which the related result source was registered with
1291 the current schema. For example:
1293 $schema->source('Book')->add_relationship('reviews', 'Review', {
1294 'foreign.book_id' => 'self.id',
1297 The condition C<$cond> needs to be an L<SQL::Abstract>-style
1298 representation of the join between the tables. For example, if you're
1299 creating a relation from Author to Book,
1301 { 'foreign.author_id' => 'self.id' }
1303 will result in the JOIN clause
1305 author me JOIN book foreign ON foreign.author_id = me.id
1307 You can specify as many foreign => self mappings as necessary.
1309 Valid attributes are as follows:
1315 Explicitly specifies the type of join to use in the relationship. Any
1316 SQL join type is valid, e.g. C<LEFT> or C<RIGHT>. It will be placed in
1317 the SQL command immediately before C<JOIN>.
1321 An arrayref containing a list of accessors in the foreign class to proxy in
1322 the main class. If, for example, you do the following:
1324 CD->might_have(liner_notes => 'LinerNotes', undef, {
1325 proxy => [ qw/notes/ ],
1328 Then, assuming LinerNotes has an accessor named notes, you can do:
1330 my $cd = CD->find(1);
1331 # set notes -- LinerNotes object is created if it doesn't exist
1332 $cd->notes('Notes go here');
1336 Specifies the type of accessor that should be created for the
1337 relationship. Valid values are C<single> (for when there is only a single
1338 related object), C<multi> (when there can be many), and C<filter> (for
1339 when there is a single related object, but you also want the relationship
1340 accessor to double as a column accessor). For C<multi> accessors, an
1341 add_to_* method is also created, which calls C<create_related> for the
1346 Throws an exception if the condition is improperly supplied, or cannot
1351 sub add_relationship {
1352 my ($self, $rel, $f_source_name, $cond, $attrs) = @_;
1353 $self->throw_exception("Can't create relationship without join condition")
1357 # Check foreign and self are right in cond
1358 if ( (ref $cond ||'') eq 'HASH') {
1359 $_ =~ /^foreign\./ or $self->throw_exception("Malformed relationship condition key '$_': must be prefixed with 'foreign.'")
1362 $_ =~ /^self\./ or $self->throw_exception("Malformed relationship condition value '$_': must be prefixed with 'self.'")
1366 my %rels = %{ $self->_relationships };
1367 $rels{$rel} = { class => $f_source_name,
1368 source => $f_source_name,
1371 $self->_relationships(\%rels);
1376 =head2 relationships
1380 =item Arguments: none
1382 =item Return Value: L<@rel_names|DBIx::Class::Relationship>
1386 my @rel_names = $source->relationships();
1388 Returns all relationship names for this source.
1393 keys %{$_[0]->_relationships};
1396 =head2 relationship_info
1400 =item Arguments: L<$rel_name|DBIx::Class::Relationship>
1402 =item Return Value: L<\%rel_data|DBIx::Class::Relationship::Base/add_relationship>
1406 Returns a hash of relationship information for the specified relationship
1407 name. The keys/values are as specified for L<DBIx::Class::Relationship::Base/add_relationship>.
1411 sub relationship_info {
1412 #my ($self, $rel) = @_;
1413 return shift->_relationships->{+shift};
1416 =head2 has_relationship
1420 =item Arguments: L<$rel_name|DBIx::Class::Relationship>
1422 =item Return Value: 1/0 (true/false)
1426 Returns true if the source has a relationship of this name, false otherwise.
1430 sub has_relationship {
1431 #my ($self, $rel) = @_;
1432 return exists shift->_relationships->{+shift};
1435 =head2 reverse_relationship_info
1439 =item Arguments: L<$rel_name|DBIx::Class::Relationship>
1441 =item Return Value: L<\%rel_data|DBIx::Class::Relationship::Base/add_relationship>
1445 Looks through all the relationships on the source this relationship
1446 points to, looking for one whose condition is the reverse of the
1447 condition on this relationship.
1449 A common use of this is to find the name of the C<belongs_to> relation
1450 opposing a C<has_many> relation. For definition of these look in
1451 L<DBIx::Class::Relationship>.
1453 The returned hashref is keyed by the name of the opposing
1454 relationship, and contains its data in the same manner as
1455 L</relationship_info>.
1459 sub reverse_relationship_info {
1460 my ($self, $rel) = @_;
1462 my $rel_info = $self->relationship_info($rel)
1463 or $self->throw_exception("No such relationship '$rel'");
1467 return $ret unless ((ref $rel_info->{cond}) eq 'HASH');
1469 my $stripped_cond = $self->__strip_relcond ($rel_info->{cond});
1471 my $registered_source_name = $self->source_name;
1473 # this may be a partial schema or something else equally esoteric
1474 my $other_rsrc = $self->related_source($rel);
1476 # Get all the relationships for that source that related to this source
1477 # whose foreign column set are our self columns on $rel and whose self
1478 # columns are our foreign columns on $rel
1479 foreach my $other_rel ($other_rsrc->relationships) {
1481 # only consider stuff that points back to us
1482 # "us" here is tricky - if we are in a schema registration, we want
1483 # to use the source_names, otherwise we will use the actual classes
1485 # the schema may be partial
1486 my $roundtrip_rsrc = dbic_internal_try { $other_rsrc->related_source($other_rel) }
1489 if ($registered_source_name) {
1490 next if $registered_source_name ne ($roundtrip_rsrc->source_name || '')
1493 next if $self->result_class ne $roundtrip_rsrc->result_class;
1496 my $other_rel_info = $other_rsrc->relationship_info($other_rel);
1498 # this can happen when we have a self-referential class
1499 next if $other_rel_info eq $rel_info;
1501 next unless ref $other_rel_info->{cond} eq 'HASH';
1502 my $other_stripped_cond = $self->__strip_relcond($other_rel_info->{cond});
1504 $ret->{$other_rel} = $other_rel_info if (
1505 $self->_compare_relationship_keys (
1506 [ keys %$stripped_cond ], [ values %$other_stripped_cond ]
1509 $self->_compare_relationship_keys (
1510 [ values %$stripped_cond ], [ keys %$other_stripped_cond ]
1518 # all this does is removes the foreign/self prefix from a condition
1519 sub __strip_relcond {
1522 { map { /^ (?:foreign|self) \. (\w+) $/x } ($_, $_[1]{$_}) }
1527 sub compare_relationship_keys {
1528 carp 'compare_relationship_keys is a private method, stop calling it';
1530 $self->_compare_relationship_keys (@_);
1533 # Returns true if both sets of keynames are the same, false otherwise.
1534 sub _compare_relationship_keys {
1535 # my ($self, $keys1, $keys2) = @_;
1537 join ("\x00", sort @{$_[1]})
1539 join ("\x00", sort @{$_[2]})
1543 # optionally takes either an arrayref of column names, or a hashref of already
1544 # retrieved colinfos
1545 # returns an arrayref of column names of the shortest unique constraint
1546 # (matching some of the input if any), giving preference to the PK
1547 sub _identifying_column_set {
1548 my ($self, $cols) = @_;
1550 my %unique = $self->unique_constraints;
1551 my $colinfos = ref $cols eq 'HASH' ? $cols : $self->columns_info($cols||());
1553 # always prefer the PK first, and then shortest constraints first
1555 for my $set (delete $unique{primary}, sort { @$a <=> @$b } (values %unique) ) {
1556 next unless $set && @$set;
1559 next USET unless ($colinfos->{$_} && !$colinfos->{$_}{is_nullable} );
1562 # copy so we can mangle it at will
1569 sub _minimal_valueset_satisfying_constraint {
1571 my $args = { ref $_[0] eq 'HASH' ? %{ $_[0] } : @_ };
1573 $args->{columns_info} ||= $self->columns_info;
1575 my $vals = $self->schema->storage->_extract_fixed_condition_columns(
1577 ($args->{carp_on_nulls} ? 'consider_nulls' : undef ),
1581 for my $col ($self->unique_constraint_columns($args->{constraint_name}) ) {
1582 if( ! exists $vals->{$col} or ( $vals->{$col}||'' ) eq UNRESOLVABLE_CONDITION ) {
1583 $cols->{missing}{$col} = undef;
1585 elsif( ! defined $vals->{$col} ) {
1586 $cols->{$args->{carp_on_nulls} ? 'undefined' : 'missing'}{$col} = undef;
1589 # we need to inject back the '=' as _extract_fixed_condition_columns
1590 # will strip it from literals and values alike, resulting in an invalid
1591 # condition in the end
1592 $cols->{present}{$col} = { '=' => $vals->{$col} };
1595 $cols->{fc}{$col} = 1 if (
1596 ( ! $cols->{missing} or ! exists $cols->{missing}{$col} )
1598 keys %{ $args->{columns_info}{$col}{_filter_info} || {} }
1602 $self->throw_exception( sprintf ( "Unable to satisfy requested constraint '%s', missing values for column(s): %s",
1603 $args->{constraint_name},
1604 join (', ', map { "'$_'" } sort keys %{$cols->{missing}} ),
1605 ) ) if $cols->{missing};
1607 $self->throw_exception( sprintf (
1608 "Unable to satisfy requested constraint '%s', FilterColumn values not usable for column(s): %s",
1609 $args->{constraint_name},
1610 join (', ', map { "'$_'" } sort keys %{$cols->{fc}}),
1616 !$ENV{DBIC_NULLABLE_KEY_NOWARN}
1618 carp_unique ( sprintf (
1619 "NULL/undef values supplied for requested unique constraint '%s' (NULL "
1620 . 'values in column(s): %s). This is almost certainly not what you wanted, '
1621 . 'though you can set DBIC_NULLABLE_KEY_NOWARN to disable this warning.',
1622 $args->{constraint_name},
1623 join (', ', map { "'$_'" } sort keys %{$cols->{undefined}}),
1627 return { map { %{ $cols->{$_}||{} } } qw(present undefined) };
1630 # Returns the {from} structure used to express JOIN conditions
1632 my ($self, $join, $alias, $seen, $jpath, $parent_force_left) = @_;
1634 # we need a supplied one, because we do in-place modifications, no returns
1635 $self->throw_exception ('You must supply a seen hashref as the 3rd argument to _resolve_join')
1636 unless ref $seen eq 'HASH';
1638 $self->throw_exception ('You must supply a joinpath arrayref as the 4th argument to _resolve_join')
1639 unless ref $jpath eq 'ARRAY';
1641 $jpath = [@$jpath]; # copy
1643 if (not defined $join or not length $join) {
1646 elsif (ref $join eq 'ARRAY') {
1649 $self->_resolve_join($_, $alias, $seen, $jpath, $parent_force_left);
1652 elsif (ref $join eq 'HASH') {
1655 for my $rel (keys %$join) {
1657 my $rel_info = $self->relationship_info($rel)
1658 or $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
1660 my $force_left = $parent_force_left;
1661 $force_left ||= lc($rel_info->{attrs}{join_type}||'') eq 'left';
1663 # the actual seen value will be incremented by the recursion
1664 my $as = $self->schema->storage->relname_to_table_alias(
1665 $rel, ($seen->{$rel} && $seen->{$rel} + 1)
1669 $self->_resolve_join($rel, $alias, $seen, [@$jpath], $force_left),
1670 $self->related_source($rel)->_resolve_join(
1671 $join->{$rel}, $as, $seen, [@$jpath, { $rel => $as }], $force_left
1679 $self->throw_exception("No idea how to resolve join reftype ".ref $join);
1682 my $count = ++$seen->{$join};
1683 my $as = $self->schema->storage->relname_to_table_alias(
1684 $join, ($count > 1 && $count)
1687 my $rel_info = $self->relationship_info($join)
1688 or $self->throw_exception("No such relationship $join on " . $self->source_name);
1690 my $rel_src = $self->related_source($join);
1691 return [ { $as => $rel_src->from,
1693 -join_type => $parent_force_left
1695 : $rel_info->{attrs}{join_type}
1697 -join_path => [@$jpath, { $join => $as } ],
1699 ! $rel_info->{attrs}{accessor}
1701 $rel_info->{attrs}{accessor} eq 'single'
1703 $rel_info->{attrs}{accessor} eq 'filter'
1706 -relation_chain_depth => ( $seen->{-relation_chain_depth} || 0 ) + 1,
1708 $self->_resolve_relationship_condition(
1710 self_alias => $alias,
1711 foreign_alias => $as,
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';
1807 # where-is-waldo block guesses relname, then further down we override it if available
1809 $is_objlike[1] ? ( rel_name => $res_args[0], self_alias => $res_args[0], foreign_alias => 'me', self_result_object => $res_args[1] )
1810 : $is_objlike[0] ? ( rel_name => $res_args[1], self_alias => 'me', foreign_alias => $res_args[1], foreign_values => $res_args[0] )
1811 : ( rel_name => $res_args[0], self_alias => $res_args[1], foreign_alias => $res_args[0] )
1814 ( $rel_name ? ( rel_name => $rel_name ) : () ),
1817 # Allowing passing relconds different than the relationshup itself is cute,
1818 # but likely dangerous. Remove that from the (still unofficial) API of
1819 # _resolve_relationship_condition, and instead make it "hard on purpose"
1820 local $self->relationship_info( $args->{rel_name} )->{cond} = $cond if defined $cond;
1822 #######################
1824 # now it's fucking easy isn't it?!
1825 my $rc = $self->_resolve_relationship_condition( $args );
1828 ( $rc->{join_free_condition} || $rc->{condition} ),
1829 ! $rc->{join_free_condition},
1832 # _resolve_relationship_condition always returns qualified cols even in the
1833 # case of join_free_condition, but nothing downstream expects this
1834 if ($rc->{join_free_condition} and ref $res[0] eq 'HASH') {
1836 { ($_ =~ /\.(.+)/) => $res[0]{$_} }
1842 return wantarray ? @res : $res[0];
1845 # Keep this indefinitely. There is evidence of both CPAN and
1846 # darkpan using it, and there isn't much harm in an extra var
1848 our $UNRESOLVABLE_CONDITION = UNRESOLVABLE_CONDITION;
1849 # YES I KNOW THIS IS EVIL
1850 # it is there to save darkpan from themselves, since internally
1851 # we are moving to a constant
1852 Internals::SvREADONLY($UNRESOLVABLE_CONDITION => 1);
1854 # Resolves the passed condition to a concrete query fragment and extra
1857 ## self-explanatory API, modeled on the custom cond coderef:
1858 # rel_name => (scalar)
1859 # foreign_alias => (scalar)
1860 # foreign_values => (either not supplied, or a hashref, or a foreign ResultObject (to be ->get_columns()ed), or plain undef )
1861 # self_alias => (scalar)
1862 # self_result_object => (either not supplied or a result object)
1863 # require_join_free_condition => (boolean, throws on failure to construct a JF-cond)
1864 # infer_values_based_on => (either not supplied or a hashref, implies require_join_free_condition)
1867 # condition => (a valid *likely fully qualified* sqla cond structure)
1868 # identity_map => (a hashref of foreign-to-self *unqualified* column equality names)
1869 # join_free_condition => (a valid *fully qualified* sqla cond structure, maybe unset)
1870 # inferred_values => (in case of an available join_free condition, this is a hashref of
1871 # *unqualified* column/value *EQUALITY* pairs, representing an amalgamation
1872 # of the JF-cond parse and infer_values_based_on
1873 # always either complete or unset)
1875 sub _resolve_relationship_condition {
1878 my $args = { ref $_[0] eq 'HASH' ? %{ $_[0] } : @_ };
1880 for ( qw( rel_name self_alias foreign_alias ) ) {
1881 $self->throw_exception("Mandatory argument '$_' to _resolve_relationship_condition() is not a plain string")
1882 if !defined $args->{$_} or length ref $args->{$_};
1885 $self->throw_exception("Arguments 'self_alias' and 'foreign_alias' may not be identical")
1886 if $args->{self_alias} eq $args->{foreign_alias};
1889 my $exception_rel_id = "relationship '$args->{rel_name}' on source '@{[ $self->source_name ]}'";
1891 my $rel_info = $self->relationship_info($args->{rel_name})
1893 # or $self->throw_exception( "No such $exception_rel_id" );
1894 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");
1897 $exception_rel_id = "relationship '$rel_info->{_original_name}' on source '@{[ $self->source_name ]}'"
1898 if $rel_info and exists $rel_info->{_original_name};
1900 $self->throw_exception("No practical way to resolve $exception_rel_id between two data structures")
1901 if exists $args->{self_result_object} and exists $args->{foreign_values};
1903 $self->throw_exception( "Argument to infer_values_based_on must be a hash" )
1904 if exists $args->{infer_values_based_on} and ref $args->{infer_values_based_on} ne 'HASH';
1906 $args->{require_join_free_condition} ||= !!$args->{infer_values_based_on};
1908 $self->throw_exception( "Argument 'self_result_object' must be an object inheriting from DBIx::Class::Row" )
1910 exists $args->{self_result_object}
1912 ( ! 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});
1917 my $storage = $self->schema->storage;
1919 if (exists $args->{foreign_values}) {
1921 if (! defined $args->{foreign_values} ) {
1922 # fallback: undef => {}
1923 $args->{foreign_values} = {};
1925 elsif (defined blessed $args->{foreign_values}) {
1927 $self->throw_exception( "Objects supplied as 'foreign_values' ($args->{foreign_values}) must inherit from DBIx::Class::Row" )
1928 unless $args->{foreign_values}->isa('DBIx::Class::Row');
1931 "Objects supplied as 'foreign_values' ($args->{foreign_values}) "
1932 . "usually should inherit from the related ResultClass ('@{[ $rel_rsrc->result_class ]}'), "
1933 . "perhaps you've made a mistake invoking the condition resolver?"
1934 ) unless $args->{foreign_values}->isa($rel_rsrc->result_class);
1936 $args->{foreign_values} = { $args->{foreign_values}->get_columns };
1938 elsif ( ref $args->{foreign_values} eq 'HASH' ) {
1940 # re-build {foreign_values} excluding identically named rels
1941 if( keys %{$args->{foreign_values}} ) {
1943 my ($col_idx, $rel_idx) = map
1944 { { map { $_ => 1 } $rel_rsrc->$_ } }
1945 qw( columns relationships )
1948 my $equivalencies = $storage->_extract_fixed_condition_columns(
1949 $args->{foreign_values},
1953 $args->{foreign_values} = { map {
1954 # skip if relationship *and* a non-literal ref
1955 # this means a multicreate stub was passed in
1959 length ref $args->{foreign_values}{$_}
1961 ! is_literal_value($args->{foreign_values}{$_})
1966 ? $self->throw_exception( "Key '$_' supplied as 'foreign_values' is not a column on related source '@{[ $rel_rsrc->source_name ]}'" )
1967 : ( !exists $equivalencies->{$_} or ($equivalencies->{$_}||'') eq UNRESOLVABLE_CONDITION )
1968 ? $self->throw_exception( "Value supplied for '...{foreign_values}{$_}' is not a direct equivalence expression" )
1969 : $args->{foreign_values}{$_}
1971 } keys %{$args->{foreign_values}} };
1975 $self->throw_exception(
1976 "Argument 'foreign_values' must be either an object inheriting from '@{[ $rel_rsrc->result_class ]}', "
1977 . "or a hash reference, or undef"
1984 if (ref $rel_info->{cond} eq 'CODE') {
1987 rel_name => $args->{rel_name},
1988 self_resultsource => $self,
1989 self_alias => $args->{self_alias},
1990 foreign_alias => $args->{foreign_alias},
1992 { (exists $args->{$_}) ? ( $_ => $args->{$_} ) : () }
1993 qw( self_result_object foreign_values )
1997 # legacy - never remove these!!!
1998 $cref_args->{foreign_relname} = $cref_args->{rel_name};
2000 $cref_args->{self_rowobj} = $cref_args->{self_result_object}
2001 if exists $cref_args->{self_result_object};
2003 ($ret->{condition}, $ret->{join_free_condition}, my @extra) = $rel_info->{cond}->($cref_args);
2006 $self->throw_exception("A custom condition coderef can return at most 2 conditions, but $exception_rel_id returned extra values: @extra")
2009 if (my $jfc = $ret->{join_free_condition}) {
2011 $self->throw_exception (
2012 "The join-free condition returned for $exception_rel_id must be a hash reference"
2013 ) unless ref $jfc eq 'HASH';
2015 my ($joinfree_alias, $joinfree_source);
2016 if (defined $args->{self_result_object}) {
2017 $joinfree_alias = $args->{foreign_alias};
2018 $joinfree_source = $rel_rsrc;
2020 elsif (defined $args->{foreign_values}) {
2021 $joinfree_alias = $args->{self_alias};
2022 $joinfree_source = $self;
2025 # FIXME sanity check until things stabilize, remove at some point
2026 $self->throw_exception (
2027 "A join-free condition returned for $exception_rel_id without a result object to chain from"
2028 ) unless $joinfree_alias;
2030 my $fq_col_list = { map
2031 { ( "$joinfree_alias.$_" => 1 ) }
2032 $joinfree_source->columns
2035 exists $fq_col_list->{$_} or $self->throw_exception (
2036 "The join-free condition returned for $exception_rel_id may only "
2037 . 'contain keys that are fully qualified column names of the corresponding source '
2038 . "'$joinfree_alias' (instead it returned '$_')"
2046 $_->isa('DBIx::Class::Row')
2048 $self->throw_exception (
2049 "The join-free condition returned for $exception_rel_id may not "
2050 . 'contain result objects as values - perhaps instead of invoking '
2051 . '->$something you meant to return ->get_column($something)'
2057 elsif (ref $rel_info->{cond} eq 'HASH') {
2059 # the condition is static - use parallel arrays
2060 # for a "pivot" depending on which side of the
2061 # rel did we get as an object
2062 my (@f_cols, @l_cols);
2063 for my $fc (keys %{ $rel_info->{cond} }) {
2064 my $lc = $rel_info->{cond}{$fc};
2066 # FIXME STRICTMODE should probably check these are valid columns
2067 $fc =~ s/^foreign\.// ||
2068 $self->throw_exception("Invalid rel cond key '$fc'");
2070 $lc =~ s/^self\.// ||
2071 $self->throw_exception("Invalid rel cond val '$lc'");
2077 # construct the crosstable condition and the identity map
2079 $ret->{condition}{"$args->{foreign_alias}.$f_cols[$_]"} = { -ident => "$args->{self_alias}.$l_cols[$_]" };
2080 $ret->{identity_map}{$l_cols[$_]} = $f_cols[$_];
2083 if ($args->{foreign_values}) {
2084 $ret->{join_free_condition}{"$args->{self_alias}.$l_cols[$_]"} = $args->{foreign_values}{$f_cols[$_]}
2087 elsif (defined $args->{self_result_object}) {
2089 for my $i (0..$#l_cols) {
2090 if ( $args->{self_result_object}->has_column_loaded($l_cols[$i]) ) {
2091 $ret->{join_free_condition}{"$args->{foreign_alias}.$f_cols[$i]"} = $args->{self_result_object}->get_column($l_cols[$i]);
2094 $self->throw_exception(sprintf
2095 "Unable to resolve relationship '%s' from object '%s': column '%s' not "
2096 . 'loaded from storage (or not passed to new() prior to insert()). You '
2097 . 'probably need to call ->discard_changes to get the server-side defaults '
2098 . 'from the database.',
2100 $args->{self_result_object},
2102 ) if $args->{self_result_object}->in_storage;
2104 # FIXME - temporarly force-override
2105 delete $args->{require_join_free_condition};
2106 $ret->{join_free_condition} = UNRESOLVABLE_CONDITION;
2112 elsif (ref $rel_info->{cond} eq 'ARRAY') {
2113 if (@{ $rel_info->{cond} } == 0) {
2115 condition => UNRESOLVABLE_CONDITION,
2116 join_free_condition => UNRESOLVABLE_CONDITION,
2120 my @subconds = map {
2121 local $rel_info->{cond} = $_;
2122 $self->_resolve_relationship_condition( $args );
2123 } @{ $rel_info->{cond} };
2125 if( @{ $rel_info->{cond} } == 1 ) {
2126 $ret = $subconds[0];
2129 # we are discarding inferred values here... likely incorrect...
2130 # then again - the entire thing is an OR, so we *can't* use them anyway
2131 for my $subcond ( @subconds ) {
2132 $self->throw_exception('Either all or none of the OR-condition members must resolve to a join-free condition')
2133 if ( $ret and ( $ret->{join_free_condition} xor $subcond->{join_free_condition} ) );
2135 $subcond->{$_} and push @{$ret->{$_}}, $subcond->{$_} for (qw(condition join_free_condition));
2141 $self->throw_exception ("Can't handle condition $rel_info->{cond} for $exception_rel_id yet :(");
2145 $args->{require_join_free_condition}
2147 ( ! $ret->{join_free_condition} or $ret->{join_free_condition} eq UNRESOLVABLE_CONDITION )
2149 $self->throw_exception(
2150 ucfirst sprintf "$exception_rel_id does not resolve to a %sjoin-free condition fragment",
2151 exists $args->{foreign_values}
2152 ? "'foreign_values'-based reversed-"
2157 # we got something back - sanity check and infer values if we can
2160 $ret->{join_free_condition}
2162 $ret->{join_free_condition} ne UNRESOLVABLE_CONDITION
2164 my $jfc = $storage->_collapse_cond( $ret->{join_free_condition} )
2167 my $jfc_eqs = $storage->_extract_fixed_condition_columns($jfc, 'consider_nulls');
2169 if (keys %$jfc_eqs) {
2172 # $jfc is fully qualified by definition
2173 my ($col) = $_ =~ /\.(.+)/;
2175 if (exists $jfc_eqs->{$_} and ($jfc_eqs->{$_}||'') ne UNRESOLVABLE_CONDITION) {
2176 $ret->{inferred_values}{$col} = $jfc_eqs->{$_};
2178 elsif ( !$args->{infer_values_based_on} or ! exists $args->{infer_values_based_on}{$col} ) {
2179 push @nonvalues, $col;
2184 delete $ret->{inferred_values} if @nonvalues;
2188 # did the user explicitly ask
2189 if ($args->{infer_values_based_on}) {
2191 $self->throw_exception(sprintf (
2192 "Unable to complete value inferrence - custom $exception_rel_id returns conditions instead of values for column(s): %s",
2193 map { "'$_'" } @nonvalues
2197 $ret->{inferred_values} ||= {};
2199 $ret->{inferred_values}{$_} = $args->{infer_values_based_on}{$_}
2200 for keys %{$args->{infer_values_based_on}};
2203 # add the identities based on the main condition
2204 # (may already be there, since easy to calculate on the fly in the HASH case)
2205 if ( ! $ret->{identity_map} ) {
2207 my $col_eqs = $storage->_extract_fixed_condition_columns($ret->{condition});
2210 for my $lhs (keys %$col_eqs) {
2212 next if $col_eqs->{$lhs} eq UNRESOLVABLE_CONDITION;
2214 # there is no way to know who is right and who is left in a cref
2215 # therefore a full blown resolution call, and figure out the
2216 # direction a bit further below
2217 $colinfos ||= $storage->_resolve_column_info([
2218 { -alias => $args->{self_alias}, -rsrc => $self },
2219 { -alias => $args->{foreign_alias}, -rsrc => $rel_rsrc },
2222 next unless $colinfos->{$lhs}; # someone is engaging in witchcraft
2224 if ( my $rhs_ref = is_literal_value( $col_eqs->{$lhs} ) ) {
2227 $colinfos->{$rhs_ref->[0]}
2229 $colinfos->{$lhs}{-source_alias} ne $colinfos->{$rhs_ref->[0]}{-source_alias}
2231 ( $colinfos->{$lhs}{-source_alias} eq $args->{self_alias} )
2232 ? ( $ret->{identity_map}{$colinfos->{$lhs}{-colname}} = $colinfos->{$rhs_ref->[0]}{-colname} )
2233 : ( $ret->{identity_map}{$colinfos->{$rhs_ref->[0]}{-colname}} = $colinfos->{$lhs}{-colname} )
2238 $col_eqs->{$lhs} =~ /^ ( \Q$args->{self_alias}\E \. .+ ) /x
2240 ($colinfos->{$1}||{})->{-result_source} == $rel_rsrc
2242 my ($lcol, $rcol) = map
2243 { $colinfos->{$_}{-colname} }
2247 "The $exception_rel_id specifies equality of column '$lcol' and the "
2248 . "*VALUE* '$rcol' (you did not use the { -ident => ... } operator)"
2254 # FIXME - temporary, to fool the idiotic check in SQLMaker::_join_condition
2255 $ret->{condition} = { -and => [ $ret->{condition} ] }
2256 unless $ret->{condition} eq UNRESOLVABLE_CONDITION;
2261 =head2 related_source
2265 =item Arguments: $rel_name
2267 =item Return Value: $source
2271 Returns the result source object for the given relationship.
2275 sub related_source {
2276 my ($self, $rel) = @_;
2277 if( !$self->has_relationship( $rel ) ) {
2278 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
2281 # if we are not registered with a schema - just use the prototype
2282 # however if we do have a schema - ask for the source by name (and
2283 # throw in the process if all fails)
2284 if (my $schema = dbic_internal_try { $self->schema }) {
2285 $schema->source($self->relationship_info($rel)->{source});
2288 my $class = $self->relationship_info($rel)->{class};
2289 $self->ensure_class_loaded($class);
2290 $class->result_source_instance;
2294 =head2 related_class
2298 =item Arguments: $rel_name
2300 =item Return Value: $classname
2304 Returns the class name for objects in the given relationship.
2309 my ($self, $rel) = @_;
2310 if( !$self->has_relationship( $rel ) ) {
2311 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
2313 return $self->schema->class($self->relationship_info($rel)->{source});
2320 =item Arguments: none
2322 =item Return Value: L<$source_handle|DBIx::Class::ResultSourceHandle>
2326 Obtain a new L<result source handle instance|DBIx::Class::ResultSourceHandle>
2327 for this source. Used as a serializable pointer to this resultsource, as it is not
2328 easy (nor advisable) to serialize CODErefs which may very well be present in e.g.
2329 relationship definitions.
2334 require DBIx::Class::ResultSourceHandle;
2335 return DBIx::Class::ResultSourceHandle->new({
2336 source_moniker => $_[0]->source_name,
2338 # so that a detached thaw can be re-frozen
2339 $_[0]->{_detached_thaw}
2340 ? ( _detached_source => $_[0] )
2341 : ( schema => $_[0]->schema )
2346 my $global_phase_destroy;
2348 ### NO detected_reinvoked_destructor check
2349 ### This code very much relies on being called multuple times
2351 return if $global_phase_destroy ||= in_global_destruction;
2357 # Under no circumstances shall $_[0] be stored anywhere else (like copied to
2358 # a lexical variable, or shifted, or anything else). Doing so will mess up
2359 # the refcount of this particular result source, and will allow the $schema
2360 # we are trying to save to reattach back to the source we are destroying.
2361 # The relevant code checking refcounts is in ::Schema::DESTROY()
2363 # if we are not a schema instance holder - we don't matter
2365 ! ref $_[0]->{schema}
2367 isweak $_[0]->{schema}
2370 # weaken our schema hold forcing the schema to find somewhere else to live
2371 # during global destruction (if we have not yet bailed out) this will throw
2372 # which will serve as a signal to not try doing anything else
2373 # however beware - on older perls the exception seems randomly untrappable
2374 # due to some weird race condition during thread joining :(((
2375 local $SIG{__DIE__} if $SIG{__DIE__};
2376 local $@ if DBIx::Class::_ENV_::UNSTABLE_DOLLARAT;
2378 weaken $_[0]->{schema};
2380 # if schema is still there reintroduce ourselves with strong refs back to us
2381 if ($_[0]->{schema}) {
2382 my $srcregs = $_[0]->{schema}->source_registrations;
2384 defined $srcregs->{$_}
2386 $srcregs->{$_} == $_[0]
2388 $srcregs->{$_} = $_[0]
2396 $global_phase_destroy = 1;
2399 # Dummy NEXTSTATE ensuring the all temporaries on the stack are garbage
2400 # collected before leaving this scope. Depending on the code above, this
2401 # may very well be just a preventive measure guarding future modifications
2405 sub STORABLE_freeze { Storable::nfreeze($_[0]->handle) }
2408 my ($self, $cloning, $ice) = @_;
2409 %$self = %{ (Storable::thaw($ice))->resolve };
2412 =head2 throw_exception
2414 See L<DBIx::Class::Schema/"throw_exception">.
2418 sub throw_exception {
2422 ? $self->{schema}->throw_exception(@_)
2423 : DBIx::Class::Exception->throw(@_)
2427 =head2 column_info_from_storage
2431 =item Arguments: 1/0 (default: 0)
2433 =item Return Value: 1/0
2437 __PACKAGE__->column_info_from_storage(1);
2439 Enables the on-demand automatic loading of the above column
2440 metadata from storage as necessary. This is *deprecated*, and
2441 should not be used. It will be removed before 1.0.
2443 =head1 FURTHER QUESTIONS?
2445 Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
2447 =head1 COPYRIGHT AND LICENSE
2449 This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
2450 by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
2451 redistribute it and/or modify it under the same terms as the
2452 L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.