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 my @hashref_attributes = qw(
20 source_info resultset_attributes
21 _columns _unique_constraints _relationships
23 my @arrayref_attributes = qw(
24 _ordered_columns _primaries
26 __PACKAGE__->mk_group_accessors(simple =>
29 qw( source_name name column_info_from_storage sqlt_deploy_callback ),
32 __PACKAGE__->mk_group_accessors(component_class => qw/
39 DBIx::Class::ResultSource - Result source object
43 # Create a table based result source, in a result class.
45 package MyApp::Schema::Result::Artist;
46 use base qw/DBIx::Class::Core/;
48 __PACKAGE__->table('artist');
49 __PACKAGE__->add_columns(qw/ artistid name /);
50 __PACKAGE__->set_primary_key('artistid');
51 __PACKAGE__->has_many(cds => 'MyApp::Schema::Result::CD');
55 # Create a query (view) based result source, in a result class
56 package MyApp::Schema::Result::Year2000CDs;
57 use base qw/DBIx::Class::Core/;
59 __PACKAGE__->load_components('InflateColumn::DateTime');
60 __PACKAGE__->table_class('DBIx::Class::ResultSource::View');
62 __PACKAGE__->table('year2000cds');
63 __PACKAGE__->result_source_instance->is_virtual(1);
64 __PACKAGE__->result_source_instance->view_definition(
65 "SELECT cdid, artist, title FROM cd WHERE year ='2000'"
71 A ResultSource is an object that represents a source of data for querying.
73 This class is a base class for various specialised types of result
74 sources, for example L<DBIx::Class::ResultSource::Table>. Table is the
75 default result source type, so one is created for you when defining a
76 result class as described in the synopsis above.
78 More specifically, the L<DBIx::Class::Core> base class pulls in the
79 L<DBIx::Class::ResultSourceProxy::Table> component, which defines
80 the L<table|DBIx::Class::ResultSourceProxy::Table/table> method.
81 When called, C<table> creates and stores an instance of
82 L<DBIx::Class::ResultSource::Table>. Luckily, to use tables as result
83 sources, you don't need to remember any of this.
85 Result sources representing select queries, or views, can also be
86 created, see L<DBIx::Class::ResultSource::View> for full details.
88 =head2 Finding result source objects
90 As mentioned above, a result source instance is created and stored for
92 L<Result Class|DBIx::Class::Manual::Glossary/Result Class>.
94 You can retrieve the result source at runtime in the following ways:
98 =item From a Schema object:
100 $schema->source($source_name);
102 =item From a Result object:
104 $result->result_source;
106 =item From a ResultSet object:
118 $class->new({attribute_name => value});
120 Creates a new ResultSource object. Not normally called directly by end users.
126 my ($class, $attrs) = @_;
127 $class = ref $class if ref $class;
129 my $self = bless { %{$attrs || {}} }, $class;
132 DBIx::Class::_ENV_::ASSERT_NO_ERRONEOUS_METAINSTANCE_USE
134 # a constructor with 'name' as sole arg clearly isn't "inheriting" from anything
135 ( not ( keys(%$self) == 1 and exists $self->{name} ) )
137 defined CORE::caller(1)
139 (CORE::caller(1))[3] !~ / ::new$ | ^ DBIx::Class :: (?:
140 ResultSourceProxy::Table::table
142 ResultSourceProxy::Table::_init_result_source_instance
147 local $Carp::CarpLevel = $Carp::CarpLevel + 1
149 Carp::confess("Incorrect instantiation of '$self': you almost certainly wanted to call ->clone() instead");
152 $self->{resultset_class} ||= 'DBIx::Class::ResultSet';
153 $self->{name} ||= "!!NAME NOT SET!!";
154 $self->{_columns_info_loaded} ||= 0;
155 $self->{sqlt_deploy_callback} ||= 'default_sqlt_deploy_hook';
157 $self->{$_} = { %{ $self->{$_} || {} } }
158 for @hashref_attributes;
160 $self->{$_} = [ @{ $self->{$_} || [] } ]
161 for @arrayref_attributes;
169 $rsrc_instance->clone( atribute_name => overriden_value );
171 A wrapper around L</new> inheriting any defaults from the callee. This method
172 also not normally invoked directly by end users.
186 (@_ == 1 and ref $_[0] eq 'HASH')
199 =item Arguments: @columns
201 =item Return Value: L<$result_source|/new>
205 $source->add_columns(qw/col1 col2 col3/);
207 $source->add_columns('col1' => \%col1_info, 'col2' => \%col2_info, ...);
209 $source->add_columns(
210 'col1' => { data_type => 'integer', is_nullable => 1, ... },
211 'col2' => { data_type => 'text', is_auto_increment => 1, ... },
214 Adds columns to the result source. If supplied colname => hashref
215 pairs, uses the hashref as the L</column_info> for that column. Repeated
216 calls of this method will add more columns, not replace them.
218 The column names given will be created as accessor methods on your
219 L<Result|DBIx::Class::Manual::ResultClass> objects. You can change the name of the accessor
220 by supplying an L</accessor> in the column_info hash.
222 If a column name beginning with a plus sign ('+col1') is provided, the
223 attributes provided will be merged with any existing attributes for the
224 column, with the new attributes taking precedence in the case that an
225 attribute already exists. Using this without a hashref
226 (C<< $source->add_columns(qw/+col1 +col2/) >>) is legal, but useless --
227 it does the same thing it would do without the plus.
229 The contents of the column_info are not set in stone. The following
230 keys are currently recognised/used by DBIx::Class:
236 { accessor => '_name' }
238 # example use, replace standard accessor with one of your own:
240 my ($self, $value) = @_;
242 die "Name cannot contain digits!" if($value =~ /\d/);
243 $self->_name($value);
245 return $self->_name();
248 Use this to set the name of the accessor method for this column. If unset,
249 the name of the column will be used.
253 { data_type => 'integer' }
255 This contains the column type. It is automatically filled if you use the
256 L<SQL::Translator::Producer::DBIx::Class::File> producer, or the
257 L<DBIx::Class::Schema::Loader> module.
259 Currently there is no standard set of values for the data_type. Use
260 whatever your database supports.
266 The length of your column, if it is a column type that can have a size
267 restriction. This is currently only used to create tables from your
268 schema, see L<DBIx::Class::Schema/deploy>.
272 For decimal or float values you can specify an ArrayRef in order to
273 control precision, assuming your database's
274 L<SQL::Translator::Producer> supports it.
280 Set this to a true value for a column that is allowed to contain NULL
281 values, default is false. This is currently only used to create tables
282 from your schema, see L<DBIx::Class::Schema/deploy>.
284 =item is_auto_increment
286 { is_auto_increment => 1 }
288 Set this to a true value for a column whose value is somehow
289 automatically set, defaults to false. This is used to determine which
290 columns to empty when cloning objects using
291 L<DBIx::Class::Row/copy>. It is also used by
292 L<DBIx::Class::Schema/deploy>.
298 Set this to a true or false value (not C<undef>) to explicitly specify
299 if this column contains numeric data. This controls how set_column
300 decides whether to consider a column dirty after an update: if
301 C<is_numeric> is true a numeric comparison C<< != >> will take place
302 instead of the usual C<eq>
304 If not specified the storage class will attempt to figure this out on
305 first access to the column, based on the column C<data_type>. The
306 result will be cached in this attribute.
310 { is_foreign_key => 1 }
312 Set this to a true value for a column that contains a key from a
313 foreign table, defaults to false. This is currently only used to
314 create tables from your schema, see L<DBIx::Class::Schema/deploy>.
318 { default_value => \'now()' }
320 Set this to the default value which will be inserted into a column by
321 the database. Can contain either a value or a function (use a
322 reference to a scalar e.g. C<\'now()'> if you want a function). This
323 is currently only used to create tables from your schema, see
324 L<DBIx::Class::Schema/deploy>.
326 See the note on L<DBIx::Class::Row/new> for more information about possible
327 issues related to db-side default values.
331 { sequence => 'my_table_seq' }
333 Set this on a primary key column to the name of the sequence used to
334 generate a new key value. If not specified, L<DBIx::Class::PK::Auto>
335 will attempt to retrieve the name of the sequence from the database
338 =item retrieve_on_insert
340 { retrieve_on_insert => 1 }
342 For every column where this is set to true, DBIC will retrieve the RDBMS-side
343 value upon a new row insertion (normally only the autoincrement PK is
344 retrieved on insert). C<INSERT ... RETURNING> is used automatically if
345 supported by the underlying storage, otherwise an extra SELECT statement is
346 executed to retrieve the missing data.
350 { auto_nextval => 1 }
352 Set this to a true value for a column whose value is retrieved automatically
353 from a sequence or function (if supported by your Storage driver.) For a
354 sequence, if you do not use a trigger to get the nextval, you have to set the
355 L</sequence> value as well.
357 Also set this for MSSQL columns with the 'uniqueidentifier'
358 L<data_type|DBIx::Class::ResultSource/data_type> whose values you want to
359 automatically generate using C<NEWID()>, unless they are a primary key in which
360 case this will be done anyway.
364 This is used by L<DBIx::Class::Schema/deploy> and L<SQL::Translator>
365 to add extra non-generic data to the column. For example: C<< extra
366 => { unsigned => 1} >> is used by the MySQL producer to set an integer
367 column to unsigned. For more details, see
368 L<SQL::Translator::Producer::MySQL>.
376 =item Arguments: $colname, \%columninfo?
378 =item Return Value: 1/0 (true/false)
382 $source->add_column('col' => \%info);
384 Add a single column and optional column info. Uses the same column
385 info keys as L</add_columns>.
390 my ($self, @cols) = @_;
391 $self->_ordered_columns(\@cols) unless $self->_ordered_columns;
394 my $columns = $self->_columns;
395 while (my $col = shift @cols) {
396 my $column_info = {};
397 if ($col =~ s/^\+//) {
398 $column_info = $self->column_info($col);
401 # If next entry is { ... } use that for the column info, if not
402 # use an empty hashref
404 my $new_info = shift(@cols);
405 %$column_info = (%$column_info, %$new_info);
407 push(@added, $col) unless exists $columns->{$col};
408 $columns->{$col} = $column_info;
410 push @{ $self->_ordered_columns }, @added;
415 DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
416 shift->add_columns(@_)
423 =item Arguments: $colname
425 =item Return Value: 1/0 (true/false)
429 if ($source->has_column($colname)) { ... }
431 Returns true if the source has a column of this name, false otherwise.
436 my ($self, $column) = @_;
437 return exists $self->_columns->{$column};
444 =item Arguments: $colname
446 =item Return Value: Hashref of info
450 my $info = $source->column_info($col);
452 Returns the column metadata hashref for a column, as originally passed
453 to L</add_columns>. See L</add_columns> above for information on the
454 contents of the hashref.
459 my ($self, $column) = @_;
460 $self->throw_exception("No such column $column")
461 unless exists $self->_columns->{$column};
463 if ( ! $self->_columns->{$column}{data_type}
464 and ! $self->{_columns_info_loaded}
465 and $self->column_info_from_storage
466 and my $stor = dbic_internal_try { $self->schema->storage } )
468 $self->{_columns_info_loaded}++;
470 # try for the case of storage without table
472 my $info = $stor->columns_info_for( $self->from );
474 { (lc $_) => $info->{$_} }
478 foreach my $col ( keys %{$self->_columns} ) {
479 $self->_columns->{$col} = {
480 %{ $self->_columns->{$col} },
481 %{ $info->{$col} || $lc_info->{lc $col} || {} }
487 return $self->_columns->{$column};
494 =item Arguments: none
496 =item Return Value: Ordered list of column names
500 my @column_names = $source->columns;
502 Returns all column names in the order they were declared to L</add_columns>.
508 $self->throw_exception(
509 "columns() is a read-only accessor, did you mean add_columns()?"
511 return @{$self->{_ordered_columns}||[]};
518 =item Arguments: \@colnames ?
520 =item Return Value: Hashref of column name/info pairs
524 my $columns_info = $source->columns_info;
526 Like L</column_info> but returns information for the requested columns. If
527 the optional column-list arrayref is omitted it returns info on all columns
528 currently defined on the ResultSource via L</add_columns>.
533 my ($self, $columns) = @_;
535 my $colinfo = $self->_columns;
538 ! $self->{_columns_info_loaded}
540 $self->column_info_from_storage
542 grep { ! $_->{data_type} } values %$colinfo
544 my $stor = dbic_internal_try { $self->schema->storage }
546 $self->{_columns_info_loaded}++;
548 # try for the case of storage without table
550 my $info = $stor->columns_info_for( $self->from );
552 { (lc $_) => $info->{$_} }
556 foreach my $col ( keys %$colinfo ) {
558 %{ $colinfo->{$col} },
559 %{ $info->{$col} || $lc_info->{lc $col} || {} }
569 if (my $inf = $colinfo->{$_}) {
573 $self->throw_exception( sprintf (
574 "No such column '%s' on source '%s'",
576 $self->source_name || $self->name || 'Unknown source...?',
588 =head2 remove_columns
592 =item Arguments: @colnames
594 =item Return Value: not defined
598 $source->remove_columns(qw/col1 col2 col3/);
600 Removes the given list of columns by name, from the result source.
602 B<Warning>: Removing a column that is also used in the sources primary
603 key, or in one of the sources unique constraints, B<will> result in a
604 broken result source.
610 =item Arguments: $colname
612 =item Return Value: not defined
616 $source->remove_column('col');
618 Remove a single column by name from the result source, similar to
621 B<Warning>: Removing a column that is also used in the sources primary
622 key, or in one of the sources unique constraints, B<will> result in a
623 broken result source.
628 my ($self, @to_remove) = @_;
630 my $columns = $self->_columns
635 delete $columns->{$_};
639 $self->_ordered_columns([ grep { not $to_remove{$_} } @{$self->_ordered_columns} ]);
643 DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
644 shift->remove_columns(@_)
647 =head2 set_primary_key
651 =item Arguments: @cols
653 =item Return Value: not defined
657 Defines one or more columns as primary key for this source. Must be
658 called after L</add_columns>.
660 Additionally, defines a L<unique constraint|/add_unique_constraint>
663 Note: you normally do want to define a primary key on your sources
664 B<even if the underlying database table does not have a primary key>.
666 L<DBIx::Class::Manual::Intro/The Significance and Importance of Primary Keys>
671 sub set_primary_key {
672 my ($self, @cols) = @_;
674 my $colinfo = $self->columns_info(\@cols);
675 for my $col (@cols) {
676 carp_unique(sprintf (
677 "Primary key of source '%s' includes the column '%s' which has its "
678 . "'is_nullable' attribute set to true. This is a mistake and will cause "
679 . 'various Result-object operations to fail',
680 $self->source_name || $self->name || 'Unknown source...?',
682 )) if $colinfo->{$col}{is_nullable};
685 $self->_primaries(\@cols);
687 $self->add_unique_constraint(primary => \@cols);
690 =head2 primary_columns
694 =item Arguments: none
696 =item Return Value: Ordered list of primary column names
700 Read-only accessor which returns the list of primary keys, supplied by
705 sub primary_columns {
706 return @{shift->_primaries||[]};
709 # a helper method that will automatically die with a descriptive message if
710 # no pk is defined on the source in question. For internal use to save
711 # on if @pks... boilerplate
712 sub _pri_cols_or_die {
714 my @pcols = $self->primary_columns
715 or $self->throw_exception (sprintf(
716 "Operation requires a primary key to be declared on '%s' via set_primary_key",
717 # source_name is set only after schema-registration
718 $self->source_name || $self->result_class || $self->name || 'Unknown source...?',
723 # same as above but mandating single-column PK (used by relationship condition
725 sub _single_pri_col_or_die {
727 my ($pri, @too_many) = $self->_pri_cols_or_die;
729 $self->throw_exception( sprintf(
730 "Operation requires a single-column primary key declared on '%s'",
731 $self->source_name || $self->result_class || $self->name || 'Unknown source...?',
739 Manually define the correct sequence for your table, to avoid the overhead
740 associated with looking up the sequence automatically. The supplied sequence
741 will be applied to the L</column_info> of each L<primary_key|/set_primary_key>
745 =item Arguments: $sequence_name
747 =item Return Value: not defined
754 my ($self,$seq) = @_;
756 my @pks = $self->primary_columns
759 $_->{sequence} = $seq
760 for values %{ $self->columns_info (\@pks) };
764 =head2 add_unique_constraint
768 =item Arguments: $name?, \@colnames
770 =item Return Value: not defined
774 Declare a unique constraint on this source. Call once for each unique
777 # For UNIQUE (column1, column2)
778 __PACKAGE__->add_unique_constraint(
779 constraint_name => [ qw/column1 column2/ ],
782 Alternatively, you can specify only the columns:
784 __PACKAGE__->add_unique_constraint([ qw/column1 column2/ ]);
786 This will result in a unique constraint named
787 C<table_column1_column2>, where C<table> is replaced with the table
790 Unique constraints are used, for example, when you pass the constraint
791 name as the C<key> attribute to L<DBIx::Class::ResultSet/find>. Then
792 only columns in the constraint are searched.
794 Throws an error if any of the given column names do not yet exist on
799 sub add_unique_constraint {
803 $self->throw_exception(
804 'add_unique_constraint() does not accept multiple constraints, use '
805 . 'add_unique_constraints() instead'
810 if (ref $cols ne 'ARRAY') {
811 $self->throw_exception (
812 'Expecting an arrayref of constraint columns, got ' . ($cols||'NOTHING')
818 $name ||= $self->name_unique_constraint($cols);
820 foreach my $col (@$cols) {
821 $self->throw_exception("No such column $col on table " . $self->name)
822 unless $self->has_column($col);
825 my %unique_constraints = $self->unique_constraints;
826 $unique_constraints{$name} = $cols;
827 $self->_unique_constraints(\%unique_constraints);
830 =head2 add_unique_constraints
834 =item Arguments: @constraints
836 =item Return Value: not defined
840 Declare multiple unique constraints on this source.
842 __PACKAGE__->add_unique_constraints(
843 constraint_name1 => [ qw/column1 column2/ ],
844 constraint_name2 => [ qw/column2 column3/ ],
847 Alternatively, you can specify only the columns:
849 __PACKAGE__->add_unique_constraints(
850 [ qw/column1 column2/ ],
851 [ qw/column3 column4/ ]
854 This will result in unique constraints named C<table_column1_column2> and
855 C<table_column3_column4>, where C<table> is replaced with the table name.
857 Throws an error if any of the given column names do not yet exist on
860 See also L</add_unique_constraint>.
864 sub add_unique_constraints {
865 DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
868 my @constraints = @_;
870 if ( !(@constraints % 2) && grep { ref $_ ne 'ARRAY' } @constraints ) {
871 # with constraint name
872 while (my ($name, $constraint) = splice @constraints, 0, 2) {
873 $self->add_unique_constraint($name => $constraint);
878 foreach my $constraint (@constraints) {
879 $self->add_unique_constraint($constraint);
884 =head2 name_unique_constraint
888 =item Arguments: \@colnames
890 =item Return Value: Constraint name
894 $source->table('mytable');
895 $source->name_unique_constraint(['col1', 'col2']);
899 Return a name for a unique constraint containing the specified
900 columns. The name is created by joining the table name and each column
901 name, using an underscore character.
903 For example, a constraint on a table named C<cd> containing the columns
904 C<artist> and C<title> would result in a constraint name of C<cd_artist_title>.
906 This is used by L</add_unique_constraint> if you do not specify the
907 optional constraint name.
911 sub name_unique_constraint {
912 my ($self, $cols) = @_;
914 my $name = $self->name;
915 $name = $$name if (ref $name eq 'SCALAR');
916 $name =~ s/ ^ [^\.]+ \. //x; # strip possible schema qualifier
918 return join '_', $name, @$cols;
921 =head2 unique_constraints
925 =item Arguments: none
927 =item Return Value: Hash of unique constraint data
931 $source->unique_constraints();
933 Read-only accessor which returns a hash of unique constraints on this
936 The hash is keyed by constraint name, and contains an arrayref of
937 column names as values.
941 sub unique_constraints {
942 return %{shift->_unique_constraints||{}};
945 =head2 unique_constraint_names
949 =item Arguments: none
951 =item Return Value: Unique constraint names
955 $source->unique_constraint_names();
957 Returns the list of unique constraint names defined on this source.
961 sub unique_constraint_names {
964 my %unique_constraints = $self->unique_constraints;
966 return keys %unique_constraints;
969 =head2 unique_constraint_columns
973 =item Arguments: $constraintname
975 =item Return Value: List of constraint columns
979 $source->unique_constraint_columns('myconstraint');
981 Returns the list of columns that make up the specified unique constraint.
985 sub unique_constraint_columns {
986 my ($self, $constraint_name) = @_;
988 my %unique_constraints = $self->unique_constraints;
990 $self->throw_exception(
991 "Unknown unique constraint $constraint_name on '" . $self->name . "'"
992 ) unless exists $unique_constraints{$constraint_name};
994 return @{ $unique_constraints{$constraint_name} };
997 =head2 sqlt_deploy_callback
1001 =item Arguments: $callback_name | \&callback_code
1003 =item Return Value: $callback_name | \&callback_code
1007 __PACKAGE__->result_source_instance->sqlt_deploy_callback('mycallbackmethod');
1011 __PACKAGE__->result_source_instance->sqlt_deploy_callback(sub {
1012 my ($source_instance, $sqlt_table) = @_;
1016 An accessor to set a callback to be called during deployment of
1017 the schema via L<DBIx::Class::Schema/create_ddl_dir> or
1018 L<DBIx::Class::Schema/deploy>.
1020 The callback can be set as either a code reference or the name of a
1021 method in the current result class.
1023 Defaults to L</default_sqlt_deploy_hook>.
1025 Your callback will be passed the $source object representing the
1026 ResultSource instance being deployed, and the
1027 L<SQL::Translator::Schema::Table> object being created from it. The
1028 callback can be used to manipulate the table object or add your own
1029 customised indexes. If you need to manipulate a non-table object, use
1030 the L<DBIx::Class::Schema/sqlt_deploy_hook>.
1032 See L<DBIx::Class::Manual::Cookbook/Adding Indexes And Functions To
1033 Your SQL> for examples.
1035 This sqlt deployment callback can only be used to manipulate
1036 SQL::Translator objects as they get turned into SQL. To execute
1037 post-deploy statements which SQL::Translator does not currently
1038 handle, override L<DBIx::Class::Schema/deploy> in your Schema class
1039 and call L<dbh_do|DBIx::Class::Storage::DBI/dbh_do>.
1041 =head2 default_sqlt_deploy_hook
1043 This is the default deploy hook implementation which checks if your
1044 current Result class has a C<sqlt_deploy_hook> method, and if present
1045 invokes it B<on the Result class directly>. This is to preserve the
1046 semantics of C<sqlt_deploy_hook> which was originally designed to expect
1047 the Result class name and the
1048 L<$sqlt_table instance|SQL::Translator::Schema::Table> of the table being
1053 sub default_sqlt_deploy_hook {
1056 my $class = $self->result_class;
1058 if ($class and $class->can('sqlt_deploy_hook')) {
1059 $class->sqlt_deploy_hook(@_);
1063 sub _invoke_sqlt_deploy_hook {
1065 if ( my $hook = $self->sqlt_deploy_callback) {
1074 =item Arguments: $classname
1076 =item Return Value: $classname
1080 use My::Schema::ResultClass::Inflator;
1083 use My::Schema::Artist;
1085 __PACKAGE__->result_class('My::Schema::ResultClass::Inflator');
1087 Set the default result class for this source. You can use this to create
1088 and use your own result inflator. See L<DBIx::Class::ResultSet/result_class>
1091 Please note that setting this to something like
1092 L<DBIx::Class::ResultClass::HashRefInflator> will make every result unblessed
1093 and make life more difficult. Inflators like those are better suited to
1094 temporary usage via L<DBIx::Class::ResultSet/result_class>.
1100 =item Arguments: none
1102 =item Return Value: L<$resultset|DBIx::Class::ResultSet>
1106 Returns a resultset for the given source. This will initially be created
1107 on demand by calling
1109 $self->resultset_class->new($self, $self->resultset_attributes)
1111 but is cached from then on unless resultset_class changes.
1113 =head2 resultset_class
1117 =item Arguments: $classname
1119 =item Return Value: $classname
1123 package My::Schema::ResultSet::Artist;
1124 use base 'DBIx::Class::ResultSet';
1127 # In the result class
1128 __PACKAGE__->resultset_class('My::Schema::ResultSet::Artist');
1131 $source->resultset_class('My::Schema::ResultSet::Artist');
1133 Set the class of the resultset. This is useful if you want to create your
1134 own resultset methods. Create your own class derived from
1135 L<DBIx::Class::ResultSet>, and set it here. If called with no arguments,
1136 this method returns the name of the existing resultset class, if one
1139 =head2 resultset_attributes
1143 =item Arguments: L<\%attrs|DBIx::Class::ResultSet/ATTRIBUTES>
1145 =item Return Value: L<\%attrs|DBIx::Class::ResultSet/ATTRIBUTES>
1149 # In the result class
1150 __PACKAGE__->resultset_attributes({ order_by => [ 'id' ] });
1153 $source->resultset_attributes({ order_by => [ 'id' ] });
1155 Store a collection of resultset attributes, that will be set on every
1156 L<DBIx::Class::ResultSet> produced from this result source.
1158 B<CAVEAT>: C<resultset_attributes> comes with its own set of issues and
1159 bugs! Notably the contents of the attributes are B<entirely static>, which
1160 greatly hinders composability (things like L<current_source_alias
1161 |DBIx::Class::ResultSet/current_source_alias> can not possibly be respected).
1162 While C<resultset_attributes> isn't deprecated per se, you are strongly urged
1163 to seek alternatives.
1165 Since relationships use attributes to link tables together, the "default"
1166 attributes you set may cause unpredictable and undesired behavior. Furthermore,
1167 the defaults B<cannot be turned off>, so you are stuck with them.
1169 In most cases, what you should actually be using are project-specific methods:
1171 package My::Schema::ResultSet::Artist;
1172 use base 'DBIx::Class::ResultSet';
1176 #__PACKAGE__->resultset_attributes({ prefetch => 'tracks' });
1179 sub with_tracks { shift->search({}, { prefetch => 'tracks' }) }
1182 $schema->resultset('Artist')->with_tracks->...
1184 This gives you the flexibility of not using it when you don't need it.
1186 For more complex situations, another solution would be to use a virtual view
1187 via L<DBIx::Class::ResultSource::View>.
1193 $self->throw_exception(
1194 'resultset does not take any arguments. If you want another resultset, '.
1195 'call it on the schema instead.'
1198 $self->resultset_class->new(
1201 ( dbic_internal_try { %{$self->schema->default_resultset_attributes} } ),
1202 %{$self->{resultset_attributes}},
1211 =item Arguments: none
1213 =item Result value: $name
1217 Returns the name of the result source, which will typically be the table
1218 name. This may be a scalar reference if the result source has a non-standard
1225 =item Arguments: $source_name
1227 =item Result value: $source_name
1231 Set an alternate name for the result source when it is loaded into a schema.
1232 This is useful if you want to refer to a result source by a name other than
1235 package ArchivedBooks;
1236 use base qw/DBIx::Class/;
1237 __PACKAGE__->table('books_archive');
1238 __PACKAGE__->source_name('Books');
1240 # from your schema...
1241 $schema->resultset('Books')->find(1);
1247 =item Arguments: none
1249 =item Return Value: FROM clause
1253 my $from_clause = $source->from();
1255 Returns an expression of the source to be supplied to storage to specify
1256 retrieval from this source. In the case of a database, the required FROM
1261 sub from { die 'Virtual method!' }
1265 Stores a hashref of per-source metadata. No specific key names
1266 have yet been standardized, the examples below are purely hypothetical
1267 and don't actually accomplish anything on their own:
1269 __PACKAGE__->source_info({
1270 "_tablespace" => 'fast_disk_array_3',
1271 "_engine" => 'InnoDB',
1278 =item Arguments: L<$schema?|DBIx::Class::Schema>
1280 =item Return Value: L<$schema|DBIx::Class::Schema>
1284 my $schema = $source->schema();
1286 Sets and/or returns the L<DBIx::Class::Schema> object to which this
1287 result source instance has been attached to.
1293 $_[0]->{schema} = $_[1];
1296 $_[0]->{schema} || do {
1297 my $name = $_[0]->{source_name} || '_unnamed_';
1298 my $err = 'Unable to perform storage-dependent operations with a detached result source '
1299 . "(source '$name' is not associated with a schema).";
1301 $err .= ' You need to use $schema->thaw() or manually set'
1302 . ' $DBIx::Class::ResultSourceHandle::thaw_schema while thawing.'
1303 if $_[0]->{_detached_thaw};
1305 DBIx::Class::Exception->throw($err);
1314 =item Arguments: none
1316 =item Return Value: L<$storage|DBIx::Class::Storage>
1320 $source->storage->debug(1);
1322 Returns the L<storage handle|DBIx::Class::Storage> for the current schema.
1327 DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
1328 $_[0]->schema->storage
1331 =head2 add_relationship
1335 =item Arguments: $rel_name, $related_source_name, \%cond, \%attrs?
1337 =item Return Value: 1/true if it succeeded
1341 $source->add_relationship('rel_name', 'related_source', $cond, $attrs);
1343 L<DBIx::Class::Relationship> describes a series of methods which
1344 create pre-defined useful types of relationships. Look there first
1345 before using this method directly.
1347 The relationship name can be arbitrary, but must be unique for each
1348 relationship attached to this result source. 'related_source' should
1349 be the name with which the related result source was registered with
1350 the current schema. For example:
1352 $schema->source('Book')->add_relationship('reviews', 'Review', {
1353 'foreign.book_id' => 'self.id',
1356 The condition C<$cond> needs to be an L<SQL::Abstract>-style
1357 representation of the join between the tables. For example, if you're
1358 creating a relation from Author to Book,
1360 { 'foreign.author_id' => 'self.id' }
1362 will result in the JOIN clause
1364 author me JOIN book foreign ON foreign.author_id = me.id
1366 You can specify as many foreign => self mappings as necessary.
1368 Valid attributes are as follows:
1374 Explicitly specifies the type of join to use in the relationship. Any
1375 SQL join type is valid, e.g. C<LEFT> or C<RIGHT>. It will be placed in
1376 the SQL command immediately before C<JOIN>.
1380 An arrayref containing a list of accessors in the foreign class to proxy in
1381 the main class. If, for example, you do the following:
1383 CD->might_have(liner_notes => 'LinerNotes', undef, {
1384 proxy => [ qw/notes/ ],
1387 Then, assuming LinerNotes has an accessor named notes, you can do:
1389 my $cd = CD->find(1);
1390 # set notes -- LinerNotes object is created if it doesn't exist
1391 $cd->notes('Notes go here');
1395 Specifies the type of accessor that should be created for the
1396 relationship. Valid values are C<single> (for when there is only a single
1397 related object), C<multi> (when there can be many), and C<filter> (for
1398 when there is a single related object, but you also want the relationship
1399 accessor to double as a column accessor). For C<multi> accessors, an
1400 add_to_* method is also created, which calls C<create_related> for the
1405 Throws an exception if the condition is improperly supplied, or cannot
1410 sub add_relationship {
1411 my ($self, $rel, $f_source_name, $cond, $attrs) = @_;
1412 $self->throw_exception("Can't create relationship without join condition")
1416 # Check foreign and self are right in cond
1417 if ( (ref $cond ||'') eq 'HASH') {
1418 $_ =~ /^foreign\./ or $self->throw_exception("Malformed relationship condition key '$_': must be prefixed with 'foreign.'")
1421 $_ =~ /^self\./ or $self->throw_exception("Malformed relationship condition value '$_': must be prefixed with 'self.'")
1425 my %rels = %{ $self->_relationships };
1426 $rels{$rel} = { class => $f_source_name,
1427 source => $f_source_name,
1430 $self->_relationships(\%rels);
1435 =head2 relationships
1439 =item Arguments: none
1441 =item Return Value: L<@rel_names|DBIx::Class::Relationship>
1445 my @rel_names = $source->relationships();
1447 Returns all relationship names for this source.
1452 keys %{$_[0]->_relationships};
1455 =head2 relationship_info
1459 =item Arguments: L<$rel_name|DBIx::Class::Relationship>
1461 =item Return Value: L<\%rel_data|DBIx::Class::Relationship::Base/add_relationship>
1465 Returns a hash of relationship information for the specified relationship
1466 name. The keys/values are as specified for L<DBIx::Class::Relationship::Base/add_relationship>.
1470 sub relationship_info {
1471 #my ($self, $rel) = @_;
1472 return shift->_relationships->{+shift};
1475 =head2 has_relationship
1479 =item Arguments: L<$rel_name|DBIx::Class::Relationship>
1481 =item Return Value: 1/0 (true/false)
1485 Returns true if the source has a relationship of this name, false otherwise.
1489 sub has_relationship {
1490 #my ($self, $rel) = @_;
1491 return exists shift->_relationships->{+shift};
1494 =head2 reverse_relationship_info
1498 =item Arguments: L<$rel_name|DBIx::Class::Relationship>
1500 =item Return Value: L<\%rel_data|DBIx::Class::Relationship::Base/add_relationship>
1504 Looks through all the relationships on the source this relationship
1505 points to, looking for one whose condition is the reverse of the
1506 condition on this relationship.
1508 A common use of this is to find the name of the C<belongs_to> relation
1509 opposing a C<has_many> relation. For definition of these look in
1510 L<DBIx::Class::Relationship>.
1512 The returned hashref is keyed by the name of the opposing
1513 relationship, and contains its data in the same manner as
1514 L</relationship_info>.
1518 sub reverse_relationship_info {
1519 my ($self, $rel) = @_;
1521 my $rel_info = $self->relationship_info($rel)
1522 or $self->throw_exception("No such relationship '$rel'");
1526 return $ret unless ((ref $rel_info->{cond}) eq 'HASH');
1528 my $stripped_cond = $self->__strip_relcond ($rel_info->{cond});
1530 my $registered_source_name = $self->source_name;
1532 # this may be a partial schema or something else equally esoteric
1533 my $other_rsrc = $self->related_source($rel);
1535 # Get all the relationships for that source that related to this source
1536 # whose foreign column set are our self columns on $rel and whose self
1537 # columns are our foreign columns on $rel
1538 foreach my $other_rel ($other_rsrc->relationships) {
1540 # only consider stuff that points back to us
1541 # "us" here is tricky - if we are in a schema registration, we want
1542 # to use the source_names, otherwise we will use the actual classes
1544 # the schema may be partial
1545 my $roundtrip_rsrc = dbic_internal_try { $other_rsrc->related_source($other_rel) }
1548 if ($registered_source_name) {
1549 next if $registered_source_name ne ($roundtrip_rsrc->source_name || '')
1552 next if $self->result_class ne $roundtrip_rsrc->result_class;
1555 my $other_rel_info = $other_rsrc->relationship_info($other_rel);
1557 # this can happen when we have a self-referential class
1558 next if $other_rel_info eq $rel_info;
1560 next unless ref $other_rel_info->{cond} eq 'HASH';
1561 my $other_stripped_cond = $self->__strip_relcond($other_rel_info->{cond});
1563 $ret->{$other_rel} = $other_rel_info if (
1564 $self->_compare_relationship_keys (
1565 [ keys %$stripped_cond ], [ values %$other_stripped_cond ]
1568 $self->_compare_relationship_keys (
1569 [ values %$stripped_cond ], [ keys %$other_stripped_cond ]
1577 # all this does is removes the foreign/self prefix from a condition
1578 sub __strip_relcond {
1581 { map { /^ (?:foreign|self) \. (\w+) $/x } ($_, $_[1]{$_}) }
1586 sub compare_relationship_keys {
1587 carp 'compare_relationship_keys is a private method, stop calling it';
1589 $self->_compare_relationship_keys (@_);
1592 # Returns true if both sets of keynames are the same, false otherwise.
1593 sub _compare_relationship_keys {
1594 # my ($self, $keys1, $keys2) = @_;
1596 join ("\x00", sort @{$_[1]})
1598 join ("\x00", sort @{$_[2]})
1602 # optionally takes either an arrayref of column names, or a hashref of already
1603 # retrieved colinfos
1604 # returns an arrayref of column names of the shortest unique constraint
1605 # (matching some of the input if any), giving preference to the PK
1606 sub _identifying_column_set {
1607 my ($self, $cols) = @_;
1609 my %unique = $self->unique_constraints;
1610 my $colinfos = ref $cols eq 'HASH' ? $cols : $self->columns_info($cols||());
1612 # always prefer the PK first, and then shortest constraints first
1614 for my $set (delete $unique{primary}, sort { @$a <=> @$b } (values %unique) ) {
1615 next unless $set && @$set;
1618 next USET unless ($colinfos->{$_} && !$colinfos->{$_}{is_nullable} );
1621 # copy so we can mangle it at will
1628 sub _minimal_valueset_satisfying_constraint {
1630 my $args = { ref $_[0] eq 'HASH' ? %{ $_[0] } : @_ };
1632 $args->{columns_info} ||= $self->columns_info;
1634 my $vals = $self->schema->storage->_extract_fixed_condition_columns(
1636 ($args->{carp_on_nulls} ? 'consider_nulls' : undef ),
1640 for my $col ($self->unique_constraint_columns($args->{constraint_name}) ) {
1641 if( ! exists $vals->{$col} or ( $vals->{$col}||'' ) eq UNRESOLVABLE_CONDITION ) {
1642 $cols->{missing}{$col} = undef;
1644 elsif( ! defined $vals->{$col} ) {
1645 $cols->{$args->{carp_on_nulls} ? 'undefined' : 'missing'}{$col} = undef;
1648 # we need to inject back the '=' as _extract_fixed_condition_columns
1649 # will strip it from literals and values alike, resulting in an invalid
1650 # condition in the end
1651 $cols->{present}{$col} = { '=' => $vals->{$col} };
1654 $cols->{fc}{$col} = 1 if (
1655 ( ! $cols->{missing} or ! exists $cols->{missing}{$col} )
1657 keys %{ $args->{columns_info}{$col}{_filter_info} || {} }
1661 $self->throw_exception( sprintf ( "Unable to satisfy requested constraint '%s', missing values for column(s): %s",
1662 $args->{constraint_name},
1663 join (', ', map { "'$_'" } sort keys %{$cols->{missing}} ),
1664 ) ) if $cols->{missing};
1666 $self->throw_exception( sprintf (
1667 "Unable to satisfy requested constraint '%s', FilterColumn values not usable for column(s): %s",
1668 $args->{constraint_name},
1669 join (', ', map { "'$_'" } sort keys %{$cols->{fc}}),
1675 !$ENV{DBIC_NULLABLE_KEY_NOWARN}
1677 carp_unique ( sprintf (
1678 "NULL/undef values supplied for requested unique constraint '%s' (NULL "
1679 . 'values in column(s): %s). This is almost certainly not what you wanted, '
1680 . 'though you can set DBIC_NULLABLE_KEY_NOWARN to disable this warning.',
1681 $args->{constraint_name},
1682 join (', ', map { "'$_'" } sort keys %{$cols->{undefined}}),
1686 return { map { %{ $cols->{$_}||{} } } qw(present undefined) };
1689 # Returns the {from} structure used to express JOIN conditions
1691 my ($self, $join, $alias, $seen, $jpath, $parent_force_left) = @_;
1693 # we need a supplied one, because we do in-place modifications, no returns
1694 $self->throw_exception ('You must supply a seen hashref as the 3rd argument to _resolve_join')
1695 unless ref $seen eq 'HASH';
1697 $self->throw_exception ('You must supply a joinpath arrayref as the 4th argument to _resolve_join')
1698 unless ref $jpath eq 'ARRAY';
1700 $jpath = [@$jpath]; # copy
1702 if (not defined $join or not length $join) {
1705 elsif (ref $join eq 'ARRAY') {
1708 $self->_resolve_join($_, $alias, $seen, $jpath, $parent_force_left);
1711 elsif (ref $join eq 'HASH') {
1714 for my $rel (keys %$join) {
1716 my $rel_info = $self->relationship_info($rel)
1717 or $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
1719 my $force_left = $parent_force_left;
1720 $force_left ||= lc($rel_info->{attrs}{join_type}||'') eq 'left';
1722 # the actual seen value will be incremented by the recursion
1723 my $as = $self->schema->storage->relname_to_table_alias(
1724 $rel, ($seen->{$rel} && $seen->{$rel} + 1)
1728 $self->_resolve_join($rel, $alias, $seen, [@$jpath], $force_left),
1729 $self->related_source($rel)->_resolve_join(
1730 $join->{$rel}, $as, $seen, [@$jpath, { $rel => $as }], $force_left
1738 $self->throw_exception("No idea how to resolve join reftype ".ref $join);
1741 my $count = ++$seen->{$join};
1742 my $as = $self->schema->storage->relname_to_table_alias(
1743 $join, ($count > 1 && $count)
1746 my $rel_info = $self->relationship_info($join)
1747 or $self->throw_exception("No such relationship $join on " . $self->source_name);
1749 my $rel_src = $self->related_source($join);
1750 return [ { $as => $rel_src->from,
1752 -join_type => $parent_force_left
1754 : $rel_info->{attrs}{join_type}
1756 -join_path => [@$jpath, { $join => $as } ],
1758 ! $rel_info->{attrs}{accessor}
1760 $rel_info->{attrs}{accessor} eq 'single'
1762 $rel_info->{attrs}{accessor} eq 'filter'
1765 -relation_chain_depth => ( $seen->{-relation_chain_depth} || 0 ) + 1,
1767 $self->_resolve_relationship_condition(
1769 self_alias => $alias,
1770 foreign_alias => $as,
1777 carp 'pk_depends_on is a private method, stop calling it';
1779 $self->_pk_depends_on (@_);
1782 # Determines whether a relation is dependent on an object from this source
1783 # having already been inserted. Takes the name of the relationship and a
1784 # hashref of columns of the related object.
1785 sub _pk_depends_on {
1786 my ($self, $rel_name, $rel_data) = @_;
1788 my $relinfo = $self->relationship_info($rel_name);
1790 # don't assume things if the relationship direction is specified
1791 return $relinfo->{attrs}{is_foreign_key_constraint}
1792 if exists ($relinfo->{attrs}{is_foreign_key_constraint});
1794 my $cond = $relinfo->{cond};
1795 return 0 unless ref($cond) eq 'HASH';
1797 # map { foreign.foo => 'self.bar' } to { bar => 'foo' }
1798 my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond };
1800 # assume anything that references our PK probably is dependent on us
1801 # rather than vice versa, unless the far side is (a) defined or (b)
1803 my $rel_source = $self->related_source($rel_name);
1805 foreach my $p ($self->primary_columns) {
1806 if (exists $keyhash->{$p}) {
1807 unless (defined($rel_data->{$keyhash->{$p}})
1808 || $rel_source->column_info($keyhash->{$p})
1809 ->{is_auto_increment}) {
1818 sub resolve_condition {
1819 carp 'resolve_condition is a private method, stop calling it';
1820 shift->_resolve_condition (@_);
1823 sub _resolve_condition {
1824 # carp_unique sprintf
1825 # '_resolve_condition is a private method, and moreover is about to go '
1826 # . 'away. Please contact the development team at %s if you believe you '
1827 # . 'have a genuine use for this method, in order to discuss alternatives.',
1828 # DBIx::Class::_ENV_::HELP_URL,
1831 #######################
1832 ### API Design? What's that...? (a backwards compatible shim, kill me now)
1834 my ($self, $cond, @res_args, $rel_name);
1836 # we *SIMPLY DON'T KNOW YET* which arg is which, yay
1837 ($self, $cond, $res_args[0], $res_args[1], $rel_name) = @_;
1839 # assume that an undef is an object-like unset (set_from_related(undef))
1840 my @is_objlike = map { ! defined $_ or length ref $_ } (@res_args);
1842 # turn objlike into proper objects for saner code further down
1844 next unless $is_objlike[$_];
1846 if ( defined blessed $res_args[$_] ) {
1848 # but wait - there is more!!! WHAT THE FUCK?!?!?!?!
1849 if ($res_args[$_]->isa('DBIx::Class::ResultSet')) {
1850 carp('Passing a resultset for relationship resolution makes no sense - invoking __gremlins__');
1851 $is_objlike[$_] = 0;
1852 $res_args[$_] = '__gremlins__';
1856 $res_args[$_] ||= {};
1858 # hate everywhere - have to pass in as a plain hash
1859 # pretending to be an object at least for now
1860 $self->throw_exception("Unsupported object-like structure encountered: $res_args[$_]")
1861 unless ref $res_args[$_] eq 'HASH';
1866 # where-is-waldo block guesses relname, then further down we override it if available
1868 $is_objlike[1] ? ( rel_name => $res_args[0], self_alias => $res_args[0], foreign_alias => 'me', self_result_object => $res_args[1] )
1869 : $is_objlike[0] ? ( rel_name => $res_args[1], self_alias => 'me', foreign_alias => $res_args[1], foreign_values => $res_args[0] )
1870 : ( rel_name => $res_args[0], self_alias => $res_args[1], foreign_alias => $res_args[0] )
1873 ( $rel_name ? ( rel_name => $rel_name ) : () ),
1876 # Allowing passing relconds different than the relationshup itself is cute,
1877 # but likely dangerous. Remove that from the (still unofficial) API of
1878 # _resolve_relationship_condition, and instead make it "hard on purpose"
1879 local $self->relationship_info( $args->{rel_name} )->{cond} = $cond if defined $cond;
1881 #######################
1883 # now it's fucking easy isn't it?!
1884 my $rc = $self->_resolve_relationship_condition( $args );
1887 ( $rc->{join_free_condition} || $rc->{condition} ),
1888 ! $rc->{join_free_condition},
1891 # _resolve_relationship_condition always returns qualified cols even in the
1892 # case of join_free_condition, but nothing downstream expects this
1893 if ($rc->{join_free_condition} and ref $res[0] eq 'HASH') {
1895 { ($_ =~ /\.(.+)/) => $res[0]{$_} }
1901 return wantarray ? @res : $res[0];
1904 # Keep this indefinitely. There is evidence of both CPAN and
1905 # darkpan using it, and there isn't much harm in an extra var
1907 our $UNRESOLVABLE_CONDITION = UNRESOLVABLE_CONDITION;
1908 # YES I KNOW THIS IS EVIL
1909 # it is there to save darkpan from themselves, since internally
1910 # we are moving to a constant
1911 Internals::SvREADONLY($UNRESOLVABLE_CONDITION => 1);
1913 # Resolves the passed condition to a concrete query fragment and extra
1916 ## self-explanatory API, modeled on the custom cond coderef:
1917 # rel_name => (scalar)
1918 # foreign_alias => (scalar)
1919 # foreign_values => (either not supplied, or a hashref, or a foreign ResultObject (to be ->get_columns()ed), or plain undef )
1920 # self_alias => (scalar)
1921 # self_result_object => (either not supplied or a result object)
1922 # require_join_free_condition => (boolean, throws on failure to construct a JF-cond)
1923 # infer_values_based_on => (either not supplied or a hashref, implies require_join_free_condition)
1926 # condition => (a valid *likely fully qualified* sqla cond structure)
1927 # identity_map => (a hashref of foreign-to-self *unqualified* column equality names)
1928 # join_free_condition => (a valid *fully qualified* sqla cond structure, maybe unset)
1929 # inferred_values => (in case of an available join_free condition, this is a hashref of
1930 # *unqualified* column/value *EQUALITY* pairs, representing an amalgamation
1931 # of the JF-cond parse and infer_values_based_on
1932 # always either complete or unset)
1934 sub _resolve_relationship_condition {
1937 my $args = { ref $_[0] eq 'HASH' ? %{ $_[0] } : @_ };
1939 for ( qw( rel_name self_alias foreign_alias ) ) {
1940 $self->throw_exception("Mandatory argument '$_' to _resolve_relationship_condition() is not a plain string")
1941 if !defined $args->{$_} or length ref $args->{$_};
1944 $self->throw_exception("Arguments 'self_alias' and 'foreign_alias' may not be identical")
1945 if $args->{self_alias} eq $args->{foreign_alias};
1948 my $exception_rel_id = "relationship '$args->{rel_name}' on source '@{[ $self->source_name ]}'";
1950 my $rel_info = $self->relationship_info($args->{rel_name})
1952 # or $self->throw_exception( "No such $exception_rel_id" );
1953 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");
1956 $exception_rel_id = "relationship '$rel_info->{_original_name}' on source '@{[ $self->source_name ]}'"
1957 if $rel_info and exists $rel_info->{_original_name};
1959 $self->throw_exception("No practical way to resolve $exception_rel_id between two data structures")
1960 if exists $args->{self_result_object} and exists $args->{foreign_values};
1962 $self->throw_exception( "Argument to infer_values_based_on must be a hash" )
1963 if exists $args->{infer_values_based_on} and ref $args->{infer_values_based_on} ne 'HASH';
1965 $args->{require_join_free_condition} ||= !!$args->{infer_values_based_on};
1967 $self->throw_exception( "Argument 'self_result_object' must be an object inheriting from DBIx::Class::Row" )
1969 exists $args->{self_result_object}
1971 ( ! defined blessed $args->{self_result_object} or ! $args->{self_result_object}->isa('DBIx::Class::Row') )
1975 my $rel_rsrc = $self->related_source($args->{rel_name});
1976 my $storage = $self->schema->storage;
1978 if (exists $args->{foreign_values}) {
1980 if (! defined $args->{foreign_values} ) {
1981 # fallback: undef => {}
1982 $args->{foreign_values} = {};
1984 elsif (defined blessed $args->{foreign_values}) {
1986 $self->throw_exception( "Objects supplied as 'foreign_values' ($args->{foreign_values}) must inherit from DBIx::Class::Row" )
1987 unless $args->{foreign_values}->isa('DBIx::Class::Row');
1990 "Objects supplied as 'foreign_values' ($args->{foreign_values}) "
1991 . "usually should inherit from the related ResultClass ('@{[ $rel_rsrc->result_class ]}'), "
1992 . "perhaps you've made a mistake invoking the condition resolver?"
1993 ) unless $args->{foreign_values}->isa($rel_rsrc->result_class);
1995 $args->{foreign_values} = { $args->{foreign_values}->get_columns };
1997 elsif ( ref $args->{foreign_values} eq 'HASH' ) {
1999 # re-build {foreign_values} excluding identically named rels
2000 if( keys %{$args->{foreign_values}} ) {
2002 my ($col_idx, $rel_idx) = map
2003 { { map { $_ => 1 } $rel_rsrc->$_ } }
2004 qw( columns relationships )
2007 my $equivalencies = $storage->_extract_fixed_condition_columns(
2008 $args->{foreign_values},
2012 $args->{foreign_values} = { map {
2013 # skip if relationship *and* a non-literal ref
2014 # this means a multicreate stub was passed in
2018 length ref $args->{foreign_values}{$_}
2020 ! is_literal_value($args->{foreign_values}{$_})
2025 ? $self->throw_exception( "Key '$_' supplied as 'foreign_values' is not a column on related source '@{[ $rel_rsrc->source_name ]}'" )
2026 : ( !exists $equivalencies->{$_} or ($equivalencies->{$_}||'') eq UNRESOLVABLE_CONDITION )
2027 ? $self->throw_exception( "Value supplied for '...{foreign_values}{$_}' is not a direct equivalence expression" )
2028 : $args->{foreign_values}{$_}
2030 } keys %{$args->{foreign_values}} };
2034 $self->throw_exception(
2035 "Argument 'foreign_values' must be either an object inheriting from '@{[ $rel_rsrc->result_class ]}', "
2036 . "or a hash reference, or undef"
2043 if (ref $rel_info->{cond} eq 'CODE') {
2046 rel_name => $args->{rel_name},
2047 self_resultsource => $self,
2048 self_alias => $args->{self_alias},
2049 foreign_alias => $args->{foreign_alias},
2051 { (exists $args->{$_}) ? ( $_ => $args->{$_} ) : () }
2052 qw( self_result_object foreign_values )
2056 # legacy - never remove these!!!
2057 $cref_args->{foreign_relname} = $cref_args->{rel_name};
2059 $cref_args->{self_rowobj} = $cref_args->{self_result_object}
2060 if exists $cref_args->{self_result_object};
2062 ($ret->{condition}, $ret->{join_free_condition}, my @extra) = $rel_info->{cond}->($cref_args);
2065 $self->throw_exception("A custom condition coderef can return at most 2 conditions, but $exception_rel_id returned extra values: @extra")
2068 if (my $jfc = $ret->{join_free_condition}) {
2070 $self->throw_exception (
2071 "The join-free condition returned for $exception_rel_id must be a hash reference"
2072 ) unless ref $jfc eq 'HASH';
2074 my ($joinfree_alias, $joinfree_source);
2075 if (defined $args->{self_result_object}) {
2076 $joinfree_alias = $args->{foreign_alias};
2077 $joinfree_source = $rel_rsrc;
2079 elsif (defined $args->{foreign_values}) {
2080 $joinfree_alias = $args->{self_alias};
2081 $joinfree_source = $self;
2084 # FIXME sanity check until things stabilize, remove at some point
2085 $self->throw_exception (
2086 "A join-free condition returned for $exception_rel_id without a result object to chain from"
2087 ) unless $joinfree_alias;
2089 my $fq_col_list = { map
2090 { ( "$joinfree_alias.$_" => 1 ) }
2091 $joinfree_source->columns
2094 exists $fq_col_list->{$_} or $self->throw_exception (
2095 "The join-free condition returned for $exception_rel_id may only "
2096 . 'contain keys that are fully qualified column names of the corresponding source '
2097 . "'$joinfree_alias' (instead it returned '$_')"
2105 $_->isa('DBIx::Class::Row')
2107 $self->throw_exception (
2108 "The join-free condition returned for $exception_rel_id may not "
2109 . 'contain result objects as values - perhaps instead of invoking '
2110 . '->$something you meant to return ->get_column($something)'
2116 elsif (ref $rel_info->{cond} eq 'HASH') {
2118 # the condition is static - use parallel arrays
2119 # for a "pivot" depending on which side of the
2120 # rel did we get as an object
2121 my (@f_cols, @l_cols);
2122 for my $fc (keys %{ $rel_info->{cond} }) {
2123 my $lc = $rel_info->{cond}{$fc};
2125 # FIXME STRICTMODE should probably check these are valid columns
2126 $fc =~ s/^foreign\.// ||
2127 $self->throw_exception("Invalid rel cond key '$fc'");
2129 $lc =~ s/^self\.// ||
2130 $self->throw_exception("Invalid rel cond val '$lc'");
2136 # construct the crosstable condition and the identity map
2138 $ret->{condition}{"$args->{foreign_alias}.$f_cols[$_]"} = { -ident => "$args->{self_alias}.$l_cols[$_]" };
2139 $ret->{identity_map}{$l_cols[$_]} = $f_cols[$_];
2142 if ($args->{foreign_values}) {
2143 $ret->{join_free_condition}{"$args->{self_alias}.$l_cols[$_]"} = $args->{foreign_values}{$f_cols[$_]}
2146 elsif (defined $args->{self_result_object}) {
2148 for my $i (0..$#l_cols) {
2149 if ( $args->{self_result_object}->has_column_loaded($l_cols[$i]) ) {
2150 $ret->{join_free_condition}{"$args->{foreign_alias}.$f_cols[$i]"} = $args->{self_result_object}->get_column($l_cols[$i]);
2153 $self->throw_exception(sprintf
2154 "Unable to resolve relationship '%s' from object '%s': column '%s' not "
2155 . 'loaded from storage (or not passed to new() prior to insert()). You '
2156 . 'probably need to call ->discard_changes to get the server-side defaults '
2157 . 'from the database.',
2159 $args->{self_result_object},
2161 ) if $args->{self_result_object}->in_storage;
2163 # FIXME - temporarly force-override
2164 delete $args->{require_join_free_condition};
2165 $ret->{join_free_condition} = UNRESOLVABLE_CONDITION;
2171 elsif (ref $rel_info->{cond} eq 'ARRAY') {
2172 if (@{ $rel_info->{cond} } == 0) {
2174 condition => UNRESOLVABLE_CONDITION,
2175 join_free_condition => UNRESOLVABLE_CONDITION,
2179 my @subconds = map {
2180 local $rel_info->{cond} = $_;
2181 $self->_resolve_relationship_condition( $args );
2182 } @{ $rel_info->{cond} };
2184 if( @{ $rel_info->{cond} } == 1 ) {
2185 $ret = $subconds[0];
2188 # we are discarding inferred values here... likely incorrect...
2189 # then again - the entire thing is an OR, so we *can't* use them anyway
2190 for my $subcond ( @subconds ) {
2191 $self->throw_exception('Either all or none of the OR-condition members must resolve to a join-free condition')
2192 if ( $ret and ( $ret->{join_free_condition} xor $subcond->{join_free_condition} ) );
2194 $subcond->{$_} and push @{$ret->{$_}}, $subcond->{$_} for (qw(condition join_free_condition));
2200 $self->throw_exception ("Can't handle condition $rel_info->{cond} for $exception_rel_id yet :(");
2204 $args->{require_join_free_condition}
2206 ( ! $ret->{join_free_condition} or $ret->{join_free_condition} eq UNRESOLVABLE_CONDITION )
2208 $self->throw_exception(
2209 ucfirst sprintf "$exception_rel_id does not resolve to a %sjoin-free condition fragment",
2210 exists $args->{foreign_values}
2211 ? "'foreign_values'-based reversed-"
2216 # we got something back - sanity check and infer values if we can
2219 $ret->{join_free_condition}
2221 $ret->{join_free_condition} ne UNRESOLVABLE_CONDITION
2223 my $jfc = $storage->_collapse_cond( $ret->{join_free_condition} )
2226 my $jfc_eqs = $storage->_extract_fixed_condition_columns($jfc, 'consider_nulls');
2228 if (keys %$jfc_eqs) {
2231 # $jfc is fully qualified by definition
2232 my ($col) = $_ =~ /\.(.+)/;
2234 if (exists $jfc_eqs->{$_} and ($jfc_eqs->{$_}||'') ne UNRESOLVABLE_CONDITION) {
2235 $ret->{inferred_values}{$col} = $jfc_eqs->{$_};
2237 elsif ( !$args->{infer_values_based_on} or ! exists $args->{infer_values_based_on}{$col} ) {
2238 push @nonvalues, $col;
2243 delete $ret->{inferred_values} if @nonvalues;
2247 # did the user explicitly ask
2248 if ($args->{infer_values_based_on}) {
2250 $self->throw_exception(sprintf (
2251 "Unable to complete value inferrence - custom $exception_rel_id returns conditions instead of values for column(s): %s",
2252 map { "'$_'" } @nonvalues
2256 $ret->{inferred_values} ||= {};
2258 $ret->{inferred_values}{$_} = $args->{infer_values_based_on}{$_}
2259 for keys %{$args->{infer_values_based_on}};
2262 # add the identities based on the main condition
2263 # (may already be there, since easy to calculate on the fly in the HASH case)
2264 if ( ! $ret->{identity_map} ) {
2266 my $col_eqs = $storage->_extract_fixed_condition_columns($ret->{condition});
2269 for my $lhs (keys %$col_eqs) {
2271 next if $col_eqs->{$lhs} eq UNRESOLVABLE_CONDITION;
2273 # there is no way to know who is right and who is left in a cref
2274 # therefore a full blown resolution call, and figure out the
2275 # direction a bit further below
2276 $colinfos ||= $storage->_resolve_column_info([
2277 { -alias => $args->{self_alias}, -rsrc => $self },
2278 { -alias => $args->{foreign_alias}, -rsrc => $rel_rsrc },
2281 next unless $colinfos->{$lhs}; # someone is engaging in witchcraft
2283 if ( my $rhs_ref = is_literal_value( $col_eqs->{$lhs} ) ) {
2286 $colinfos->{$rhs_ref->[0]}
2288 $colinfos->{$lhs}{-source_alias} ne $colinfos->{$rhs_ref->[0]}{-source_alias}
2290 ( $colinfos->{$lhs}{-source_alias} eq $args->{self_alias} )
2291 ? ( $ret->{identity_map}{$colinfos->{$lhs}{-colname}} = $colinfos->{$rhs_ref->[0]}{-colname} )
2292 : ( $ret->{identity_map}{$colinfos->{$rhs_ref->[0]}{-colname}} = $colinfos->{$lhs}{-colname} )
2297 $col_eqs->{$lhs} =~ /^ ( \Q$args->{self_alias}\E \. .+ ) /x
2299 ($colinfos->{$1}||{})->{-result_source} == $rel_rsrc
2301 my ($lcol, $rcol) = map
2302 { $colinfos->{$_}{-colname} }
2306 "The $exception_rel_id specifies equality of column '$lcol' and the "
2307 . "*VALUE* '$rcol' (you did not use the { -ident => ... } operator)"
2313 # FIXME - temporary, to fool the idiotic check in SQLMaker::_join_condition
2314 $ret->{condition} = { -and => [ $ret->{condition} ] }
2315 unless $ret->{condition} eq UNRESOLVABLE_CONDITION;
2320 =head2 related_source
2324 =item Arguments: $rel_name
2326 =item Return Value: $source
2330 Returns the result source object for the given relationship.
2334 sub related_source {
2335 my ($self, $rel) = @_;
2336 if( !$self->has_relationship( $rel ) ) {
2337 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
2340 # if we are not registered with a schema - just use the prototype
2341 # however if we do have a schema - ask for the source by name (and
2342 # throw in the process if all fails)
2343 if (my $schema = dbic_internal_try { $self->schema }) {
2344 $schema->source($self->relationship_info($rel)->{source});
2347 my $class = $self->relationship_info($rel)->{class};
2348 $self->ensure_class_loaded($class);
2349 $class->result_source_instance;
2353 =head2 related_class
2357 =item Arguments: $rel_name
2359 =item Return Value: $classname
2363 Returns the class name for objects in the given relationship.
2368 my ($self, $rel) = @_;
2369 if( !$self->has_relationship( $rel ) ) {
2370 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
2372 return $self->schema->class($self->relationship_info($rel)->{source});
2379 =item Arguments: none
2381 =item Return Value: L<$source_handle|DBIx::Class::ResultSourceHandle>
2385 Obtain a new L<result source handle instance|DBIx::Class::ResultSourceHandle>
2386 for this source. Used as a serializable pointer to this resultsource, as it is not
2387 easy (nor advisable) to serialize CODErefs which may very well be present in e.g.
2388 relationship definitions.
2393 require DBIx::Class::ResultSourceHandle;
2394 return DBIx::Class::ResultSourceHandle->new({
2395 source_moniker => $_[0]->source_name,
2397 # so that a detached thaw can be re-frozen
2398 $_[0]->{_detached_thaw}
2399 ? ( _detached_source => $_[0] )
2400 : ( schema => $_[0]->schema )
2405 my $global_phase_destroy;
2407 ### NO detected_reinvoked_destructor check
2408 ### This code very much relies on being called multuple times
2410 return if $global_phase_destroy ||= in_global_destruction;
2416 # Under no circumstances shall $_[0] be stored anywhere else (like copied to
2417 # a lexical variable, or shifted, or anything else). Doing so will mess up
2418 # the refcount of this particular result source, and will allow the $schema
2419 # we are trying to save to reattach back to the source we are destroying.
2420 # The relevant code checking refcounts is in ::Schema::DESTROY()
2422 # if we are not a schema instance holder - we don't matter
2424 ! ref $_[0]->{schema}
2426 isweak $_[0]->{schema}
2429 # weaken our schema hold forcing the schema to find somewhere else to live
2430 # during global destruction (if we have not yet bailed out) this will throw
2431 # which will serve as a signal to not try doing anything else
2432 # however beware - on older perls the exception seems randomly untrappable
2433 # due to some weird race condition during thread joining :(((
2434 local $SIG{__DIE__} if $SIG{__DIE__};
2435 local $@ if DBIx::Class::_ENV_::UNSTABLE_DOLLARAT;
2437 weaken $_[0]->{schema};
2439 # if schema is still there reintroduce ourselves with strong refs back to us
2440 if ($_[0]->{schema}) {
2441 my $srcregs = $_[0]->{schema}->source_registrations;
2443 defined $srcregs->{$_}
2445 $srcregs->{$_} == $_[0]
2447 $srcregs->{$_} = $_[0]
2455 $global_phase_destroy = 1;
2458 # Dummy NEXTSTATE ensuring the all temporaries on the stack are garbage
2459 # collected before leaving this scope. Depending on the code above, this
2460 # may very well be just a preventive measure guarding future modifications
2464 sub STORABLE_freeze { Storable::nfreeze($_[0]->handle) }
2467 my ($self, $cloning, $ice) = @_;
2468 %$self = %{ (Storable::thaw($ice))->resolve };
2471 =head2 throw_exception
2473 See L<DBIx::Class::Schema/"throw_exception">.
2477 sub throw_exception {
2481 ? $self->{schema}->throw_exception(@_)
2482 : DBIx::Class::Exception->throw(@_)
2486 =head2 column_info_from_storage
2490 =item Arguments: 1/0 (default: 0)
2492 =item Return Value: 1/0
2496 __PACKAGE__->column_info_from_storage(1);
2498 Enables the on-demand automatic loading of the above column
2499 metadata from storage as necessary. This is *deprecated*, and
2500 should not be used. It will be removed before 1.0.
2502 =head1 FURTHER QUESTIONS?
2504 Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
2506 =head1 COPYRIGHT AND LICENSE
2508 This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
2509 by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
2510 redistribute it and/or modify it under the same terms as the
2511 L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.