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 refaddr );
14 # FIXME - somehow breaks ResultSetManager, do not remove until investigated
15 use DBIx::Class::ResultSet;
19 my @hashref_attributes = qw(
20 source_info resultset_attributes
21 _columns _unique_constraints _relationships
23 my @arrayref_attributes = qw(
24 _ordered_columns _primaries
26 __PACKAGE__->mk_group_accessors(simple =>
29 qw( source_name name column_info_from_storage sqlt_deploy_callback ),
32 __PACKAGE__->mk_group_accessors(component_class => qw/
39 DBIx::Class::ResultSource - Result source object
43 # Create a table based result source, in a result class.
45 package MyApp::Schema::Result::Artist;
46 use base qw/DBIx::Class::Core/;
48 __PACKAGE__->table('artist');
49 __PACKAGE__->add_columns(qw/ artistid name /);
50 __PACKAGE__->set_primary_key('artistid');
51 __PACKAGE__->has_many(cds => 'MyApp::Schema::Result::CD');
55 # Create a query (view) based result source, in a result class
56 package MyApp::Schema::Result::Year2000CDs;
57 use base qw/DBIx::Class::Core/;
59 __PACKAGE__->load_components('InflateColumn::DateTime');
60 __PACKAGE__->table_class('DBIx::Class::ResultSource::View');
62 __PACKAGE__->table('year2000cds');
63 __PACKAGE__->result_source_instance->is_virtual(1);
64 __PACKAGE__->result_source_instance->view_definition(
65 "SELECT cdid, artist, title FROM cd WHERE year ='2000'"
71 A ResultSource is an object that represents a source of data for querying.
73 This class is a base class for various specialised types of result
74 sources, for example L<DBIx::Class::ResultSource::Table>. Table is the
75 default result source type, so one is created for you when defining a
76 result class as described in the synopsis above.
78 More specifically, the L<DBIx::Class::Core> base class pulls in the
79 L<DBIx::Class::ResultSourceProxy::Table> component, which defines
80 the L<table|DBIx::Class::ResultSourceProxy::Table/table> method.
81 When called, C<table> creates and stores an instance of
82 L<DBIx::Class::ResultSource::Table>. Luckily, to use tables as result
83 sources, you don't need to remember any of this.
85 Result sources representing select queries, or views, can also be
86 created, see L<DBIx::Class::ResultSource::View> for full details.
88 =head2 Finding result source objects
90 As mentioned above, a result source instance is created and stored for
92 L<Result Class|DBIx::Class::Manual::Glossary/Result Class>.
94 You can retrieve the result source at runtime in the following ways:
98 =item From a Schema object:
100 $schema->source($source_name);
102 =item From a Result object:
104 $result->result_source;
106 =item From a ResultSet object:
118 $class->new({attribute_name => value});
120 Creates a new ResultSource object. Not normally called directly by end users.
127 sub __derived_instances {
129 (defined $_->{weakref})
132 } values %{ $rsrc_registry->{ refaddr($_[0]) }{ derivatives } }
136 my ($class, $attrs) = @_;
137 $class = ref $class if ref $class;
139 my $ancestor = delete $attrs->{__derived_from};
141 my $self = bless { %$attrs }, $class;
144 DBIx::Class::_ENV_::ASSERT_NO_ERRONEOUS_METAINSTANCE_USE
146 # a constructor with 'name' as sole arg clearly isn't "inheriting" from anything
147 ( not ( keys(%$self) == 1 and exists $self->{name} ) )
149 defined CORE::caller(1)
151 (CORE::caller(1))[3] !~ / ::new$ | ^ DBIx::Class :: (?:
152 ResultSourceProxy::Table::table
154 ResultSourceProxy::Table::_init_result_source_instance
159 local $Carp::CarpLevel = $Carp::CarpLevel + 1
161 Carp::confess("Incorrect instantiation of '$self': you almost certainly wanted to call ->clone() instead");
164 my $own_slot = $rsrc_registry->{
165 my $own_addr = refaddr $self
166 } = { derivatives => {} };
168 weaken( $own_slot->{weakref} = $self );
173 my $ancestor_slot = $rsrc_registry->{
174 my $ancestor_addr = refaddr $ancestor
178 # on ancestry recording compact registry slots, prevent unbound growth
179 for my $r ( $rsrc_registry, map { $_->{derivatives} } values %$rsrc_registry ) {
180 defined $r->{$_}{weakref} or delete $r->{$_}
184 weaken( $_->{$own_addr} = $own_slot ) for map
185 { $_->{derivatives} }
189 { defined $_->{derivatives}{$ancestor_addr} }
190 values %$rsrc_registry
197 $self->{resultset_class} ||= 'DBIx::Class::ResultSet';
198 $self->{name} ||= "!!NAME NOT SET!!";
199 $self->{_columns_info_loaded} ||= 0;
200 $self->{sqlt_deploy_callback} ||= 'default_sqlt_deploy_hook';
202 $self->{$_} = { %{ $self->{$_} || {} } }
203 for @hashref_attributes;
205 $self->{$_} = [ @{ $self->{$_} || [] } ]
206 for @arrayref_attributes;
211 sub DBIx::Class::__Rsrc_Ancestry_iThreads_handler__::CLONE {
212 for my $r ( $rsrc_registry, map { $_->{derivatives} } values %$rsrc_registry ) {
214 defined $_->{weakref}
215 ? ( refaddr $_->{weakref} => $_ )
224 $rsrc_instance->clone( atribute_name => overriden_value );
226 A wrapper around L</new> inheriting any defaults from the callee. This method
227 also not normally invoked directly by end users.
237 ? ( %$self, __derived_from => $self )
241 (@_ == 1 and ref $_[0] eq 'HASH')
254 =item Arguments: @columns
256 =item Return Value: L<$result_source|/new>
260 $source->add_columns(qw/col1 col2 col3/);
262 $source->add_columns('col1' => \%col1_info, 'col2' => \%col2_info, ...);
264 $source->add_columns(
265 'col1' => { data_type => 'integer', is_nullable => 1, ... },
266 'col2' => { data_type => 'text', is_auto_increment => 1, ... },
269 Adds columns to the result source. If supplied colname => hashref
270 pairs, uses the hashref as the L</column_info> for that column. Repeated
271 calls of this method will add more columns, not replace them.
273 The column names given will be created as accessor methods on your
274 L<Result|DBIx::Class::Manual::ResultClass> objects. You can change the name of the accessor
275 by supplying an L</accessor> in the column_info hash.
277 If a column name beginning with a plus sign ('+col1') is provided, the
278 attributes provided will be merged with any existing attributes for the
279 column, with the new attributes taking precedence in the case that an
280 attribute already exists. Using this without a hashref
281 (C<< $source->add_columns(qw/+col1 +col2/) >>) is legal, but useless --
282 it does the same thing it would do without the plus.
284 The contents of the column_info are not set in stone. The following
285 keys are currently recognised/used by DBIx::Class:
291 { accessor => '_name' }
293 # example use, replace standard accessor with one of your own:
295 my ($self, $value) = @_;
297 die "Name cannot contain digits!" if($value =~ /\d/);
298 $self->_name($value);
300 return $self->_name();
303 Use this to set the name of the accessor method for this column. If unset,
304 the name of the column will be used.
308 { data_type => 'integer' }
310 This contains the column type. It is automatically filled if you use the
311 L<SQL::Translator::Producer::DBIx::Class::File> producer, or the
312 L<DBIx::Class::Schema::Loader> module.
314 Currently there is no standard set of values for the data_type. Use
315 whatever your database supports.
321 The length of your column, if it is a column type that can have a size
322 restriction. This is currently only used to create tables from your
323 schema, see L<DBIx::Class::Schema/deploy>.
327 For decimal or float values you can specify an ArrayRef in order to
328 control precision, assuming your database's
329 L<SQL::Translator::Producer> supports it.
335 Set this to a true value for a column that is allowed to contain NULL
336 values, default is false. This is currently only used to create tables
337 from your schema, see L<DBIx::Class::Schema/deploy>.
339 =item is_auto_increment
341 { is_auto_increment => 1 }
343 Set this to a true value for a column whose value is somehow
344 automatically set, defaults to false. This is used to determine which
345 columns to empty when cloning objects using
346 L<DBIx::Class::Row/copy>. It is also used by
347 L<DBIx::Class::Schema/deploy>.
353 Set this to a true or false value (not C<undef>) to explicitly specify
354 if this column contains numeric data. This controls how set_column
355 decides whether to consider a column dirty after an update: if
356 C<is_numeric> is true a numeric comparison C<< != >> will take place
357 instead of the usual C<eq>
359 If not specified the storage class will attempt to figure this out on
360 first access to the column, based on the column C<data_type>. The
361 result will be cached in this attribute.
365 { is_foreign_key => 1 }
367 Set this to a true value for a column that contains a key from a
368 foreign table, defaults to false. This is currently only used to
369 create tables from your schema, see L<DBIx::Class::Schema/deploy>.
373 { default_value => \'now()' }
375 Set this to the default value which will be inserted into a column by
376 the database. Can contain either a value or a function (use a
377 reference to a scalar e.g. C<\'now()'> if you want a function). This
378 is currently only used to create tables from your schema, see
379 L<DBIx::Class::Schema/deploy>.
381 See the note on L<DBIx::Class::Row/new> for more information about possible
382 issues related to db-side default values.
386 { sequence => 'my_table_seq' }
388 Set this on a primary key column to the name of the sequence used to
389 generate a new key value. If not specified, L<DBIx::Class::PK::Auto>
390 will attempt to retrieve the name of the sequence from the database
393 =item retrieve_on_insert
395 { retrieve_on_insert => 1 }
397 For every column where this is set to true, DBIC will retrieve the RDBMS-side
398 value upon a new row insertion (normally only the autoincrement PK is
399 retrieved on insert). C<INSERT ... RETURNING> is used automatically if
400 supported by the underlying storage, otherwise an extra SELECT statement is
401 executed to retrieve the missing data.
405 { auto_nextval => 1 }
407 Set this to a true value for a column whose value is retrieved automatically
408 from a sequence or function (if supported by your Storage driver.) For a
409 sequence, if you do not use a trigger to get the nextval, you have to set the
410 L</sequence> value as well.
412 Also set this for MSSQL columns with the 'uniqueidentifier'
413 L<data_type|DBIx::Class::ResultSource/data_type> whose values you want to
414 automatically generate using C<NEWID()>, unless they are a primary key in which
415 case this will be done anyway.
419 This is used by L<DBIx::Class::Schema/deploy> and L<SQL::Translator>
420 to add extra non-generic data to the column. For example: C<< extra
421 => { unsigned => 1} >> is used by the MySQL producer to set an integer
422 column to unsigned. For more details, see
423 L<SQL::Translator::Producer::MySQL>.
431 =item Arguments: $colname, \%columninfo?
433 =item Return Value: 1/0 (true/false)
437 $source->add_column('col' => \%info);
439 Add a single column and optional column info. Uses the same column
440 info keys as L</add_columns>.
445 my ($self, @cols) = @_;
446 $self->_ordered_columns(\@cols) unless $self->_ordered_columns;
449 my $columns = $self->_columns;
450 while (my $col = shift @cols) {
451 my $column_info = {};
452 if ($col =~ s/^\+//) {
453 $column_info = $self->column_info($col);
456 # If next entry is { ... } use that for the column info, if not
457 # use an empty hashref
459 my $new_info = shift(@cols);
460 %$column_info = (%$column_info, %$new_info);
462 push(@added, $col) unless exists $columns->{$col};
463 $columns->{$col} = $column_info;
465 push @{ $self->_ordered_columns }, @added;
470 DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
471 shift->add_columns(@_)
478 =item Arguments: $colname
480 =item Return Value: 1/0 (true/false)
484 if ($source->has_column($colname)) { ... }
486 Returns true if the source has a column of this name, false otherwise.
491 my ($self, $column) = @_;
492 return exists $self->_columns->{$column};
499 =item Arguments: $colname
501 =item Return Value: Hashref of info
505 my $info = $source->column_info($col);
507 Returns the column metadata hashref for a column, as originally passed
508 to L</add_columns>. See L</add_columns> above for information on the
509 contents of the hashref.
514 my ($self, $column) = @_;
515 $self->throw_exception("No such column $column")
516 unless exists $self->_columns->{$column};
518 if ( ! $self->_columns->{$column}{data_type}
519 and ! $self->{_columns_info_loaded}
520 and $self->column_info_from_storage
521 and my $stor = dbic_internal_try { $self->schema->storage } )
523 $self->{_columns_info_loaded}++;
525 # try for the case of storage without table
527 my $info = $stor->columns_info_for( $self->from );
529 { (lc $_) => $info->{$_} }
533 foreach my $col ( keys %{$self->_columns} ) {
534 $self->_columns->{$col} = {
535 %{ $self->_columns->{$col} },
536 %{ $info->{$col} || $lc_info->{lc $col} || {} }
542 return $self->_columns->{$column};
549 =item Arguments: none
551 =item Return Value: Ordered list of column names
555 my @column_names = $source->columns;
557 Returns all column names in the order they were declared to L</add_columns>.
563 $self->throw_exception(
564 "columns() is a read-only accessor, did you mean add_columns()?"
566 return @{$self->{_ordered_columns}||[]};
573 =item Arguments: \@colnames ?
575 =item Return Value: Hashref of column name/info pairs
579 my $columns_info = $source->columns_info;
581 Like L</column_info> but returns information for the requested columns. If
582 the optional column-list arrayref is omitted it returns info on all columns
583 currently defined on the ResultSource via L</add_columns>.
588 my ($self, $columns) = @_;
590 my $colinfo = $self->_columns;
593 ! $self->{_columns_info_loaded}
595 $self->column_info_from_storage
597 grep { ! $_->{data_type} } values %$colinfo
599 my $stor = dbic_internal_try { $self->schema->storage }
601 $self->{_columns_info_loaded}++;
603 # try for the case of storage without table
605 my $info = $stor->columns_info_for( $self->from );
607 { (lc $_) => $info->{$_} }
611 foreach my $col ( keys %$colinfo ) {
613 %{ $colinfo->{$col} },
614 %{ $info->{$col} || $lc_info->{lc $col} || {} }
624 if (my $inf = $colinfo->{$_}) {
628 $self->throw_exception( sprintf (
629 "No such column '%s' on source '%s'",
631 $self->source_name || $self->name || 'Unknown source...?',
643 =head2 remove_columns
647 =item Arguments: @colnames
649 =item Return Value: not defined
653 $source->remove_columns(qw/col1 col2 col3/);
655 Removes the given list of columns by name, from the result source.
657 B<Warning>: Removing a column that is also used in the sources primary
658 key, or in one of the sources unique constraints, B<will> result in a
659 broken result source.
665 =item Arguments: $colname
667 =item Return Value: not defined
671 $source->remove_column('col');
673 Remove a single column by name from the result source, similar to
676 B<Warning>: Removing a column that is also used in the sources primary
677 key, or in one of the sources unique constraints, B<will> result in a
678 broken result source.
683 my ($self, @to_remove) = @_;
685 my $columns = $self->_columns
690 delete $columns->{$_};
694 $self->_ordered_columns([ grep { not $to_remove{$_} } @{$self->_ordered_columns} ]);
698 DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
699 shift->remove_columns(@_)
702 =head2 set_primary_key
706 =item Arguments: @cols
708 =item Return Value: not defined
712 Defines one or more columns as primary key for this source. Must be
713 called after L</add_columns>.
715 Additionally, defines a L<unique constraint|/add_unique_constraint>
718 Note: you normally do want to define a primary key on your sources
719 B<even if the underlying database table does not have a primary key>.
721 L<DBIx::Class::Manual::Intro/The Significance and Importance of Primary Keys>
726 sub set_primary_key {
727 my ($self, @cols) = @_;
729 my $colinfo = $self->columns_info(\@cols);
730 for my $col (@cols) {
731 carp_unique(sprintf (
732 "Primary key of source '%s' includes the column '%s' which has its "
733 . "'is_nullable' attribute set to true. This is a mistake and will cause "
734 . 'various Result-object operations to fail',
735 $self->source_name || $self->name || 'Unknown source...?',
737 )) if $colinfo->{$col}{is_nullable};
740 $self->_primaries(\@cols);
742 $self->add_unique_constraint(primary => \@cols);
745 =head2 primary_columns
749 =item Arguments: none
751 =item Return Value: Ordered list of primary column names
755 Read-only accessor which returns the list of primary keys, supplied by
760 sub primary_columns {
761 return @{shift->_primaries||[]};
764 # a helper method that will automatically die with a descriptive message if
765 # no pk is defined on the source in question. For internal use to save
766 # on if @pks... boilerplate
767 sub _pri_cols_or_die {
769 my @pcols = $self->primary_columns
770 or $self->throw_exception (sprintf(
771 "Operation requires a primary key to be declared on '%s' via set_primary_key",
772 # source_name is set only after schema-registration
773 $self->source_name || $self->result_class || $self->name || 'Unknown source...?',
778 # same as above but mandating single-column PK (used by relationship condition
780 sub _single_pri_col_or_die {
782 my ($pri, @too_many) = $self->_pri_cols_or_die;
784 $self->throw_exception( sprintf(
785 "Operation requires a single-column primary key declared on '%s'",
786 $self->source_name || $self->result_class || $self->name || 'Unknown source...?',
794 Manually define the correct sequence for your table, to avoid the overhead
795 associated with looking up the sequence automatically. The supplied sequence
796 will be applied to the L</column_info> of each L<primary_key|/set_primary_key>
800 =item Arguments: $sequence_name
802 =item Return Value: not defined
809 my ($self,$seq) = @_;
811 my @pks = $self->primary_columns
814 $_->{sequence} = $seq
815 for values %{ $self->columns_info (\@pks) };
819 =head2 add_unique_constraint
823 =item Arguments: $name?, \@colnames
825 =item Return Value: not defined
829 Declare a unique constraint on this source. Call once for each unique
832 # For UNIQUE (column1, column2)
833 __PACKAGE__->add_unique_constraint(
834 constraint_name => [ qw/column1 column2/ ],
837 Alternatively, you can specify only the columns:
839 __PACKAGE__->add_unique_constraint([ qw/column1 column2/ ]);
841 This will result in a unique constraint named
842 C<table_column1_column2>, where C<table> is replaced with the table
845 Unique constraints are used, for example, when you pass the constraint
846 name as the C<key> attribute to L<DBIx::Class::ResultSet/find>. Then
847 only columns in the constraint are searched.
849 Throws an error if any of the given column names do not yet exist on
854 sub add_unique_constraint {
858 $self->throw_exception(
859 'add_unique_constraint() does not accept multiple constraints, use '
860 . 'add_unique_constraints() instead'
865 if (ref $cols ne 'ARRAY') {
866 $self->throw_exception (
867 'Expecting an arrayref of constraint columns, got ' . ($cols||'NOTHING')
873 $name ||= $self->name_unique_constraint($cols);
875 foreach my $col (@$cols) {
876 $self->throw_exception("No such column $col on table " . $self->name)
877 unless $self->has_column($col);
880 my %unique_constraints = $self->unique_constraints;
881 $unique_constraints{$name} = $cols;
882 $self->_unique_constraints(\%unique_constraints);
885 =head2 add_unique_constraints
889 =item Arguments: @constraints
891 =item Return Value: not defined
895 Declare multiple unique constraints on this source.
897 __PACKAGE__->add_unique_constraints(
898 constraint_name1 => [ qw/column1 column2/ ],
899 constraint_name2 => [ qw/column2 column3/ ],
902 Alternatively, you can specify only the columns:
904 __PACKAGE__->add_unique_constraints(
905 [ qw/column1 column2/ ],
906 [ qw/column3 column4/ ]
909 This will result in unique constraints named C<table_column1_column2> and
910 C<table_column3_column4>, where C<table> is replaced with the table name.
912 Throws an error if any of the given column names do not yet exist on
915 See also L</add_unique_constraint>.
919 sub add_unique_constraints {
920 DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
923 my @constraints = @_;
925 if ( !(@constraints % 2) && grep { ref $_ ne 'ARRAY' } @constraints ) {
926 # with constraint name
927 while (my ($name, $constraint) = splice @constraints, 0, 2) {
928 $self->add_unique_constraint($name => $constraint);
933 foreach my $constraint (@constraints) {
934 $self->add_unique_constraint($constraint);
939 =head2 name_unique_constraint
943 =item Arguments: \@colnames
945 =item Return Value: Constraint name
949 $source->table('mytable');
950 $source->name_unique_constraint(['col1', 'col2']);
954 Return a name for a unique constraint containing the specified
955 columns. The name is created by joining the table name and each column
956 name, using an underscore character.
958 For example, a constraint on a table named C<cd> containing the columns
959 C<artist> and C<title> would result in a constraint name of C<cd_artist_title>.
961 This is used by L</add_unique_constraint> if you do not specify the
962 optional constraint name.
966 sub name_unique_constraint {
967 my ($self, $cols) = @_;
969 my $name = $self->name;
970 $name = $$name if (ref $name eq 'SCALAR');
971 $name =~ s/ ^ [^\.]+ \. //x; # strip possible schema qualifier
973 return join '_', $name, @$cols;
976 =head2 unique_constraints
980 =item Arguments: none
982 =item Return Value: Hash of unique constraint data
986 $source->unique_constraints();
988 Read-only accessor which returns a hash of unique constraints on this
991 The hash is keyed by constraint name, and contains an arrayref of
992 column names as values.
996 sub unique_constraints {
997 return %{shift->_unique_constraints||{}};
1000 =head2 unique_constraint_names
1004 =item Arguments: none
1006 =item Return Value: Unique constraint names
1010 $source->unique_constraint_names();
1012 Returns the list of unique constraint names defined on this source.
1016 sub unique_constraint_names {
1019 my %unique_constraints = $self->unique_constraints;
1021 return keys %unique_constraints;
1024 =head2 unique_constraint_columns
1028 =item Arguments: $constraintname
1030 =item Return Value: List of constraint columns
1034 $source->unique_constraint_columns('myconstraint');
1036 Returns the list of columns that make up the specified unique constraint.
1040 sub unique_constraint_columns {
1041 my ($self, $constraint_name) = @_;
1043 my %unique_constraints = $self->unique_constraints;
1045 $self->throw_exception(
1046 "Unknown unique constraint $constraint_name on '" . $self->name . "'"
1047 ) unless exists $unique_constraints{$constraint_name};
1049 return @{ $unique_constraints{$constraint_name} };
1052 =head2 sqlt_deploy_callback
1056 =item Arguments: $callback_name | \&callback_code
1058 =item Return Value: $callback_name | \&callback_code
1062 __PACKAGE__->result_source_instance->sqlt_deploy_callback('mycallbackmethod');
1066 __PACKAGE__->result_source_instance->sqlt_deploy_callback(sub {
1067 my ($source_instance, $sqlt_table) = @_;
1071 An accessor to set a callback to be called during deployment of
1072 the schema via L<DBIx::Class::Schema/create_ddl_dir> or
1073 L<DBIx::Class::Schema/deploy>.
1075 The callback can be set as either a code reference or the name of a
1076 method in the current result class.
1078 Defaults to L</default_sqlt_deploy_hook>.
1080 Your callback will be passed the $source object representing the
1081 ResultSource instance being deployed, and the
1082 L<SQL::Translator::Schema::Table> object being created from it. The
1083 callback can be used to manipulate the table object or add your own
1084 customised indexes. If you need to manipulate a non-table object, use
1085 the L<DBIx::Class::Schema/sqlt_deploy_hook>.
1087 See L<DBIx::Class::Manual::Cookbook/Adding Indexes And Functions To
1088 Your SQL> for examples.
1090 This sqlt deployment callback can only be used to manipulate
1091 SQL::Translator objects as they get turned into SQL. To execute
1092 post-deploy statements which SQL::Translator does not currently
1093 handle, override L<DBIx::Class::Schema/deploy> in your Schema class
1094 and call L<dbh_do|DBIx::Class::Storage::DBI/dbh_do>.
1096 =head2 default_sqlt_deploy_hook
1098 This is the default deploy hook implementation which checks if your
1099 current Result class has a C<sqlt_deploy_hook> method, and if present
1100 invokes it B<on the Result class directly>. This is to preserve the
1101 semantics of C<sqlt_deploy_hook> which was originally designed to expect
1102 the Result class name and the
1103 L<$sqlt_table instance|SQL::Translator::Schema::Table> of the table being
1108 sub default_sqlt_deploy_hook {
1111 my $class = $self->result_class;
1113 if ($class and $class->can('sqlt_deploy_hook')) {
1114 $class->sqlt_deploy_hook(@_);
1118 sub _invoke_sqlt_deploy_hook {
1120 if ( my $hook = $self->sqlt_deploy_callback) {
1129 =item Arguments: $classname
1131 =item Return Value: $classname
1135 use My::Schema::ResultClass::Inflator;
1138 use My::Schema::Artist;
1140 __PACKAGE__->result_class('My::Schema::ResultClass::Inflator');
1142 Set the default result class for this source. You can use this to create
1143 and use your own result inflator. See L<DBIx::Class::ResultSet/result_class>
1146 Please note that setting this to something like
1147 L<DBIx::Class::ResultClass::HashRefInflator> will make every result unblessed
1148 and make life more difficult. Inflators like those are better suited to
1149 temporary usage via L<DBIx::Class::ResultSet/result_class>.
1155 =item Arguments: none
1157 =item Return Value: L<$resultset|DBIx::Class::ResultSet>
1161 Returns a resultset for the given source. This will initially be created
1162 on demand by calling
1164 $self->resultset_class->new($self, $self->resultset_attributes)
1166 but is cached from then on unless resultset_class changes.
1168 =head2 resultset_class
1172 =item Arguments: $classname
1174 =item Return Value: $classname
1178 package My::Schema::ResultSet::Artist;
1179 use base 'DBIx::Class::ResultSet';
1182 # In the result class
1183 __PACKAGE__->resultset_class('My::Schema::ResultSet::Artist');
1186 $source->resultset_class('My::Schema::ResultSet::Artist');
1188 Set the class of the resultset. This is useful if you want to create your
1189 own resultset methods. Create your own class derived from
1190 L<DBIx::Class::ResultSet>, and set it here. If called with no arguments,
1191 this method returns the name of the existing resultset class, if one
1194 =head2 resultset_attributes
1198 =item Arguments: L<\%attrs|DBIx::Class::ResultSet/ATTRIBUTES>
1200 =item Return Value: L<\%attrs|DBIx::Class::ResultSet/ATTRIBUTES>
1204 # In the result class
1205 __PACKAGE__->resultset_attributes({ order_by => [ 'id' ] });
1208 $source->resultset_attributes({ order_by => [ 'id' ] });
1210 Store a collection of resultset attributes, that will be set on every
1211 L<DBIx::Class::ResultSet> produced from this result source.
1213 B<CAVEAT>: C<resultset_attributes> comes with its own set of issues and
1214 bugs! Notably the contents of the attributes are B<entirely static>, which
1215 greatly hinders composability (things like L<current_source_alias
1216 |DBIx::Class::ResultSet/current_source_alias> can not possibly be respected).
1217 While C<resultset_attributes> isn't deprecated per se, you are strongly urged
1218 to seek alternatives.
1220 Since relationships use attributes to link tables together, the "default"
1221 attributes you set may cause unpredictable and undesired behavior. Furthermore,
1222 the defaults B<cannot be turned off>, so you are stuck with them.
1224 In most cases, what you should actually be using are project-specific methods:
1226 package My::Schema::ResultSet::Artist;
1227 use base 'DBIx::Class::ResultSet';
1231 #__PACKAGE__->resultset_attributes({ prefetch => 'tracks' });
1234 sub with_tracks { shift->search({}, { prefetch => 'tracks' }) }
1237 $schema->resultset('Artist')->with_tracks->...
1239 This gives you the flexibility of not using it when you don't need it.
1241 For more complex situations, another solution would be to use a virtual view
1242 via L<DBIx::Class::ResultSource::View>.
1248 $self->throw_exception(
1249 'resultset does not take any arguments. If you want another resultset, '.
1250 'call it on the schema instead.'
1253 $self->resultset_class->new(
1256 ( dbic_internal_try { %{$self->schema->default_resultset_attributes} } ),
1257 %{$self->{resultset_attributes}},
1266 =item Arguments: none
1268 =item Result value: $name
1272 Returns the name of the result source, which will typically be the table
1273 name. This may be a scalar reference if the result source has a non-standard
1280 =item Arguments: $source_name
1282 =item Result value: $source_name
1286 Set an alternate name for the result source when it is loaded into a schema.
1287 This is useful if you want to refer to a result source by a name other than
1290 package ArchivedBooks;
1291 use base qw/DBIx::Class/;
1292 __PACKAGE__->table('books_archive');
1293 __PACKAGE__->source_name('Books');
1295 # from your schema...
1296 $schema->resultset('Books')->find(1);
1302 =item Arguments: none
1304 =item Return Value: FROM clause
1308 my $from_clause = $source->from();
1310 Returns an expression of the source to be supplied to storage to specify
1311 retrieval from this source. In the case of a database, the required FROM
1316 sub from { die 'Virtual method!' }
1320 Stores a hashref of per-source metadata. No specific key names
1321 have yet been standardized, the examples below are purely hypothetical
1322 and don't actually accomplish anything on their own:
1324 __PACKAGE__->source_info({
1325 "_tablespace" => 'fast_disk_array_3',
1326 "_engine" => 'InnoDB',
1333 =item Arguments: L<$schema?|DBIx::Class::Schema>
1335 =item Return Value: L<$schema|DBIx::Class::Schema>
1339 my $schema = $source->schema();
1341 Sets and/or returns the L<DBIx::Class::Schema> object to which this
1342 result source instance has been attached to.
1348 $_[0]->{schema} = $_[1];
1351 $_[0]->{schema} || do {
1352 my $name = $_[0]->{source_name} || '_unnamed_';
1353 my $err = 'Unable to perform storage-dependent operations with a detached result source '
1354 . "(source '$name' is not associated with a schema).";
1356 $err .= ' You need to use $schema->thaw() or manually set'
1357 . ' $DBIx::Class::ResultSourceHandle::thaw_schema while thawing.'
1358 if $_[0]->{_detached_thaw};
1360 DBIx::Class::Exception->throw($err);
1369 =item Arguments: none
1371 =item Return Value: L<$storage|DBIx::Class::Storage>
1375 $source->storage->debug(1);
1377 Returns the L<storage handle|DBIx::Class::Storage> for the current schema.
1382 DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
1383 $_[0]->schema->storage
1386 =head2 add_relationship
1390 =item Arguments: $rel_name, $related_source_name, \%cond, \%attrs?
1392 =item Return Value: 1/true if it succeeded
1396 $source->add_relationship('rel_name', 'related_source', $cond, $attrs);
1398 L<DBIx::Class::Relationship> describes a series of methods which
1399 create pre-defined useful types of relationships. Look there first
1400 before using this method directly.
1402 The relationship name can be arbitrary, but must be unique for each
1403 relationship attached to this result source. 'related_source' should
1404 be the name with which the related result source was registered with
1405 the current schema. For example:
1407 $schema->source('Book')->add_relationship('reviews', 'Review', {
1408 'foreign.book_id' => 'self.id',
1411 The condition C<$cond> needs to be an L<SQL::Abstract>-style
1412 representation of the join between the tables. For example, if you're
1413 creating a relation from Author to Book,
1415 { 'foreign.author_id' => 'self.id' }
1417 will result in the JOIN clause
1419 author me JOIN book foreign ON foreign.author_id = me.id
1421 You can specify as many foreign => self mappings as necessary.
1423 Valid attributes are as follows:
1429 Explicitly specifies the type of join to use in the relationship. Any
1430 SQL join type is valid, e.g. C<LEFT> or C<RIGHT>. It will be placed in
1431 the SQL command immediately before C<JOIN>.
1435 An arrayref containing a list of accessors in the foreign class to proxy in
1436 the main class. If, for example, you do the following:
1438 CD->might_have(liner_notes => 'LinerNotes', undef, {
1439 proxy => [ qw/notes/ ],
1442 Then, assuming LinerNotes has an accessor named notes, you can do:
1444 my $cd = CD->find(1);
1445 # set notes -- LinerNotes object is created if it doesn't exist
1446 $cd->notes('Notes go here');
1450 Specifies the type of accessor that should be created for the
1451 relationship. Valid values are C<single> (for when there is only a single
1452 related object), C<multi> (when there can be many), and C<filter> (for
1453 when there is a single related object, but you also want the relationship
1454 accessor to double as a column accessor). For C<multi> accessors, an
1455 add_to_* method is also created, which calls C<create_related> for the
1460 Throws an exception if the condition is improperly supplied, or cannot
1465 sub add_relationship {
1466 my ($self, $rel, $f_source_name, $cond, $attrs) = @_;
1467 $self->throw_exception("Can't create relationship without join condition")
1471 # Check foreign and self are right in cond
1472 if ( (ref $cond ||'') eq 'HASH') {
1473 $_ =~ /^foreign\./ or $self->throw_exception("Malformed relationship condition key '$_': must be prefixed with 'foreign.'")
1476 $_ =~ /^self\./ or $self->throw_exception("Malformed relationship condition value '$_': must be prefixed with 'self.'")
1480 my %rels = %{ $self->_relationships };
1481 $rels{$rel} = { class => $f_source_name,
1482 source => $f_source_name,
1485 $self->_relationships(\%rels);
1490 =head2 relationships
1494 =item Arguments: none
1496 =item Return Value: L<@rel_names|DBIx::Class::Relationship>
1500 my @rel_names = $source->relationships();
1502 Returns all relationship names for this source.
1507 keys %{$_[0]->_relationships};
1510 =head2 relationship_info
1514 =item Arguments: L<$rel_name|DBIx::Class::Relationship>
1516 =item Return Value: L<\%rel_data|DBIx::Class::Relationship::Base/add_relationship>
1520 Returns a hash of relationship information for the specified relationship
1521 name. The keys/values are as specified for L<DBIx::Class::Relationship::Base/add_relationship>.
1525 sub relationship_info {
1526 #my ($self, $rel) = @_;
1527 return shift->_relationships->{+shift};
1530 =head2 has_relationship
1534 =item Arguments: L<$rel_name|DBIx::Class::Relationship>
1536 =item Return Value: 1/0 (true/false)
1540 Returns true if the source has a relationship of this name, false otherwise.
1544 sub has_relationship {
1545 #my ($self, $rel) = @_;
1546 return exists shift->_relationships->{+shift};
1549 =head2 reverse_relationship_info
1553 =item Arguments: L<$rel_name|DBIx::Class::Relationship>
1555 =item Return Value: L<\%rel_data|DBIx::Class::Relationship::Base/add_relationship>
1559 Looks through all the relationships on the source this relationship
1560 points to, looking for one whose condition is the reverse of the
1561 condition on this relationship.
1563 A common use of this is to find the name of the C<belongs_to> relation
1564 opposing a C<has_many> relation. For definition of these look in
1565 L<DBIx::Class::Relationship>.
1567 The returned hashref is keyed by the name of the opposing
1568 relationship, and contains its data in the same manner as
1569 L</relationship_info>.
1573 sub reverse_relationship_info {
1574 my ($self, $rel) = @_;
1576 my $rel_info = $self->relationship_info($rel)
1577 or $self->throw_exception("No such relationship '$rel'");
1581 return $ret unless ((ref $rel_info->{cond}) eq 'HASH');
1583 my $stripped_cond = $self->__strip_relcond ($rel_info->{cond});
1585 my $registered_source_name = $self->source_name;
1587 # this may be a partial schema or something else equally esoteric
1588 my $other_rsrc = $self->related_source($rel);
1590 # Get all the relationships for that source that related to this source
1591 # whose foreign column set are our self columns on $rel and whose self
1592 # columns are our foreign columns on $rel
1593 foreach my $other_rel ($other_rsrc->relationships) {
1595 # only consider stuff that points back to us
1596 # "us" here is tricky - if we are in a schema registration, we want
1597 # to use the source_names, otherwise we will use the actual classes
1599 # the schema may be partial
1600 my $roundtrip_rsrc = dbic_internal_try { $other_rsrc->related_source($other_rel) }
1603 if ($registered_source_name) {
1604 next if $registered_source_name ne ($roundtrip_rsrc->source_name || '')
1607 next if $self->result_class ne $roundtrip_rsrc->result_class;
1610 my $other_rel_info = $other_rsrc->relationship_info($other_rel);
1612 # this can happen when we have a self-referential class
1613 next if $other_rel_info eq $rel_info;
1615 next unless ref $other_rel_info->{cond} eq 'HASH';
1616 my $other_stripped_cond = $self->__strip_relcond($other_rel_info->{cond});
1618 $ret->{$other_rel} = $other_rel_info if (
1619 $self->_compare_relationship_keys (
1620 [ keys %$stripped_cond ], [ values %$other_stripped_cond ]
1623 $self->_compare_relationship_keys (
1624 [ values %$stripped_cond ], [ keys %$other_stripped_cond ]
1632 # all this does is removes the foreign/self prefix from a condition
1633 sub __strip_relcond {
1636 { map { /^ (?:foreign|self) \. (\w+) $/x } ($_, $_[1]{$_}) }
1641 sub compare_relationship_keys {
1642 carp 'compare_relationship_keys is a private method, stop calling it';
1644 $self->_compare_relationship_keys (@_);
1647 # Returns true if both sets of keynames are the same, false otherwise.
1648 sub _compare_relationship_keys {
1649 # my ($self, $keys1, $keys2) = @_;
1651 join ("\x00", sort @{$_[1]})
1653 join ("\x00", sort @{$_[2]})
1657 # optionally takes either an arrayref of column names, or a hashref of already
1658 # retrieved colinfos
1659 # returns an arrayref of column names of the shortest unique constraint
1660 # (matching some of the input if any), giving preference to the PK
1661 sub _identifying_column_set {
1662 my ($self, $cols) = @_;
1664 my %unique = $self->unique_constraints;
1665 my $colinfos = ref $cols eq 'HASH' ? $cols : $self->columns_info($cols||());
1667 # always prefer the PK first, and then shortest constraints first
1669 for my $set (delete $unique{primary}, sort { @$a <=> @$b } (values %unique) ) {
1670 next unless $set && @$set;
1673 next USET unless ($colinfos->{$_} && !$colinfos->{$_}{is_nullable} );
1676 # copy so we can mangle it at will
1683 sub _minimal_valueset_satisfying_constraint {
1685 my $args = { ref $_[0] eq 'HASH' ? %{ $_[0] } : @_ };
1687 $args->{columns_info} ||= $self->columns_info;
1689 my $vals = $self->schema->storage->_extract_fixed_condition_columns(
1691 ($args->{carp_on_nulls} ? 'consider_nulls' : undef ),
1695 for my $col ($self->unique_constraint_columns($args->{constraint_name}) ) {
1696 if( ! exists $vals->{$col} or ( $vals->{$col}||'' ) eq UNRESOLVABLE_CONDITION ) {
1697 $cols->{missing}{$col} = undef;
1699 elsif( ! defined $vals->{$col} ) {
1700 $cols->{$args->{carp_on_nulls} ? 'undefined' : 'missing'}{$col} = undef;
1703 # we need to inject back the '=' as _extract_fixed_condition_columns
1704 # will strip it from literals and values alike, resulting in an invalid
1705 # condition in the end
1706 $cols->{present}{$col} = { '=' => $vals->{$col} };
1709 $cols->{fc}{$col} = 1 if (
1710 ( ! $cols->{missing} or ! exists $cols->{missing}{$col} )
1712 keys %{ $args->{columns_info}{$col}{_filter_info} || {} }
1716 $self->throw_exception( sprintf ( "Unable to satisfy requested constraint '%s', missing values for column(s): %s",
1717 $args->{constraint_name},
1718 join (', ', map { "'$_'" } sort keys %{$cols->{missing}} ),
1719 ) ) if $cols->{missing};
1721 $self->throw_exception( sprintf (
1722 "Unable to satisfy requested constraint '%s', FilterColumn values not usable for column(s): %s",
1723 $args->{constraint_name},
1724 join (', ', map { "'$_'" } sort keys %{$cols->{fc}}),
1730 !$ENV{DBIC_NULLABLE_KEY_NOWARN}
1732 carp_unique ( sprintf (
1733 "NULL/undef values supplied for requested unique constraint '%s' (NULL "
1734 . 'values in column(s): %s). This is almost certainly not what you wanted, '
1735 . 'though you can set DBIC_NULLABLE_KEY_NOWARN to disable this warning.',
1736 $args->{constraint_name},
1737 join (', ', map { "'$_'" } sort keys %{$cols->{undefined}}),
1741 return { map { %{ $cols->{$_}||{} } } qw(present undefined) };
1744 # Returns the {from} structure used to express JOIN conditions
1746 my ($self, $join, $alias, $seen, $jpath, $parent_force_left) = @_;
1748 # we need a supplied one, because we do in-place modifications, no returns
1749 $self->throw_exception ('You must supply a seen hashref as the 3rd argument to _resolve_join')
1750 unless ref $seen eq 'HASH';
1752 $self->throw_exception ('You must supply a joinpath arrayref as the 4th argument to _resolve_join')
1753 unless ref $jpath eq 'ARRAY';
1755 $jpath = [@$jpath]; # copy
1757 if (not defined $join or not length $join) {
1760 elsif (ref $join eq 'ARRAY') {
1763 $self->_resolve_join($_, $alias, $seen, $jpath, $parent_force_left);
1766 elsif (ref $join eq 'HASH') {
1769 for my $rel (keys %$join) {
1771 my $rel_info = $self->relationship_info($rel)
1772 or $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
1774 my $force_left = $parent_force_left;
1775 $force_left ||= lc($rel_info->{attrs}{join_type}||'') eq 'left';
1777 # the actual seen value will be incremented by the recursion
1778 my $as = $self->schema->storage->relname_to_table_alias(
1779 $rel, ($seen->{$rel} && $seen->{$rel} + 1)
1783 $self->_resolve_join($rel, $alias, $seen, [@$jpath], $force_left),
1784 $self->related_source($rel)->_resolve_join(
1785 $join->{$rel}, $as, $seen, [@$jpath, { $rel => $as }], $force_left
1793 $self->throw_exception("No idea how to resolve join reftype ".ref $join);
1796 my $count = ++$seen->{$join};
1797 my $as = $self->schema->storage->relname_to_table_alias(
1798 $join, ($count > 1 && $count)
1801 my $rel_info = $self->relationship_info($join)
1802 or $self->throw_exception("No such relationship $join on " . $self->source_name);
1804 my $rel_src = $self->related_source($join);
1805 return [ { $as => $rel_src->from,
1807 -join_type => $parent_force_left
1809 : $rel_info->{attrs}{join_type}
1811 -join_path => [@$jpath, { $join => $as } ],
1813 ! $rel_info->{attrs}{accessor}
1815 $rel_info->{attrs}{accessor} eq 'single'
1817 $rel_info->{attrs}{accessor} eq 'filter'
1820 -relation_chain_depth => ( $seen->{-relation_chain_depth} || 0 ) + 1,
1822 $self->_resolve_relationship_condition(
1824 self_alias => $alias,
1825 foreign_alias => $as,
1832 carp 'pk_depends_on is a private method, stop calling it';
1834 $self->_pk_depends_on (@_);
1837 # Determines whether a relation is dependent on an object from this source
1838 # having already been inserted. Takes the name of the relationship and a
1839 # hashref of columns of the related object.
1840 sub _pk_depends_on {
1841 my ($self, $rel_name, $rel_data) = @_;
1843 my $relinfo = $self->relationship_info($rel_name);
1845 # don't assume things if the relationship direction is specified
1846 return $relinfo->{attrs}{is_foreign_key_constraint}
1847 if exists ($relinfo->{attrs}{is_foreign_key_constraint});
1849 my $cond = $relinfo->{cond};
1850 return 0 unless ref($cond) eq 'HASH';
1852 # map { foreign.foo => 'self.bar' } to { bar => 'foo' }
1853 my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond };
1855 # assume anything that references our PK probably is dependent on us
1856 # rather than vice versa, unless the far side is (a) defined or (b)
1858 my $rel_source = $self->related_source($rel_name);
1860 foreach my $p ($self->primary_columns) {
1861 if (exists $keyhash->{$p}) {
1862 unless (defined($rel_data->{$keyhash->{$p}})
1863 || $rel_source->column_info($keyhash->{$p})
1864 ->{is_auto_increment}) {
1873 sub resolve_condition {
1874 carp 'resolve_condition is a private method, stop calling it';
1875 shift->_resolve_condition (@_);
1878 sub _resolve_condition {
1879 # carp_unique sprintf
1880 # '_resolve_condition is a private method, and moreover is about to go '
1881 # . 'away. Please contact the development team at %s if you believe you '
1882 # . 'have a genuine use for this method, in order to discuss alternatives.',
1883 # DBIx::Class::_ENV_::HELP_URL,
1886 #######################
1887 ### API Design? What's that...? (a backwards compatible shim, kill me now)
1889 my ($self, $cond, @res_args, $rel_name);
1891 # we *SIMPLY DON'T KNOW YET* which arg is which, yay
1892 ($self, $cond, $res_args[0], $res_args[1], $rel_name) = @_;
1894 # assume that an undef is an object-like unset (set_from_related(undef))
1895 my @is_objlike = map { ! defined $_ or length ref $_ } (@res_args);
1897 # turn objlike into proper objects for saner code further down
1899 next unless $is_objlike[$_];
1901 if ( defined blessed $res_args[$_] ) {
1903 # but wait - there is more!!! WHAT THE FUCK?!?!?!?!
1904 if ($res_args[$_]->isa('DBIx::Class::ResultSet')) {
1905 carp('Passing a resultset for relationship resolution makes no sense - invoking __gremlins__');
1906 $is_objlike[$_] = 0;
1907 $res_args[$_] = '__gremlins__';
1911 $res_args[$_] ||= {};
1913 # hate everywhere - have to pass in as a plain hash
1914 # pretending to be an object at least for now
1915 $self->throw_exception("Unsupported object-like structure encountered: $res_args[$_]")
1916 unless ref $res_args[$_] eq 'HASH';
1921 # where-is-waldo block guesses relname, then further down we override it if available
1923 $is_objlike[1] ? ( rel_name => $res_args[0], self_alias => $res_args[0], foreign_alias => 'me', self_result_object => $res_args[1] )
1924 : $is_objlike[0] ? ( rel_name => $res_args[1], self_alias => 'me', foreign_alias => $res_args[1], foreign_values => $res_args[0] )
1925 : ( rel_name => $res_args[0], self_alias => $res_args[1], foreign_alias => $res_args[0] )
1928 ( $rel_name ? ( rel_name => $rel_name ) : () ),
1931 # Allowing passing relconds different than the relationshup itself is cute,
1932 # but likely dangerous. Remove that from the (still unofficial) API of
1933 # _resolve_relationship_condition, and instead make it "hard on purpose"
1934 local $self->relationship_info( $args->{rel_name} )->{cond} = $cond if defined $cond;
1936 #######################
1938 # now it's fucking easy isn't it?!
1939 my $rc = $self->_resolve_relationship_condition( $args );
1942 ( $rc->{join_free_condition} || $rc->{condition} ),
1943 ! $rc->{join_free_condition},
1946 # _resolve_relationship_condition always returns qualified cols even in the
1947 # case of join_free_condition, but nothing downstream expects this
1948 if ($rc->{join_free_condition} and ref $res[0] eq 'HASH') {
1950 { ($_ =~ /\.(.+)/) => $res[0]{$_} }
1956 return wantarray ? @res : $res[0];
1959 # Keep this indefinitely. There is evidence of both CPAN and
1960 # darkpan using it, and there isn't much harm in an extra var
1962 our $UNRESOLVABLE_CONDITION = UNRESOLVABLE_CONDITION;
1963 # YES I KNOW THIS IS EVIL
1964 # it is there to save darkpan from themselves, since internally
1965 # we are moving to a constant
1966 Internals::SvREADONLY($UNRESOLVABLE_CONDITION => 1);
1968 # Resolves the passed condition to a concrete query fragment and extra
1971 ## self-explanatory API, modeled on the custom cond coderef:
1972 # rel_name => (scalar)
1973 # foreign_alias => (scalar)
1974 # foreign_values => (either not supplied, or a hashref, or a foreign ResultObject (to be ->get_columns()ed), or plain undef )
1975 # self_alias => (scalar)
1976 # self_result_object => (either not supplied or a result object)
1977 # require_join_free_condition => (boolean, throws on failure to construct a JF-cond)
1978 # infer_values_based_on => (either not supplied or a hashref, implies require_join_free_condition)
1981 # condition => (a valid *likely fully qualified* sqla cond structure)
1982 # identity_map => (a hashref of foreign-to-self *unqualified* column equality names)
1983 # join_free_condition => (a valid *fully qualified* sqla cond structure, maybe unset)
1984 # inferred_values => (in case of an available join_free condition, this is a hashref of
1985 # *unqualified* column/value *EQUALITY* pairs, representing an amalgamation
1986 # of the JF-cond parse and infer_values_based_on
1987 # always either complete or unset)
1989 sub _resolve_relationship_condition {
1992 my $args = { ref $_[0] eq 'HASH' ? %{ $_[0] } : @_ };
1994 for ( qw( rel_name self_alias foreign_alias ) ) {
1995 $self->throw_exception("Mandatory argument '$_' to _resolve_relationship_condition() is not a plain string")
1996 if !defined $args->{$_} or length ref $args->{$_};
1999 $self->throw_exception("Arguments 'self_alias' and 'foreign_alias' may not be identical")
2000 if $args->{self_alias} eq $args->{foreign_alias};
2003 my $exception_rel_id = "relationship '$args->{rel_name}' on source '@{[ $self->source_name ]}'";
2005 my $rel_info = $self->relationship_info($args->{rel_name})
2007 # or $self->throw_exception( "No such $exception_rel_id" );
2008 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");
2011 $exception_rel_id = "relationship '$rel_info->{_original_name}' on source '@{[ $self->source_name ]}'"
2012 if $rel_info and exists $rel_info->{_original_name};
2014 $self->throw_exception("No practical way to resolve $exception_rel_id between two data structures")
2015 if exists $args->{self_result_object} and exists $args->{foreign_values};
2017 $self->throw_exception( "Argument to infer_values_based_on must be a hash" )
2018 if exists $args->{infer_values_based_on} and ref $args->{infer_values_based_on} ne 'HASH';
2020 $args->{require_join_free_condition} ||= !!$args->{infer_values_based_on};
2022 $self->throw_exception( "Argument 'self_result_object' must be an object inheriting from DBIx::Class::Row" )
2024 exists $args->{self_result_object}
2026 ( ! defined blessed $args->{self_result_object} or ! $args->{self_result_object}->isa('DBIx::Class::Row') )
2030 my $rel_rsrc = $self->related_source($args->{rel_name});
2031 my $storage = $self->schema->storage;
2033 if (exists $args->{foreign_values}) {
2035 if (! defined $args->{foreign_values} ) {
2036 # fallback: undef => {}
2037 $args->{foreign_values} = {};
2039 elsif (defined blessed $args->{foreign_values}) {
2041 $self->throw_exception( "Objects supplied as 'foreign_values' ($args->{foreign_values}) must inherit from DBIx::Class::Row" )
2042 unless $args->{foreign_values}->isa('DBIx::Class::Row');
2045 "Objects supplied as 'foreign_values' ($args->{foreign_values}) "
2046 . "usually should inherit from the related ResultClass ('@{[ $rel_rsrc->result_class ]}'), "
2047 . "perhaps you've made a mistake invoking the condition resolver?"
2048 ) unless $args->{foreign_values}->isa($rel_rsrc->result_class);
2050 $args->{foreign_values} = { $args->{foreign_values}->get_columns };
2052 elsif ( ref $args->{foreign_values} eq 'HASH' ) {
2054 # re-build {foreign_values} excluding identically named rels
2055 if( keys %{$args->{foreign_values}} ) {
2057 my ($col_idx, $rel_idx) = map
2058 { { map { $_ => 1 } $rel_rsrc->$_ } }
2059 qw( columns relationships )
2062 my $equivalencies = $storage->_extract_fixed_condition_columns(
2063 $args->{foreign_values},
2067 $args->{foreign_values} = { map {
2068 # skip if relationship *and* a non-literal ref
2069 # this means a multicreate stub was passed in
2073 length ref $args->{foreign_values}{$_}
2075 ! is_literal_value($args->{foreign_values}{$_})
2080 ? $self->throw_exception( "Key '$_' supplied as 'foreign_values' is not a column on related source '@{[ $rel_rsrc->source_name ]}'" )
2081 : ( !exists $equivalencies->{$_} or ($equivalencies->{$_}||'') eq UNRESOLVABLE_CONDITION )
2082 ? $self->throw_exception( "Value supplied for '...{foreign_values}{$_}' is not a direct equivalence expression" )
2083 : $args->{foreign_values}{$_}
2085 } keys %{$args->{foreign_values}} };
2089 $self->throw_exception(
2090 "Argument 'foreign_values' must be either an object inheriting from '@{[ $rel_rsrc->result_class ]}', "
2091 . "or a hash reference, or undef"
2098 if (ref $rel_info->{cond} eq 'CODE') {
2101 rel_name => $args->{rel_name},
2102 self_resultsource => $self,
2103 self_alias => $args->{self_alias},
2104 foreign_alias => $args->{foreign_alias},
2106 { (exists $args->{$_}) ? ( $_ => $args->{$_} ) : () }
2107 qw( self_result_object foreign_values )
2111 # legacy - never remove these!!!
2112 $cref_args->{foreign_relname} = $cref_args->{rel_name};
2114 $cref_args->{self_rowobj} = $cref_args->{self_result_object}
2115 if exists $cref_args->{self_result_object};
2117 ($ret->{condition}, $ret->{join_free_condition}, my @extra) = $rel_info->{cond}->($cref_args);
2120 $self->throw_exception("A custom condition coderef can return at most 2 conditions, but $exception_rel_id returned extra values: @extra")
2123 if (my $jfc = $ret->{join_free_condition}) {
2125 $self->throw_exception (
2126 "The join-free condition returned for $exception_rel_id must be a hash reference"
2127 ) unless ref $jfc eq 'HASH';
2129 my ($joinfree_alias, $joinfree_source);
2130 if (defined $args->{self_result_object}) {
2131 $joinfree_alias = $args->{foreign_alias};
2132 $joinfree_source = $rel_rsrc;
2134 elsif (defined $args->{foreign_values}) {
2135 $joinfree_alias = $args->{self_alias};
2136 $joinfree_source = $self;
2139 # FIXME sanity check until things stabilize, remove at some point
2140 $self->throw_exception (
2141 "A join-free condition returned for $exception_rel_id without a result object to chain from"
2142 ) unless $joinfree_alias;
2144 my $fq_col_list = { map
2145 { ( "$joinfree_alias.$_" => 1 ) }
2146 $joinfree_source->columns
2149 exists $fq_col_list->{$_} or $self->throw_exception (
2150 "The join-free condition returned for $exception_rel_id may only "
2151 . 'contain keys that are fully qualified column names of the corresponding source '
2152 . "'$joinfree_alias' (instead it returned '$_')"
2160 $_->isa('DBIx::Class::Row')
2162 $self->throw_exception (
2163 "The join-free condition returned for $exception_rel_id may not "
2164 . 'contain result objects as values - perhaps instead of invoking '
2165 . '->$something you meant to return ->get_column($something)'
2171 elsif (ref $rel_info->{cond} eq 'HASH') {
2173 # the condition is static - use parallel arrays
2174 # for a "pivot" depending on which side of the
2175 # rel did we get as an object
2176 my (@f_cols, @l_cols);
2177 for my $fc (keys %{ $rel_info->{cond} }) {
2178 my $lc = $rel_info->{cond}{$fc};
2180 # FIXME STRICTMODE should probably check these are valid columns
2181 $fc =~ s/^foreign\.// ||
2182 $self->throw_exception("Invalid rel cond key '$fc'");
2184 $lc =~ s/^self\.// ||
2185 $self->throw_exception("Invalid rel cond val '$lc'");
2191 # construct the crosstable condition and the identity map
2193 $ret->{condition}{"$args->{foreign_alias}.$f_cols[$_]"} = { -ident => "$args->{self_alias}.$l_cols[$_]" };
2194 $ret->{identity_map}{$l_cols[$_]} = $f_cols[$_];
2197 if ($args->{foreign_values}) {
2198 $ret->{join_free_condition}{"$args->{self_alias}.$l_cols[$_]"} = $args->{foreign_values}{$f_cols[$_]}
2201 elsif (defined $args->{self_result_object}) {
2203 for my $i (0..$#l_cols) {
2204 if ( $args->{self_result_object}->has_column_loaded($l_cols[$i]) ) {
2205 $ret->{join_free_condition}{"$args->{foreign_alias}.$f_cols[$i]"} = $args->{self_result_object}->get_column($l_cols[$i]);
2208 $self->throw_exception(sprintf
2209 "Unable to resolve relationship '%s' from object '%s': column '%s' not "
2210 . 'loaded from storage (or not passed to new() prior to insert()). You '
2211 . 'probably need to call ->discard_changes to get the server-side defaults '
2212 . 'from the database.',
2214 $args->{self_result_object},
2216 ) if $args->{self_result_object}->in_storage;
2218 # FIXME - temporarly force-override
2219 delete $args->{require_join_free_condition};
2220 $ret->{join_free_condition} = UNRESOLVABLE_CONDITION;
2226 elsif (ref $rel_info->{cond} eq 'ARRAY') {
2227 if (@{ $rel_info->{cond} } == 0) {
2229 condition => UNRESOLVABLE_CONDITION,
2230 join_free_condition => UNRESOLVABLE_CONDITION,
2234 my @subconds = map {
2235 local $rel_info->{cond} = $_;
2236 $self->_resolve_relationship_condition( $args );
2237 } @{ $rel_info->{cond} };
2239 if( @{ $rel_info->{cond} } == 1 ) {
2240 $ret = $subconds[0];
2243 # we are discarding inferred values here... likely incorrect...
2244 # then again - the entire thing is an OR, so we *can't* use them anyway
2245 for my $subcond ( @subconds ) {
2246 $self->throw_exception('Either all or none of the OR-condition members must resolve to a join-free condition')
2247 if ( $ret and ( $ret->{join_free_condition} xor $subcond->{join_free_condition} ) );
2249 $subcond->{$_} and push @{$ret->{$_}}, $subcond->{$_} for (qw(condition join_free_condition));
2255 $self->throw_exception ("Can't handle condition $rel_info->{cond} for $exception_rel_id yet :(");
2259 $args->{require_join_free_condition}
2261 ( ! $ret->{join_free_condition} or $ret->{join_free_condition} eq UNRESOLVABLE_CONDITION )
2263 $self->throw_exception(
2264 ucfirst sprintf "$exception_rel_id does not resolve to a %sjoin-free condition fragment",
2265 exists $args->{foreign_values}
2266 ? "'foreign_values'-based reversed-"
2271 # we got something back - sanity check and infer values if we can
2274 $ret->{join_free_condition}
2276 $ret->{join_free_condition} ne UNRESOLVABLE_CONDITION
2278 my $jfc = $storage->_collapse_cond( $ret->{join_free_condition} )
2281 my $jfc_eqs = $storage->_extract_fixed_condition_columns($jfc, 'consider_nulls');
2283 if (keys %$jfc_eqs) {
2286 # $jfc is fully qualified by definition
2287 my ($col) = $_ =~ /\.(.+)/;
2289 if (exists $jfc_eqs->{$_} and ($jfc_eqs->{$_}||'') ne UNRESOLVABLE_CONDITION) {
2290 $ret->{inferred_values}{$col} = $jfc_eqs->{$_};
2292 elsif ( !$args->{infer_values_based_on} or ! exists $args->{infer_values_based_on}{$col} ) {
2293 push @nonvalues, $col;
2298 delete $ret->{inferred_values} if @nonvalues;
2302 # did the user explicitly ask
2303 if ($args->{infer_values_based_on}) {
2305 $self->throw_exception(sprintf (
2306 "Unable to complete value inferrence - custom $exception_rel_id returns conditions instead of values for column(s): %s",
2307 map { "'$_'" } @nonvalues
2311 $ret->{inferred_values} ||= {};
2313 $ret->{inferred_values}{$_} = $args->{infer_values_based_on}{$_}
2314 for keys %{$args->{infer_values_based_on}};
2317 # add the identities based on the main condition
2318 # (may already be there, since easy to calculate on the fly in the HASH case)
2319 if ( ! $ret->{identity_map} ) {
2321 my $col_eqs = $storage->_extract_fixed_condition_columns($ret->{condition});
2324 for my $lhs (keys %$col_eqs) {
2326 next if $col_eqs->{$lhs} eq UNRESOLVABLE_CONDITION;
2328 # there is no way to know who is right and who is left in a cref
2329 # therefore a full blown resolution call, and figure out the
2330 # direction a bit further below
2331 $colinfos ||= $storage->_resolve_column_info([
2332 { -alias => $args->{self_alias}, -rsrc => $self },
2333 { -alias => $args->{foreign_alias}, -rsrc => $rel_rsrc },
2336 next unless $colinfos->{$lhs}; # someone is engaging in witchcraft
2338 if ( my $rhs_ref = is_literal_value( $col_eqs->{$lhs} ) ) {
2341 $colinfos->{$rhs_ref->[0]}
2343 $colinfos->{$lhs}{-source_alias} ne $colinfos->{$rhs_ref->[0]}{-source_alias}
2345 ( $colinfos->{$lhs}{-source_alias} eq $args->{self_alias} )
2346 ? ( $ret->{identity_map}{$colinfos->{$lhs}{-colname}} = $colinfos->{$rhs_ref->[0]}{-colname} )
2347 : ( $ret->{identity_map}{$colinfos->{$rhs_ref->[0]}{-colname}} = $colinfos->{$lhs}{-colname} )
2352 $col_eqs->{$lhs} =~ /^ ( \Q$args->{self_alias}\E \. .+ ) /x
2354 ($colinfos->{$1}||{})->{-result_source} == $rel_rsrc
2356 my ($lcol, $rcol) = map
2357 { $colinfos->{$_}{-colname} }
2361 "The $exception_rel_id specifies equality of column '$lcol' and the "
2362 . "*VALUE* '$rcol' (you did not use the { -ident => ... } operator)"
2368 # FIXME - temporary, to fool the idiotic check in SQLMaker::_join_condition
2369 $ret->{condition} = { -and => [ $ret->{condition} ] }
2370 unless $ret->{condition} eq UNRESOLVABLE_CONDITION;
2375 =head2 related_source
2379 =item Arguments: $rel_name
2381 =item Return Value: $source
2385 Returns the result source object for the given relationship.
2389 sub related_source {
2390 my ($self, $rel) = @_;
2391 if( !$self->has_relationship( $rel ) ) {
2392 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
2395 # if we are not registered with a schema - just use the prototype
2396 # however if we do have a schema - ask for the source by name (and
2397 # throw in the process if all fails)
2398 if (my $schema = dbic_internal_try { $self->schema }) {
2399 $schema->source($self->relationship_info($rel)->{source});
2402 my $class = $self->relationship_info($rel)->{class};
2403 $self->ensure_class_loaded($class);
2404 $class->result_source_instance;
2408 =head2 related_class
2412 =item Arguments: $rel_name
2414 =item Return Value: $classname
2418 Returns the class name for objects in the given relationship.
2423 my ($self, $rel) = @_;
2424 if( !$self->has_relationship( $rel ) ) {
2425 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
2427 return $self->schema->class($self->relationship_info($rel)->{source});
2434 =item Arguments: none
2436 =item Return Value: L<$source_handle|DBIx::Class::ResultSourceHandle>
2440 Obtain a new L<result source handle instance|DBIx::Class::ResultSourceHandle>
2441 for this source. Used as a serializable pointer to this resultsource, as it is not
2442 easy (nor advisable) to serialize CODErefs which may very well be present in e.g.
2443 relationship definitions.
2448 require DBIx::Class::ResultSourceHandle;
2449 return DBIx::Class::ResultSourceHandle->new({
2450 source_moniker => $_[0]->source_name,
2452 # so that a detached thaw can be re-frozen
2453 $_[0]->{_detached_thaw}
2454 ? ( _detached_source => $_[0] )
2455 : ( schema => $_[0]->schema )
2460 my $global_phase_destroy;
2462 ### NO detected_reinvoked_destructor check
2463 ### This code very much relies on being called multuple times
2465 return if $global_phase_destroy ||= in_global_destruction;
2471 # Under no circumstances shall $_[0] be stored anywhere else (like copied to
2472 # a lexical variable, or shifted, or anything else). Doing so will mess up
2473 # the refcount of this particular result source, and will allow the $schema
2474 # we are trying to save to reattach back to the source we are destroying.
2475 # The relevant code checking refcounts is in ::Schema::DESTROY()
2477 # if we are not a schema instance holder - we don't matter
2479 ! ref $_[0]->{schema}
2481 isweak $_[0]->{schema}
2484 # weaken our schema hold forcing the schema to find somewhere else to live
2485 # during global destruction (if we have not yet bailed out) this will throw
2486 # which will serve as a signal to not try doing anything else
2487 # however beware - on older perls the exception seems randomly untrappable
2488 # due to some weird race condition during thread joining :(((
2489 local $SIG{__DIE__} if $SIG{__DIE__};
2490 local $@ if DBIx::Class::_ENV_::UNSTABLE_DOLLARAT;
2492 weaken $_[0]->{schema};
2494 # if schema is still there reintroduce ourselves with strong refs back to us
2495 if ($_[0]->{schema}) {
2496 my $srcregs = $_[0]->{schema}->source_registrations;
2498 defined $srcregs->{$_}
2500 $srcregs->{$_} == $_[0]
2502 $srcregs->{$_} = $_[0]
2510 $global_phase_destroy = 1;
2513 # Dummy NEXTSTATE ensuring the all temporaries on the stack are garbage
2514 # collected before leaving this scope. Depending on the code above, this
2515 # may very well be just a preventive measure guarding future modifications
2519 sub STORABLE_freeze { Storable::nfreeze($_[0]->handle) }
2522 my ($self, $cloning, $ice) = @_;
2523 %$self = %{ (Storable::thaw($ice))->resolve };
2526 =head2 throw_exception
2528 See L<DBIx::Class::Schema/"throw_exception">.
2532 sub throw_exception {
2536 ? $self->{schema}->throw_exception(@_)
2537 : DBIx::Class::Exception->throw(@_)
2541 =head2 column_info_from_storage
2545 =item Arguments: 1/0 (default: 0)
2547 =item Return Value: 1/0
2551 __PACKAGE__->column_info_from_storage(1);
2553 Enables the on-demand automatic loading of the above column
2554 metadata from storage as necessary. This is *deprecated*, and
2555 should not be used. It will be removed before 1.0.
2557 =head1 FURTHER QUESTIONS?
2559 Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
2561 =head1 COPYRIGHT AND LICENSE
2563 This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
2564 by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
2565 redistribute it and/or modify it under the same terms as the
2566 L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.