1 package DBIx::Class::ResultSource;
6 use base 'DBIx::Class::ResultSource::RowParser';
9 use DBIx::Class::_Util qw( UNRESOLVABLE_CONDITION dbic_internal_try fail_on_internal_call );
10 use SQL::Abstract 'is_literal_value';
11 use Devel::GlobalDestruction;
12 use Scalar::Util qw/blessed weaken isweak/;
14 # FIXME - somehow breaks ResultSetManager, do not remove until investigated
15 use DBIx::Class::ResultSet;
19 __PACKAGE__->mk_group_accessors(simple => qw/
20 source_name name source_info
21 _ordered_columns _columns _primaries _unique_constraints
22 _relationships resultset_attributes
23 column_info_from_storage sqlt_deploy_callback
26 __PACKAGE__->mk_group_accessors(component_class => qw/
33 DBIx::Class::ResultSource - Result source object
37 # Create a table based result source, in a result class.
39 package MyApp::Schema::Result::Artist;
40 use base qw/DBIx::Class::Core/;
42 __PACKAGE__->table('artist');
43 __PACKAGE__->add_columns(qw/ artistid name /);
44 __PACKAGE__->set_primary_key('artistid');
45 __PACKAGE__->has_many(cds => 'MyApp::Schema::Result::CD');
49 # Create a query (view) based result source, in a result class
50 package MyApp::Schema::Result::Year2000CDs;
51 use base qw/DBIx::Class::Core/;
53 __PACKAGE__->load_components('InflateColumn::DateTime');
54 __PACKAGE__->table_class('DBIx::Class::ResultSource::View');
56 __PACKAGE__->table('year2000cds');
57 __PACKAGE__->result_source_instance->is_virtual(1);
58 __PACKAGE__->result_source_instance->view_definition(
59 "SELECT cdid, artist, title FROM cd WHERE year ='2000'"
65 A ResultSource is an object that represents a source of data for querying.
67 This class is a base class for various specialised types of result
68 sources, for example L<DBIx::Class::ResultSource::Table>. Table is the
69 default result source type, so one is created for you when defining a
70 result class as described in the synopsis above.
72 More specifically, the L<DBIx::Class::Core> base class pulls in the
73 L<DBIx::Class::ResultSourceProxy::Table> component, which defines
74 the L<table|DBIx::Class::ResultSourceProxy::Table/table> method.
75 When called, C<table> creates and stores an instance of
76 L<DBIx::Class::ResultSource::Table>. Luckily, to use tables as result
77 sources, you don't need to remember any of this.
79 Result sources representing select queries, or views, can also be
80 created, see L<DBIx::Class::ResultSource::View> for full details.
82 =head2 Finding result source objects
84 As mentioned above, a result source instance is created and stored for
86 L<Result Class|DBIx::Class::Manual::Glossary/Result Class>.
88 You can retrieve the result source at runtime in the following ways:
92 =item From a Schema object:
94 $schema->source($source_name);
96 =item From a Result object:
98 $result->result_source;
100 =item From a ResultSet object:
112 $class->new({attribute_name => value});
114 Creates a new ResultSource object. Not normally called directly by end users.
120 my ($class, $attrs) = @_;
121 $class = ref $class if ref $class;
123 my $self = bless { %{$attrs || {}} }, $class;
126 DBIx::Class::_ENV_::ASSERT_NO_ERRONEOUS_METAINSTANCE_USE
128 # a constructor with 'name' as sole arg clearly isn't "inheriting" from anything
129 ( not ( keys(%$self) == 1 and exists $self->{name} ) )
131 defined CORE::caller(1)
133 (CORE::caller(1))[3] !~ / ::new$ | ^ DBIx::Class :: (?:
134 ResultSourceProxy::Table::table
136 ResultSourceProxy::Table::_init_result_source_instance
141 local $Carp::CarpLevel = $Carp::CarpLevel + 1
143 Carp::confess("Incorrect instantiation of '$self': you almost certainly wanted to call ->clone() instead");
146 $self->{resultset_class} ||= 'DBIx::Class::ResultSet';
147 $self->{name} ||= "!!NAME NOT SET!!";
148 $self->{_columns_info_loaded} ||= 0;
149 $self->{sqlt_deploy_callback} ||= 'default_sqlt_deploy_hook';
151 $self->{$_} = { %{ $self->{$_} || {} } }
152 for qw( _columns _relationships resultset_attributes );
154 $self->{_ordered_columns} = [ @{ $self->{_ordered_columns} || [] } ];
162 $rsrc_instance->clone( atribute_name => overriden_value );
164 A wrapper around L</new> inheriting any defaults from the callee. This method
165 also not normally invoked directly by end users.
179 (@_ == 1 and ref $_[0] eq 'HASH')
192 =item Arguments: @columns
194 =item Return Value: L<$result_source|/new>
198 $source->add_columns(qw/col1 col2 col3/);
200 $source->add_columns('col1' => \%col1_info, 'col2' => \%col2_info, ...);
202 $source->add_columns(
203 'col1' => { data_type => 'integer', is_nullable => 1, ... },
204 'col2' => { data_type => 'text', is_auto_increment => 1, ... },
207 Adds columns to the result source. If supplied colname => hashref
208 pairs, uses the hashref as the L</column_info> for that column. Repeated
209 calls of this method will add more columns, not replace them.
211 The column names given will be created as accessor methods on your
212 L<Result|DBIx::Class::Manual::ResultClass> objects. You can change the name of the accessor
213 by supplying an L</accessor> in the column_info hash.
215 If a column name beginning with a plus sign ('+col1') is provided, the
216 attributes provided will be merged with any existing attributes for the
217 column, with the new attributes taking precedence in the case that an
218 attribute already exists. Using this without a hashref
219 (C<< $source->add_columns(qw/+col1 +col2/) >>) is legal, but useless --
220 it does the same thing it would do without the plus.
222 The contents of the column_info are not set in stone. The following
223 keys are currently recognised/used by DBIx::Class:
229 { accessor => '_name' }
231 # example use, replace standard accessor with one of your own:
233 my ($self, $value) = @_;
235 die "Name cannot contain digits!" if($value =~ /\d/);
236 $self->_name($value);
238 return $self->_name();
241 Use this to set the name of the accessor method for this column. If unset,
242 the name of the column will be used.
246 { data_type => 'integer' }
248 This contains the column type. It is automatically filled if you use the
249 L<SQL::Translator::Producer::DBIx::Class::File> producer, or the
250 L<DBIx::Class::Schema::Loader> module.
252 Currently there is no standard set of values for the data_type. Use
253 whatever your database supports.
259 The length of your column, if it is a column type that can have a size
260 restriction. This is currently only used to create tables from your
261 schema, see L<DBIx::Class::Schema/deploy>.
265 For decimal or float values you can specify an ArrayRef in order to
266 control precision, assuming your database's
267 L<SQL::Translator::Producer> supports it.
273 Set this to a true value for a column that is allowed to contain NULL
274 values, default is false. This is currently only used to create tables
275 from your schema, see L<DBIx::Class::Schema/deploy>.
277 =item is_auto_increment
279 { is_auto_increment => 1 }
281 Set this to a true value for a column whose value is somehow
282 automatically set, defaults to false. This is used to determine which
283 columns to empty when cloning objects using
284 L<DBIx::Class::Row/copy>. It is also used by
285 L<DBIx::Class::Schema/deploy>.
291 Set this to a true or false value (not C<undef>) to explicitly specify
292 if this column contains numeric data. This controls how set_column
293 decides whether to consider a column dirty after an update: if
294 C<is_numeric> is true a numeric comparison C<< != >> will take place
295 instead of the usual C<eq>
297 If not specified the storage class will attempt to figure this out on
298 first access to the column, based on the column C<data_type>. The
299 result will be cached in this attribute.
303 { is_foreign_key => 1 }
305 Set this to a true value for a column that contains a key from a
306 foreign table, defaults to false. This is currently only used to
307 create tables from your schema, see L<DBIx::Class::Schema/deploy>.
311 { default_value => \'now()' }
313 Set this to the default value which will be inserted into a column by
314 the database. Can contain either a value or a function (use a
315 reference to a scalar e.g. C<\'now()'> if you want a function). This
316 is currently only used to create tables from your schema, see
317 L<DBIx::Class::Schema/deploy>.
319 See the note on L<DBIx::Class::Row/new> for more information about possible
320 issues related to db-side default values.
324 { sequence => 'my_table_seq' }
326 Set this on a primary key column to the name of the sequence used to
327 generate a new key value. If not specified, L<DBIx::Class::PK::Auto>
328 will attempt to retrieve the name of the sequence from the database
331 =item retrieve_on_insert
333 { retrieve_on_insert => 1 }
335 For every column where this is set to true, DBIC will retrieve the RDBMS-side
336 value upon a new row insertion (normally only the autoincrement PK is
337 retrieved on insert). C<INSERT ... RETURNING> is used automatically if
338 supported by the underlying storage, otherwise an extra SELECT statement is
339 executed to retrieve the missing data.
343 { auto_nextval => 1 }
345 Set this to a true value for a column whose value is retrieved automatically
346 from a sequence or function (if supported by your Storage driver.) For a
347 sequence, if you do not use a trigger to get the nextval, you have to set the
348 L</sequence> value as well.
350 Also set this for MSSQL columns with the 'uniqueidentifier'
351 L<data_type|DBIx::Class::ResultSource/data_type> whose values you want to
352 automatically generate using C<NEWID()>, unless they are a primary key in which
353 case this will be done anyway.
357 This is used by L<DBIx::Class::Schema/deploy> and L<SQL::Translator>
358 to add extra non-generic data to the column. For example: C<< extra
359 => { unsigned => 1} >> is used by the MySQL producer to set an integer
360 column to unsigned. For more details, see
361 L<SQL::Translator::Producer::MySQL>.
369 =item Arguments: $colname, \%columninfo?
371 =item Return Value: 1/0 (true/false)
375 $source->add_column('col' => \%info);
377 Add a single column and optional column info. Uses the same column
378 info keys as L</add_columns>.
383 my ($self, @cols) = @_;
384 $self->_ordered_columns(\@cols) unless $self->_ordered_columns;
387 my $columns = $self->_columns;
388 while (my $col = shift @cols) {
389 my $column_info = {};
390 if ($col =~ s/^\+//) {
391 $column_info = $self->column_info($col);
394 # If next entry is { ... } use that for the column info, if not
395 # use an empty hashref
397 my $new_info = shift(@cols);
398 %$column_info = (%$column_info, %$new_info);
400 push(@added, $col) unless exists $columns->{$col};
401 $columns->{$col} = $column_info;
403 push @{ $self->_ordered_columns }, @added;
408 DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
409 shift->add_columns(@_)
416 =item Arguments: $colname
418 =item Return Value: 1/0 (true/false)
422 if ($source->has_column($colname)) { ... }
424 Returns true if the source has a column of this name, false otherwise.
429 my ($self, $column) = @_;
430 return exists $self->_columns->{$column};
437 =item Arguments: $colname
439 =item Return Value: Hashref of info
443 my $info = $source->column_info($col);
445 Returns the column metadata hashref for a column, as originally passed
446 to L</add_columns>. See L</add_columns> above for information on the
447 contents of the hashref.
452 my ($self, $column) = @_;
453 $self->throw_exception("No such column $column")
454 unless exists $self->_columns->{$column};
456 if ( ! $self->_columns->{$column}{data_type}
457 and ! $self->{_columns_info_loaded}
458 and $self->column_info_from_storage
459 and my $stor = dbic_internal_try { $self->schema->storage } )
461 $self->{_columns_info_loaded}++;
463 # try for the case of storage without table
465 my $info = $stor->columns_info_for( $self->from );
467 { (lc $_) => $info->{$_} }
471 foreach my $col ( keys %{$self->_columns} ) {
472 $self->_columns->{$col} = {
473 %{ $self->_columns->{$col} },
474 %{ $info->{$col} || $lc_info->{lc $col} || {} }
480 return $self->_columns->{$column};
487 =item Arguments: none
489 =item Return Value: Ordered list of column names
493 my @column_names = $source->columns;
495 Returns all column names in the order they were declared to L</add_columns>.
501 $self->throw_exception(
502 "columns() is a read-only accessor, did you mean add_columns()?"
504 return @{$self->{_ordered_columns}||[]};
511 =item Arguments: \@colnames ?
513 =item Return Value: Hashref of column name/info pairs
517 my $columns_info = $source->columns_info;
519 Like L</column_info> but returns information for the requested columns. If
520 the optional column-list arrayref is omitted it returns info on all columns
521 currently defined on the ResultSource via L</add_columns>.
526 my ($self, $columns) = @_;
528 my $colinfo = $self->_columns;
531 ! $self->{_columns_info_loaded}
533 $self->column_info_from_storage
535 grep { ! $_->{data_type} } values %$colinfo
537 my $stor = dbic_internal_try { $self->schema->storage }
539 $self->{_columns_info_loaded}++;
541 # try for the case of storage without table
543 my $info = $stor->columns_info_for( $self->from );
545 { (lc $_) => $info->{$_} }
549 foreach my $col ( keys %$colinfo ) {
551 %{ $colinfo->{$col} },
552 %{ $info->{$col} || $lc_info->{lc $col} || {} }
562 if (my $inf = $colinfo->{$_}) {
566 $self->throw_exception( sprintf (
567 "No such column '%s' on source '%s'",
569 $self->source_name || $self->name || 'Unknown source...?',
581 =head2 remove_columns
585 =item Arguments: @colnames
587 =item Return Value: not defined
591 $source->remove_columns(qw/col1 col2 col3/);
593 Removes the given list of columns by name, from the result source.
595 B<Warning>: Removing a column that is also used in the sources primary
596 key, or in one of the sources unique constraints, B<will> result in a
597 broken result source.
603 =item Arguments: $colname
605 =item Return Value: not defined
609 $source->remove_column('col');
611 Remove a single column by name from the result source, similar to
614 B<Warning>: Removing a column that is also used in the sources primary
615 key, or in one of the sources unique constraints, B<will> result in a
616 broken result source.
621 my ($self, @to_remove) = @_;
623 my $columns = $self->_columns
628 delete $columns->{$_};
632 $self->_ordered_columns([ grep { not $to_remove{$_} } @{$self->_ordered_columns} ]);
636 DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
637 shift->remove_columns(@_)
640 =head2 set_primary_key
644 =item Arguments: @cols
646 =item Return Value: not defined
650 Defines one or more columns as primary key for this source. Must be
651 called after L</add_columns>.
653 Additionally, defines a L<unique constraint|/add_unique_constraint>
656 Note: you normally do want to define a primary key on your sources
657 B<even if the underlying database table does not have a primary key>.
659 L<DBIx::Class::Manual::Intro/The Significance and Importance of Primary Keys>
664 sub set_primary_key {
665 my ($self, @cols) = @_;
667 my $colinfo = $self->columns_info(\@cols);
668 for my $col (@cols) {
669 carp_unique(sprintf (
670 "Primary key of source '%s' includes the column '%s' which has its "
671 . "'is_nullable' attribute set to true. This is a mistake and will cause "
672 . 'various Result-object operations to fail',
673 $self->source_name || $self->name || 'Unknown source...?',
675 )) if $colinfo->{$col}{is_nullable};
678 $self->_primaries(\@cols);
680 $self->add_unique_constraint(primary => \@cols);
683 =head2 primary_columns
687 =item Arguments: none
689 =item Return Value: Ordered list of primary column names
693 Read-only accessor which returns the list of primary keys, supplied by
698 sub primary_columns {
699 return @{shift->_primaries||[]};
702 # a helper method that will automatically die with a descriptive message if
703 # no pk is defined on the source in question. For internal use to save
704 # on if @pks... boilerplate
705 sub _pri_cols_or_die {
707 my @pcols = $self->primary_columns
708 or $self->throw_exception (sprintf(
709 "Operation requires a primary key to be declared on '%s' via set_primary_key",
710 # source_name is set only after schema-registration
711 $self->source_name || $self->result_class || $self->name || 'Unknown source...?',
716 # same as above but mandating single-column PK (used by relationship condition
718 sub _single_pri_col_or_die {
720 my ($pri, @too_many) = $self->_pri_cols_or_die;
722 $self->throw_exception( sprintf(
723 "Operation requires a single-column primary key declared on '%s'",
724 $self->source_name || $self->result_class || $self->name || 'Unknown source...?',
732 Manually define the correct sequence for your table, to avoid the overhead
733 associated with looking up the sequence automatically. The supplied sequence
734 will be applied to the L</column_info> of each L<primary_key|/set_primary_key>
738 =item Arguments: $sequence_name
740 =item Return Value: not defined
747 my ($self,$seq) = @_;
749 my @pks = $self->primary_columns
752 $_->{sequence} = $seq
753 for values %{ $self->columns_info (\@pks) };
757 =head2 add_unique_constraint
761 =item Arguments: $name?, \@colnames
763 =item Return Value: not defined
767 Declare a unique constraint on this source. Call once for each unique
770 # For UNIQUE (column1, column2)
771 __PACKAGE__->add_unique_constraint(
772 constraint_name => [ qw/column1 column2/ ],
775 Alternatively, you can specify only the columns:
777 __PACKAGE__->add_unique_constraint([ qw/column1 column2/ ]);
779 This will result in a unique constraint named
780 C<table_column1_column2>, where C<table> is replaced with the table
783 Unique constraints are used, for example, when you pass the constraint
784 name as the C<key> attribute to L<DBIx::Class::ResultSet/find>. Then
785 only columns in the constraint are searched.
787 Throws an error if any of the given column names do not yet exist on
792 sub add_unique_constraint {
796 $self->throw_exception(
797 'add_unique_constraint() does not accept multiple constraints, use '
798 . 'add_unique_constraints() instead'
803 if (ref $cols ne 'ARRAY') {
804 $self->throw_exception (
805 'Expecting an arrayref of constraint columns, got ' . ($cols||'NOTHING')
811 $name ||= $self->name_unique_constraint($cols);
813 foreach my $col (@$cols) {
814 $self->throw_exception("No such column $col on table " . $self->name)
815 unless $self->has_column($col);
818 my %unique_constraints = $self->unique_constraints;
819 $unique_constraints{$name} = $cols;
820 $self->_unique_constraints(\%unique_constraints);
823 =head2 add_unique_constraints
827 =item Arguments: @constraints
829 =item Return Value: not defined
833 Declare multiple unique constraints on this source.
835 __PACKAGE__->add_unique_constraints(
836 constraint_name1 => [ qw/column1 column2/ ],
837 constraint_name2 => [ qw/column2 column3/ ],
840 Alternatively, you can specify only the columns:
842 __PACKAGE__->add_unique_constraints(
843 [ qw/column1 column2/ ],
844 [ qw/column3 column4/ ]
847 This will result in unique constraints named C<table_column1_column2> and
848 C<table_column3_column4>, where C<table> is replaced with the table name.
850 Throws an error if any of the given column names do not yet exist on
853 See also L</add_unique_constraint>.
857 sub add_unique_constraints {
858 DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
861 my @constraints = @_;
863 if ( !(@constraints % 2) && grep { ref $_ ne 'ARRAY' } @constraints ) {
864 # with constraint name
865 while (my ($name, $constraint) = splice @constraints, 0, 2) {
866 $self->add_unique_constraint($name => $constraint);
871 foreach my $constraint (@constraints) {
872 $self->add_unique_constraint($constraint);
877 =head2 name_unique_constraint
881 =item Arguments: \@colnames
883 =item Return Value: Constraint name
887 $source->table('mytable');
888 $source->name_unique_constraint(['col1', 'col2']);
892 Return a name for a unique constraint containing the specified
893 columns. The name is created by joining the table name and each column
894 name, using an underscore character.
896 For example, a constraint on a table named C<cd> containing the columns
897 C<artist> and C<title> would result in a constraint name of C<cd_artist_title>.
899 This is used by L</add_unique_constraint> if you do not specify the
900 optional constraint name.
904 sub name_unique_constraint {
905 my ($self, $cols) = @_;
907 my $name = $self->name;
908 $name = $$name if (ref $name eq 'SCALAR');
909 $name =~ s/ ^ [^\.]+ \. //x; # strip possible schema qualifier
911 return join '_', $name, @$cols;
914 =head2 unique_constraints
918 =item Arguments: none
920 =item Return Value: Hash of unique constraint data
924 $source->unique_constraints();
926 Read-only accessor which returns a hash of unique constraints on this
929 The hash is keyed by constraint name, and contains an arrayref of
930 column names as values.
934 sub unique_constraints {
935 return %{shift->_unique_constraints||{}};
938 =head2 unique_constraint_names
942 =item Arguments: none
944 =item Return Value: Unique constraint names
948 $source->unique_constraint_names();
950 Returns the list of unique constraint names defined on this source.
954 sub unique_constraint_names {
957 my %unique_constraints = $self->unique_constraints;
959 return keys %unique_constraints;
962 =head2 unique_constraint_columns
966 =item Arguments: $constraintname
968 =item Return Value: List of constraint columns
972 $source->unique_constraint_columns('myconstraint');
974 Returns the list of columns that make up the specified unique constraint.
978 sub unique_constraint_columns {
979 my ($self, $constraint_name) = @_;
981 my %unique_constraints = $self->unique_constraints;
983 $self->throw_exception(
984 "Unknown unique constraint $constraint_name on '" . $self->name . "'"
985 ) unless exists $unique_constraints{$constraint_name};
987 return @{ $unique_constraints{$constraint_name} };
990 =head2 sqlt_deploy_callback
994 =item Arguments: $callback_name | \&callback_code
996 =item Return Value: $callback_name | \&callback_code
1000 __PACKAGE__->result_source_instance->sqlt_deploy_callback('mycallbackmethod');
1004 __PACKAGE__->result_source_instance->sqlt_deploy_callback(sub {
1005 my ($source_instance, $sqlt_table) = @_;
1009 An accessor to set a callback to be called during deployment of
1010 the schema via L<DBIx::Class::Schema/create_ddl_dir> or
1011 L<DBIx::Class::Schema/deploy>.
1013 The callback can be set as either a code reference or the name of a
1014 method in the current result class.
1016 Defaults to L</default_sqlt_deploy_hook>.
1018 Your callback will be passed the $source object representing the
1019 ResultSource instance being deployed, and the
1020 L<SQL::Translator::Schema::Table> object being created from it. The
1021 callback can be used to manipulate the table object or add your own
1022 customised indexes. If you need to manipulate a non-table object, use
1023 the L<DBIx::Class::Schema/sqlt_deploy_hook>.
1025 See L<DBIx::Class::Manual::Cookbook/Adding Indexes And Functions To
1026 Your SQL> for examples.
1028 This sqlt deployment callback can only be used to manipulate
1029 SQL::Translator objects as they get turned into SQL. To execute
1030 post-deploy statements which SQL::Translator does not currently
1031 handle, override L<DBIx::Class::Schema/deploy> in your Schema class
1032 and call L<dbh_do|DBIx::Class::Storage::DBI/dbh_do>.
1034 =head2 default_sqlt_deploy_hook
1036 This is the default deploy hook implementation which checks if your
1037 current Result class has a C<sqlt_deploy_hook> method, and if present
1038 invokes it B<on the Result class directly>. This is to preserve the
1039 semantics of C<sqlt_deploy_hook> which was originally designed to expect
1040 the Result class name and the
1041 L<$sqlt_table instance|SQL::Translator::Schema::Table> of the table being
1046 sub default_sqlt_deploy_hook {
1049 my $class = $self->result_class;
1051 if ($class and $class->can('sqlt_deploy_hook')) {
1052 $class->sqlt_deploy_hook(@_);
1056 sub _invoke_sqlt_deploy_hook {
1058 if ( my $hook = $self->sqlt_deploy_callback) {
1067 =item Arguments: $classname
1069 =item Return Value: $classname
1073 use My::Schema::ResultClass::Inflator;
1076 use My::Schema::Artist;
1078 __PACKAGE__->result_class('My::Schema::ResultClass::Inflator');
1080 Set the default result class for this source. You can use this to create
1081 and use your own result inflator. See L<DBIx::Class::ResultSet/result_class>
1084 Please note that setting this to something like
1085 L<DBIx::Class::ResultClass::HashRefInflator> will make every result unblessed
1086 and make life more difficult. Inflators like those are better suited to
1087 temporary usage via L<DBIx::Class::ResultSet/result_class>.
1093 =item Arguments: none
1095 =item Return Value: L<$resultset|DBIx::Class::ResultSet>
1099 Returns a resultset for the given source. This will initially be created
1100 on demand by calling
1102 $self->resultset_class->new($self, $self->resultset_attributes)
1104 but is cached from then on unless resultset_class changes.
1106 =head2 resultset_class
1110 =item Arguments: $classname
1112 =item Return Value: $classname
1116 package My::Schema::ResultSet::Artist;
1117 use base 'DBIx::Class::ResultSet';
1120 # In the result class
1121 __PACKAGE__->resultset_class('My::Schema::ResultSet::Artist');
1124 $source->resultset_class('My::Schema::ResultSet::Artist');
1126 Set the class of the resultset. This is useful if you want to create your
1127 own resultset methods. Create your own class derived from
1128 L<DBIx::Class::ResultSet>, and set it here. If called with no arguments,
1129 this method returns the name of the existing resultset class, if one
1132 =head2 resultset_attributes
1136 =item Arguments: L<\%attrs|DBIx::Class::ResultSet/ATTRIBUTES>
1138 =item Return Value: L<\%attrs|DBIx::Class::ResultSet/ATTRIBUTES>
1142 # In the result class
1143 __PACKAGE__->resultset_attributes({ order_by => [ 'id' ] });
1146 $source->resultset_attributes({ order_by => [ 'id' ] });
1148 Store a collection of resultset attributes, that will be set on every
1149 L<DBIx::Class::ResultSet> produced from this result source.
1151 B<CAVEAT>: C<resultset_attributes> comes with its own set of issues and
1152 bugs! Notably the contents of the attributes are B<entirely static>, which
1153 greatly hinders composability (things like L<current_source_alias
1154 |DBIx::Class::ResultSet/current_source_alias> can not possibly be respected).
1155 While C<resultset_attributes> isn't deprecated per se, you are strongly urged
1156 to seek alternatives.
1158 Since relationships use attributes to link tables together, the "default"
1159 attributes you set may cause unpredictable and undesired behavior. Furthermore,
1160 the defaults B<cannot be turned off>, so you are stuck with them.
1162 In most cases, what you should actually be using are project-specific methods:
1164 package My::Schema::ResultSet::Artist;
1165 use base 'DBIx::Class::ResultSet';
1169 #__PACKAGE__->resultset_attributes({ prefetch => 'tracks' });
1172 sub with_tracks { shift->search({}, { prefetch => 'tracks' }) }
1175 $schema->resultset('Artist')->with_tracks->...
1177 This gives you the flexibility of not using it when you don't need it.
1179 For more complex situations, another solution would be to use a virtual view
1180 via L<DBIx::Class::ResultSource::View>.
1186 $self->throw_exception(
1187 'resultset does not take any arguments. If you want another resultset, '.
1188 'call it on the schema instead.'
1191 $self->resultset_class->new(
1194 ( dbic_internal_try { %{$self->schema->default_resultset_attributes} } ),
1195 %{$self->{resultset_attributes}},
1204 =item Arguments: none
1206 =item Result value: $name
1210 Returns the name of the result source, which will typically be the table
1211 name. This may be a scalar reference if the result source has a non-standard
1218 =item Arguments: $source_name
1220 =item Result value: $source_name
1224 Set an alternate name for the result source when it is loaded into a schema.
1225 This is useful if you want to refer to a result source by a name other than
1228 package ArchivedBooks;
1229 use base qw/DBIx::Class/;
1230 __PACKAGE__->table('books_archive');
1231 __PACKAGE__->source_name('Books');
1233 # from your schema...
1234 $schema->resultset('Books')->find(1);
1240 =item Arguments: none
1242 =item Return Value: FROM clause
1246 my $from_clause = $source->from();
1248 Returns an expression of the source to be supplied to storage to specify
1249 retrieval from this source. In the case of a database, the required FROM
1254 sub from { die 'Virtual method!' }
1258 Stores a hashref of per-source metadata. No specific key names
1259 have yet been standardized, the examples below are purely hypothetical
1260 and don't actually accomplish anything on their own:
1262 __PACKAGE__->source_info({
1263 "_tablespace" => 'fast_disk_array_3',
1264 "_engine" => 'InnoDB',
1271 =item Arguments: L<$schema?|DBIx::Class::Schema>
1273 =item Return Value: L<$schema|DBIx::Class::Schema>
1277 my $schema = $source->schema();
1279 Sets and/or returns the L<DBIx::Class::Schema> object to which this
1280 result source instance has been attached to.
1286 $_[0]->{schema} = $_[1];
1289 $_[0]->{schema} || do {
1290 my $name = $_[0]->{source_name} || '_unnamed_';
1291 my $err = 'Unable to perform storage-dependent operations with a detached result source '
1292 . "(source '$name' is not associated with a schema).";
1294 $err .= ' You need to use $schema->thaw() or manually set'
1295 . ' $DBIx::Class::ResultSourceHandle::thaw_schema while thawing.'
1296 if $_[0]->{_detached_thaw};
1298 DBIx::Class::Exception->throw($err);
1307 =item Arguments: none
1309 =item Return Value: L<$storage|DBIx::Class::Storage>
1313 $source->storage->debug(1);
1315 Returns the L<storage handle|DBIx::Class::Storage> for the current schema.
1320 DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
1321 $_[0]->schema->storage
1324 =head2 add_relationship
1328 =item Arguments: $rel_name, $related_source_name, \%cond, \%attrs?
1330 =item Return Value: 1/true if it succeeded
1334 $source->add_relationship('rel_name', 'related_source', $cond, $attrs);
1336 L<DBIx::Class::Relationship> describes a series of methods which
1337 create pre-defined useful types of relationships. Look there first
1338 before using this method directly.
1340 The relationship name can be arbitrary, but must be unique for each
1341 relationship attached to this result source. 'related_source' should
1342 be the name with which the related result source was registered with
1343 the current schema. For example:
1345 $schema->source('Book')->add_relationship('reviews', 'Review', {
1346 'foreign.book_id' => 'self.id',
1349 The condition C<$cond> needs to be an L<SQL::Abstract>-style
1350 representation of the join between the tables. For example, if you're
1351 creating a relation from Author to Book,
1353 { 'foreign.author_id' => 'self.id' }
1355 will result in the JOIN clause
1357 author me JOIN book foreign ON foreign.author_id = me.id
1359 You can specify as many foreign => self mappings as necessary.
1361 Valid attributes are as follows:
1367 Explicitly specifies the type of join to use in the relationship. Any
1368 SQL join type is valid, e.g. C<LEFT> or C<RIGHT>. It will be placed in
1369 the SQL command immediately before C<JOIN>.
1373 An arrayref containing a list of accessors in the foreign class to proxy in
1374 the main class. If, for example, you do the following:
1376 CD->might_have(liner_notes => 'LinerNotes', undef, {
1377 proxy => [ qw/notes/ ],
1380 Then, assuming LinerNotes has an accessor named notes, you can do:
1382 my $cd = CD->find(1);
1383 # set notes -- LinerNotes object is created if it doesn't exist
1384 $cd->notes('Notes go here');
1388 Specifies the type of accessor that should be created for the
1389 relationship. Valid values are C<single> (for when there is only a single
1390 related object), C<multi> (when there can be many), and C<filter> (for
1391 when there is a single related object, but you also want the relationship
1392 accessor to double as a column accessor). For C<multi> accessors, an
1393 add_to_* method is also created, which calls C<create_related> for the
1398 Throws an exception if the condition is improperly supplied, or cannot
1403 sub add_relationship {
1404 my ($self, $rel, $f_source_name, $cond, $attrs) = @_;
1405 $self->throw_exception("Can't create relationship without join condition")
1409 # Check foreign and self are right in cond
1410 if ( (ref $cond ||'') eq 'HASH') {
1411 $_ =~ /^foreign\./ or $self->throw_exception("Malformed relationship condition key '$_': must be prefixed with 'foreign.'")
1414 $_ =~ /^self\./ or $self->throw_exception("Malformed relationship condition value '$_': must be prefixed with 'self.'")
1418 my %rels = %{ $self->_relationships };
1419 $rels{$rel} = { class => $f_source_name,
1420 source => $f_source_name,
1423 $self->_relationships(\%rels);
1428 =head2 relationships
1432 =item Arguments: none
1434 =item Return Value: L<@rel_names|DBIx::Class::Relationship>
1438 my @rel_names = $source->relationships();
1440 Returns all relationship names for this source.
1445 keys %{$_[0]->_relationships};
1448 =head2 relationship_info
1452 =item Arguments: L<$rel_name|DBIx::Class::Relationship>
1454 =item Return Value: L<\%rel_data|DBIx::Class::Relationship::Base/add_relationship>
1458 Returns a hash of relationship information for the specified relationship
1459 name. The keys/values are as specified for L<DBIx::Class::Relationship::Base/add_relationship>.
1463 sub relationship_info {
1464 #my ($self, $rel) = @_;
1465 return shift->_relationships->{+shift};
1468 =head2 has_relationship
1472 =item Arguments: L<$rel_name|DBIx::Class::Relationship>
1474 =item Return Value: 1/0 (true/false)
1478 Returns true if the source has a relationship of this name, false otherwise.
1482 sub has_relationship {
1483 #my ($self, $rel) = @_;
1484 return exists shift->_relationships->{+shift};
1487 =head2 reverse_relationship_info
1491 =item Arguments: L<$rel_name|DBIx::Class::Relationship>
1493 =item Return Value: L<\%rel_data|DBIx::Class::Relationship::Base/add_relationship>
1497 Looks through all the relationships on the source this relationship
1498 points to, looking for one whose condition is the reverse of the
1499 condition on this relationship.
1501 A common use of this is to find the name of the C<belongs_to> relation
1502 opposing a C<has_many> relation. For definition of these look in
1503 L<DBIx::Class::Relationship>.
1505 The returned hashref is keyed by the name of the opposing
1506 relationship, and contains its data in the same manner as
1507 L</relationship_info>.
1511 sub reverse_relationship_info {
1512 my ($self, $rel) = @_;
1514 my $rel_info = $self->relationship_info($rel)
1515 or $self->throw_exception("No such relationship '$rel'");
1519 return $ret unless ((ref $rel_info->{cond}) eq 'HASH');
1521 my $stripped_cond = $self->__strip_relcond ($rel_info->{cond});
1523 my $registered_source_name = $self->source_name;
1525 # this may be a partial schema or something else equally esoteric
1526 my $other_rsrc = $self->related_source($rel);
1528 # Get all the relationships for that source that related to this source
1529 # whose foreign column set are our self columns on $rel and whose self
1530 # columns are our foreign columns on $rel
1531 foreach my $other_rel ($other_rsrc->relationships) {
1533 # only consider stuff that points back to us
1534 # "us" here is tricky - if we are in a schema registration, we want
1535 # to use the source_names, otherwise we will use the actual classes
1537 # the schema may be partial
1538 my $roundtrip_rsrc = dbic_internal_try { $other_rsrc->related_source($other_rel) }
1541 if ($registered_source_name) {
1542 next if $registered_source_name ne ($roundtrip_rsrc->source_name || '')
1545 next if $self->result_class ne $roundtrip_rsrc->result_class;
1548 my $other_rel_info = $other_rsrc->relationship_info($other_rel);
1550 # this can happen when we have a self-referential class
1551 next if $other_rel_info eq $rel_info;
1553 next unless ref $other_rel_info->{cond} eq 'HASH';
1554 my $other_stripped_cond = $self->__strip_relcond($other_rel_info->{cond});
1556 $ret->{$other_rel} = $other_rel_info if (
1557 $self->_compare_relationship_keys (
1558 [ keys %$stripped_cond ], [ values %$other_stripped_cond ]
1561 $self->_compare_relationship_keys (
1562 [ values %$stripped_cond ], [ keys %$other_stripped_cond ]
1570 # all this does is removes the foreign/self prefix from a condition
1571 sub __strip_relcond {
1574 { map { /^ (?:foreign|self) \. (\w+) $/x } ($_, $_[1]{$_}) }
1579 sub compare_relationship_keys {
1580 carp 'compare_relationship_keys is a private method, stop calling it';
1582 $self->_compare_relationship_keys (@_);
1585 # Returns true if both sets of keynames are the same, false otherwise.
1586 sub _compare_relationship_keys {
1587 # my ($self, $keys1, $keys2) = @_;
1589 join ("\x00", sort @{$_[1]})
1591 join ("\x00", sort @{$_[2]})
1595 # optionally takes either an arrayref of column names, or a hashref of already
1596 # retrieved colinfos
1597 # returns an arrayref of column names of the shortest unique constraint
1598 # (matching some of the input if any), giving preference to the PK
1599 sub _identifying_column_set {
1600 my ($self, $cols) = @_;
1602 my %unique = $self->unique_constraints;
1603 my $colinfos = ref $cols eq 'HASH' ? $cols : $self->columns_info($cols||());
1605 # always prefer the PK first, and then shortest constraints first
1607 for my $set (delete $unique{primary}, sort { @$a <=> @$b } (values %unique) ) {
1608 next unless $set && @$set;
1611 next USET unless ($colinfos->{$_} && !$colinfos->{$_}{is_nullable} );
1614 # copy so we can mangle it at will
1621 sub _minimal_valueset_satisfying_constraint {
1623 my $args = { ref $_[0] eq 'HASH' ? %{ $_[0] } : @_ };
1625 $args->{columns_info} ||= $self->columns_info;
1627 my $vals = $self->schema->storage->_extract_fixed_condition_columns(
1629 ($args->{carp_on_nulls} ? 'consider_nulls' : undef ),
1633 for my $col ($self->unique_constraint_columns($args->{constraint_name}) ) {
1634 if( ! exists $vals->{$col} or ( $vals->{$col}||'' ) eq UNRESOLVABLE_CONDITION ) {
1635 $cols->{missing}{$col} = undef;
1637 elsif( ! defined $vals->{$col} ) {
1638 $cols->{$args->{carp_on_nulls} ? 'undefined' : 'missing'}{$col} = undef;
1641 # we need to inject back the '=' as _extract_fixed_condition_columns
1642 # will strip it from literals and values alike, resulting in an invalid
1643 # condition in the end
1644 $cols->{present}{$col} = { '=' => $vals->{$col} };
1647 $cols->{fc}{$col} = 1 if (
1648 ( ! $cols->{missing} or ! exists $cols->{missing}{$col} )
1650 keys %{ $args->{columns_info}{$col}{_filter_info} || {} }
1654 $self->throw_exception( sprintf ( "Unable to satisfy requested constraint '%s', missing values for column(s): %s",
1655 $args->{constraint_name},
1656 join (', ', map { "'$_'" } sort keys %{$cols->{missing}} ),
1657 ) ) if $cols->{missing};
1659 $self->throw_exception( sprintf (
1660 "Unable to satisfy requested constraint '%s', FilterColumn values not usable for column(s): %s",
1661 $args->{constraint_name},
1662 join (', ', map { "'$_'" } sort keys %{$cols->{fc}}),
1668 !$ENV{DBIC_NULLABLE_KEY_NOWARN}
1670 carp_unique ( sprintf (
1671 "NULL/undef values supplied for requested unique constraint '%s' (NULL "
1672 . 'values in column(s): %s). This is almost certainly not what you wanted, '
1673 . 'though you can set DBIC_NULLABLE_KEY_NOWARN to disable this warning.',
1674 $args->{constraint_name},
1675 join (', ', map { "'$_'" } sort keys %{$cols->{undefined}}),
1679 return { map { %{ $cols->{$_}||{} } } qw(present undefined) };
1682 # Returns the {from} structure used to express JOIN conditions
1684 my ($self, $join, $alias, $seen, $jpath, $parent_force_left) = @_;
1686 # we need a supplied one, because we do in-place modifications, no returns
1687 $self->throw_exception ('You must supply a seen hashref as the 3rd argument to _resolve_join')
1688 unless ref $seen eq 'HASH';
1690 $self->throw_exception ('You must supply a joinpath arrayref as the 4th argument to _resolve_join')
1691 unless ref $jpath eq 'ARRAY';
1693 $jpath = [@$jpath]; # copy
1695 if (not defined $join or not length $join) {
1698 elsif (ref $join eq 'ARRAY') {
1701 $self->_resolve_join($_, $alias, $seen, $jpath, $parent_force_left);
1704 elsif (ref $join eq 'HASH') {
1707 for my $rel (keys %$join) {
1709 my $rel_info = $self->relationship_info($rel)
1710 or $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
1712 my $force_left = $parent_force_left;
1713 $force_left ||= lc($rel_info->{attrs}{join_type}||'') eq 'left';
1715 # the actual seen value will be incremented by the recursion
1716 my $as = $self->schema->storage->relname_to_table_alias(
1717 $rel, ($seen->{$rel} && $seen->{$rel} + 1)
1721 $self->_resolve_join($rel, $alias, $seen, [@$jpath], $force_left),
1722 $self->related_source($rel)->_resolve_join(
1723 $join->{$rel}, $as, $seen, [@$jpath, { $rel => $as }], $force_left
1731 $self->throw_exception("No idea how to resolve join reftype ".ref $join);
1734 my $count = ++$seen->{$join};
1735 my $as = $self->schema->storage->relname_to_table_alias(
1736 $join, ($count > 1 && $count)
1739 my $rel_info = $self->relationship_info($join)
1740 or $self->throw_exception("No such relationship $join on " . $self->source_name);
1742 my $rel_src = $self->related_source($join);
1743 return [ { $as => $rel_src->from,
1745 -join_type => $parent_force_left
1747 : $rel_info->{attrs}{join_type}
1749 -join_path => [@$jpath, { $join => $as } ],
1751 ! $rel_info->{attrs}{accessor}
1753 $rel_info->{attrs}{accessor} eq 'single'
1755 $rel_info->{attrs}{accessor} eq 'filter'
1758 -relation_chain_depth => ( $seen->{-relation_chain_depth} || 0 ) + 1,
1760 $self->_resolve_relationship_condition(
1762 self_alias => $alias,
1763 foreign_alias => $as,
1770 carp 'pk_depends_on is a private method, stop calling it';
1772 $self->_pk_depends_on (@_);
1775 # Determines whether a relation is dependent on an object from this source
1776 # having already been inserted. Takes the name of the relationship and a
1777 # hashref of columns of the related object.
1778 sub _pk_depends_on {
1779 my ($self, $rel_name, $rel_data) = @_;
1781 my $relinfo = $self->relationship_info($rel_name);
1783 # don't assume things if the relationship direction is specified
1784 return $relinfo->{attrs}{is_foreign_key_constraint}
1785 if exists ($relinfo->{attrs}{is_foreign_key_constraint});
1787 my $cond = $relinfo->{cond};
1788 return 0 unless ref($cond) eq 'HASH';
1790 # map { foreign.foo => 'self.bar' } to { bar => 'foo' }
1791 my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond };
1793 # assume anything that references our PK probably is dependent on us
1794 # rather than vice versa, unless the far side is (a) defined or (b)
1796 my $rel_source = $self->related_source($rel_name);
1798 foreach my $p ($self->primary_columns) {
1799 if (exists $keyhash->{$p}) {
1800 unless (defined($rel_data->{$keyhash->{$p}})
1801 || $rel_source->column_info($keyhash->{$p})
1802 ->{is_auto_increment}) {
1811 sub resolve_condition {
1812 carp 'resolve_condition is a private method, stop calling it';
1813 shift->_resolve_condition (@_);
1816 sub _resolve_condition {
1817 # carp_unique sprintf
1818 # '_resolve_condition is a private method, and moreover is about to go '
1819 # . 'away. Please contact the development team at %s if you believe you '
1820 # . 'have a genuine use for this method, in order to discuss alternatives.',
1821 # DBIx::Class::_ENV_::HELP_URL,
1824 #######################
1825 ### API Design? What's that...? (a backwards compatible shim, kill me now)
1827 my ($self, $cond, @res_args, $rel_name);
1829 # we *SIMPLY DON'T KNOW YET* which arg is which, yay
1830 ($self, $cond, $res_args[0], $res_args[1], $rel_name) = @_;
1832 # assume that an undef is an object-like unset (set_from_related(undef))
1833 my @is_objlike = map { ! defined $_ or length ref $_ } (@res_args);
1835 # turn objlike into proper objects for saner code further down
1837 next unless $is_objlike[$_];
1839 if ( defined blessed $res_args[$_] ) {
1841 # but wait - there is more!!! WHAT THE FUCK?!?!?!?!
1842 if ($res_args[$_]->isa('DBIx::Class::ResultSet')) {
1843 carp('Passing a resultset for relationship resolution makes no sense - invoking __gremlins__');
1844 $is_objlike[$_] = 0;
1845 $res_args[$_] = '__gremlins__';
1849 $res_args[$_] ||= {};
1851 # hate everywhere - have to pass in as a plain hash
1852 # pretending to be an object at least for now
1853 $self->throw_exception("Unsupported object-like structure encountered: $res_args[$_]")
1854 unless ref $res_args[$_] eq 'HASH';
1859 # where-is-waldo block guesses relname, then further down we override it if available
1861 $is_objlike[1] ? ( rel_name => $res_args[0], self_alias => $res_args[0], foreign_alias => 'me', self_result_object => $res_args[1] )
1862 : $is_objlike[0] ? ( rel_name => $res_args[1], self_alias => 'me', foreign_alias => $res_args[1], foreign_values => $res_args[0] )
1863 : ( rel_name => $res_args[0], self_alias => $res_args[1], foreign_alias => $res_args[0] )
1866 ( $rel_name ? ( rel_name => $rel_name ) : () ),
1869 # Allowing passing relconds different than the relationshup itself is cute,
1870 # but likely dangerous. Remove that from the (still unofficial) API of
1871 # _resolve_relationship_condition, and instead make it "hard on purpose"
1872 local $self->relationship_info( $args->{rel_name} )->{cond} = $cond if defined $cond;
1874 #######################
1876 # now it's fucking easy isn't it?!
1877 my $rc = $self->_resolve_relationship_condition( $args );
1880 ( $rc->{join_free_condition} || $rc->{condition} ),
1881 ! $rc->{join_free_condition},
1884 # _resolve_relationship_condition always returns qualified cols even in the
1885 # case of join_free_condition, but nothing downstream expects this
1886 if ($rc->{join_free_condition} and ref $res[0] eq 'HASH') {
1888 { ($_ =~ /\.(.+)/) => $res[0]{$_} }
1894 return wantarray ? @res : $res[0];
1897 # Keep this indefinitely. There is evidence of both CPAN and
1898 # darkpan using it, and there isn't much harm in an extra var
1900 our $UNRESOLVABLE_CONDITION = UNRESOLVABLE_CONDITION;
1901 # YES I KNOW THIS IS EVIL
1902 # it is there to save darkpan from themselves, since internally
1903 # we are moving to a constant
1904 Internals::SvREADONLY($UNRESOLVABLE_CONDITION => 1);
1906 # Resolves the passed condition to a concrete query fragment and extra
1909 ## self-explanatory API, modeled on the custom cond coderef:
1910 # rel_name => (scalar)
1911 # foreign_alias => (scalar)
1912 # foreign_values => (either not supplied, or a hashref, or a foreign ResultObject (to be ->get_columns()ed), or plain undef )
1913 # self_alias => (scalar)
1914 # self_result_object => (either not supplied or a result object)
1915 # require_join_free_condition => (boolean, throws on failure to construct a JF-cond)
1916 # infer_values_based_on => (either not supplied or a hashref, implies require_join_free_condition)
1919 # condition => (a valid *likely fully qualified* sqla cond structure)
1920 # identity_map => (a hashref of foreign-to-self *unqualified* column equality names)
1921 # join_free_condition => (a valid *fully qualified* sqla cond structure, maybe unset)
1922 # inferred_values => (in case of an available join_free condition, this is a hashref of
1923 # *unqualified* column/value *EQUALITY* pairs, representing an amalgamation
1924 # of the JF-cond parse and infer_values_based_on
1925 # always either complete or unset)
1927 sub _resolve_relationship_condition {
1930 my $args = { ref $_[0] eq 'HASH' ? %{ $_[0] } : @_ };
1932 for ( qw( rel_name self_alias foreign_alias ) ) {
1933 $self->throw_exception("Mandatory argument '$_' to _resolve_relationship_condition() is not a plain string")
1934 if !defined $args->{$_} or length ref $args->{$_};
1937 $self->throw_exception("Arguments 'self_alias' and 'foreign_alias' may not be identical")
1938 if $args->{self_alias} eq $args->{foreign_alias};
1941 my $exception_rel_id = "relationship '$args->{rel_name}' on source '@{[ $self->source_name ]}'";
1943 my $rel_info = $self->relationship_info($args->{rel_name})
1945 # or $self->throw_exception( "No such $exception_rel_id" );
1946 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");
1949 $exception_rel_id = "relationship '$rel_info->{_original_name}' on source '@{[ $self->source_name ]}'"
1950 if $rel_info and exists $rel_info->{_original_name};
1952 $self->throw_exception("No practical way to resolve $exception_rel_id between two data structures")
1953 if exists $args->{self_result_object} and exists $args->{foreign_values};
1955 $self->throw_exception( "Argument to infer_values_based_on must be a hash" )
1956 if exists $args->{infer_values_based_on} and ref $args->{infer_values_based_on} ne 'HASH';
1958 $args->{require_join_free_condition} ||= !!$args->{infer_values_based_on};
1960 $self->throw_exception( "Argument 'self_result_object' must be an object inheriting from DBIx::Class::Row" )
1962 exists $args->{self_result_object}
1964 ( ! defined blessed $args->{self_result_object} or ! $args->{self_result_object}->isa('DBIx::Class::Row') )
1968 my $rel_rsrc = $self->related_source($args->{rel_name});
1969 my $storage = $self->schema->storage;
1971 if (exists $args->{foreign_values}) {
1973 if (! defined $args->{foreign_values} ) {
1974 # fallback: undef => {}
1975 $args->{foreign_values} = {};
1977 elsif (defined blessed $args->{foreign_values}) {
1979 $self->throw_exception( "Objects supplied as 'foreign_values' ($args->{foreign_values}) must inherit from DBIx::Class::Row" )
1980 unless $args->{foreign_values}->isa('DBIx::Class::Row');
1983 "Objects supplied as 'foreign_values' ($args->{foreign_values}) "
1984 . "usually should inherit from the related ResultClass ('@{[ $rel_rsrc->result_class ]}'), "
1985 . "perhaps you've made a mistake invoking the condition resolver?"
1986 ) unless $args->{foreign_values}->isa($rel_rsrc->result_class);
1988 $args->{foreign_values} = { $args->{foreign_values}->get_columns };
1990 elsif ( ref $args->{foreign_values} eq 'HASH' ) {
1992 # re-build {foreign_values} excluding identically named rels
1993 if( keys %{$args->{foreign_values}} ) {
1995 my ($col_idx, $rel_idx) = map
1996 { { map { $_ => 1 } $rel_rsrc->$_ } }
1997 qw( columns relationships )
2000 my $equivalencies = $storage->_extract_fixed_condition_columns(
2001 $args->{foreign_values},
2005 $args->{foreign_values} = { map {
2006 # skip if relationship *and* a non-literal ref
2007 # this means a multicreate stub was passed in
2011 length ref $args->{foreign_values}{$_}
2013 ! is_literal_value($args->{foreign_values}{$_})
2018 ? $self->throw_exception( "Key '$_' supplied as 'foreign_values' is not a column on related source '@{[ $rel_rsrc->source_name ]}'" )
2019 : ( !exists $equivalencies->{$_} or ($equivalencies->{$_}||'') eq UNRESOLVABLE_CONDITION )
2020 ? $self->throw_exception( "Value supplied for '...{foreign_values}{$_}' is not a direct equivalence expression" )
2021 : $args->{foreign_values}{$_}
2023 } keys %{$args->{foreign_values}} };
2027 $self->throw_exception(
2028 "Argument 'foreign_values' must be either an object inheriting from '@{[ $rel_rsrc->result_class ]}', "
2029 . "or a hash reference, or undef"
2036 if (ref $rel_info->{cond} eq 'CODE') {
2039 rel_name => $args->{rel_name},
2040 self_resultsource => $self,
2041 self_alias => $args->{self_alias},
2042 foreign_alias => $args->{foreign_alias},
2044 { (exists $args->{$_}) ? ( $_ => $args->{$_} ) : () }
2045 qw( self_result_object foreign_values )
2049 # legacy - never remove these!!!
2050 $cref_args->{foreign_relname} = $cref_args->{rel_name};
2052 $cref_args->{self_rowobj} = $cref_args->{self_result_object}
2053 if exists $cref_args->{self_result_object};
2055 ($ret->{condition}, $ret->{join_free_condition}, my @extra) = $rel_info->{cond}->($cref_args);
2058 $self->throw_exception("A custom condition coderef can return at most 2 conditions, but $exception_rel_id returned extra values: @extra")
2061 if (my $jfc = $ret->{join_free_condition}) {
2063 $self->throw_exception (
2064 "The join-free condition returned for $exception_rel_id must be a hash reference"
2065 ) unless ref $jfc eq 'HASH';
2067 my ($joinfree_alias, $joinfree_source);
2068 if (defined $args->{self_result_object}) {
2069 $joinfree_alias = $args->{foreign_alias};
2070 $joinfree_source = $rel_rsrc;
2072 elsif (defined $args->{foreign_values}) {
2073 $joinfree_alias = $args->{self_alias};
2074 $joinfree_source = $self;
2077 # FIXME sanity check until things stabilize, remove at some point
2078 $self->throw_exception (
2079 "A join-free condition returned for $exception_rel_id without a result object to chain from"
2080 ) unless $joinfree_alias;
2082 my $fq_col_list = { map
2083 { ( "$joinfree_alias.$_" => 1 ) }
2084 $joinfree_source->columns
2087 exists $fq_col_list->{$_} or $self->throw_exception (
2088 "The join-free condition returned for $exception_rel_id may only "
2089 . 'contain keys that are fully qualified column names of the corresponding source '
2090 . "'$joinfree_alias' (instead it returned '$_')"
2098 $_->isa('DBIx::Class::Row')
2100 $self->throw_exception (
2101 "The join-free condition returned for $exception_rel_id may not "
2102 . 'contain result objects as values - perhaps instead of invoking '
2103 . '->$something you meant to return ->get_column($something)'
2109 elsif (ref $rel_info->{cond} eq 'HASH') {
2111 # the condition is static - use parallel arrays
2112 # for a "pivot" depending on which side of the
2113 # rel did we get as an object
2114 my (@f_cols, @l_cols);
2115 for my $fc (keys %{ $rel_info->{cond} }) {
2116 my $lc = $rel_info->{cond}{$fc};
2118 # FIXME STRICTMODE should probably check these are valid columns
2119 $fc =~ s/^foreign\.// ||
2120 $self->throw_exception("Invalid rel cond key '$fc'");
2122 $lc =~ s/^self\.// ||
2123 $self->throw_exception("Invalid rel cond val '$lc'");
2129 # construct the crosstable condition and the identity map
2131 $ret->{condition}{"$args->{foreign_alias}.$f_cols[$_]"} = { -ident => "$args->{self_alias}.$l_cols[$_]" };
2132 $ret->{identity_map}{$l_cols[$_]} = $f_cols[$_];
2135 if ($args->{foreign_values}) {
2136 $ret->{join_free_condition}{"$args->{self_alias}.$l_cols[$_]"} = $args->{foreign_values}{$f_cols[$_]}
2139 elsif (defined $args->{self_result_object}) {
2141 for my $i (0..$#l_cols) {
2142 if ( $args->{self_result_object}->has_column_loaded($l_cols[$i]) ) {
2143 $ret->{join_free_condition}{"$args->{foreign_alias}.$f_cols[$i]"} = $args->{self_result_object}->get_column($l_cols[$i]);
2146 $self->throw_exception(sprintf
2147 "Unable to resolve relationship '%s' from object '%s': column '%s' not "
2148 . 'loaded from storage (or not passed to new() prior to insert()). You '
2149 . 'probably need to call ->discard_changes to get the server-side defaults '
2150 . 'from the database.',
2152 $args->{self_result_object},
2154 ) if $args->{self_result_object}->in_storage;
2156 # FIXME - temporarly force-override
2157 delete $args->{require_join_free_condition};
2158 $ret->{join_free_condition} = UNRESOLVABLE_CONDITION;
2164 elsif (ref $rel_info->{cond} eq 'ARRAY') {
2165 if (@{ $rel_info->{cond} } == 0) {
2167 condition => UNRESOLVABLE_CONDITION,
2168 join_free_condition => UNRESOLVABLE_CONDITION,
2172 my @subconds = map {
2173 local $rel_info->{cond} = $_;
2174 $self->_resolve_relationship_condition( $args );
2175 } @{ $rel_info->{cond} };
2177 if( @{ $rel_info->{cond} } == 1 ) {
2178 $ret = $subconds[0];
2181 # we are discarding inferred values here... likely incorrect...
2182 # then again - the entire thing is an OR, so we *can't* use them anyway
2183 for my $subcond ( @subconds ) {
2184 $self->throw_exception('Either all or none of the OR-condition members must resolve to a join-free condition')
2185 if ( $ret and ( $ret->{join_free_condition} xor $subcond->{join_free_condition} ) );
2187 $subcond->{$_} and push @{$ret->{$_}}, $subcond->{$_} for (qw(condition join_free_condition));
2193 $self->throw_exception ("Can't handle condition $rel_info->{cond} for $exception_rel_id yet :(");
2197 $args->{require_join_free_condition}
2199 ( ! $ret->{join_free_condition} or $ret->{join_free_condition} eq UNRESOLVABLE_CONDITION )
2201 $self->throw_exception(
2202 ucfirst sprintf "$exception_rel_id does not resolve to a %sjoin-free condition fragment",
2203 exists $args->{foreign_values}
2204 ? "'foreign_values'-based reversed-"
2209 # we got something back - sanity check and infer values if we can
2212 $ret->{join_free_condition}
2214 $ret->{join_free_condition} ne UNRESOLVABLE_CONDITION
2216 my $jfc = $storage->_collapse_cond( $ret->{join_free_condition} )
2219 my $jfc_eqs = $storage->_extract_fixed_condition_columns($jfc, 'consider_nulls');
2221 if (keys %$jfc_eqs) {
2224 # $jfc is fully qualified by definition
2225 my ($col) = $_ =~ /\.(.+)/;
2227 if (exists $jfc_eqs->{$_} and ($jfc_eqs->{$_}||'') ne UNRESOLVABLE_CONDITION) {
2228 $ret->{inferred_values}{$col} = $jfc_eqs->{$_};
2230 elsif ( !$args->{infer_values_based_on} or ! exists $args->{infer_values_based_on}{$col} ) {
2231 push @nonvalues, $col;
2236 delete $ret->{inferred_values} if @nonvalues;
2240 # did the user explicitly ask
2241 if ($args->{infer_values_based_on}) {
2243 $self->throw_exception(sprintf (
2244 "Unable to complete value inferrence - custom $exception_rel_id returns conditions instead of values for column(s): %s",
2245 map { "'$_'" } @nonvalues
2249 $ret->{inferred_values} ||= {};
2251 $ret->{inferred_values}{$_} = $args->{infer_values_based_on}{$_}
2252 for keys %{$args->{infer_values_based_on}};
2255 # add the identities based on the main condition
2256 # (may already be there, since easy to calculate on the fly in the HASH case)
2257 if ( ! $ret->{identity_map} ) {
2259 my $col_eqs = $storage->_extract_fixed_condition_columns($ret->{condition});
2262 for my $lhs (keys %$col_eqs) {
2264 next if $col_eqs->{$lhs} eq UNRESOLVABLE_CONDITION;
2266 # there is no way to know who is right and who is left in a cref
2267 # therefore a full blown resolution call, and figure out the
2268 # direction a bit further below
2269 $colinfos ||= $storage->_resolve_column_info([
2270 { -alias => $args->{self_alias}, -rsrc => $self },
2271 { -alias => $args->{foreign_alias}, -rsrc => $rel_rsrc },
2274 next unless $colinfos->{$lhs}; # someone is engaging in witchcraft
2276 if ( my $rhs_ref = is_literal_value( $col_eqs->{$lhs} ) ) {
2279 $colinfos->{$rhs_ref->[0]}
2281 $colinfos->{$lhs}{-source_alias} ne $colinfos->{$rhs_ref->[0]}{-source_alias}
2283 ( $colinfos->{$lhs}{-source_alias} eq $args->{self_alias} )
2284 ? ( $ret->{identity_map}{$colinfos->{$lhs}{-colname}} = $colinfos->{$rhs_ref->[0]}{-colname} )
2285 : ( $ret->{identity_map}{$colinfos->{$rhs_ref->[0]}{-colname}} = $colinfos->{$lhs}{-colname} )
2290 $col_eqs->{$lhs} =~ /^ ( \Q$args->{self_alias}\E \. .+ ) /x
2292 ($colinfos->{$1}||{})->{-result_source} == $rel_rsrc
2294 my ($lcol, $rcol) = map
2295 { $colinfos->{$_}{-colname} }
2299 "The $exception_rel_id specifies equality of column '$lcol' and the "
2300 . "*VALUE* '$rcol' (you did not use the { -ident => ... } operator)"
2306 # FIXME - temporary, to fool the idiotic check in SQLMaker::_join_condition
2307 $ret->{condition} = { -and => [ $ret->{condition} ] }
2308 unless $ret->{condition} eq UNRESOLVABLE_CONDITION;
2313 =head2 related_source
2317 =item Arguments: $rel_name
2319 =item Return Value: $source
2323 Returns the result source object for the given relationship.
2327 sub related_source {
2328 my ($self, $rel) = @_;
2329 if( !$self->has_relationship( $rel ) ) {
2330 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
2333 # if we are not registered with a schema - just use the prototype
2334 # however if we do have a schema - ask for the source by name (and
2335 # throw in the process if all fails)
2336 if (my $schema = dbic_internal_try { $self->schema }) {
2337 $schema->source($self->relationship_info($rel)->{source});
2340 my $class = $self->relationship_info($rel)->{class};
2341 $self->ensure_class_loaded($class);
2342 $class->result_source_instance;
2346 =head2 related_class
2350 =item Arguments: $rel_name
2352 =item Return Value: $classname
2356 Returns the class name for objects in the given relationship.
2361 my ($self, $rel) = @_;
2362 if( !$self->has_relationship( $rel ) ) {
2363 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
2365 return $self->schema->class($self->relationship_info($rel)->{source});
2372 =item Arguments: none
2374 =item Return Value: L<$source_handle|DBIx::Class::ResultSourceHandle>
2378 Obtain a new L<result source handle instance|DBIx::Class::ResultSourceHandle>
2379 for this source. Used as a serializable pointer to this resultsource, as it is not
2380 easy (nor advisable) to serialize CODErefs which may very well be present in e.g.
2381 relationship definitions.
2386 require DBIx::Class::ResultSourceHandle;
2387 return DBIx::Class::ResultSourceHandle->new({
2388 source_moniker => $_[0]->source_name,
2390 # so that a detached thaw can be re-frozen
2391 $_[0]->{_detached_thaw}
2392 ? ( _detached_source => $_[0] )
2393 : ( schema => $_[0]->schema )
2398 my $global_phase_destroy;
2400 ### NO detected_reinvoked_destructor check
2401 ### This code very much relies on being called multuple times
2403 return if $global_phase_destroy ||= in_global_destruction;
2409 # Under no circumstances shall $_[0] be stored anywhere else (like copied to
2410 # a lexical variable, or shifted, or anything else). Doing so will mess up
2411 # the refcount of this particular result source, and will allow the $schema
2412 # we are trying to save to reattach back to the source we are destroying.
2413 # The relevant code checking refcounts is in ::Schema::DESTROY()
2415 # if we are not a schema instance holder - we don't matter
2417 ! ref $_[0]->{schema}
2419 isweak $_[0]->{schema}
2422 # weaken our schema hold forcing the schema to find somewhere else to live
2423 # during global destruction (if we have not yet bailed out) this will throw
2424 # which will serve as a signal to not try doing anything else
2425 # however beware - on older perls the exception seems randomly untrappable
2426 # due to some weird race condition during thread joining :(((
2427 local $SIG{__DIE__} if $SIG{__DIE__};
2428 local $@ if DBIx::Class::_ENV_::UNSTABLE_DOLLARAT;
2430 weaken $_[0]->{schema};
2432 # if schema is still there reintroduce ourselves with strong refs back to us
2433 if ($_[0]->{schema}) {
2434 my $srcregs = $_[0]->{schema}->source_registrations;
2436 defined $srcregs->{$_}
2438 $srcregs->{$_} == $_[0]
2440 $srcregs->{$_} = $_[0]
2448 $global_phase_destroy = 1;
2451 # Dummy NEXTSTATE ensuring the all temporaries on the stack are garbage
2452 # collected before leaving this scope. Depending on the code above, this
2453 # may very well be just a preventive measure guarding future modifications
2457 sub STORABLE_freeze { Storable::nfreeze($_[0]->handle) }
2460 my ($self, $cloning, $ice) = @_;
2461 %$self = %{ (Storable::thaw($ice))->resolve };
2464 =head2 throw_exception
2466 See L<DBIx::Class::Schema/"throw_exception">.
2470 sub throw_exception {
2474 ? $self->{schema}->throw_exception(@_)
2475 : DBIx::Class::Exception->throw(@_)
2479 =head2 column_info_from_storage
2483 =item Arguments: 1/0 (default: 0)
2485 =item Return Value: 1/0
2489 __PACKAGE__->column_info_from_storage(1);
2491 Enables the on-demand automatic loading of the above column
2492 metadata from storage as necessary. This is *deprecated*, and
2493 should not be used. It will be removed before 1.0.
2495 =head1 FURTHER QUESTIONS?
2497 Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
2499 =head1 COPYRIGHT AND LICENSE
2501 This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
2502 by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
2503 redistribute it and/or modify it under the same terms as the
2504 L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.