1 package DBIx::Class::ResultSource;
6 use base 'DBIx::Class::ResultSource::RowParser';
10 use DBIx::Class::_Util qw( UNRESOLVABLE_CONDITION dbic_internal_try fail_on_internal_call );
11 use SQL::Abstract 'is_literal_value';
12 use Devel::GlobalDestruction;
13 use Scalar::Util qw/blessed weaken isweak/;
15 # FIXME - somehow breaks ResultSetManager, do not remove until investigated
16 use DBIx::Class::ResultSet;
20 __PACKAGE__->mk_group_accessors(simple => qw/
21 source_name name source_info
22 _ordered_columns _columns _primaries _unique_constraints
23 _relationships resultset_attributes
24 column_info_from_storage sqlt_deploy_callback
27 __PACKAGE__->mk_group_accessors(component_class => qw/
34 DBIx::Class::ResultSource - Result source object
38 # Create a table based result source, in a result class.
40 package MyApp::Schema::Result::Artist;
41 use base qw/DBIx::Class::Core/;
43 __PACKAGE__->table('artist');
44 __PACKAGE__->add_columns(qw/ artistid name /);
45 __PACKAGE__->set_primary_key('artistid');
46 __PACKAGE__->has_many(cds => 'MyApp::Schema::Result::CD');
50 # Create a query (view) based result source, in a result class
51 package MyApp::Schema::Result::Year2000CDs;
52 use base qw/DBIx::Class::Core/;
54 __PACKAGE__->load_components('InflateColumn::DateTime');
55 __PACKAGE__->table_class('DBIx::Class::ResultSource::View');
57 __PACKAGE__->table('year2000cds');
58 __PACKAGE__->result_source_instance->is_virtual(1);
59 __PACKAGE__->result_source_instance->view_definition(
60 "SELECT cdid, artist, title FROM cd WHERE year ='2000'"
66 A ResultSource is an object that represents a source of data for querying.
68 This class is a base class for various specialised types of result
69 sources, for example L<DBIx::Class::ResultSource::Table>. Table is the
70 default result source type, so one is created for you when defining a
71 result class as described in the synopsis above.
73 More specifically, the L<DBIx::Class::Core> base class pulls in the
74 L<DBIx::Class::ResultSourceProxy::Table> component, which defines
75 the L<table|DBIx::Class::ResultSourceProxy::Table/table> method.
76 When called, C<table> creates and stores an instance of
77 L<DBIx::Class::ResultSource::Table>. Luckily, to use tables as result
78 sources, you don't need to remember any of this.
80 Result sources representing select queries, or views, can also be
81 created, see L<DBIx::Class::ResultSource::View> for full details.
83 =head2 Finding result source objects
85 As mentioned above, a result source instance is created and stored for
87 L<Result Class|DBIx::Class::Manual::Glossary/Result Class>.
89 You can retrieve the result source at runtime in the following ways:
93 =item From a Schema object:
95 $schema->source($source_name);
97 =item From a Result object:
99 $result->result_source;
101 =item From a ResultSet object:
113 $class->new({attribute_name => value});
115 Creates a new ResultSource object. Not normally called directly by end users.
120 my ($class, $attrs) = @_;
121 $class = ref $class if ref $class;
123 my $new = bless { %{$attrs || {}} }, $class;
124 $new->{resultset_class} ||= 'DBIx::Class::ResultSet';
125 $new->{resultset_attributes} = { %{$new->{resultset_attributes} || {}} };
126 $new->{_ordered_columns} = [ @{$new->{_ordered_columns}||[]}];
127 $new->{_columns} = { %{$new->{_columns}||{}} };
128 $new->{_relationships} = { %{$new->{_relationships}||{}} };
129 $new->{name} ||= "!!NAME NOT SET!!";
130 $new->{_columns_info_loaded} ||= 0;
131 $new->{sqlt_deploy_callback} ||= 'default_sqlt_deploy_hook';
141 =item Arguments: @columns
143 =item Return Value: L<$result_source|/new>
147 $source->add_columns(qw/col1 col2 col3/);
149 $source->add_columns('col1' => \%col1_info, 'col2' => \%col2_info, ...);
151 $source->add_columns(
152 'col1' => { data_type => 'integer', is_nullable => 1, ... },
153 'col2' => { data_type => 'text', is_auto_increment => 1, ... },
156 Adds columns to the result source. If supplied colname => hashref
157 pairs, uses the hashref as the L</column_info> for that column. Repeated
158 calls of this method will add more columns, not replace them.
160 The column names given will be created as accessor methods on your
161 L<Result|DBIx::Class::Manual::ResultClass> objects. You can change the name of the accessor
162 by supplying an L</accessor> in the column_info hash.
164 If a column name beginning with a plus sign ('+col1') is provided, the
165 attributes provided will be merged with any existing attributes for the
166 column, with the new attributes taking precedence in the case that an
167 attribute already exists. Using this without a hashref
168 (C<< $source->add_columns(qw/+col1 +col2/) >>) is legal, but useless --
169 it does the same thing it would do without the plus.
171 The contents of the column_info are not set in stone. The following
172 keys are currently recognised/used by DBIx::Class:
178 { accessor => '_name' }
180 # example use, replace standard accessor with one of your own:
182 my ($self, $value) = @_;
184 die "Name cannot contain digits!" if($value =~ /\d/);
185 $self->_name($value);
187 return $self->_name();
190 Use this to set the name of the accessor method for this column. If unset,
191 the name of the column will be used.
195 { data_type => 'integer' }
197 This contains the column type. It is automatically filled if you use the
198 L<SQL::Translator::Producer::DBIx::Class::File> producer, or the
199 L<DBIx::Class::Schema::Loader> module.
201 Currently there is no standard set of values for the data_type. Use
202 whatever your database supports.
208 The length of your column, if it is a column type that can have a size
209 restriction. This is currently only used to create tables from your
210 schema, see L<DBIx::Class::Schema/deploy>.
214 For decimal or float values you can specify an ArrayRef in order to
215 control precision, assuming your database's
216 L<SQL::Translator::Producer> supports it.
222 Set this to a true value for a column that is allowed to contain NULL
223 values, default is false. This is currently only used to create tables
224 from your schema, see L<DBIx::Class::Schema/deploy>.
226 =item is_auto_increment
228 { is_auto_increment => 1 }
230 Set this to a true value for a column whose value is somehow
231 automatically set, defaults to false. This is used to determine which
232 columns to empty when cloning objects using
233 L<DBIx::Class::Row/copy>. It is also used by
234 L<DBIx::Class::Schema/deploy>.
240 Set this to a true or false value (not C<undef>) to explicitly specify
241 if this column contains numeric data. This controls how set_column
242 decides whether to consider a column dirty after an update: if
243 C<is_numeric> is true a numeric comparison C<< != >> will take place
244 instead of the usual C<eq>
246 If not specified the storage class will attempt to figure this out on
247 first access to the column, based on the column C<data_type>. The
248 result will be cached in this attribute.
252 { is_foreign_key => 1 }
254 Set this to a true value for a column that contains a key from a
255 foreign table, defaults to false. This is currently only used to
256 create tables from your schema, see L<DBIx::Class::Schema/deploy>.
260 { default_value => \'now()' }
262 Set this to the default value which will be inserted into a column by
263 the database. Can contain either a value or a function (use a
264 reference to a scalar e.g. C<\'now()'> if you want a function). This
265 is currently only used to create tables from your schema, see
266 L<DBIx::Class::Schema/deploy>.
268 See the note on L<DBIx::Class::Row/new> for more information about possible
269 issues related to db-side default values.
273 { sequence => 'my_table_seq' }
275 Set this on a primary key column to the name of the sequence used to
276 generate a new key value. If not specified, L<DBIx::Class::PK::Auto>
277 will attempt to retrieve the name of the sequence from the database
280 =item retrieve_on_insert
282 { retrieve_on_insert => 1 }
284 For every column where this is set to true, DBIC will retrieve the RDBMS-side
285 value upon a new row insertion (normally only the autoincrement PK is
286 retrieved on insert). C<INSERT ... RETURNING> is used automatically if
287 supported by the underlying storage, otherwise an extra SELECT statement is
288 executed to retrieve the missing data.
292 { auto_nextval => 1 }
294 Set this to a true value for a column whose value is retrieved automatically
295 from a sequence or function (if supported by your Storage driver.) For a
296 sequence, if you do not use a trigger to get the nextval, you have to set the
297 L</sequence> value as well.
299 Also set this for MSSQL columns with the 'uniqueidentifier'
300 L<data_type|DBIx::Class::ResultSource/data_type> whose values you want to
301 automatically generate using C<NEWID()>, unless they are a primary key in which
302 case this will be done anyway.
306 This is used by L<DBIx::Class::Schema/deploy> and L<SQL::Translator>
307 to add extra non-generic data to the column. For example: C<< extra
308 => { unsigned => 1} >> is used by the MySQL producer to set an integer
309 column to unsigned. For more details, see
310 L<SQL::Translator::Producer::MySQL>.
318 =item Arguments: $colname, \%columninfo?
320 =item Return Value: 1/0 (true/false)
324 $source->add_column('col' => \%info);
326 Add a single column and optional column info. Uses the same column
327 info keys as L</add_columns>.
332 my ($self, @cols) = @_;
333 $self->_ordered_columns(\@cols) unless $self->_ordered_columns;
336 my $columns = $self->_columns;
337 while (my $col = shift @cols) {
338 my $column_info = {};
339 if ($col =~ s/^\+//) {
340 $column_info = $self->column_info($col);
343 # If next entry is { ... } use that for the column info, if not
344 # use an empty hashref
346 my $new_info = shift(@cols);
347 %$column_info = (%$column_info, %$new_info);
349 push(@added, $col) unless exists $columns->{$col};
350 $columns->{$col} = $column_info;
352 push @{ $self->_ordered_columns }, @added;
357 DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
358 shift->add_columns(@_)
365 =item Arguments: $colname
367 =item Return Value: 1/0 (true/false)
371 if ($source->has_column($colname)) { ... }
373 Returns true if the source has a column of this name, false otherwise.
378 my ($self, $column) = @_;
379 return exists $self->_columns->{$column};
386 =item Arguments: $colname
388 =item Return Value: Hashref of info
392 my $info = $source->column_info($col);
394 Returns the column metadata hashref for a column, as originally passed
395 to L</add_columns>. See L</add_columns> above for information on the
396 contents of the hashref.
401 my ($self, $column) = @_;
402 $self->throw_exception("No such column $column")
403 unless exists $self->_columns->{$column};
405 if ( ! $self->_columns->{$column}{data_type}
406 and ! $self->{_columns_info_loaded}
407 and $self->column_info_from_storage
408 and my $stor = dbic_internal_try { $self->schema->storage } )
410 $self->{_columns_info_loaded}++;
412 # try for the case of storage without table
414 my $info = $stor->columns_info_for( $self->from );
416 { (lc $_) => $info->{$_} }
420 foreach my $col ( keys %{$self->_columns} ) {
421 $self->_columns->{$col} = {
422 %{ $self->_columns->{$col} },
423 %{ $info->{$col} || $lc_info->{lc $col} || {} }
429 return $self->_columns->{$column};
436 =item Arguments: none
438 =item Return Value: Ordered list of column names
442 my @column_names = $source->columns;
444 Returns all column names in the order they were declared to L</add_columns>.
450 $self->throw_exception(
451 "columns() is a read-only accessor, did you mean add_columns()?"
453 return @{$self->{_ordered_columns}||[]};
460 =item Arguments: \@colnames ?
462 =item Return Value: Hashref of column name/info pairs
466 my $columns_info = $source->columns_info;
468 Like L</column_info> but returns information for the requested columns. If
469 the optional column-list arrayref is omitted it returns info on all columns
470 currently defined on the ResultSource via L</add_columns>.
475 my ($self, $columns) = @_;
477 my $colinfo = $self->_columns;
480 ! $self->{_columns_info_loaded}
482 $self->column_info_from_storage
484 grep { ! $_->{data_type} } values %$colinfo
486 my $stor = dbic_internal_try { $self->schema->storage }
488 $self->{_columns_info_loaded}++;
490 # try for the case of storage without table
492 my $info = $stor->columns_info_for( $self->from );
494 { (lc $_) => $info->{$_} }
498 foreach my $col ( keys %$colinfo ) {
500 %{ $colinfo->{$col} },
501 %{ $info->{$col} || $lc_info->{lc $col} || {} }
511 if (my $inf = $colinfo->{$_}) {
515 $self->throw_exception( sprintf (
516 "No such column '%s' on source '%s'",
518 $self->source_name || $self->name || 'Unknown source...?',
530 =head2 remove_columns
534 =item Arguments: @colnames
536 =item Return Value: not defined
540 $source->remove_columns(qw/col1 col2 col3/);
542 Removes the given list of columns by name, from the result source.
544 B<Warning>: Removing a column that is also used in the sources primary
545 key, or in one of the sources unique constraints, B<will> result in a
546 broken result source.
552 =item Arguments: $colname
554 =item Return Value: not defined
558 $source->remove_column('col');
560 Remove a single column by name from the result source, similar to
563 B<Warning>: Removing a column that is also used in the sources primary
564 key, or in one of the sources unique constraints, B<will> result in a
565 broken result source.
570 my ($self, @to_remove) = @_;
572 my $columns = $self->_columns
577 delete $columns->{$_};
581 $self->_ordered_columns([ grep { not $to_remove{$_} } @{$self->_ordered_columns} ]);
585 DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
586 shift->remove_columns(@_)
589 =head2 set_primary_key
593 =item Arguments: @cols
595 =item Return Value: not defined
599 Defines one or more columns as primary key for this source. Must be
600 called after L</add_columns>.
602 Additionally, defines a L<unique constraint|/add_unique_constraint>
605 Note: you normally do want to define a primary key on your sources
606 B<even if the underlying database table does not have a primary key>.
608 L<DBIx::Class::Manual::Intro/The Significance and Importance of Primary Keys>
613 sub set_primary_key {
614 my ($self, @cols) = @_;
616 my $colinfo = $self->columns_info(\@cols);
617 for my $col (@cols) {
618 carp_unique(sprintf (
619 "Primary key of source '%s' includes the column '%s' which has its "
620 . "'is_nullable' attribute set to true. This is a mistake and will cause "
621 . 'various Result-object operations to fail',
622 $self->source_name || $self->name || 'Unknown source...?',
624 )) if $colinfo->{$col}{is_nullable};
627 $self->_primaries(\@cols);
629 $self->add_unique_constraint(primary => \@cols);
632 =head2 primary_columns
636 =item Arguments: none
638 =item Return Value: Ordered list of primary column names
642 Read-only accessor which returns the list of primary keys, supplied by
647 sub primary_columns {
648 return @{shift->_primaries||[]};
651 # a helper method that will automatically die with a descriptive message if
652 # no pk is defined on the source in question. For internal use to save
653 # on if @pks... boilerplate
654 sub _pri_cols_or_die {
656 my @pcols = $self->primary_columns
657 or $self->throw_exception (sprintf(
658 "Operation requires a primary key to be declared on '%s' via set_primary_key",
659 # source_name is set only after schema-registration
660 $self->source_name || $self->result_class || $self->name || 'Unknown source...?',
665 # same as above but mandating single-column PK (used by relationship condition
667 sub _single_pri_col_or_die {
669 my ($pri, @too_many) = $self->_pri_cols_or_die;
671 $self->throw_exception( sprintf(
672 "Operation requires a single-column primary key declared on '%s'",
673 $self->source_name || $self->result_class || $self->name || 'Unknown source...?',
681 Manually define the correct sequence for your table, to avoid the overhead
682 associated with looking up the sequence automatically. The supplied sequence
683 will be applied to the L</column_info> of each L<primary_key|/set_primary_key>
687 =item Arguments: $sequence_name
689 =item Return Value: not defined
696 my ($self,$seq) = @_;
698 my @pks = $self->primary_columns
701 $_->{sequence} = $seq
702 for values %{ $self->columns_info (\@pks) };
706 =head2 add_unique_constraint
710 =item Arguments: $name?, \@colnames
712 =item Return Value: not defined
716 Declare a unique constraint on this source. Call once for each unique
719 # For UNIQUE (column1, column2)
720 __PACKAGE__->add_unique_constraint(
721 constraint_name => [ qw/column1 column2/ ],
724 Alternatively, you can specify only the columns:
726 __PACKAGE__->add_unique_constraint([ qw/column1 column2/ ]);
728 This will result in a unique constraint named
729 C<table_column1_column2>, where C<table> is replaced with the table
732 Unique constraints are used, for example, when you pass the constraint
733 name as the C<key> attribute to L<DBIx::Class::ResultSet/find>. Then
734 only columns in the constraint are searched.
736 Throws an error if any of the given column names do not yet exist on
741 sub add_unique_constraint {
745 $self->throw_exception(
746 'add_unique_constraint() does not accept multiple constraints, use '
747 . 'add_unique_constraints() instead'
752 if (ref $cols ne 'ARRAY') {
753 $self->throw_exception (
754 'Expecting an arrayref of constraint columns, got ' . ($cols||'NOTHING')
760 $name ||= $self->name_unique_constraint($cols);
762 foreach my $col (@$cols) {
763 $self->throw_exception("No such column $col on table " . $self->name)
764 unless $self->has_column($col);
767 my %unique_constraints = $self->unique_constraints;
768 $unique_constraints{$name} = $cols;
769 $self->_unique_constraints(\%unique_constraints);
772 =head2 add_unique_constraints
776 =item Arguments: @constraints
778 =item Return Value: not defined
782 Declare multiple unique constraints on this source.
784 __PACKAGE__->add_unique_constraints(
785 constraint_name1 => [ qw/column1 column2/ ],
786 constraint_name2 => [ qw/column2 column3/ ],
789 Alternatively, you can specify only the columns:
791 __PACKAGE__->add_unique_constraints(
792 [ qw/column1 column2/ ],
793 [ qw/column3 column4/ ]
796 This will result in unique constraints named C<table_column1_column2> and
797 C<table_column3_column4>, where C<table> is replaced with the table name.
799 Throws an error if any of the given column names do not yet exist on
802 See also L</add_unique_constraint>.
806 sub add_unique_constraints {
807 DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
810 my @constraints = @_;
812 if ( !(@constraints % 2) && grep { ref $_ ne 'ARRAY' } @constraints ) {
813 # with constraint name
814 while (my ($name, $constraint) = splice @constraints, 0, 2) {
815 $self->add_unique_constraint($name => $constraint);
820 foreach my $constraint (@constraints) {
821 $self->add_unique_constraint($constraint);
826 =head2 name_unique_constraint
830 =item Arguments: \@colnames
832 =item Return Value: Constraint name
836 $source->table('mytable');
837 $source->name_unique_constraint(['col1', 'col2']);
841 Return a name for a unique constraint containing the specified
842 columns. The name is created by joining the table name and each column
843 name, using an underscore character.
845 For example, a constraint on a table named C<cd> containing the columns
846 C<artist> and C<title> would result in a constraint name of C<cd_artist_title>.
848 This is used by L</add_unique_constraint> if you do not specify the
849 optional constraint name.
853 sub name_unique_constraint {
854 my ($self, $cols) = @_;
856 my $name = $self->name;
857 $name = $$name if (ref $name eq 'SCALAR');
858 $name =~ s/ ^ [^\.]+ \. //x; # strip possible schema qualifier
860 return join '_', $name, @$cols;
863 =head2 unique_constraints
867 =item Arguments: none
869 =item Return Value: Hash of unique constraint data
873 $source->unique_constraints();
875 Read-only accessor which returns a hash of unique constraints on this
878 The hash is keyed by constraint name, and contains an arrayref of
879 column names as values.
883 sub unique_constraints {
884 return %{shift->_unique_constraints||{}};
887 =head2 unique_constraint_names
891 =item Arguments: none
893 =item Return Value: Unique constraint names
897 $source->unique_constraint_names();
899 Returns the list of unique constraint names defined on this source.
903 sub unique_constraint_names {
906 my %unique_constraints = $self->unique_constraints;
908 return keys %unique_constraints;
911 =head2 unique_constraint_columns
915 =item Arguments: $constraintname
917 =item Return Value: List of constraint columns
921 $source->unique_constraint_columns('myconstraint');
923 Returns the list of columns that make up the specified unique constraint.
927 sub unique_constraint_columns {
928 my ($self, $constraint_name) = @_;
930 my %unique_constraints = $self->unique_constraints;
932 $self->throw_exception(
933 "Unknown unique constraint $constraint_name on '" . $self->name . "'"
934 ) unless exists $unique_constraints{$constraint_name};
936 return @{ $unique_constraints{$constraint_name} };
939 =head2 sqlt_deploy_callback
943 =item Arguments: $callback_name | \&callback_code
945 =item Return Value: $callback_name | \&callback_code
949 __PACKAGE__->result_source_instance->sqlt_deploy_callback('mycallbackmethod');
953 __PACKAGE__->result_source_instance->sqlt_deploy_callback(sub {
954 my ($source_instance, $sqlt_table) = @_;
958 An accessor to set a callback to be called during deployment of
959 the schema via L<DBIx::Class::Schema/create_ddl_dir> or
960 L<DBIx::Class::Schema/deploy>.
962 The callback can be set as either a code reference or the name of a
963 method in the current result class.
965 Defaults to L</default_sqlt_deploy_hook>.
967 Your callback will be passed the $source object representing the
968 ResultSource instance being deployed, and the
969 L<SQL::Translator::Schema::Table> object being created from it. The
970 callback can be used to manipulate the table object or add your own
971 customised indexes. If you need to manipulate a non-table object, use
972 the L<DBIx::Class::Schema/sqlt_deploy_hook>.
974 See L<DBIx::Class::Manual::Cookbook/Adding Indexes And Functions To
975 Your SQL> for examples.
977 This sqlt deployment callback can only be used to manipulate
978 SQL::Translator objects as they get turned into SQL. To execute
979 post-deploy statements which SQL::Translator does not currently
980 handle, override L<DBIx::Class::Schema/deploy> in your Schema class
981 and call L<dbh_do|DBIx::Class::Storage::DBI/dbh_do>.
983 =head2 default_sqlt_deploy_hook
985 This is the default deploy hook implementation which checks if your
986 current Result class has a C<sqlt_deploy_hook> method, and if present
987 invokes it B<on the Result class directly>. This is to preserve the
988 semantics of C<sqlt_deploy_hook> which was originally designed to expect
989 the Result class name and the
990 L<$sqlt_table instance|SQL::Translator::Schema::Table> of the table being
995 sub default_sqlt_deploy_hook {
998 my $class = $self->result_class;
1000 if ($class and $class->can('sqlt_deploy_hook')) {
1001 $class->sqlt_deploy_hook(@_);
1005 sub _invoke_sqlt_deploy_hook {
1007 if ( my $hook = $self->sqlt_deploy_callback) {
1016 =item Arguments: $classname
1018 =item Return Value: $classname
1022 use My::Schema::ResultClass::Inflator;
1025 use My::Schema::Artist;
1027 __PACKAGE__->result_class('My::Schema::ResultClass::Inflator');
1029 Set the default result class for this source. You can use this to create
1030 and use your own result inflator. See L<DBIx::Class::ResultSet/result_class>
1033 Please note that setting this to something like
1034 L<DBIx::Class::ResultClass::HashRefInflator> will make every result unblessed
1035 and make life more difficult. Inflators like those are better suited to
1036 temporary usage via L<DBIx::Class::ResultSet/result_class>.
1042 =item Arguments: none
1044 =item Return Value: L<$resultset|DBIx::Class::ResultSet>
1048 Returns a resultset for the given source. This will initially be created
1049 on demand by calling
1051 $self->resultset_class->new($self, $self->resultset_attributes)
1053 but is cached from then on unless resultset_class changes.
1055 =head2 resultset_class
1059 =item Arguments: $classname
1061 =item Return Value: $classname
1065 package My::Schema::ResultSet::Artist;
1066 use base 'DBIx::Class::ResultSet';
1069 # In the result class
1070 __PACKAGE__->resultset_class('My::Schema::ResultSet::Artist');
1073 $source->resultset_class('My::Schema::ResultSet::Artist');
1075 Set the class of the resultset. This is useful if you want to create your
1076 own resultset methods. Create your own class derived from
1077 L<DBIx::Class::ResultSet>, and set it here. If called with no arguments,
1078 this method returns the name of the existing resultset class, if one
1081 =head2 resultset_attributes
1085 =item Arguments: L<\%attrs|DBIx::Class::ResultSet/ATTRIBUTES>
1087 =item Return Value: L<\%attrs|DBIx::Class::ResultSet/ATTRIBUTES>
1091 # In the result class
1092 __PACKAGE__->resultset_attributes({ order_by => [ 'id' ] });
1095 $source->resultset_attributes({ order_by => [ 'id' ] });
1097 Store a collection of resultset attributes, that will be set on every
1098 L<DBIx::Class::ResultSet> produced from this result source.
1100 B<CAVEAT>: C<resultset_attributes> comes with its own set of issues and
1101 bugs! While C<resultset_attributes> isn't deprecated per se, its usage is
1104 Since relationships use attributes to link tables together, the "default"
1105 attributes you set may cause unpredictable and undesired behavior. Furthermore,
1106 the defaults cannot be turned off, so you are stuck with them.
1108 In most cases, what you should actually be using are project-specific methods:
1110 package My::Schema::ResultSet::Artist;
1111 use base 'DBIx::Class::ResultSet';
1115 #__PACKAGE__->resultset_attributes({ prefetch => 'tracks' });
1118 sub with_tracks { shift->search({}, { prefetch => 'tracks' }) }
1121 $schema->resultset('Artist')->with_tracks->...
1123 This gives you the flexibility of not using it when you don't need it.
1125 For more complex situations, another solution would be to use a virtual view
1126 via L<DBIx::Class::ResultSource::View>.
1132 $self->throw_exception(
1133 'resultset does not take any arguments. If you want another resultset, '.
1134 'call it on the schema instead.'
1137 $self->resultset_class->new(
1140 ( dbic_internal_try { %{$self->schema->default_resultset_attributes} } ),
1141 %{$self->{resultset_attributes}},
1150 =item Arguments: none
1152 =item Result value: $name
1156 Returns the name of the result source, which will typically be the table
1157 name. This may be a scalar reference if the result source has a non-standard
1164 =item Arguments: $source_name
1166 =item Result value: $source_name
1170 Set an alternate name for the result source when it is loaded into a schema.
1171 This is useful if you want to refer to a result source by a name other than
1174 package ArchivedBooks;
1175 use base qw/DBIx::Class/;
1176 __PACKAGE__->table('books_archive');
1177 __PACKAGE__->source_name('Books');
1179 # from your schema...
1180 $schema->resultset('Books')->find(1);
1186 =item Arguments: none
1188 =item Return Value: FROM clause
1192 my $from_clause = $source->from();
1194 Returns an expression of the source to be supplied to storage to specify
1195 retrieval from this source. In the case of a database, the required FROM
1200 sub from { die 'Virtual method!' }
1204 Stores a hashref of per-source metadata. No specific key names
1205 have yet been standardized, the examples below are purely hypothetical
1206 and don't actually accomplish anything on their own:
1208 __PACKAGE__->source_info({
1209 "_tablespace" => 'fast_disk_array_3',
1210 "_engine" => 'InnoDB',
1217 =item Arguments: L<$schema?|DBIx::Class::Schema>
1219 =item Return Value: L<$schema|DBIx::Class::Schema>
1223 my $schema = $source->schema();
1225 Sets and/or returns the L<DBIx::Class::Schema> object to which this
1226 result source instance has been attached to.
1232 $_[0]->{schema} = $_[1];
1235 $_[0]->{schema} || do {
1236 my $name = $_[0]->{source_name} || '_unnamed_';
1237 my $err = 'Unable to perform storage-dependent operations with a detached result source '
1238 . "(source '$name' is not associated with a schema).";
1240 $err .= ' You need to use $schema->thaw() or manually set'
1241 . ' $DBIx::Class::ResultSourceHandle::thaw_schema while thawing.'
1242 if $_[0]->{_detached_thaw};
1244 DBIx::Class::Exception->throw($err);
1253 =item Arguments: none
1255 =item Return Value: L<$storage|DBIx::Class::Storage>
1259 $source->storage->debug(1);
1261 Returns the L<storage handle|DBIx::Class::Storage> for the current schema.
1266 DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
1267 $_[0]->schema->storage
1270 =head2 add_relationship
1274 =item Arguments: $rel_name, $related_source_name, \%cond, \%attrs?
1276 =item Return Value: 1/true if it succeeded
1280 $source->add_relationship('rel_name', 'related_source', $cond, $attrs);
1282 L<DBIx::Class::Relationship> describes a series of methods which
1283 create pre-defined useful types of relationships. Look there first
1284 before using this method directly.
1286 The relationship name can be arbitrary, but must be unique for each
1287 relationship attached to this result source. 'related_source' should
1288 be the name with which the related result source was registered with
1289 the current schema. For example:
1291 $schema->source('Book')->add_relationship('reviews', 'Review', {
1292 'foreign.book_id' => 'self.id',
1295 The condition C<$cond> needs to be an L<SQL::Abstract>-style
1296 representation of the join between the tables. For example, if you're
1297 creating a relation from Author to Book,
1299 { 'foreign.author_id' => 'self.id' }
1301 will result in the JOIN clause
1303 author me JOIN book foreign ON foreign.author_id = me.id
1305 You can specify as many foreign => self mappings as necessary.
1307 Valid attributes are as follows:
1313 Explicitly specifies the type of join to use in the relationship. Any
1314 SQL join type is valid, e.g. C<LEFT> or C<RIGHT>. It will be placed in
1315 the SQL command immediately before C<JOIN>.
1319 An arrayref containing a list of accessors in the foreign class to proxy in
1320 the main class. If, for example, you do the following:
1322 CD->might_have(liner_notes => 'LinerNotes', undef, {
1323 proxy => [ qw/notes/ ],
1326 Then, assuming LinerNotes has an accessor named notes, you can do:
1328 my $cd = CD->find(1);
1329 # set notes -- LinerNotes object is created if it doesn't exist
1330 $cd->notes('Notes go here');
1334 Specifies the type of accessor that should be created for the
1335 relationship. Valid values are C<single> (for when there is only a single
1336 related object), C<multi> (when there can be many), and C<filter> (for
1337 when there is a single related object, but you also want the relationship
1338 accessor to double as a column accessor). For C<multi> accessors, an
1339 add_to_* method is also created, which calls C<create_related> for the
1344 Throws an exception if the condition is improperly supplied, or cannot
1349 sub add_relationship {
1350 my ($self, $rel, $f_source_name, $cond, $attrs) = @_;
1351 $self->throw_exception("Can't create relationship without join condition")
1355 # Check foreign and self are right in cond
1356 if ( (ref $cond ||'') eq 'HASH') {
1357 $_ =~ /^foreign\./ or $self->throw_exception("Malformed relationship condition key '$_': must be prefixed with 'foreign.'")
1360 $_ =~ /^self\./ or $self->throw_exception("Malformed relationship condition value '$_': must be prefixed with 'self.'")
1364 my %rels = %{ $self->_relationships };
1365 $rels{$rel} = { class => $f_source_name,
1366 source => $f_source_name,
1369 $self->_relationships(\%rels);
1374 =head2 relationships
1378 =item Arguments: none
1380 =item Return Value: L<@rel_names|DBIx::Class::Relationship>
1384 my @rel_names = $source->relationships();
1386 Returns all relationship names for this source.
1391 keys %{$_[0]->_relationships};
1394 =head2 relationship_info
1398 =item Arguments: L<$rel_name|DBIx::Class::Relationship>
1400 =item Return Value: L<\%rel_data|DBIx::Class::Relationship::Base/add_relationship>
1404 Returns a hash of relationship information for the specified relationship
1405 name. The keys/values are as specified for L<DBIx::Class::Relationship::Base/add_relationship>.
1409 sub relationship_info {
1410 #my ($self, $rel) = @_;
1411 return shift->_relationships->{+shift};
1414 =head2 has_relationship
1418 =item Arguments: L<$rel_name|DBIx::Class::Relationship>
1420 =item Return Value: 1/0 (true/false)
1424 Returns true if the source has a relationship of this name, false otherwise.
1428 sub has_relationship {
1429 #my ($self, $rel) = @_;
1430 return exists shift->_relationships->{+shift};
1433 =head2 reverse_relationship_info
1437 =item Arguments: L<$rel_name|DBIx::Class::Relationship>
1439 =item Return Value: L<\%rel_data|DBIx::Class::Relationship::Base/add_relationship>
1443 Looks through all the relationships on the source this relationship
1444 points to, looking for one whose condition is the reverse of the
1445 condition on this relationship.
1447 A common use of this is to find the name of the C<belongs_to> relation
1448 opposing a C<has_many> relation. For definition of these look in
1449 L<DBIx::Class::Relationship>.
1451 The returned hashref is keyed by the name of the opposing
1452 relationship, and contains its data in the same manner as
1453 L</relationship_info>.
1457 sub reverse_relationship_info {
1458 my ($self, $rel) = @_;
1460 my $rel_info = $self->relationship_info($rel)
1461 or $self->throw_exception("No such relationship '$rel'");
1465 return $ret unless ((ref $rel_info->{cond}) eq 'HASH');
1467 my $stripped_cond = $self->__strip_relcond ($rel_info->{cond});
1469 my $registered_source_name = $self->source_name;
1471 # this may be a partial schema or something else equally esoteric
1472 my $other_rsrc = $self->related_source($rel);
1474 # Get all the relationships for that source that related to this source
1475 # whose foreign column set are our self columns on $rel and whose self
1476 # columns are our foreign columns on $rel
1477 foreach my $other_rel ($other_rsrc->relationships) {
1479 # only consider stuff that points back to us
1480 # "us" here is tricky - if we are in a schema registration, we want
1481 # to use the source_names, otherwise we will use the actual classes
1483 # the schema may be partial
1484 my $roundtrip_rsrc = dbic_internal_try { $other_rsrc->related_source($other_rel) }
1487 if ($registered_source_name) {
1488 next if $registered_source_name ne ($roundtrip_rsrc->source_name || '')
1491 next if $self->result_class ne $roundtrip_rsrc->result_class;
1494 my $other_rel_info = $other_rsrc->relationship_info($other_rel);
1496 # this can happen when we have a self-referential class
1497 next if $other_rel_info eq $rel_info;
1499 next unless ref $other_rel_info->{cond} eq 'HASH';
1500 my $other_stripped_cond = $self->__strip_relcond($other_rel_info->{cond});
1502 $ret->{$other_rel} = $other_rel_info if (
1503 $self->_compare_relationship_keys (
1504 [ keys %$stripped_cond ], [ values %$other_stripped_cond ]
1507 $self->_compare_relationship_keys (
1508 [ values %$stripped_cond ], [ keys %$other_stripped_cond ]
1516 # all this does is removes the foreign/self prefix from a condition
1517 sub __strip_relcond {
1520 { map { /^ (?:foreign|self) \. (\w+) $/x } ($_, $_[1]{$_}) }
1525 sub compare_relationship_keys {
1526 carp 'compare_relationship_keys is a private method, stop calling it';
1528 $self->_compare_relationship_keys (@_);
1531 # Returns true if both sets of keynames are the same, false otherwise.
1532 sub _compare_relationship_keys {
1533 # my ($self, $keys1, $keys2) = @_;
1535 join ("\x00", sort @{$_[1]})
1537 join ("\x00", sort @{$_[2]})
1541 # optionally takes either an arrayref of column names, or a hashref of already
1542 # retrieved colinfos
1543 # returns an arrayref of column names of the shortest unique constraint
1544 # (matching some of the input if any), giving preference to the PK
1545 sub _identifying_column_set {
1546 my ($self, $cols) = @_;
1548 my %unique = $self->unique_constraints;
1549 my $colinfos = ref $cols eq 'HASH' ? $cols : $self->columns_info($cols||());
1551 # always prefer the PK first, and then shortest constraints first
1553 for my $set (delete $unique{primary}, sort { @$a <=> @$b } (values %unique) ) {
1554 next unless $set && @$set;
1557 next USET unless ($colinfos->{$_} && !$colinfos->{$_}{is_nullable} );
1560 # copy so we can mangle it at will
1567 sub _minimal_valueset_satisfying_constraint {
1569 my $args = { ref $_[0] eq 'HASH' ? %{ $_[0] } : @_ };
1571 $args->{columns_info} ||= $self->columns_info;
1573 my $vals = $self->schema->storage->_extract_fixed_condition_columns(
1575 ($args->{carp_on_nulls} ? 'consider_nulls' : undef ),
1579 for my $col ($self->unique_constraint_columns($args->{constraint_name}) ) {
1580 if( ! exists $vals->{$col} or ( $vals->{$col}||'' ) eq UNRESOLVABLE_CONDITION ) {
1581 $cols->{missing}{$col} = undef;
1583 elsif( ! defined $vals->{$col} ) {
1584 $cols->{$args->{carp_on_nulls} ? 'undefined' : 'missing'}{$col} = undef;
1587 # we need to inject back the '=' as _extract_fixed_condition_columns
1588 # will strip it from literals and values alike, resulting in an invalid
1589 # condition in the end
1590 $cols->{present}{$col} = { '=' => $vals->{$col} };
1593 $cols->{fc}{$col} = 1 if (
1594 ( ! $cols->{missing} or ! exists $cols->{missing}{$col} )
1596 keys %{ $args->{columns_info}{$col}{_filter_info} || {} }
1600 $self->throw_exception( sprintf ( "Unable to satisfy requested constraint '%s', missing values for column(s): %s",
1601 $args->{constraint_name},
1602 join (', ', map { "'$_'" } sort keys %{$cols->{missing}} ),
1603 ) ) if $cols->{missing};
1605 $self->throw_exception( sprintf (
1606 "Unable to satisfy requested constraint '%s', FilterColumn values not usable for column(s): %s",
1607 $args->{constraint_name},
1608 join (', ', map { "'$_'" } sort keys %{$cols->{fc}}),
1614 !$ENV{DBIC_NULLABLE_KEY_NOWARN}
1616 carp_unique ( sprintf (
1617 "NULL/undef values supplied for requested unique constraint '%s' (NULL "
1618 . 'values in column(s): %s). This is almost certainly not what you wanted, '
1619 . 'though you can set DBIC_NULLABLE_KEY_NOWARN to disable this warning.',
1620 $args->{constraint_name},
1621 join (', ', map { "'$_'" } sort keys %{$cols->{undefined}}),
1625 return { map { %{ $cols->{$_}||{} } } qw(present undefined) };
1628 # Returns the {from} structure used to express JOIN conditions
1630 my ($self, $join, $alias, $seen, $jpath, $parent_force_left) = @_;
1632 # we need a supplied one, because we do in-place modifications, no returns
1633 $self->throw_exception ('You must supply a seen hashref as the 3rd argument to _resolve_join')
1634 unless ref $seen eq 'HASH';
1636 $self->throw_exception ('You must supply a joinpath arrayref as the 4th argument to _resolve_join')
1637 unless ref $jpath eq 'ARRAY';
1639 $jpath = [@$jpath]; # copy
1641 if (not defined $join or not length $join) {
1644 elsif (ref $join eq 'ARRAY') {
1647 $self->_resolve_join($_, $alias, $seen, $jpath, $parent_force_left);
1650 elsif (ref $join eq 'HASH') {
1653 for my $rel (keys %$join) {
1655 my $rel_info = $self->relationship_info($rel)
1656 or $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
1658 my $force_left = $parent_force_left;
1659 $force_left ||= lc($rel_info->{attrs}{join_type}||'') eq 'left';
1661 # the actual seen value will be incremented by the recursion
1662 my $as = $self->schema->storage->relname_to_table_alias(
1663 $rel, ($seen->{$rel} && $seen->{$rel} + 1)
1667 $self->_resolve_join($rel, $alias, $seen, [@$jpath], $force_left),
1668 $self->related_source($rel)->_resolve_join(
1669 $join->{$rel}, $as, $seen, [@$jpath, { $rel => $as }], $force_left
1677 $self->throw_exception("No idea how to resolve join reftype ".ref $join);
1680 my $count = ++$seen->{$join};
1681 my $as = $self->schema->storage->relname_to_table_alias(
1682 $join, ($count > 1 && $count)
1685 my $rel_info = $self->relationship_info($join)
1686 or $self->throw_exception("No such relationship $join on " . $self->source_name);
1688 my $rel_src = $self->related_source($join);
1689 return [ { $as => $rel_src->from,
1691 -join_type => $parent_force_left
1693 : $rel_info->{attrs}{join_type}
1695 -join_path => [@$jpath, { $join => $as } ],
1697 ! $rel_info->{attrs}{accessor}
1699 $rel_info->{attrs}{accessor} eq 'single'
1701 $rel_info->{attrs}{accessor} eq 'filter'
1704 -relation_chain_depth => ( $seen->{-relation_chain_depth} || 0 ) + 1,
1706 $self->_resolve_relationship_condition(
1708 self_alias => $alias,
1709 foreign_alias => $as,
1716 carp 'pk_depends_on is a private method, stop calling it';
1718 $self->_pk_depends_on (@_);
1721 # Determines whether a relation is dependent on an object from this source
1722 # having already been inserted. Takes the name of the relationship and a
1723 # hashref of columns of the related object.
1724 sub _pk_depends_on {
1725 my ($self, $rel_name, $rel_data) = @_;
1727 my $relinfo = $self->relationship_info($rel_name);
1729 # don't assume things if the relationship direction is specified
1730 return $relinfo->{attrs}{is_foreign_key_constraint}
1731 if exists ($relinfo->{attrs}{is_foreign_key_constraint});
1733 my $cond = $relinfo->{cond};
1734 return 0 unless ref($cond) eq 'HASH';
1736 # map { foreign.foo => 'self.bar' } to { bar => 'foo' }
1737 my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond };
1739 # assume anything that references our PK probably is dependent on us
1740 # rather than vice versa, unless the far side is (a) defined or (b)
1742 my $rel_source = $self->related_source($rel_name);
1744 foreach my $p ($self->primary_columns) {
1745 if (exists $keyhash->{$p}) {
1746 unless (defined($rel_data->{$keyhash->{$p}})
1747 || $rel_source->column_info($keyhash->{$p})
1748 ->{is_auto_increment}) {
1757 sub resolve_condition {
1758 carp 'resolve_condition is a private method, stop calling it';
1759 shift->_resolve_condition (@_);
1762 sub _resolve_condition {
1763 # carp_unique sprintf
1764 # '_resolve_condition is a private method, and moreover is about to go '
1765 # . 'away. Please contact the development team at %s if you believe you '
1766 # . 'have a genuine use for this method, in order to discuss alternatives.',
1767 # DBIx::Class::_ENV_::HELP_URL,
1770 #######################
1771 ### API Design? What's that...? (a backwards compatible shim, kill me now)
1773 my ($self, $cond, @res_args, $rel_name);
1775 # we *SIMPLY DON'T KNOW YET* which arg is which, yay
1776 ($self, $cond, $res_args[0], $res_args[1], $rel_name) = @_;
1778 # assume that an undef is an object-like unset (set_from_related(undef))
1779 my @is_objlike = map { ! defined $_ or length ref $_ } (@res_args);
1781 # turn objlike into proper objects for saner code further down
1783 next unless $is_objlike[$_];
1785 if ( defined blessed $res_args[$_] ) {
1787 # but wait - there is more!!! WHAT THE FUCK?!?!?!?!
1788 if ($res_args[$_]->isa('DBIx::Class::ResultSet')) {
1789 carp('Passing a resultset for relationship resolution makes no sense - invoking __gremlins__');
1790 $is_objlike[$_] = 0;
1791 $res_args[$_] = '__gremlins__';
1795 $res_args[$_] ||= {};
1797 # hate everywhere - have to pass in as a plain hash
1798 # pretending to be an object at least for now
1799 $self->throw_exception("Unsupported object-like structure encountered: $res_args[$_]")
1800 unless ref $res_args[$_] eq 'HASH';
1805 # where-is-waldo block guesses relname, then further down we override it if available
1807 $is_objlike[1] ? ( rel_name => $res_args[0], self_alias => $res_args[0], foreign_alias => 'me', self_result_object => $res_args[1] )
1808 : $is_objlike[0] ? ( rel_name => $res_args[1], self_alias => 'me', foreign_alias => $res_args[1], foreign_values => $res_args[0] )
1809 : ( rel_name => $res_args[0], self_alias => $res_args[1], foreign_alias => $res_args[0] )
1812 ( $rel_name ? ( rel_name => $rel_name ) : () ),
1815 # Allowing passing relconds different than the relationshup itself is cute,
1816 # but likely dangerous. Remove that from the (still unofficial) API of
1817 # _resolve_relationship_condition, and instead make it "hard on purpose"
1818 local $self->relationship_info( $args->{rel_name} )->{cond} = $cond if defined $cond;
1820 #######################
1822 # now it's fucking easy isn't it?!
1823 my $rc = $self->_resolve_relationship_condition( $args );
1826 ( $rc->{join_free_condition} || $rc->{condition} ),
1827 ! $rc->{join_free_condition},
1830 # _resolve_relationship_condition always returns qualified cols even in the
1831 # case of join_free_condition, but nothing downstream expects this
1832 if ($rc->{join_free_condition} and ref $res[0] eq 'HASH') {
1834 { ($_ =~ /\.(.+)/) => $res[0]{$_} }
1840 return wantarray ? @res : $res[0];
1843 # Keep this indefinitely. There is evidence of both CPAN and
1844 # darkpan using it, and there isn't much harm in an extra var
1846 our $UNRESOLVABLE_CONDITION = UNRESOLVABLE_CONDITION;
1847 # YES I KNOW THIS IS EVIL
1848 # it is there to save darkpan from themselves, since internally
1849 # we are moving to a constant
1850 Internals::SvREADONLY($UNRESOLVABLE_CONDITION => 1);
1852 # Resolves the passed condition to a concrete query fragment and extra
1855 ## self-explanatory API, modeled on the custom cond coderef:
1856 # rel_name => (scalar)
1857 # foreign_alias => (scalar)
1858 # foreign_values => (either not supplied, or a hashref, or a foreign ResultObject (to be ->get_columns()ed), or plain undef )
1859 # self_alias => (scalar)
1860 # self_result_object => (either not supplied or a result object)
1861 # require_join_free_condition => (boolean, throws on failure to construct a JF-cond)
1862 # infer_values_based_on => (either not supplied or a hashref, implies require_join_free_condition)
1865 # condition => (a valid *likely fully qualified* sqla cond structure)
1866 # identity_map => (a hashref of foreign-to-self *unqualified* column equality names)
1867 # join_free_condition => (a valid *fully qualified* sqla cond structure, maybe unset)
1868 # inferred_values => (in case of an available join_free condition, this is a hashref of
1869 # *unqualified* column/value *EQUALITY* pairs, representing an amalgamation
1870 # of the JF-cond parse and infer_values_based_on
1871 # always either complete or unset)
1873 sub _resolve_relationship_condition {
1876 my $args = { ref $_[0] eq 'HASH' ? %{ $_[0] } : @_ };
1878 for ( qw( rel_name self_alias foreign_alias ) ) {
1879 $self->throw_exception("Mandatory argument '$_' to _resolve_relationship_condition() is not a plain string")
1880 if !defined $args->{$_} or length ref $args->{$_};
1883 $self->throw_exception("Arguments 'self_alias' and 'foreign_alias' may not be identical")
1884 if $args->{self_alias} eq $args->{foreign_alias};
1887 my $exception_rel_id = "relationship '$args->{rel_name}' on source '@{[ $self->source_name ]}'";
1889 my $rel_info = $self->relationship_info($args->{rel_name})
1891 # or $self->throw_exception( "No such $exception_rel_id" );
1892 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");
1895 $exception_rel_id = "relationship '$rel_info->{_original_name}' on source '@{[ $self->source_name ]}'"
1896 if $rel_info and exists $rel_info->{_original_name};
1898 $self->throw_exception("No practical way to resolve $exception_rel_id between two data structures")
1899 if exists $args->{self_result_object} and exists $args->{foreign_values};
1901 $self->throw_exception( "Argument to infer_values_based_on must be a hash" )
1902 if exists $args->{infer_values_based_on} and ref $args->{infer_values_based_on} ne 'HASH';
1904 $args->{require_join_free_condition} ||= !!$args->{infer_values_based_on};
1906 $self->throw_exception( "Argument 'self_result_object' must be an object inheriting from DBIx::Class::Row" )
1908 exists $args->{self_result_object}
1910 ( ! defined blessed $args->{self_result_object} or ! $args->{self_result_object}->isa('DBIx::Class::Row') )
1914 my $rel_rsrc = $self->related_source($args->{rel_name});
1915 my $storage = $self->schema->storage;
1917 if (exists $args->{foreign_values}) {
1919 if (! defined $args->{foreign_values} ) {
1920 # fallback: undef => {}
1921 $args->{foreign_values} = {};
1923 elsif (defined blessed $args->{foreign_values}) {
1925 $self->throw_exception( "Objects supplied as 'foreign_values' ($args->{foreign_values}) must inherit from DBIx::Class::Row" )
1926 unless $args->{foreign_values}->isa('DBIx::Class::Row');
1929 "Objects supplied as 'foreign_values' ($args->{foreign_values}) "
1930 . "usually should inherit from the related ResultClass ('@{[ $rel_rsrc->result_class ]}'), "
1931 . "perhaps you've made a mistake invoking the condition resolver?"
1932 ) unless $args->{foreign_values}->isa($rel_rsrc->result_class);
1934 $args->{foreign_values} = { $args->{foreign_values}->get_columns };
1936 elsif ( ref $args->{foreign_values} eq 'HASH' ) {
1938 # re-build {foreign_values} excluding identically named rels
1939 if( keys %{$args->{foreign_values}} ) {
1941 my ($col_idx, $rel_idx) = map
1942 { { map { $_ => 1 } $rel_rsrc->$_ } }
1943 qw( columns relationships )
1946 my $equivalencies = $storage->_extract_fixed_condition_columns(
1947 $args->{foreign_values},
1951 $args->{foreign_values} = { map {
1952 # skip if relationship *and* a non-literal ref
1953 # this means a multicreate stub was passed in
1957 length ref $args->{foreign_values}{$_}
1959 ! is_literal_value($args->{foreign_values}{$_})
1964 ? $self->throw_exception( "Key '$_' supplied as 'foreign_values' is not a column on related source '@{[ $rel_rsrc->source_name ]}'" )
1965 : ( !exists $equivalencies->{$_} or ($equivalencies->{$_}||'') eq UNRESOLVABLE_CONDITION )
1966 ? $self->throw_exception( "Value supplied for '...{foreign_values}{$_}' is not a direct equivalence expression" )
1967 : $args->{foreign_values}{$_}
1969 } keys %{$args->{foreign_values}} };
1973 $self->throw_exception(
1974 "Argument 'foreign_values' must be either an object inheriting from '@{[ $rel_rsrc->result_class ]}', "
1975 . "or a hash reference, or undef"
1982 if (ref $rel_info->{cond} eq 'CODE') {
1985 rel_name => $args->{rel_name},
1986 self_resultsource => $self,
1987 self_alias => $args->{self_alias},
1988 foreign_alias => $args->{foreign_alias},
1990 { (exists $args->{$_}) ? ( $_ => $args->{$_} ) : () }
1991 qw( self_result_object foreign_values )
1995 # legacy - never remove these!!!
1996 $cref_args->{foreign_relname} = $cref_args->{rel_name};
1998 $cref_args->{self_rowobj} = $cref_args->{self_result_object}
1999 if exists $cref_args->{self_result_object};
2001 ($ret->{condition}, $ret->{join_free_condition}, my @extra) = $rel_info->{cond}->($cref_args);
2004 $self->throw_exception("A custom condition coderef can return at most 2 conditions, but $exception_rel_id returned extra values: @extra")
2007 if (my $jfc = $ret->{join_free_condition}) {
2009 $self->throw_exception (
2010 "The join-free condition returned for $exception_rel_id must be a hash reference"
2011 ) unless ref $jfc eq 'HASH';
2013 my ($joinfree_alias, $joinfree_source);
2014 if (defined $args->{self_result_object}) {
2015 $joinfree_alias = $args->{foreign_alias};
2016 $joinfree_source = $rel_rsrc;
2018 elsif (defined $args->{foreign_values}) {
2019 $joinfree_alias = $args->{self_alias};
2020 $joinfree_source = $self;
2023 # FIXME sanity check until things stabilize, remove at some point
2024 $self->throw_exception (
2025 "A join-free condition returned for $exception_rel_id without a result object to chain from"
2026 ) unless $joinfree_alias;
2028 my $fq_col_list = { map
2029 { ( "$joinfree_alias.$_" => 1 ) }
2030 $joinfree_source->columns
2033 exists $fq_col_list->{$_} or $self->throw_exception (
2034 "The join-free condition returned for $exception_rel_id may only "
2035 . 'contain keys that are fully qualified column names of the corresponding source '
2036 . "'$joinfree_alias' (instead it returned '$_')"
2044 $_->isa('DBIx::Class::Row')
2046 $self->throw_exception (
2047 "The join-free condition returned for $exception_rel_id may not "
2048 . 'contain result objects as values - perhaps instead of invoking '
2049 . '->$something you meant to return ->get_column($something)'
2055 elsif (ref $rel_info->{cond} eq 'HASH') {
2057 # the condition is static - use parallel arrays
2058 # for a "pivot" depending on which side of the
2059 # rel did we get as an object
2060 my (@f_cols, @l_cols);
2061 for my $fc (keys %{ $rel_info->{cond} }) {
2062 my $lc = $rel_info->{cond}{$fc};
2064 # FIXME STRICTMODE should probably check these are valid columns
2065 $fc =~ s/^foreign\.// ||
2066 $self->throw_exception("Invalid rel cond key '$fc'");
2068 $lc =~ s/^self\.// ||
2069 $self->throw_exception("Invalid rel cond val '$lc'");
2075 # construct the crosstable condition and the identity map
2077 $ret->{condition}{"$args->{foreign_alias}.$f_cols[$_]"} = { -ident => "$args->{self_alias}.$l_cols[$_]" };
2078 $ret->{identity_map}{$l_cols[$_]} = $f_cols[$_];
2081 if ($args->{foreign_values}) {
2082 $ret->{join_free_condition}{"$args->{self_alias}.$l_cols[$_]"} = $args->{foreign_values}{$f_cols[$_]}
2085 elsif (defined $args->{self_result_object}) {
2087 for my $i (0..$#l_cols) {
2088 if ( $args->{self_result_object}->has_column_loaded($l_cols[$i]) ) {
2089 $ret->{join_free_condition}{"$args->{foreign_alias}.$f_cols[$i]"} = $args->{self_result_object}->get_column($l_cols[$i]);
2092 $self->throw_exception(sprintf
2093 "Unable to resolve relationship '%s' from object '%s': column '%s' not "
2094 . 'loaded from storage (or not passed to new() prior to insert()). You '
2095 . 'probably need to call ->discard_changes to get the server-side defaults '
2096 . 'from the database.',
2098 $args->{self_result_object},
2100 ) if $args->{self_result_object}->in_storage;
2102 # FIXME - temporarly force-override
2103 delete $args->{require_join_free_condition};
2104 $ret->{join_free_condition} = UNRESOLVABLE_CONDITION;
2110 elsif (ref $rel_info->{cond} eq 'ARRAY') {
2111 if (@{ $rel_info->{cond} } == 0) {
2113 condition => UNRESOLVABLE_CONDITION,
2114 join_free_condition => UNRESOLVABLE_CONDITION,
2118 my @subconds = map {
2119 local $rel_info->{cond} = $_;
2120 $self->_resolve_relationship_condition( $args );
2121 } @{ $rel_info->{cond} };
2123 if( @{ $rel_info->{cond} } == 1 ) {
2124 $ret = $subconds[0];
2127 # we are discarding inferred values here... likely incorrect...
2128 # then again - the entire thing is an OR, so we *can't* use them anyway
2129 for my $subcond ( @subconds ) {
2130 $self->throw_exception('Either all or none of the OR-condition members must resolve to a join-free condition')
2131 if ( $ret and ( $ret->{join_free_condition} xor $subcond->{join_free_condition} ) );
2133 $subcond->{$_} and push @{$ret->{$_}}, $subcond->{$_} for (qw(condition join_free_condition));
2139 $self->throw_exception ("Can't handle condition $rel_info->{cond} for $exception_rel_id yet :(");
2143 $args->{require_join_free_condition}
2145 ( ! $ret->{join_free_condition} or $ret->{join_free_condition} eq UNRESOLVABLE_CONDITION )
2147 $self->throw_exception(
2148 ucfirst sprintf "$exception_rel_id does not resolve to a %sjoin-free condition fragment",
2149 exists $args->{foreign_values}
2150 ? "'foreign_values'-based reversed-"
2155 # we got something back - sanity check and infer values if we can
2158 $ret->{join_free_condition}
2160 $ret->{join_free_condition} ne UNRESOLVABLE_CONDITION
2162 my $jfc = $storage->_collapse_cond( $ret->{join_free_condition} )
2165 my $jfc_eqs = $storage->_extract_fixed_condition_columns($jfc, 'consider_nulls');
2167 if (keys %$jfc_eqs) {
2170 # $jfc is fully qualified by definition
2171 my ($col) = $_ =~ /\.(.+)/;
2173 if (exists $jfc_eqs->{$_} and ($jfc_eqs->{$_}||'') ne UNRESOLVABLE_CONDITION) {
2174 $ret->{inferred_values}{$col} = $jfc_eqs->{$_};
2176 elsif ( !$args->{infer_values_based_on} or ! exists $args->{infer_values_based_on}{$col} ) {
2177 push @nonvalues, $col;
2182 delete $ret->{inferred_values} if @nonvalues;
2186 # did the user explicitly ask
2187 if ($args->{infer_values_based_on}) {
2189 $self->throw_exception(sprintf (
2190 "Unable to complete value inferrence - custom $exception_rel_id returns conditions instead of values for column(s): %s",
2191 map { "'$_'" } @nonvalues
2195 $ret->{inferred_values} ||= {};
2197 $ret->{inferred_values}{$_} = $args->{infer_values_based_on}{$_}
2198 for keys %{$args->{infer_values_based_on}};
2201 # add the identities based on the main condition
2202 # (may already be there, since easy to calculate on the fly in the HASH case)
2203 if ( ! $ret->{identity_map} ) {
2205 my $col_eqs = $storage->_extract_fixed_condition_columns($ret->{condition});
2208 for my $lhs (keys %$col_eqs) {
2210 next if $col_eqs->{$lhs} eq UNRESOLVABLE_CONDITION;
2212 # there is no way to know who is right and who is left in a cref
2213 # therefore a full blown resolution call, and figure out the
2214 # direction a bit further below
2215 $colinfos ||= $storage->_resolve_column_info([
2216 { -alias => $args->{self_alias}, -rsrc => $self },
2217 { -alias => $args->{foreign_alias}, -rsrc => $rel_rsrc },
2220 next unless $colinfos->{$lhs}; # someone is engaging in witchcraft
2222 if ( my $rhs_ref = is_literal_value( $col_eqs->{$lhs} ) ) {
2225 $colinfos->{$rhs_ref->[0]}
2227 $colinfos->{$lhs}{-source_alias} ne $colinfos->{$rhs_ref->[0]}{-source_alias}
2229 ( $colinfos->{$lhs}{-source_alias} eq $args->{self_alias} )
2230 ? ( $ret->{identity_map}{$colinfos->{$lhs}{-colname}} = $colinfos->{$rhs_ref->[0]}{-colname} )
2231 : ( $ret->{identity_map}{$colinfos->{$rhs_ref->[0]}{-colname}} = $colinfos->{$lhs}{-colname} )
2236 $col_eqs->{$lhs} =~ /^ ( \Q$args->{self_alias}\E \. .+ ) /x
2238 ($colinfos->{$1}||{})->{-result_source} == $rel_rsrc
2240 my ($lcol, $rcol) = map
2241 { $colinfos->{$_}{-colname} }
2245 "The $exception_rel_id specifies equality of column '$lcol' and the "
2246 . "*VALUE* '$rcol' (you did not use the { -ident => ... } operator)"
2252 # FIXME - temporary, to fool the idiotic check in SQLMaker::_join_condition
2253 $ret->{condition} = { -and => [ $ret->{condition} ] }
2254 unless $ret->{condition} eq UNRESOLVABLE_CONDITION;
2259 =head2 related_source
2263 =item Arguments: $rel_name
2265 =item Return Value: $source
2269 Returns the result source object for the given relationship.
2273 sub related_source {
2274 my ($self, $rel) = @_;
2275 if( !$self->has_relationship( $rel ) ) {
2276 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
2279 # if we are not registered with a schema - just use the prototype
2280 # however if we do have a schema - ask for the source by name (and
2281 # throw in the process if all fails)
2282 if (my $schema = dbic_internal_try { $self->schema }) {
2283 $schema->source($self->relationship_info($rel)->{source});
2286 my $class = $self->relationship_info($rel)->{class};
2287 $self->ensure_class_loaded($class);
2288 $class->result_source_instance;
2292 =head2 related_class
2296 =item Arguments: $rel_name
2298 =item Return Value: $classname
2302 Returns the class name for objects in the given relationship.
2307 my ($self, $rel) = @_;
2308 if( !$self->has_relationship( $rel ) ) {
2309 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
2311 return $self->schema->class($self->relationship_info($rel)->{source});
2318 =item Arguments: none
2320 =item Return Value: L<$source_handle|DBIx::Class::ResultSourceHandle>
2324 Obtain a new L<result source handle instance|DBIx::Class::ResultSourceHandle>
2325 for this source. Used as a serializable pointer to this resultsource, as it is not
2326 easy (nor advisable) to serialize CODErefs which may very well be present in e.g.
2327 relationship definitions.
2332 require DBIx::Class::ResultSourceHandle;
2333 return DBIx::Class::ResultSourceHandle->new({
2334 source_moniker => $_[0]->source_name,
2336 # so that a detached thaw can be re-frozen
2337 $_[0]->{_detached_thaw}
2338 ? ( _detached_source => $_[0] )
2339 : ( schema => $_[0]->schema )
2344 my $global_phase_destroy;
2346 ### NO detected_reinvoked_destructor check
2347 ### This code very much relies on being called multuple times
2349 return if $global_phase_destroy ||= in_global_destruction;
2355 # Under no circumstances shall $_[0] be stored anywhere else (like copied to
2356 # a lexical variable, or shifted, or anything else). Doing so will mess up
2357 # the refcount of this particular result source, and will allow the $schema
2358 # we are trying to save to reattach back to the source we are destroying.
2359 # The relevant code checking refcounts is in ::Schema::DESTROY()
2361 # if we are not a schema instance holder - we don't matter
2363 ! ref $_[0]->{schema}
2365 isweak $_[0]->{schema}
2368 # weaken our schema hold forcing the schema to find somewhere else to live
2369 # during global destruction (if we have not yet bailed out) this will throw
2370 # which will serve as a signal to not try doing anything else
2371 # however beware - on older perls the exception seems randomly untrappable
2372 # due to some weird race condition during thread joining :(((
2373 local $SIG{__DIE__} if $SIG{__DIE__};
2376 weaken $_[0]->{schema};
2378 # if schema is still there reintroduce ourselves with strong refs back to us
2379 if ($_[0]->{schema}) {
2380 my $srcregs = $_[0]->{schema}->source_registrations;
2382 defined $srcregs->{$_}
2384 $srcregs->{$_} == $_[0]
2386 $srcregs->{$_} = $_[0]
2394 $global_phase_destroy = 1;
2397 # Dummy NEXTSTATE ensuring the all temporaries on the stack are garbage
2398 # collected before leaving this scope. Depending on the code above, this
2399 # may very well be just a preventive measure guarding future modifications
2403 sub STORABLE_freeze { Storable::nfreeze($_[0]->handle) }
2406 my ($self, $cloning, $ice) = @_;
2407 %$self = %{ (Storable::thaw($ice))->resolve };
2410 =head2 throw_exception
2412 See L<DBIx::Class::Schema/"throw_exception">.
2416 sub throw_exception {
2420 ? $self->{schema}->throw_exception(@_)
2421 : DBIx::Class::Exception->throw(@_)
2425 =head2 column_info_from_storage
2429 =item Arguments: 1/0 (default: 0)
2431 =item Return Value: 1/0
2435 __PACKAGE__->column_info_from_storage(1);
2437 Enables the on-demand automatic loading of the above column
2438 metadata from storage as necessary. This is *deprecated*, and
2439 should not be used. It will be removed before 1.0.
2441 =head1 FURTHER QUESTIONS?
2443 Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
2445 =head1 COPYRIGHT AND LICENSE
2447 This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
2448 by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
2449 redistribute it and/or modify it under the same terms as the
2450 L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.