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;
20 my @hashref_attributes = qw(
21 source_info resultset_attributes
22 _columns _unique_constraints _relationships
24 my @arrayref_attributes = qw(
25 _ordered_columns _primaries
31 qw( source_name name column_info_from_storage sqlt_deploy_callback ),
36 has '+name' => ( default => "!!NAME NOT SET!!" );
37 has '+sqlt_deploy_callback' => ( default => 'default_sqlt_deploy_hook' );
39 # We use the CAG accessors for this due to the "load-on-get" logic
40 # not being cleanly triggerable from within Moo
41 __PACKAGE__->mk_group_accessors(component_class => qw/
48 DBIx::Class::ResultSource - Result source object
52 # Create a table based result source, in a result class.
54 package MyApp::Schema::Result::Artist;
55 use base qw/DBIx::Class::Core/;
57 __PACKAGE__->table('artist');
58 __PACKAGE__->add_columns(qw/ artistid name /);
59 __PACKAGE__->set_primary_key('artistid');
60 __PACKAGE__->has_many(cds => 'MyApp::Schema::Result::CD');
64 # Create a query (view) based result source, in a result class
65 package MyApp::Schema::Result::Year2000CDs;
66 use base qw/DBIx::Class::Core/;
68 __PACKAGE__->load_components('InflateColumn::DateTime');
69 __PACKAGE__->table_class('DBIx::Class::ResultSource::View');
71 __PACKAGE__->table('year2000cds');
72 __PACKAGE__->result_source->is_virtual(1);
73 __PACKAGE__->result_source->view_definition(
74 "SELECT cdid, artist, title FROM cd WHERE year ='2000'"
80 A ResultSource is an object that represents a source of data for querying.
82 This class is a base class for various specialised types of result
83 sources, for example L<DBIx::Class::ResultSource::Table>. Table is the
84 default result source type, so one is created for you when defining a
85 result class as described in the synopsis above.
87 More specifically, the L<DBIx::Class::Core> base class pulls in the
88 L<DBIx::Class::ResultSourceProxy::Table> component, which defines
89 the L<table|DBIx::Class::ResultSourceProxy::Table/table> method.
90 When called, C<table> creates and stores an instance of
91 L<DBIx::Class::ResultSource::Table>. Luckily, to use tables as result
92 sources, you don't need to remember any of this.
94 Result sources representing select queries, or views, can also be
95 created, see L<DBIx::Class::ResultSource::View> for full details.
97 =head2 Finding result source objects
99 As mentioned above, a result source instance is created and stored for
100 you when you define a
101 L<Result Class|DBIx::Class::Manual::Glossary/Result Class>.
103 You can retrieve the result source at runtime in the following ways:
107 =item From a Schema object:
109 $schema->source($source_name);
111 =item From a Result object:
113 $result->result_source;
115 =item From a ResultSet object:
127 $class->new({attribute_name => value});
129 Creates a new ResultSource object. Not normally called directly by end users.
136 # <ribasushi> haarg: one more question - is there a straightforward way to inline BUILD/BUILDARGS ?
137 # <ribasushi> ( I have both )
138 # <haarg> not really. it's something we probably should do, but don't currently.
140 # Because there are spots that call ->new($rsrc_object) in the wild
141 sub BUILDARGS { +{ %{ $_[1] || {} } } }
146 sub __derived_instances {
148 (defined $_->{weakref})
151 } values %{ $rsrc_registry->{ refaddr($_[0]) }{ derivatives } }
158 DBIx::Class::_ENV_::ASSERT_NO_ERRONEOUS_METAINSTANCE_USE
160 # a constructor with 'name' as sole arg clearly isn't "inheriting" from anything
161 ( not ( keys(%{$_[0]}) == 1 and exists $_[0]->{name} ) )
163 defined CORE::caller(1)
165 (CORE::caller(1))[3] !~ / ::new$ | ^ DBIx::Class :: (?:
166 ResultSourceProxy::Table::table
168 ResultSourceProxy::Table::_init_result_source_instance
173 local $Carp::CarpLevel = $Carp::CarpLevel + 1
175 Carp::confess("Incorrect instantiation of '$self': you almost certainly wanted to call ->clone() instead");
178 my $ancestor = delete $_[0]->{__derived_from};
180 # Allow complete transparency to subclasses: ->new( \%random_stuff )
187 my $own_slot = $rsrc_registry->{
188 my $own_addr = refaddr $self
189 } = { derivatives => {} };
191 weaken( $own_slot->{weakref} = $self );
196 my $ancestor_slot = $rsrc_registry->{
197 my $ancestor_addr = refaddr $ancestor
201 # on ancestry recording compact registry slots, prevent unbound growth
202 for my $r ( $rsrc_registry, map { $_->{derivatives} } values %$rsrc_registry ) {
203 defined $r->{$_}{weakref} or delete $r->{$_}
207 weaken( $_->{$own_addr} = $own_slot ) for map
208 { $_->{derivatives} }
212 { defined $_->{derivatives}{$ancestor_addr} }
213 values %$rsrc_registry
220 # not a default because we use the CAG accessors, see top of file
221 $self->{resultset_class} ||= 'DBIx::Class::ResultSet';
223 $self->{$_} = { %{ $self->{$_} || {} } }
224 for @hashref_attributes;
226 $self->{$_} = [ @{ $self->{$_} || [] } ]
227 for @arrayref_attributes;
232 sub DBIx::Class::__Rsrc_Ancestry_iThreads_handler__::CLONE {
233 for my $r ( $rsrc_registry, map { $_->{derivatives} } values %$rsrc_registry ) {
235 defined $_->{weakref}
236 ? ( refaddr $_->{weakref} => $_ )
245 $rsrc_instance->clone( atribute_name => overriden_value );
247 A wrapper around L</new> inheriting any defaults from the callee. This method
248 also not normally invoked directly by end users.
258 ? ( %$self, __derived_from => $self )
262 (@_ == 1 and ref $_[0] eq 'HASH')
275 =item Arguments: @columns
277 =item Return Value: L<$result_source|/new>
281 $source->add_columns(qw/col1 col2 col3/);
283 $source->add_columns('col1' => \%col1_info, 'col2' => \%col2_info, ...);
285 $source->add_columns(
286 'col1' => { data_type => 'integer', is_nullable => 1, ... },
287 'col2' => { data_type => 'text', is_auto_increment => 1, ... },
290 Adds columns to the result source. If supplied colname => hashref
291 pairs, uses the hashref as the L</column_info> for that column. Repeated
292 calls of this method will add more columns, not replace them.
294 The column names given will be created as accessor methods on your
295 L<Result|DBIx::Class::Manual::ResultClass> objects. You can change the name of the accessor
296 by supplying an L</accessor> in the column_info hash.
298 If a column name beginning with a plus sign ('+col1') is provided, the
299 attributes provided will be merged with any existing attributes for the
300 column, with the new attributes taking precedence in the case that an
301 attribute already exists. Using this without a hashref
302 (C<< $source->add_columns(qw/+col1 +col2/) >>) is legal, but useless --
303 it does the same thing it would do without the plus.
305 The contents of the column_info are not set in stone. The following
306 keys are currently recognised/used by DBIx::Class:
312 { accessor => '_name' }
314 # example use, replace standard accessor with one of your own:
316 my ($self, $value) = @_;
318 die "Name cannot contain digits!" if($value =~ /\d/);
319 $self->_name($value);
321 return $self->_name();
324 Use this to set the name of the accessor method for this column. If unset,
325 the name of the column will be used.
329 { data_type => 'integer' }
331 This contains the column type. It is automatically filled if you use the
332 L<SQL::Translator::Producer::DBIx::Class::File> producer, or the
333 L<DBIx::Class::Schema::Loader> module.
335 Currently there is no standard set of values for the data_type. Use
336 whatever your database supports.
342 The length of your column, if it is a column type that can have a size
343 restriction. This is currently only used to create tables from your
344 schema, see L<DBIx::Class::Schema/deploy>.
348 For decimal or float values you can specify an ArrayRef in order to
349 control precision, assuming your database's
350 L<SQL::Translator::Producer> supports it.
356 Set this to a true value for a column that is allowed to contain NULL
357 values, default is false. This is currently only used to create tables
358 from your schema, see L<DBIx::Class::Schema/deploy>.
360 =item is_auto_increment
362 { is_auto_increment => 1 }
364 Set this to a true value for a column whose value is somehow
365 automatically set, defaults to false. This is used to determine which
366 columns to empty when cloning objects using
367 L<DBIx::Class::Row/copy>. It is also used by
368 L<DBIx::Class::Schema/deploy>.
374 Set this to a true or false value (not C<undef>) to explicitly specify
375 if this column contains numeric data. This controls how set_column
376 decides whether to consider a column dirty after an update: if
377 C<is_numeric> is true a numeric comparison C<< != >> will take place
378 instead of the usual C<eq>
380 If not specified the storage class will attempt to figure this out on
381 first access to the column, based on the column C<data_type>. The
382 result will be cached in this attribute.
386 { is_foreign_key => 1 }
388 Set this to a true value for a column that contains a key from a
389 foreign table, defaults to false. This is currently only used to
390 create tables from your schema, see L<DBIx::Class::Schema/deploy>.
394 { default_value => \'now()' }
396 Set this to the default value which will be inserted into a column by
397 the database. Can contain either a value or a function (use a
398 reference to a scalar e.g. C<\'now()'> if you want a function). This
399 is currently only used to create tables from your schema, see
400 L<DBIx::Class::Schema/deploy>.
402 See the note on L<DBIx::Class::Row/new> for more information about possible
403 issues related to db-side default values.
407 { sequence => 'my_table_seq' }
409 Set this on a primary key column to the name of the sequence used to
410 generate a new key value. If not specified, L<DBIx::Class::PK::Auto>
411 will attempt to retrieve the name of the sequence from the database
414 =item retrieve_on_insert
416 { retrieve_on_insert => 1 }
418 For every column where this is set to true, DBIC will retrieve the RDBMS-side
419 value upon a new row insertion (normally only the autoincrement PK is
420 retrieved on insert). C<INSERT ... RETURNING> is used automatically if
421 supported by the underlying storage, otherwise an extra SELECT statement is
422 executed to retrieve the missing data.
426 { auto_nextval => 1 }
428 Set this to a true value for a column whose value is retrieved automatically
429 from a sequence or function (if supported by your Storage driver.) For a
430 sequence, if you do not use a trigger to get the nextval, you have to set the
431 L</sequence> value as well.
433 Also set this for MSSQL columns with the 'uniqueidentifier'
434 L<data_type|DBIx::Class::ResultSource/data_type> whose values you want to
435 automatically generate using C<NEWID()>, unless they are a primary key in which
436 case this will be done anyway.
440 This is used by L<DBIx::Class::Schema/deploy> and L<SQL::Translator>
441 to add extra non-generic data to the column. For example: C<< extra
442 => { unsigned => 1} >> is used by the MySQL producer to set an integer
443 column to unsigned. For more details, see
444 L<SQL::Translator::Producer::MySQL>.
452 =item Arguments: $colname, \%columninfo?
454 =item Return Value: 1/0 (true/false)
458 $source->add_column('col' => \%info);
460 Add a single column and optional column info. Uses the same column
461 info keys as L</add_columns>.
466 my ($self, @cols) = @_;
467 $self->_ordered_columns(\@cols) unless $self->_ordered_columns;
469 my ( @added, $colinfos );
470 my $columns = $self->_columns;
472 while (my $col = shift @cols) {
477 ( $colinfos ||= $self->columns_info )->{$col}
483 # If next entry is { ... } use that for the column info, if not
484 # use an empty hashref
486 my $new_info = shift(@cols);
487 %$column_info = (%$column_info, %$new_info);
489 push(@added, $col) unless exists $columns->{$col};
490 $columns->{$col} = $column_info;
493 push @{ $self->_ordered_columns }, @added;
498 DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
499 shift->add_columns(@_)
506 =item Arguments: $colname
508 =item Return Value: 1/0 (true/false)
512 if ($source->has_column($colname)) { ... }
514 Returns true if the source has a column of this name, false otherwise.
519 my ($self, $column) = @_;
520 return exists $self->_columns->{$column};
527 =item Arguments: $colname
529 =item Return Value: Hashref of info
533 my $info = $source->column_info($col);
535 Returns the column metadata hashref for a column, as originally passed
536 to L</add_columns>. See L</add_columns> above for information on the
537 contents of the hashref.
542 DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
544 #my ($self, $column) = @_;
545 $_[0]->columns_info([ $_[1] ])->{$_[1]};
552 =item Arguments: none
554 =item Return Value: Ordered list of column names
558 my @column_names = $source->columns;
560 Returns all column names in the order they were declared to L</add_columns>.
566 $self->throw_exception(
567 "columns() is a read-only accessor, did you mean add_columns()?"
569 return @{$self->{_ordered_columns}||[]};
576 =item Arguments: \@colnames ?
578 =item Return Value: Hashref of column name/info pairs
582 my $columns_info = $source->columns_info;
584 Like L</column_info> but returns information for the requested columns. If
585 the optional column-list arrayref is omitted it returns info on all columns
586 currently defined on the ResultSource via L</add_columns>.
591 my ($self, $columns) = @_;
593 my $colinfo = $self->_columns;
596 ! $self->{_columns_info_loaded}
598 $self->column_info_from_storage
600 grep { ! $_->{data_type} } values %$colinfo
602 my $stor = dbic_internal_try { $self->schema->storage }
604 $self->{_columns_info_loaded}++;
606 # try for the case of storage without table
608 my $info = $stor->columns_info_for( $self->from );
610 { (lc $_) => $info->{$_} }
614 foreach my $col ( keys %$colinfo ) {
616 %{ $colinfo->{$col} },
617 %{ $info->{$col} || $lc_info->{lc $col} || {} }
627 if (my $inf = $colinfo->{$_}) {
631 $self->throw_exception( sprintf (
632 "No such column '%s' on source '%s'",
634 $self->source_name || $self->name || 'Unknown source...?',
640 # the shallow copy is crucial - there are exists() checks within
648 =head2 remove_columns
652 =item Arguments: @colnames
654 =item Return Value: not defined
658 $source->remove_columns(qw/col1 col2 col3/);
660 Removes the given list of columns by name, from the result source.
662 B<Warning>: Removing a column that is also used in the sources primary
663 key, or in one of the sources unique constraints, B<will> result in a
664 broken result source.
670 =item Arguments: $colname
672 =item Return Value: not defined
676 $source->remove_column('col');
678 Remove a single column by name from the result source, similar to
681 B<Warning>: Removing a column that is also used in the sources primary
682 key, or in one of the sources unique constraints, B<will> result in a
683 broken result source.
688 my ($self, @to_remove) = @_;
690 my $columns = $self->_columns
695 delete $columns->{$_};
699 $self->_ordered_columns([ grep { not $to_remove{$_} } @{$self->_ordered_columns} ]);
703 DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
704 shift->remove_columns(@_)
707 =head2 set_primary_key
711 =item Arguments: @cols
713 =item Return Value: not defined
717 Defines one or more columns as primary key for this source. Must be
718 called after L</add_columns>.
720 Additionally, defines a L<unique constraint|/add_unique_constraint>
723 Note: you normally do want to define a primary key on your sources
724 B<even if the underlying database table does not have a primary key>.
726 L<DBIx::Class::Manual::Intro/The Significance and Importance of Primary Keys>
731 sub set_primary_key {
732 my ($self, @cols) = @_;
734 my $colinfo = $self->columns_info(\@cols);
735 for my $col (@cols) {
736 carp_unique(sprintf (
737 "Primary key of source '%s' includes the column '%s' which has its "
738 . "'is_nullable' attribute set to true. This is a mistake and will cause "
739 . 'various Result-object operations to fail',
740 $self->source_name || $self->name || 'Unknown source...?',
742 )) if $colinfo->{$col}{is_nullable};
745 $self->_primaries(\@cols);
747 $self->add_unique_constraint(primary => \@cols);
750 =head2 primary_columns
754 =item Arguments: none
756 =item Return Value: Ordered list of primary column names
760 Read-only accessor which returns the list of primary keys, supplied by
765 sub primary_columns {
766 return @{shift->_primaries||[]};
769 # a helper method that will automatically die with a descriptive message if
770 # no pk is defined on the source in question. For internal use to save
771 # on if @pks... boilerplate
772 sub _pri_cols_or_die {
774 my @pcols = $self->primary_columns
775 or $self->throw_exception (sprintf(
776 "Operation requires a primary key to be declared on '%s' via set_primary_key",
777 # source_name is set only after schema-registration
778 $self->source_name || $self->result_class || $self->name || 'Unknown source...?',
783 # same as above but mandating single-column PK (used by relationship condition
785 sub _single_pri_col_or_die {
787 my ($pri, @too_many) = $self->_pri_cols_or_die;
789 $self->throw_exception( sprintf(
790 "Operation requires a single-column primary key declared on '%s'",
791 $self->source_name || $self->result_class || $self->name || 'Unknown source...?',
799 Manually define the correct sequence for your table, to avoid the overhead
800 associated with looking up the sequence automatically. The supplied sequence
801 will be applied to the L</column_info> of each L<primary_key|/set_primary_key>
805 =item Arguments: $sequence_name
807 =item Return Value: not defined
814 my ($self,$seq) = @_;
816 my @pks = $self->primary_columns
819 $_->{sequence} = $seq
820 for values %{ $self->columns_info (\@pks) };
824 =head2 add_unique_constraint
828 =item Arguments: $name?, \@colnames
830 =item Return Value: not defined
834 Declare a unique constraint on this source. Call once for each unique
837 # For UNIQUE (column1, column2)
838 __PACKAGE__->add_unique_constraint(
839 constraint_name => [ qw/column1 column2/ ],
842 Alternatively, you can specify only the columns:
844 __PACKAGE__->add_unique_constraint([ qw/column1 column2/ ]);
846 This will result in a unique constraint named
847 C<table_column1_column2>, where C<table> is replaced with the table
850 Unique constraints are used, for example, when you pass the constraint
851 name as the C<key> attribute to L<DBIx::Class::ResultSet/find>. Then
852 only columns in the constraint are searched.
854 Throws an error if any of the given column names do not yet exist on
859 sub add_unique_constraint {
863 $self->throw_exception(
864 'add_unique_constraint() does not accept multiple constraints, use '
865 . 'add_unique_constraints() instead'
870 if (ref $cols ne 'ARRAY') {
871 $self->throw_exception (
872 'Expecting an arrayref of constraint columns, got ' . ($cols||'NOTHING')
878 $name ||= $self->name_unique_constraint($cols);
880 foreach my $col (@$cols) {
881 $self->throw_exception("No such column $col on table " . $self->name)
882 unless $self->has_column($col);
885 my %unique_constraints = $self->unique_constraints;
886 $unique_constraints{$name} = $cols;
887 $self->_unique_constraints(\%unique_constraints);
890 =head2 add_unique_constraints
894 =item Arguments: @constraints
896 =item Return Value: not defined
900 Declare multiple unique constraints on this source.
902 __PACKAGE__->add_unique_constraints(
903 constraint_name1 => [ qw/column1 column2/ ],
904 constraint_name2 => [ qw/column2 column3/ ],
907 Alternatively, you can specify only the columns:
909 __PACKAGE__->add_unique_constraints(
910 [ qw/column1 column2/ ],
911 [ qw/column3 column4/ ]
914 This will result in unique constraints named C<table_column1_column2> and
915 C<table_column3_column4>, where C<table> is replaced with the table name.
917 Throws an error if any of the given column names do not yet exist on
920 See also L</add_unique_constraint>.
924 sub add_unique_constraints {
925 DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
928 my @constraints = @_;
930 if ( !(@constraints % 2) && grep { ref $_ ne 'ARRAY' } @constraints ) {
931 # with constraint name
932 while (my ($name, $constraint) = splice @constraints, 0, 2) {
933 $self->add_unique_constraint($name => $constraint);
938 foreach my $constraint (@constraints) {
939 $self->add_unique_constraint($constraint);
944 =head2 name_unique_constraint
948 =item Arguments: \@colnames
950 =item Return Value: Constraint name
954 $source->table('mytable');
955 $source->name_unique_constraint(['col1', 'col2']);
959 Return a name for a unique constraint containing the specified
960 columns. The name is created by joining the table name and each column
961 name, using an underscore character.
963 For example, a constraint on a table named C<cd> containing the columns
964 C<artist> and C<title> would result in a constraint name of C<cd_artist_title>.
966 This is used by L</add_unique_constraint> if you do not specify the
967 optional constraint name.
971 sub name_unique_constraint {
972 my ($self, $cols) = @_;
974 my $name = $self->name;
975 $name = $$name if (ref $name eq 'SCALAR');
976 $name =~ s/ ^ [^\.]+ \. //x; # strip possible schema qualifier
978 return join '_', $name, @$cols;
981 =head2 unique_constraints
985 =item Arguments: none
987 =item Return Value: Hash of unique constraint data
991 $source->unique_constraints();
993 Read-only accessor which returns a hash of unique constraints on this
996 The hash is keyed by constraint name, and contains an arrayref of
997 column names as values.
1001 sub unique_constraints {
1002 return %{shift->_unique_constraints||{}};
1005 =head2 unique_constraint_names
1009 =item Arguments: none
1011 =item Return Value: Unique constraint names
1015 $source->unique_constraint_names();
1017 Returns the list of unique constraint names defined on this source.
1021 sub unique_constraint_names {
1024 my %unique_constraints = $self->unique_constraints;
1026 return keys %unique_constraints;
1029 =head2 unique_constraint_columns
1033 =item Arguments: $constraintname
1035 =item Return Value: List of constraint columns
1039 $source->unique_constraint_columns('myconstraint');
1041 Returns the list of columns that make up the specified unique constraint.
1045 sub unique_constraint_columns {
1046 my ($self, $constraint_name) = @_;
1048 my %unique_constraints = $self->unique_constraints;
1050 $self->throw_exception(
1051 "Unknown unique constraint $constraint_name on '" . $self->name . "'"
1052 ) unless exists $unique_constraints{$constraint_name};
1054 return @{ $unique_constraints{$constraint_name} };
1057 =head2 sqlt_deploy_callback
1061 =item Arguments: $callback_name | \&callback_code
1063 =item Return Value: $callback_name | \&callback_code
1067 __PACKAGE__->result_source->sqlt_deploy_callback('mycallbackmethod');
1071 __PACKAGE__->result_source->sqlt_deploy_callback(sub {
1072 my ($source_instance, $sqlt_table) = @_;
1076 An accessor to set a callback to be called during deployment of
1077 the schema via L<DBIx::Class::Schema/create_ddl_dir> or
1078 L<DBIx::Class::Schema/deploy>.
1080 The callback can be set as either a code reference or the name of a
1081 method in the current result class.
1083 Defaults to L</default_sqlt_deploy_hook>.
1085 Your callback will be passed the $source object representing the
1086 ResultSource instance being deployed, and the
1087 L<SQL::Translator::Schema::Table> object being created from it. The
1088 callback can be used to manipulate the table object or add your own
1089 customised indexes. If you need to manipulate a non-table object, use
1090 the L<DBIx::Class::Schema/sqlt_deploy_hook>.
1092 See L<DBIx::Class::Manual::Cookbook/Adding Indexes And Functions To
1093 Your SQL> for examples.
1095 This sqlt deployment callback can only be used to manipulate
1096 SQL::Translator objects as they get turned into SQL. To execute
1097 post-deploy statements which SQL::Translator does not currently
1098 handle, override L<DBIx::Class::Schema/deploy> in your Schema class
1099 and call L<dbh_do|DBIx::Class::Storage::DBI/dbh_do>.
1101 =head2 default_sqlt_deploy_hook
1103 This is the default deploy hook implementation which checks if your
1104 current Result class has a C<sqlt_deploy_hook> method, and if present
1105 invokes it B<on the Result class directly>. This is to preserve the
1106 semantics of C<sqlt_deploy_hook> which was originally designed to expect
1107 the Result class name and the
1108 L<$sqlt_table instance|SQL::Translator::Schema::Table> of the table being
1113 sub default_sqlt_deploy_hook {
1116 my $class = $self->result_class;
1118 if ($class and $class->can('sqlt_deploy_hook')) {
1119 $class->sqlt_deploy_hook(@_);
1123 sub _invoke_sqlt_deploy_hook {
1125 if ( my $hook = $self->sqlt_deploy_callback) {
1134 =item Arguments: $classname
1136 =item Return Value: $classname
1140 use My::Schema::ResultClass::Inflator;
1143 use My::Schema::Artist;
1145 __PACKAGE__->result_class('My::Schema::ResultClass::Inflator');
1147 Set the default result class for this source. You can use this to create
1148 and use your own result inflator. See L<DBIx::Class::ResultSet/result_class>
1151 Please note that setting this to something like
1152 L<DBIx::Class::ResultClass::HashRefInflator> will make every result unblessed
1153 and make life more difficult. Inflators like those are better suited to
1154 temporary usage via L<DBIx::Class::ResultSet/result_class>.
1160 =item Arguments: none
1162 =item Return Value: L<$resultset|DBIx::Class::ResultSet>
1166 Returns a resultset for the given source. This will initially be created
1167 on demand by calling
1169 $self->resultset_class->new($self, $self->resultset_attributes)
1171 but is cached from then on unless resultset_class changes.
1173 =head2 resultset_class
1177 =item Arguments: $classname
1179 =item Return Value: $classname
1183 package My::Schema::ResultSet::Artist;
1184 use base 'DBIx::Class::ResultSet';
1187 # In the result class
1188 __PACKAGE__->resultset_class('My::Schema::ResultSet::Artist');
1191 $source->resultset_class('My::Schema::ResultSet::Artist');
1193 Set the class of the resultset. This is useful if you want to create your
1194 own resultset methods. Create your own class derived from
1195 L<DBIx::Class::ResultSet>, and set it here. If called with no arguments,
1196 this method returns the name of the existing resultset class, if one
1199 =head2 resultset_attributes
1203 =item Arguments: L<\%attrs|DBIx::Class::ResultSet/ATTRIBUTES>
1205 =item Return Value: L<\%attrs|DBIx::Class::ResultSet/ATTRIBUTES>
1209 # In the result class
1210 __PACKAGE__->resultset_attributes({ order_by => [ 'id' ] });
1213 $source->resultset_attributes({ order_by => [ 'id' ] });
1215 Store a collection of resultset attributes, that will be set on every
1216 L<DBIx::Class::ResultSet> produced from this result source.
1218 B<CAVEAT>: C<resultset_attributes> comes with its own set of issues and
1219 bugs! Notably the contents of the attributes are B<entirely static>, which
1220 greatly hinders composability (things like L<current_source_alias
1221 |DBIx::Class::ResultSet/current_source_alias> can not possibly be respected).
1222 While C<resultset_attributes> isn't deprecated per se, you are strongly urged
1223 to seek alternatives.
1225 Since relationships use attributes to link tables together, the "default"
1226 attributes you set may cause unpredictable and undesired behavior. Furthermore,
1227 the defaults B<cannot be turned off>, so you are stuck with them.
1229 In most cases, what you should actually be using are project-specific methods:
1231 package My::Schema::ResultSet::Artist;
1232 use base 'DBIx::Class::ResultSet';
1236 #__PACKAGE__->resultset_attributes({ prefetch => 'tracks' });
1239 sub with_tracks { shift->search({}, { prefetch => 'tracks' }) }
1242 $schema->resultset('Artist')->with_tracks->...
1244 This gives you the flexibility of not using it when you don't need it.
1246 For more complex situations, another solution would be to use a virtual view
1247 via L<DBIx::Class::ResultSource::View>.
1253 $self->throw_exception(
1254 'resultset does not take any arguments. If you want another resultset, '.
1255 'call it on the schema instead.'
1258 $self->resultset_class->new(
1261 ( dbic_internal_try { %{$self->schema->default_resultset_attributes} } ),
1262 %{$self->{resultset_attributes}},
1271 =item Arguments: none
1273 =item Result value: $name
1277 Returns the name of the result source, which will typically be the table
1278 name. This may be a scalar reference if the result source has a non-standard
1285 =item Arguments: $source_name
1287 =item Result value: $source_name
1291 Set an alternate name for the result source when it is loaded into a schema.
1292 This is useful if you want to refer to a result source by a name other than
1295 package ArchivedBooks;
1296 use base qw/DBIx::Class/;
1297 __PACKAGE__->table('books_archive');
1298 __PACKAGE__->source_name('Books');
1300 # from your schema...
1301 $schema->resultset('Books')->find(1);
1307 =item Arguments: none
1309 =item Return Value: FROM clause
1313 my $from_clause = $source->from();
1315 Returns an expression of the source to be supplied to storage to specify
1316 retrieval from this source. In the case of a database, the required FROM
1321 sub from { die 'Virtual method!' }
1325 Stores a hashref of per-source metadata. No specific key names
1326 have yet been standardized, the examples below are purely hypothetical
1327 and don't actually accomplish anything on their own:
1329 __PACKAGE__->source_info({
1330 "_tablespace" => 'fast_disk_array_3',
1331 "_engine" => 'InnoDB',
1338 =item Arguments: L<$schema?|DBIx::Class::Schema>
1340 =item Return Value: L<$schema|DBIx::Class::Schema>
1344 my $schema = $source->schema();
1346 Sets and/or returns the L<DBIx::Class::Schema> object to which this
1347 result source instance has been attached to.
1353 $_[0]->{schema} = $_[1];
1356 $_[0]->{schema} || do {
1357 my $name = $_[0]->{source_name} || '_unnamed_';
1358 my $err = 'Unable to perform storage-dependent operations with a detached result source '
1359 . "(source '$name' is not associated with a schema).";
1361 $err .= ' You need to use $schema->thaw() or manually set'
1362 . ' $DBIx::Class::ResultSourceHandle::thaw_schema while thawing.'
1363 if $_[0]->{_detached_thaw};
1365 DBIx::Class::Exception->throw($err);
1374 =item Arguments: none
1376 =item Return Value: L<$storage|DBIx::Class::Storage>
1380 $source->storage->debug(1);
1382 Returns the L<storage handle|DBIx::Class::Storage> for the current schema.
1387 DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
1388 $_[0]->schema->storage
1391 =head2 add_relationship
1395 =item Arguments: $rel_name, $related_source_name, \%cond, \%attrs?
1397 =item Return Value: 1/true if it succeeded
1401 $source->add_relationship('rel_name', 'related_source', $cond, $attrs);
1403 L<DBIx::Class::Relationship> describes a series of methods which
1404 create pre-defined useful types of relationships. Look there first
1405 before using this method directly.
1407 The relationship name can be arbitrary, but must be unique for each
1408 relationship attached to this result source. 'related_source' should
1409 be the name with which the related result source was registered with
1410 the current schema. For example:
1412 $schema->source('Book')->add_relationship('reviews', 'Review', {
1413 'foreign.book_id' => 'self.id',
1416 The condition C<$cond> needs to be an L<SQL::Abstract>-style
1417 representation of the join between the tables. For example, if you're
1418 creating a relation from Author to Book,
1420 { 'foreign.author_id' => 'self.id' }
1422 will result in the JOIN clause
1424 author me JOIN book foreign ON foreign.author_id = me.id
1426 You can specify as many foreign => self mappings as necessary.
1428 Valid attributes are as follows:
1434 Explicitly specifies the type of join to use in the relationship. Any
1435 SQL join type is valid, e.g. C<LEFT> or C<RIGHT>. It will be placed in
1436 the SQL command immediately before C<JOIN>.
1440 An arrayref containing a list of accessors in the foreign class to proxy in
1441 the main class. If, for example, you do the following:
1443 CD->might_have(liner_notes => 'LinerNotes', undef, {
1444 proxy => [ qw/notes/ ],
1447 Then, assuming LinerNotes has an accessor named notes, you can do:
1449 my $cd = CD->find(1);
1450 # set notes -- LinerNotes object is created if it doesn't exist
1451 $cd->notes('Notes go here');
1455 Specifies the type of accessor that should be created for the
1456 relationship. Valid values are C<single> (for when there is only a single
1457 related object), C<multi> (when there can be many), and C<filter> (for
1458 when there is a single related object, but you also want the relationship
1459 accessor to double as a column accessor). For C<multi> accessors, an
1460 add_to_* method is also created, which calls C<create_related> for the
1465 Throws an exception if the condition is improperly supplied, or cannot
1470 sub add_relationship {
1471 my ($self, $rel, $f_source_name, $cond, $attrs) = @_;
1472 $self->throw_exception("Can't create relationship without join condition")
1476 # Check foreign and self are right in cond
1477 if ( (ref $cond ||'') eq 'HASH') {
1478 $_ =~ /^foreign\./ or $self->throw_exception("Malformed relationship condition key '$_': must be prefixed with 'foreign.'")
1481 $_ =~ /^self\./ or $self->throw_exception("Malformed relationship condition value '$_': must be prefixed with 'self.'")
1485 my %rels = %{ $self->_relationships };
1486 $rels{$rel} = { class => $f_source_name,
1487 source => $f_source_name,
1490 $self->_relationships(\%rels);
1495 =head2 relationships
1499 =item Arguments: none
1501 =item Return Value: L<@rel_names|DBIx::Class::Relationship>
1505 my @rel_names = $source->relationships();
1507 Returns all relationship names for this source.
1512 keys %{$_[0]->_relationships};
1515 =head2 relationship_info
1519 =item Arguments: L<$rel_name|DBIx::Class::Relationship>
1521 =item Return Value: L<\%rel_data|DBIx::Class::Relationship::Base/add_relationship>
1525 Returns a hash of relationship information for the specified relationship
1526 name. The keys/values are as specified for L<DBIx::Class::Relationship::Base/add_relationship>.
1530 sub relationship_info {
1531 #my ($self, $rel) = @_;
1532 return shift->_relationships->{+shift};
1535 =head2 has_relationship
1539 =item Arguments: L<$rel_name|DBIx::Class::Relationship>
1541 =item Return Value: 1/0 (true/false)
1545 Returns true if the source has a relationship of this name, false otherwise.
1549 sub has_relationship {
1550 #my ($self, $rel) = @_;
1551 return exists shift->_relationships->{+shift};
1554 =head2 reverse_relationship_info
1558 =item Arguments: L<$rel_name|DBIx::Class::Relationship>
1560 =item Return Value: L<\%rel_data|DBIx::Class::Relationship::Base/add_relationship>
1564 Looks through all the relationships on the source this relationship
1565 points to, looking for one whose condition is the reverse of the
1566 condition on this relationship.
1568 A common use of this is to find the name of the C<belongs_to> relation
1569 opposing a C<has_many> relation. For definition of these look in
1570 L<DBIx::Class::Relationship>.
1572 The returned hashref is keyed by the name of the opposing
1573 relationship, and contains its data in the same manner as
1574 L</relationship_info>.
1578 sub reverse_relationship_info {
1579 my ($self, $rel) = @_;
1581 my $rel_info = $self->relationship_info($rel)
1582 or $self->throw_exception("No such relationship '$rel'");
1586 return $ret unless ((ref $rel_info->{cond}) eq 'HASH');
1588 my $stripped_cond = $self->__strip_relcond ($rel_info->{cond});
1590 my $registered_source_name = $self->source_name;
1592 # this may be a partial schema or something else equally esoteric
1593 my $other_rsrc = $self->related_source($rel);
1595 # Get all the relationships for that source that related to this source
1596 # whose foreign column set are our self columns on $rel and whose self
1597 # columns are our foreign columns on $rel
1598 foreach my $other_rel ($other_rsrc->relationships) {
1600 # only consider stuff that points back to us
1601 # "us" here is tricky - if we are in a schema registration, we want
1602 # to use the source_names, otherwise we will use the actual classes
1604 # the schema may be partial
1605 my $roundtrip_rsrc = dbic_internal_try { $other_rsrc->related_source($other_rel) }
1608 if ($registered_source_name) {
1609 next if $registered_source_name ne ($roundtrip_rsrc->source_name || '')
1612 next if $self->result_class ne $roundtrip_rsrc->result_class;
1615 my $other_rel_info = $other_rsrc->relationship_info($other_rel);
1617 # this can happen when we have a self-referential class
1618 next if $other_rel_info eq $rel_info;
1620 next unless ref $other_rel_info->{cond} eq 'HASH';
1621 my $other_stripped_cond = $self->__strip_relcond($other_rel_info->{cond});
1623 $ret->{$other_rel} = $other_rel_info if (
1624 $self->_compare_relationship_keys (
1625 [ keys %$stripped_cond ], [ values %$other_stripped_cond ]
1628 $self->_compare_relationship_keys (
1629 [ values %$stripped_cond ], [ keys %$other_stripped_cond ]
1637 # all this does is removes the foreign/self prefix from a condition
1638 sub __strip_relcond {
1641 { map { /^ (?:foreign|self) \. (\w+) $/x } ($_, $_[1]{$_}) }
1646 sub compare_relationship_keys {
1647 carp 'compare_relationship_keys is a private method, stop calling it';
1649 $self->_compare_relationship_keys (@_);
1652 # Returns true if both sets of keynames are the same, false otherwise.
1653 sub _compare_relationship_keys {
1654 # my ($self, $keys1, $keys2) = @_;
1656 join ("\x00", sort @{$_[1]})
1658 join ("\x00", sort @{$_[2]})
1662 # optionally takes either an arrayref of column names, or a hashref of already
1663 # retrieved colinfos
1664 # returns an arrayref of column names of the shortest unique constraint
1665 # (matching some of the input if any), giving preference to the PK
1666 sub _identifying_column_set {
1667 my ($self, $cols) = @_;
1669 my %unique = $self->unique_constraints;
1670 my $colinfos = ref $cols eq 'HASH' ? $cols : $self->columns_info($cols||());
1672 # always prefer the PK first, and then shortest constraints first
1674 for my $set (delete $unique{primary}, sort { @$a <=> @$b } (values %unique) ) {
1675 next unless $set && @$set;
1678 next USET unless ($colinfos->{$_} && !$colinfos->{$_}{is_nullable} );
1681 # copy so we can mangle it at will
1688 sub _minimal_valueset_satisfying_constraint {
1690 my $args = { ref $_[0] eq 'HASH' ? %{ $_[0] } : @_ };
1692 $args->{columns_info} ||= $self->columns_info;
1694 my $vals = $self->schema->storage->_extract_fixed_condition_columns(
1696 ($args->{carp_on_nulls} ? 'consider_nulls' : undef ),
1700 for my $col ($self->unique_constraint_columns($args->{constraint_name}) ) {
1701 if( ! exists $vals->{$col} or ( $vals->{$col}||'' ) eq UNRESOLVABLE_CONDITION ) {
1702 $cols->{missing}{$col} = undef;
1704 elsif( ! defined $vals->{$col} ) {
1705 $cols->{$args->{carp_on_nulls} ? 'undefined' : 'missing'}{$col} = undef;
1708 # we need to inject back the '=' as _extract_fixed_condition_columns
1709 # will strip it from literals and values alike, resulting in an invalid
1710 # condition in the end
1711 $cols->{present}{$col} = { '=' => $vals->{$col} };
1714 $cols->{fc}{$col} = 1 if (
1715 ( ! $cols->{missing} or ! exists $cols->{missing}{$col} )
1717 keys %{ $args->{columns_info}{$col}{_filter_info} || {} }
1721 $self->throw_exception( sprintf ( "Unable to satisfy requested constraint '%s', missing values for column(s): %s",
1722 $args->{constraint_name},
1723 join (', ', map { "'$_'" } sort keys %{$cols->{missing}} ),
1724 ) ) if $cols->{missing};
1726 $self->throw_exception( sprintf (
1727 "Unable to satisfy requested constraint '%s', FilterColumn values not usable for column(s): %s",
1728 $args->{constraint_name},
1729 join (', ', map { "'$_'" } sort keys %{$cols->{fc}}),
1735 !$ENV{DBIC_NULLABLE_KEY_NOWARN}
1737 carp_unique ( sprintf (
1738 "NULL/undef values supplied for requested unique constraint '%s' (NULL "
1739 . 'values in column(s): %s). This is almost certainly not what you wanted, '
1740 . 'though you can set DBIC_NULLABLE_KEY_NOWARN to disable this warning.',
1741 $args->{constraint_name},
1742 join (', ', map { "'$_'" } sort keys %{$cols->{undefined}}),
1746 return { map { %{ $cols->{$_}||{} } } qw(present undefined) };
1749 # Returns the {from} structure used to express JOIN conditions
1751 my ($self, $join, $alias, $seen, $jpath, $parent_force_left) = @_;
1753 # we need a supplied one, because we do in-place modifications, no returns
1754 $self->throw_exception ('You must supply a seen hashref as the 3rd argument to _resolve_join')
1755 unless ref $seen eq 'HASH';
1757 $self->throw_exception ('You must supply a joinpath arrayref as the 4th argument to _resolve_join')
1758 unless ref $jpath eq 'ARRAY';
1760 $jpath = [@$jpath]; # copy
1762 if (not defined $join or not length $join) {
1765 elsif (ref $join eq 'ARRAY') {
1768 $self->_resolve_join($_, $alias, $seen, $jpath, $parent_force_left);
1771 elsif (ref $join eq 'HASH') {
1774 for my $rel (keys %$join) {
1776 my $rel_info = $self->relationship_info($rel)
1777 or $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
1779 my $force_left = $parent_force_left;
1780 $force_left ||= lc($rel_info->{attrs}{join_type}||'') eq 'left';
1782 # the actual seen value will be incremented by the recursion
1783 my $as = $self->schema->storage->relname_to_table_alias(
1784 $rel, ($seen->{$rel} && $seen->{$rel} + 1)
1788 $self->_resolve_join($rel, $alias, $seen, [@$jpath], $force_left),
1789 $self->related_source($rel)->_resolve_join(
1790 $join->{$rel}, $as, $seen, [@$jpath, { $rel => $as }], $force_left
1798 $self->throw_exception("No idea how to resolve join reftype ".ref $join);
1801 my $count = ++$seen->{$join};
1802 my $as = $self->schema->storage->relname_to_table_alias(
1803 $join, ($count > 1 && $count)
1806 my $rel_info = $self->relationship_info($join)
1807 or $self->throw_exception("No such relationship $join on " . $self->source_name);
1809 my $rel_src = $self->related_source($join);
1810 return [ { $as => $rel_src->from,
1812 -join_type => $parent_force_left
1814 : $rel_info->{attrs}{join_type}
1816 -join_path => [@$jpath, { $join => $as } ],
1818 ! $rel_info->{attrs}{accessor}
1820 $rel_info->{attrs}{accessor} eq 'single'
1822 $rel_info->{attrs}{accessor} eq 'filter'
1825 -relation_chain_depth => ( $seen->{-relation_chain_depth} || 0 ) + 1,
1827 $self->_resolve_relationship_condition(
1829 self_alias => $alias,
1830 foreign_alias => $as,
1837 carp 'pk_depends_on is a private method, stop calling it';
1839 $self->_pk_depends_on (@_);
1842 # Determines whether a relation is dependent on an object from this source
1843 # having already been inserted. Takes the name of the relationship and a
1844 # hashref of columns of the related object.
1845 sub _pk_depends_on {
1846 my ($self, $rel_name, $rel_data) = @_;
1848 my $relinfo = $self->relationship_info($rel_name);
1850 # don't assume things if the relationship direction is specified
1851 return $relinfo->{attrs}{is_foreign_key_constraint}
1852 if exists ($relinfo->{attrs}{is_foreign_key_constraint});
1854 my $cond = $relinfo->{cond};
1855 return 0 unless ref($cond) eq 'HASH';
1857 # map { foreign.foo => 'self.bar' } to { bar => 'foo' }
1858 my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond };
1860 # assume anything that references our PK probably is dependent on us
1861 # rather than vice versa, unless the far side is (a) defined or (b)
1863 my $rel_source = $self->related_source($rel_name);
1867 foreach my $p ($self->primary_columns) {
1869 exists $keyhash->{$p}
1871 ! defined( $rel_data->{$keyhash->{$p}} )
1873 ! ( $colinfos ||= $rel_source->columns_info )
1874 ->{$keyhash->{$p}}{is_auto_increment}
1881 sub resolve_condition {
1882 carp 'resolve_condition is a private method, stop calling it';
1883 shift->_resolve_condition (@_);
1886 sub _resolve_condition {
1887 # carp_unique sprintf
1888 # '_resolve_condition is a private method, and moreover is about to go '
1889 # . 'away. Please contact the development team at %s if you believe you '
1890 # . 'have a genuine use for this method, in order to discuss alternatives.',
1891 # DBIx::Class::_ENV_::HELP_URL,
1894 #######################
1895 ### API Design? What's that...? (a backwards compatible shim, kill me now)
1897 my ($self, $cond, @res_args, $rel_name);
1899 # we *SIMPLY DON'T KNOW YET* which arg is which, yay
1900 ($self, $cond, $res_args[0], $res_args[1], $rel_name) = @_;
1902 # assume that an undef is an object-like unset (set_from_related(undef))
1903 my @is_objlike = map { ! defined $_ or length ref $_ } (@res_args);
1905 # turn objlike into proper objects for saner code further down
1907 next unless $is_objlike[$_];
1909 if ( defined blessed $res_args[$_] ) {
1911 # but wait - there is more!!! WHAT THE FUCK?!?!?!?!
1912 if ($res_args[$_]->isa('DBIx::Class::ResultSet')) {
1913 carp('Passing a resultset for relationship resolution makes no sense - invoking __gremlins__');
1914 $is_objlike[$_] = 0;
1915 $res_args[$_] = '__gremlins__';
1919 $res_args[$_] ||= {};
1921 # hate everywhere - have to pass in as a plain hash
1922 # pretending to be an object at least for now
1923 $self->throw_exception("Unsupported object-like structure encountered: $res_args[$_]")
1924 unless ref $res_args[$_] eq 'HASH';
1929 # where-is-waldo block guesses relname, then further down we override it if available
1931 $is_objlike[1] ? ( rel_name => $res_args[0], self_alias => $res_args[0], foreign_alias => 'me', self_result_object => $res_args[1] )
1932 : $is_objlike[0] ? ( rel_name => $res_args[1], self_alias => 'me', foreign_alias => $res_args[1], foreign_values => $res_args[0] )
1933 : ( rel_name => $res_args[0], self_alias => $res_args[1], foreign_alias => $res_args[0] )
1936 ( $rel_name ? ( rel_name => $rel_name ) : () ),
1939 # Allowing passing relconds different than the relationshup itself is cute,
1940 # but likely dangerous. Remove that from the (still unofficial) API of
1941 # _resolve_relationship_condition, and instead make it "hard on purpose"
1942 local $self->relationship_info( $args->{rel_name} )->{cond} = $cond if defined $cond;
1944 #######################
1946 # now it's fucking easy isn't it?!
1947 my $rc = $self->_resolve_relationship_condition( $args );
1950 ( $rc->{join_free_condition} || $rc->{condition} ),
1951 ! $rc->{join_free_condition},
1954 # _resolve_relationship_condition always returns qualified cols even in the
1955 # case of join_free_condition, but nothing downstream expects this
1956 if ($rc->{join_free_condition} and ref $res[0] eq 'HASH') {
1958 { ($_ =~ /\.(.+)/) => $res[0]{$_} }
1964 return wantarray ? @res : $res[0];
1967 # Keep this indefinitely. There is evidence of both CPAN and
1968 # darkpan using it, and there isn't much harm in an extra var
1970 our $UNRESOLVABLE_CONDITION = UNRESOLVABLE_CONDITION;
1971 # YES I KNOW THIS IS EVIL
1972 # it is there to save darkpan from themselves, since internally
1973 # we are moving to a constant
1974 Internals::SvREADONLY($UNRESOLVABLE_CONDITION => 1);
1976 # Resolves the passed condition to a concrete query fragment and extra
1979 ## self-explanatory API, modeled on the custom cond coderef:
1980 # rel_name => (scalar)
1981 # foreign_alias => (scalar)
1982 # foreign_values => (either not supplied, or a hashref, or a foreign ResultObject (to be ->get_columns()ed), or plain undef )
1983 # self_alias => (scalar)
1984 # self_result_object => (either not supplied or a result object)
1985 # require_join_free_condition => (boolean, throws on failure to construct a JF-cond)
1986 # infer_values_based_on => (either not supplied or a hashref, implies require_join_free_condition)
1989 # condition => (a valid *likely fully qualified* sqla cond structure)
1990 # identity_map => (a hashref of foreign-to-self *unqualified* column equality names)
1991 # join_free_condition => (a valid *fully qualified* sqla cond structure, maybe unset)
1992 # inferred_values => (in case of an available join_free condition, this is a hashref of
1993 # *unqualified* column/value *EQUALITY* pairs, representing an amalgamation
1994 # of the JF-cond parse and infer_values_based_on
1995 # always either complete or unset)
1997 sub _resolve_relationship_condition {
2000 my $args = { ref $_[0] eq 'HASH' ? %{ $_[0] } : @_ };
2002 for ( qw( rel_name self_alias foreign_alias ) ) {
2003 $self->throw_exception("Mandatory argument '$_' to _resolve_relationship_condition() is not a plain string")
2004 if !defined $args->{$_} or length ref $args->{$_};
2007 $self->throw_exception("Arguments 'self_alias' and 'foreign_alias' may not be identical")
2008 if $args->{self_alias} eq $args->{foreign_alias};
2011 my $exception_rel_id = "relationship '$args->{rel_name}' on source '@{[ $self->source_name ]}'";
2013 my $rel_info = $self->relationship_info($args->{rel_name})
2015 # or $self->throw_exception( "No such $exception_rel_id" );
2016 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");
2019 $exception_rel_id = "relationship '$rel_info->{_original_name}' on source '@{[ $self->source_name ]}'"
2020 if $rel_info and exists $rel_info->{_original_name};
2022 $self->throw_exception("No practical way to resolve $exception_rel_id between two data structures")
2023 if exists $args->{self_result_object} and exists $args->{foreign_values};
2025 $self->throw_exception( "Argument to infer_values_based_on must be a hash" )
2026 if exists $args->{infer_values_based_on} and ref $args->{infer_values_based_on} ne 'HASH';
2028 $args->{require_join_free_condition} ||= !!$args->{infer_values_based_on};
2030 $self->throw_exception( "Argument 'self_result_object' must be an object inheriting from DBIx::Class::Row" )
2032 exists $args->{self_result_object}
2034 ( ! defined blessed $args->{self_result_object} or ! $args->{self_result_object}->isa('DBIx::Class::Row') )
2038 my $rel_rsrc = $self->related_source($args->{rel_name});
2039 my $storage = $self->schema->storage;
2041 if (exists $args->{foreign_values}) {
2043 if (! defined $args->{foreign_values} ) {
2044 # fallback: undef => {}
2045 $args->{foreign_values} = {};
2047 elsif (defined blessed $args->{foreign_values}) {
2049 $self->throw_exception( "Objects supplied as 'foreign_values' ($args->{foreign_values}) must inherit from DBIx::Class::Row" )
2050 unless $args->{foreign_values}->isa('DBIx::Class::Row');
2053 "Objects supplied as 'foreign_values' ($args->{foreign_values}) "
2054 . "usually should inherit from the related ResultClass ('@{[ $rel_rsrc->result_class ]}'), "
2055 . "perhaps you've made a mistake invoking the condition resolver?"
2056 ) unless $args->{foreign_values}->isa($rel_rsrc->result_class);
2058 $args->{foreign_values} = { $args->{foreign_values}->get_columns };
2060 elsif ( ref $args->{foreign_values} eq 'HASH' ) {
2062 # re-build {foreign_values} excluding identically named rels
2063 if( keys %{$args->{foreign_values}} ) {
2065 my ($col_idx, $rel_idx) = map
2066 { { map { $_ => 1 } $rel_rsrc->$_ } }
2067 qw( columns relationships )
2070 my $equivalencies = $storage->_extract_fixed_condition_columns(
2071 $args->{foreign_values},
2075 $args->{foreign_values} = { map {
2076 # skip if relationship *and* a non-literal ref
2077 # this means a multicreate stub was passed in
2081 length ref $args->{foreign_values}{$_}
2083 ! is_literal_value($args->{foreign_values}{$_})
2088 ? $self->throw_exception( "Key '$_' supplied as 'foreign_values' is not a column on related source '@{[ $rel_rsrc->source_name ]}'" )
2089 : ( !exists $equivalencies->{$_} or ($equivalencies->{$_}||'') eq UNRESOLVABLE_CONDITION )
2090 ? $self->throw_exception( "Value supplied for '...{foreign_values}{$_}' is not a direct equivalence expression" )
2091 : $args->{foreign_values}{$_}
2093 } keys %{$args->{foreign_values}} };
2097 $self->throw_exception(
2098 "Argument 'foreign_values' must be either an object inheriting from '@{[ $rel_rsrc->result_class ]}', "
2099 . "or a hash reference, or undef"
2106 if (ref $rel_info->{cond} eq 'CODE') {
2109 rel_name => $args->{rel_name},
2110 self_resultsource => $self,
2111 self_alias => $args->{self_alias},
2112 foreign_alias => $args->{foreign_alias},
2114 { (exists $args->{$_}) ? ( $_ => $args->{$_} ) : () }
2115 qw( self_result_object foreign_values )
2119 # legacy - never remove these!!!
2120 $cref_args->{foreign_relname} = $cref_args->{rel_name};
2122 $cref_args->{self_rowobj} = $cref_args->{self_result_object}
2123 if exists $cref_args->{self_result_object};
2125 ($ret->{condition}, $ret->{join_free_condition}, my @extra) = $rel_info->{cond}->($cref_args);
2128 $self->throw_exception("A custom condition coderef can return at most 2 conditions, but $exception_rel_id returned extra values: @extra")
2131 if (my $jfc = $ret->{join_free_condition}) {
2133 $self->throw_exception (
2134 "The join-free condition returned for $exception_rel_id must be a hash reference"
2135 ) unless ref $jfc eq 'HASH';
2137 my ($joinfree_alias, $joinfree_source);
2138 if (defined $args->{self_result_object}) {
2139 $joinfree_alias = $args->{foreign_alias};
2140 $joinfree_source = $rel_rsrc;
2142 elsif (defined $args->{foreign_values}) {
2143 $joinfree_alias = $args->{self_alias};
2144 $joinfree_source = $self;
2147 # FIXME sanity check until things stabilize, remove at some point
2148 $self->throw_exception (
2149 "A join-free condition returned for $exception_rel_id without a result object to chain from"
2150 ) unless $joinfree_alias;
2152 my $fq_col_list = { map
2153 { ( "$joinfree_alias.$_" => 1 ) }
2154 $joinfree_source->columns
2157 exists $fq_col_list->{$_} or $self->throw_exception (
2158 "The join-free condition returned for $exception_rel_id may only "
2159 . 'contain keys that are fully qualified column names of the corresponding source '
2160 . "'$joinfree_alias' (instead it returned '$_')"
2168 $_->isa('DBIx::Class::Row')
2170 $self->throw_exception (
2171 "The join-free condition returned for $exception_rel_id may not "
2172 . 'contain result objects as values - perhaps instead of invoking '
2173 . '->$something you meant to return ->get_column($something)'
2179 elsif (ref $rel_info->{cond} eq 'HASH') {
2181 # the condition is static - use parallel arrays
2182 # for a "pivot" depending on which side of the
2183 # rel did we get as an object
2184 my (@f_cols, @l_cols);
2185 for my $fc (keys %{ $rel_info->{cond} }) {
2186 my $lc = $rel_info->{cond}{$fc};
2188 # FIXME STRICTMODE should probably check these are valid columns
2189 $fc =~ s/^foreign\.// ||
2190 $self->throw_exception("Invalid rel cond key '$fc'");
2192 $lc =~ s/^self\.// ||
2193 $self->throw_exception("Invalid rel cond val '$lc'");
2199 # construct the crosstable condition and the identity map
2201 $ret->{condition}{"$args->{foreign_alias}.$f_cols[$_]"} = { -ident => "$args->{self_alias}.$l_cols[$_]" };
2202 $ret->{identity_map}{$l_cols[$_]} = $f_cols[$_];
2205 if ($args->{foreign_values}) {
2206 $ret->{join_free_condition}{"$args->{self_alias}.$l_cols[$_]"} = $args->{foreign_values}{$f_cols[$_]}
2209 elsif (defined $args->{self_result_object}) {
2211 for my $i (0..$#l_cols) {
2212 if ( $args->{self_result_object}->has_column_loaded($l_cols[$i]) ) {
2213 $ret->{join_free_condition}{"$args->{foreign_alias}.$f_cols[$i]"} = $args->{self_result_object}->get_column($l_cols[$i]);
2216 $self->throw_exception(sprintf
2217 "Unable to resolve relationship '%s' from object '%s': column '%s' not "
2218 . 'loaded from storage (or not passed to new() prior to insert()). You '
2219 . 'probably need to call ->discard_changes to get the server-side defaults '
2220 . 'from the database.',
2222 $args->{self_result_object},
2224 ) if $args->{self_result_object}->in_storage;
2226 # FIXME - temporarly force-override
2227 delete $args->{require_join_free_condition};
2228 $ret->{join_free_condition} = UNRESOLVABLE_CONDITION;
2234 elsif (ref $rel_info->{cond} eq 'ARRAY') {
2235 if (@{ $rel_info->{cond} } == 0) {
2237 condition => UNRESOLVABLE_CONDITION,
2238 join_free_condition => UNRESOLVABLE_CONDITION,
2242 my @subconds = map {
2243 local $rel_info->{cond} = $_;
2244 $self->_resolve_relationship_condition( $args );
2245 } @{ $rel_info->{cond} };
2247 if( @{ $rel_info->{cond} } == 1 ) {
2248 $ret = $subconds[0];
2251 # we are discarding inferred values here... likely incorrect...
2252 # then again - the entire thing is an OR, so we *can't* use them anyway
2253 for my $subcond ( @subconds ) {
2254 $self->throw_exception('Either all or none of the OR-condition members must resolve to a join-free condition')
2255 if ( $ret and ( $ret->{join_free_condition} xor $subcond->{join_free_condition} ) );
2257 $subcond->{$_} and push @{$ret->{$_}}, $subcond->{$_} for (qw(condition join_free_condition));
2263 $self->throw_exception ("Can't handle condition $rel_info->{cond} for $exception_rel_id yet :(");
2267 $args->{require_join_free_condition}
2269 ( ! $ret->{join_free_condition} or $ret->{join_free_condition} eq UNRESOLVABLE_CONDITION )
2271 $self->throw_exception(
2272 ucfirst sprintf "$exception_rel_id does not resolve to a %sjoin-free condition fragment",
2273 exists $args->{foreign_values}
2274 ? "'foreign_values'-based reversed-"
2279 # we got something back - sanity check and infer values if we can
2282 $ret->{join_free_condition}
2284 $ret->{join_free_condition} ne UNRESOLVABLE_CONDITION
2286 my $jfc = $storage->_collapse_cond( $ret->{join_free_condition} )
2289 my $jfc_eqs = $storage->_extract_fixed_condition_columns($jfc, 'consider_nulls');
2291 if (keys %$jfc_eqs) {
2294 # $jfc is fully qualified by definition
2295 my ($col) = $_ =~ /\.(.+)/;
2297 if (exists $jfc_eqs->{$_} and ($jfc_eqs->{$_}||'') ne UNRESOLVABLE_CONDITION) {
2298 $ret->{inferred_values}{$col} = $jfc_eqs->{$_};
2300 elsif ( !$args->{infer_values_based_on} or ! exists $args->{infer_values_based_on}{$col} ) {
2301 push @nonvalues, $col;
2306 delete $ret->{inferred_values} if @nonvalues;
2310 # did the user explicitly ask
2311 if ($args->{infer_values_based_on}) {
2313 $self->throw_exception(sprintf (
2314 "Unable to complete value inferrence - custom $exception_rel_id returns conditions instead of values for column(s): %s",
2315 map { "'$_'" } @nonvalues
2319 $ret->{inferred_values} ||= {};
2321 $ret->{inferred_values}{$_} = $args->{infer_values_based_on}{$_}
2322 for keys %{$args->{infer_values_based_on}};
2325 # add the identities based on the main condition
2326 # (may already be there, since easy to calculate on the fly in the HASH case)
2327 if ( ! $ret->{identity_map} ) {
2329 my $col_eqs = $storage->_extract_fixed_condition_columns($ret->{condition});
2332 for my $lhs (keys %$col_eqs) {
2334 next if $col_eqs->{$lhs} eq UNRESOLVABLE_CONDITION;
2336 # there is no way to know who is right and who is left in a cref
2337 # therefore a full blown resolution call, and figure out the
2338 # direction a bit further below
2339 $colinfos ||= $storage->_resolve_column_info([
2340 { -alias => $args->{self_alias}, -rsrc => $self },
2341 { -alias => $args->{foreign_alias}, -rsrc => $rel_rsrc },
2344 next unless $colinfos->{$lhs}; # someone is engaging in witchcraft
2346 if ( my $rhs_ref = is_literal_value( $col_eqs->{$lhs} ) ) {
2349 $colinfos->{$rhs_ref->[0]}
2351 $colinfos->{$lhs}{-source_alias} ne $colinfos->{$rhs_ref->[0]}{-source_alias}
2353 ( $colinfos->{$lhs}{-source_alias} eq $args->{self_alias} )
2354 ? ( $ret->{identity_map}{$colinfos->{$lhs}{-colname}} = $colinfos->{$rhs_ref->[0]}{-colname} )
2355 : ( $ret->{identity_map}{$colinfos->{$rhs_ref->[0]}{-colname}} = $colinfos->{$lhs}{-colname} )
2360 $col_eqs->{$lhs} =~ /^ ( \Q$args->{self_alias}\E \. .+ ) /x
2362 ($colinfos->{$1}||{})->{-result_source} == $rel_rsrc
2364 my ($lcol, $rcol) = map
2365 { $colinfos->{$_}{-colname} }
2369 "The $exception_rel_id specifies equality of column '$lcol' and the "
2370 . "*VALUE* '$rcol' (you did not use the { -ident => ... } operator)"
2376 # FIXME - temporary, to fool the idiotic check in SQLMaker::_join_condition
2377 $ret->{condition} = { -and => [ $ret->{condition} ] }
2378 unless $ret->{condition} eq UNRESOLVABLE_CONDITION;
2383 =head2 related_source
2387 =item Arguments: $rel_name
2389 =item Return Value: $source
2393 Returns the result source object for the given relationship.
2397 sub related_source {
2398 my ($self, $rel) = @_;
2399 if( !$self->has_relationship( $rel ) ) {
2400 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
2403 # if we are not registered with a schema - just use the prototype
2404 # however if we do have a schema - ask for the source by name (and
2405 # throw in the process if all fails)
2406 if (my $schema = dbic_internal_try { $self->schema }) {
2407 $schema->source($self->relationship_info($rel)->{source});
2410 my $class = $self->relationship_info($rel)->{class};
2411 $self->ensure_class_loaded($class);
2412 $class->result_source;
2416 =head2 related_class
2420 =item Arguments: $rel_name
2422 =item Return Value: $classname
2426 Returns the class name for objects in the given relationship.
2431 my ($self, $rel) = @_;
2432 if( !$self->has_relationship( $rel ) ) {
2433 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
2435 return $self->schema->class($self->relationship_info($rel)->{source});
2442 =item Arguments: none
2444 =item Return Value: L<$source_handle|DBIx::Class::ResultSourceHandle>
2448 Obtain a new L<result source handle instance|DBIx::Class::ResultSourceHandle>
2449 for this source. Used as a serializable pointer to this resultsource, as it is not
2450 easy (nor advisable) to serialize CODErefs which may very well be present in e.g.
2451 relationship definitions.
2456 require DBIx::Class::ResultSourceHandle;
2457 return DBIx::Class::ResultSourceHandle->new({
2458 source_moniker => $_[0]->source_name,
2460 # so that a detached thaw can be re-frozen
2461 $_[0]->{_detached_thaw}
2462 ? ( _detached_source => $_[0] )
2463 : ( schema => $_[0]->schema )
2468 my $global_phase_destroy;
2470 ### NO detected_reinvoked_destructor check
2471 ### This code very much relies on being called multuple times
2473 return if $global_phase_destroy ||= in_global_destruction;
2479 # Under no circumstances shall $_[0] be stored anywhere else (like copied to
2480 # a lexical variable, or shifted, or anything else). Doing so will mess up
2481 # the refcount of this particular result source, and will allow the $schema
2482 # we are trying to save to reattach back to the source we are destroying.
2483 # The relevant code checking refcounts is in ::Schema::DESTROY()
2485 # if we are not a schema instance holder - we don't matter
2487 ! ref $_[0]->{schema}
2489 isweak $_[0]->{schema}
2492 # weaken our schema hold forcing the schema to find somewhere else to live
2493 # during global destruction (if we have not yet bailed out) this will throw
2494 # which will serve as a signal to not try doing anything else
2495 # however beware - on older perls the exception seems randomly untrappable
2496 # due to some weird race condition during thread joining :(((
2497 local $SIG{__DIE__} if $SIG{__DIE__};
2498 local $@ if DBIx::Class::_ENV_::UNSTABLE_DOLLARAT;
2500 weaken $_[0]->{schema};
2502 # if schema is still there reintroduce ourselves with strong refs back to us
2503 if ($_[0]->{schema}) {
2504 my $srcregs = $_[0]->{schema}->source_registrations;
2506 defined $srcregs->{$_}
2508 $srcregs->{$_} == $_[0]
2510 $srcregs->{$_} = $_[0]
2518 $global_phase_destroy = 1;
2521 # Dummy NEXTSTATE ensuring the all temporaries on the stack are garbage
2522 # collected before leaving this scope. Depending on the code above, this
2523 # may very well be just a preventive measure guarding future modifications
2527 sub STORABLE_freeze { Storable::nfreeze($_[0]->handle) }
2530 my ($self, $cloning, $ice) = @_;
2531 %$self = %{ (Storable::thaw($ice))->resolve };
2534 =head2 throw_exception
2536 See L<DBIx::Class::Schema/"throw_exception">.
2540 sub throw_exception {
2544 ? $self->{schema}->throw_exception(@_)
2545 : DBIx::Class::Exception->throw(@_)
2549 =head2 column_info_from_storage
2553 =item Arguments: 1/0 (default: 0)
2555 =item Return Value: 1/0
2559 __PACKAGE__->column_info_from_storage(1);
2561 Enables the on-demand automatic loading of the above column
2562 metadata from storage as necessary. This is *deprecated*, and
2563 should not be used. It will be removed before 1.0.
2565 =head1 FURTHER QUESTIONS?
2567 Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
2569 =head1 COPYRIGHT AND LICENSE
2571 This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
2572 by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
2573 redistribute it and/or modify it under the same terms as the
2574 L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.