1 package DBIx::Class::ResultSource;
6 use base qw/DBIx::Class::ResultSource::RowParser DBIx::Class/;
8 use DBIx::Class::ResultSet;
9 use DBIx::Class::ResultSourceHandle;
11 use DBIx::Class::Carp;
12 use DBIx::Class::_Util 'UNRESOLVABLE_CONDITION';
13 use SQL::Abstract 'is_literal_value';
14 use Devel::GlobalDestruction;
16 use Scalar::Util qw/blessed weaken isweak/;
20 __PACKAGE__->mk_group_accessors(simple => qw/
21 source_name name source_info
22 _ordered_columns _columns _primaries
23 _unique_constraints _unique_constraints_extra
24 _relationships resultset_attributes
25 column_info_from_storage
28 __PACKAGE__->mk_group_accessors(component_class => qw/
33 __PACKAGE__->mk_classdata( sqlt_deploy_callback => 'default_sqlt_deploy_hook' );
37 DBIx::Class::ResultSource - Result source object
41 # Create a table based result source, in a result class.
43 package MyApp::Schema::Result::Artist;
44 use base qw/DBIx::Class::Core/;
46 __PACKAGE__->table('artist');
47 __PACKAGE__->add_columns(qw/ artistid name /);
48 __PACKAGE__->set_primary_key('artistid');
49 __PACKAGE__->has_many(cds => 'MyApp::Schema::Result::CD');
53 # Create a query (view) based result source, in a result class
54 package MyApp::Schema::Result::Year2000CDs;
55 use base qw/DBIx::Class::Core/;
57 __PACKAGE__->load_components('InflateColumn::DateTime');
58 __PACKAGE__->table_class('DBIx::Class::ResultSource::View');
60 __PACKAGE__->table('year2000cds');
61 __PACKAGE__->result_source_instance->is_virtual(1);
62 __PACKAGE__->result_source_instance->view_definition(
63 "SELECT cdid, artist, title FROM cd WHERE year ='2000'"
69 A ResultSource is an object that represents a source of data for querying.
71 This class is a base class for various specialised types of result
72 sources, for example L<DBIx::Class::ResultSource::Table>. Table is the
73 default result source type, so one is created for you when defining a
74 result class as described in the synopsis above.
76 More specifically, the L<DBIx::Class::Core> base class pulls in the
77 L<DBIx::Class::ResultSourceProxy::Table> component, which defines
78 the L<table|DBIx::Class::ResultSourceProxy::Table/table> method.
79 When called, C<table> creates and stores an instance of
80 L<DBIx::Class::ResultSource::Table>. Luckily, to use tables as result
81 sources, you don't need to remember any of this.
83 Result sources representing select queries, or views, can also be
84 created, see L<DBIx::Class::ResultSource::View> for full details.
86 =head2 Finding result source objects
88 As mentioned above, a result source instance is created and stored for
90 L<Result Class|DBIx::Class::Manual::Glossary/Result Class>.
92 You can retrieve the result source at runtime in the following ways:
96 =item From a Schema object:
98 $schema->source($source_name);
100 =item From a Result object:
102 $result->result_source;
104 =item From a ResultSet object:
116 $class->new({attribute_name => value});
118 Creates a new ResultSource object. Not normally called directly by end users.
123 my ($class, $attrs) = @_;
124 $class = ref $class if ref $class;
126 my $new = bless { %{$attrs || {}} }, $class;
127 $new->{resultset_class} ||= 'DBIx::Class::ResultSet';
128 $new->{resultset_attributes} = { %{$new->{resultset_attributes} || {}} };
129 $new->{_ordered_columns} = [ @{$new->{_ordered_columns}||[]}];
130 $new->{_columns} = { %{$new->{_columns}||{}} };
131 $new->{_relationships} = { %{$new->{_relationships}||{}} };
132 $new->{name} ||= "!!NAME NOT SET!!";
133 $new->{_columns_info_loaded} ||= 0;
143 =item Arguments: @columns
145 =item Return Value: L<$result_source|/new>
149 $source->add_columns(qw/col1 col2 col3/);
151 $source->add_columns('col1' => \%col1_info, 'col2' => \%col2_info, ...);
153 $source->add_columns(
154 'col1' => { data_type => 'integer', is_nullable => 1, ... },
155 'col2' => { data_type => 'text', is_auto_increment => 1, ... },
158 Adds columns to the result source. If supplied colname => hashref
159 pairs, uses the hashref as the L</column_info> for that column. Repeated
160 calls of this method will add more columns, not replace them.
162 The column names given will be created as accessor methods on your
163 L<Result|DBIx::Class::Manual::ResultClass> objects. You can change the name of the accessor
164 by supplying an L</accessor> in the column_info hash.
166 If a column name beginning with a plus sign ('+col1') is provided, the
167 attributes provided will be merged with any existing attributes for the
168 column, with the new attributes taking precedence in the case that an
169 attribute already exists. Using this without a hashref
170 (C<< $source->add_columns(qw/+col1 +col2/) >>) is legal, but useless --
171 it does the same thing it would do without the plus.
173 The contents of the column_info are not set in stone. The following
174 keys are currently recognised/used by DBIx::Class:
180 { accessor => '_name' }
182 # example use, replace standard accessor with one of your own:
184 my ($self, $value) = @_;
186 die "Name cannot contain digits!" if($value =~ /\d/);
187 $self->_name($value);
189 return $self->_name();
192 Use this to set the name of the accessor method for this column. If unset,
193 the name of the column will be used.
197 { data_type => 'integer' }
199 This contains the column type. It is automatically filled if you use the
200 L<SQL::Translator::Producer::DBIx::Class::File> producer, or the
201 L<DBIx::Class::Schema::Loader> module.
203 Currently there is no standard set of values for the data_type. Use
204 whatever your database supports.
210 The length of your column, if it is a column type that can have a size
211 restriction. This is currently only used to create tables from your
212 schema, see L<DBIx::Class::Schema/deploy>.
216 For decimal or float values you can specify an ArrayRef in order to
217 control precision, assuming your database's
218 L<SQL::Translator::Producer> supports it.
224 Set this to a true value for a column that is allowed to contain NULL
225 values, default is false. This is currently only used to create tables
226 from your schema, see L<DBIx::Class::Schema/deploy>.
228 =item is_auto_increment
230 { is_auto_increment => 1 }
232 Set this to a true value for a column whose value is somehow
233 automatically set, defaults to false. This is used to determine which
234 columns to empty when cloning objects using
235 L<DBIx::Class::Row/copy>. It is also used by
236 L<DBIx::Class::Schema/deploy>.
242 Set this to a true or false value (not C<undef>) to explicitly specify
243 if this column contains numeric data. This controls how set_column
244 decides whether to consider a column dirty after an update: if
245 C<is_numeric> is true a numeric comparison C<< != >> will take place
246 instead of the usual C<eq>
248 If not specified the storage class will attempt to figure this out on
249 first access to the column, based on the column C<data_type>. The
250 result will be cached in this attribute.
254 { is_foreign_key => 1 }
256 Set this to a true value for a column that contains a key from a
257 foreign table, defaults to false. This is currently only used to
258 create tables from your schema, see L<DBIx::Class::Schema/deploy>.
262 { default_value => \'now()' }
264 Set this to the default value which will be inserted into a column by
265 the database. Can contain either a value or a function (use a
266 reference to a scalar e.g. C<\'now()'> if you want a function). This
267 is currently only used to create tables from your schema, see
268 L<DBIx::Class::Schema/deploy>.
270 See the note on L<DBIx::Class::Row/new> for more information about possible
271 issues related to db-side default values.
275 { sequence => 'my_table_seq' }
277 Set this on a primary key column to the name of the sequence used to
278 generate a new key value. If not specified, L<DBIx::Class::PK::Auto>
279 will attempt to retrieve the name of the sequence from the database
282 =item retrieve_on_insert
284 { retrieve_on_insert => 1 }
286 For every column where this is set to true, DBIC will retrieve the RDBMS-side
287 value upon a new row insertion (normally only the autoincrement PK is
288 retrieved on insert). C<INSERT ... RETURNING> is used automatically if
289 supported by the underlying storage, otherwise an extra SELECT statement is
290 executed to retrieve the missing data.
294 { auto_nextval => 1 }
296 Set this to a true value for a column whose value is retrieved automatically
297 from a sequence or function (if supported by your Storage driver.) For a
298 sequence, if you do not use a trigger to get the nextval, you have to set the
299 L</sequence> value as well.
301 Also set this for MSSQL columns with the 'uniqueidentifier'
302 L<data_type|DBIx::Class::ResultSource/data_type> whose values you want to
303 automatically generate using C<NEWID()>, unless they are a primary key in which
304 case this will be done anyway.
308 This is used by L<DBIx::Class::Schema/deploy> and L<SQL::Translator>
309 to add extra non-generic data to the column. For example: C<< extra
310 => { unsigned => 1} >> is used by the MySQL producer to set an integer
311 column to unsigned. For more details, see
312 L<SQL::Translator::Producer::MySQL>.
320 =item Arguments: $colname, \%columninfo?
322 =item Return Value: 1/0 (true/false)
326 $source->add_column('col' => \%info);
328 Add a single column and optional column info. Uses the same column
329 info keys as L</add_columns>.
334 my ($self, @cols) = @_;
335 $self->_ordered_columns(\@cols) unless $self->_ordered_columns;
338 my $columns = $self->_columns;
339 while (my $col = shift @cols) {
340 my $column_info = {};
341 if ($col =~ s/^\+//) {
342 $column_info = $self->column_info($col);
345 # If next entry is { ... } use that for the column info, if not
346 # use an empty hashref
348 my $new_info = shift(@cols);
349 %$column_info = (%$column_info, %$new_info);
351 push(@added, $col) unless exists $columns->{$col};
352 $columns->{$col} = $column_info;
354 push @{ $self->_ordered_columns }, @added;
358 sub add_column { shift->add_columns(@_); } # DO NOT CHANGE THIS TO GLOB
364 =item Arguments: $colname
366 =item Return Value: 1/0 (true/false)
370 if ($source->has_column($colname)) { ... }
372 Returns true if the source has a column of this name, false otherwise.
377 my ($self, $column) = @_;
378 return exists $self->_columns->{$column};
385 =item Arguments: $colname
387 =item Return Value: Hashref of info
391 my $info = $source->column_info($col);
393 Returns the column metadata hashref for a column, as originally passed
394 to L</add_columns>. See L</add_columns> above for information on the
395 contents of the hashref.
400 my ($self, $column) = @_;
401 $self->throw_exception("No such column $column")
402 unless exists $self->_columns->{$column};
404 if ( ! $self->_columns->{$column}{data_type}
405 and ! $self->{_columns_info_loaded}
406 and $self->column_info_from_storage
407 and my $stor = try { $self->storage } )
409 $self->{_columns_info_loaded}++;
411 # try for the case of storage without table
413 my $info = $stor->columns_info_for( $self->from );
415 { (lc $_) => $info->{$_} }
419 foreach my $col ( keys %{$self->_columns} ) {
420 $self->_columns->{$col} = {
421 %{ $self->_columns->{$col} },
422 %{ $info->{$col} || $lc_info->{lc $col} || {} }
428 return $self->_columns->{$column};
435 =item Arguments: none
437 =item Return Value: Ordered list of column names
441 my @column_names = $source->columns;
443 Returns all column names in the order they were declared to L</add_columns>.
449 $self->throw_exception(
450 "columns() is a read-only accessor, did you mean add_columns()?"
452 return @{$self->{_ordered_columns}||[]};
459 =item Arguments: \@colnames ?
461 =item Return Value: Hashref of column name/info pairs
465 my $columns_info = $source->columns_info;
467 Like L</column_info> but returns information for the requested columns. If
468 the optional column-list arrayref is omitted it returns info on all columns
469 currently defined on the ResultSource via L</add_columns>.
474 my ($self, $columns) = @_;
476 my $colinfo = $self->_columns;
479 ! $self->{_columns_info_loaded}
481 $self->column_info_from_storage
483 grep { ! $_->{data_type} } values %$colinfo
485 my $stor = try { $self->storage }
487 $self->{_columns_info_loaded}++;
489 # try for the case of storage without table
491 my $info = $stor->columns_info_for( $self->from );
493 { (lc $_) => $info->{$_} }
497 foreach my $col ( keys %$colinfo ) {
499 %{ $colinfo->{$col} },
500 %{ $info->{$col} || $lc_info->{lc $col} || {} }
510 if (my $inf = $colinfo->{$_}) {
514 $self->throw_exception( sprintf (
515 "No such column '%s' on source '%s'",
517 $self->source_name || $self->name || 'Unknown source...?',
529 =head2 remove_columns
533 =item Arguments: @colnames
535 =item Return Value: not defined
539 $source->remove_columns(qw/col1 col2 col3/);
541 Removes the given list of columns by name, from the result source.
543 B<Warning>: Removing a column that is also used in the sources primary
544 key, or in one of the sources unique constraints, B<will> result in a
545 broken result source.
551 =item Arguments: $colname
553 =item Return Value: not defined
557 $source->remove_column('col');
559 Remove a single column by name from the result source, similar to
562 B<Warning>: Removing a column that is also used in the sources primary
563 key, or in one of the sources unique constraints, B<will> result in a
564 broken result source.
569 my ($self, @to_remove) = @_;
571 my $columns = $self->_columns
576 delete $columns->{$_};
580 $self->_ordered_columns([ grep { not $to_remove{$_} } @{$self->_ordered_columns} ]);
583 sub remove_column { shift->remove_columns(@_); } # DO NOT CHANGE THIS TO GLOB
585 =head2 set_primary_key
589 =item Arguments: @cols
591 =item Return Value: not defined
595 Defines one or more columns as primary key for this source. Must be
596 called after L</add_columns>.
598 Additionally, defines a L<unique constraint|/add_unique_constraint>
601 Note: you normally do want to define a primary key on your sources
602 B<even if the underlying database table does not have a primary key>.
604 L<DBIx::Class::Manual::Intro/The Significance and Importance of Primary Keys>
609 sub set_primary_key {
610 my ($self, @cols) = @_;
612 my $colinfo = $self->columns_info(\@cols);
613 for my $col (@cols) {
614 carp_unique(sprintf (
615 "Primary key of source '%s' includes the column '%s' which has its "
616 . "'is_nullable' attribute set to true. This is a mistake and will cause "
617 . 'various Result-object operations to fail',
618 $self->source_name || $self->name || 'Unknown source...?',
620 )) if $colinfo->{$col}{is_nullable};
623 $self->_primaries(\@cols);
625 $self->add_unique_constraint(primary => \@cols);
628 =head2 primary_columns
632 =item Arguments: none
634 =item Return Value: Ordered list of primary column names
638 Read-only accessor which returns the list of primary keys, supplied by
643 sub primary_columns {
644 return @{shift->_primaries||[]};
647 # a helper method that will automatically die with a descriptive message if
648 # no pk is defined on the source in question. For internal use to save
649 # on if @pks... boilerplate
650 sub _pri_cols_or_die {
652 my @pcols = $self->primary_columns
653 or $self->throw_exception (sprintf(
654 "Operation requires a primary key to be declared on '%s' via set_primary_key",
655 # source_name is set only after schema-registration
656 $self->source_name || $self->result_class || $self->name || 'Unknown source...?',
661 # same as above but mandating single-column PK (used by relationship condition
663 sub _single_pri_col_or_die {
665 my ($pri, @too_many) = $self->_pri_cols_or_die;
667 $self->throw_exception( sprintf(
668 "Operation requires a single-column primary key declared on '%s'",
669 $self->source_name || $self->result_class || $self->name || 'Unknown source...?',
677 Manually define the correct sequence for your table, to avoid the overhead
678 associated with looking up the sequence automatically. The supplied sequence
679 will be applied to the L</column_info> of each L<primary_key|/set_primary_key>
683 =item Arguments: $sequence_name
685 =item Return Value: not defined
692 my ($self,$seq) = @_;
694 my @pks = $self->primary_columns
697 $_->{sequence} = $seq
698 for values %{ $self->columns_info (\@pks) };
702 =head2 add_unique_constraint
706 =item Arguments: $name?, \@colnames, \%options?
708 =item Return Value: not defined
712 Declare a unique constraint on this source. Call once for each unique
715 # For UNIQUE (column1, column2)
716 __PACKAGE__->add_unique_constraint(
717 constraint_name => [ qw/column1 column2/ ],
721 Alternatively, you can specify only the columns:
723 __PACKAGE__->add_unique_constraint([ qw/column1 column2/ ]);
725 This will result in a unique constraint named
726 C<table_column1_column2>, where C<table> is replaced with the table
729 The options hashref will be passed to
730 L<SQL::Translator::Schema::Constraint/new>; the intention being to
731 allow the C<deferrable> flag to be set, but you may find others
732 useful. Note that C<name>, C<type>, and C<fields> will be ignored.
734 Unique constraints are used, for example, when you pass the constraint
735 name as the C<key> attribute to L<DBIx::Class::ResultSet/find>. Then
736 only columns in the constraint are searched.
738 Throws an error if any of the given column names do not yet exist on
743 sub add_unique_constraint {
746 if ((grep {ref $_ eq 'ARRAY'} @_) > 1) {
747 $self->throw_exception(
748 'add_unique_constraint() does not accept multiple constraints, use '
749 . 'add_unique_constraints() instead'
755 if (ref $cols eq 'HASH') {
760 if (ref $cols ne 'ARRAY') {
761 $self->throw_exception (
762 'Expecting an arrayref of constraint columns, got ' . ($cols||'NOTHING')
768 $name ||= $self->name_unique_constraint($cols);
770 foreach my $col (@$cols) {
771 $self->throw_exception("No such column $col on table " . $self->name)
772 unless $self->has_column($col);
775 my %unique_constraints = $self->unique_constraints;
776 my %unique_constraints_extra = $self->unique_constraints_extra;
777 $unique_constraints{$name} = $cols;
778 $unique_constraints_extra{$name} = $opts;
779 $self->_unique_constraints(\%unique_constraints);
780 $self->_unique_constraints_extra(\%unique_constraints_extra);
783 =head2 add_unique_constraints
787 =item Arguments: @constraints
789 =item Return Value: not defined
793 Declare multiple unique constraints on this source.
795 __PACKAGE__->add_unique_constraints(
796 constraint_name1 => [ qw/column1 column2/ ],
797 constraint_name2 => [ qw/column2 column3/ ],
800 Alternatively, you can specify only the columns:
802 __PACKAGE__->add_unique_constraints(
803 [ qw/column1 column2/ ],
804 [ qw/column3 column4/ ]
807 This will result in unique constraints named C<table_column1_column2> and
808 C<table_column3_column4>, where C<table> is replaced with the table name.
810 Throws an error if any of the given column names do not yet exist on
813 See also L</add_unique_constraint>.
817 sub add_unique_constraints {
819 my @constraints = @_;
821 if ( !(@constraints % 2) && grep { ref $_ ne 'ARRAY' } @constraints ) {
822 # with constraint name
823 while (my ($name, $constraint) = splice @constraints, 0, 2) {
824 $self->add_unique_constraint($name => $constraint);
829 foreach my $constraint (@constraints) {
830 $self->add_unique_constraint($constraint);
835 =head2 name_unique_constraint
839 =item Arguments: \@colnames
841 =item Return Value: Constraint name
845 $source->table('mytable');
846 $source->name_unique_constraint(['col1', 'col2']);
850 Return a name for a unique constraint containing the specified
851 columns. The name is created by joining the table name and each column
852 name, using an underscore character.
854 For example, a constraint on a table named C<cd> containing the columns
855 C<artist> and C<title> would result in a constraint name of C<cd_artist_title>.
857 This is used by L</add_unique_constraint> if you do not specify the
858 optional constraint name.
862 sub name_unique_constraint {
863 my ($self, $cols) = @_;
865 my $name = $self->name;
866 $name = $$name if (ref $name eq 'SCALAR');
867 $name =~ s/ ^ [^\.]+ \. //x; # strip possible schema qualifier
869 return join '_', $name, @$cols;
872 =head2 unique_constraints
876 =item Arguments: none
878 =item Return Value: Hash of unique constraint data
882 $source->unique_constraints();
884 Read-only accessor which returns a hash of unique constraints on this
887 The hash is keyed by constraint name, and contains an arrayref of
888 column names as values.
892 sub unique_constraints {
893 return %{shift->_unique_constraints||{}};
896 =head2 unique_constraints_extra
900 =item Arguments: none
902 =item Return Value: Hash of unique constraint \%options
906 my %uq_extras = $source->unique_constraints_extra();
908 Read-only accessor which returns a hash of the options provided to
911 The hash is keyed by constraint name, and the values are the options
912 hashrefs as provided to L</add_unique_constraint>.
916 sub unique_constraints_extra {
917 return %{shift->_unique_constraints_extra||{}};
920 =head2 unique_constraint_names
924 =item Arguments: none
926 =item Return Value: Unique constraint names
930 $source->unique_constraint_names();
932 Returns the list of unique constraint names defined on this source.
936 sub unique_constraint_names {
939 my %unique_constraints = $self->unique_constraints;
941 return keys %unique_constraints;
944 =head2 unique_constraint_columns
948 =item Arguments: $constraintname
950 =item Return Value: List of constraint columns
954 $source->unique_constraint_columns('myconstraint');
956 Returns the list of columns that make up the specified unique constraint.
960 sub unique_constraint_columns {
961 my ($self, $constraint_name) = @_;
963 my %unique_constraints = $self->unique_constraints;
965 $self->throw_exception(
966 "Unknown unique constraint $constraint_name on '" . $self->name . "'"
967 ) unless exists $unique_constraints{$constraint_name};
969 return @{ $unique_constraints{$constraint_name} };
972 =head2 sqlt_deploy_callback
976 =item Arguments: $callback_name | \&callback_code
978 =item Return Value: $callback_name | \&callback_code
982 __PACKAGE__->sqlt_deploy_callback('mycallbackmethod');
986 __PACKAGE__->sqlt_deploy_callback(sub {
987 my ($source_instance, $sqlt_table) = @_;
991 An accessor to set a callback to be called during deployment of
992 the schema via L<DBIx::Class::Schema/create_ddl_dir> or
993 L<DBIx::Class::Schema/deploy>.
995 The callback can be set as either a code reference or the name of a
996 method in the current result class.
998 Defaults to L</default_sqlt_deploy_hook>.
1000 Your callback will be passed the $source object representing the
1001 ResultSource instance being deployed, and the
1002 L<SQL::Translator::Schema::Table> object being created from it. The
1003 callback can be used to manipulate the table object or add your own
1004 customised indexes. If you need to manipulate a non-table object, use
1005 the L<DBIx::Class::Schema/sqlt_deploy_hook>.
1007 See L<DBIx::Class::Manual::Cookbook/Adding Indexes And Functions To
1008 Your SQL> for examples.
1010 This sqlt deployment callback can only be used to manipulate
1011 SQL::Translator objects as they get turned into SQL. To execute
1012 post-deploy statements which SQL::Translator does not currently
1013 handle, override L<DBIx::Class::Schema/deploy> in your Schema class
1014 and call L<dbh_do|DBIx::Class::Storage::DBI/dbh_do>.
1016 =head2 default_sqlt_deploy_hook
1018 This is the default deploy hook implementation which checks if your
1019 current Result class has a C<sqlt_deploy_hook> method, and if present
1020 invokes it B<on the Result class directly>. This is to preserve the
1021 semantics of C<sqlt_deploy_hook> which was originally designed to expect
1022 the Result class name and the
1023 L<$sqlt_table instance|SQL::Translator::Schema::Table> of the table being
1028 sub default_sqlt_deploy_hook {
1031 my $class = $self->result_class;
1033 if ($class and $class->can('sqlt_deploy_hook')) {
1034 $class->sqlt_deploy_hook(@_);
1038 sub _invoke_sqlt_deploy_hook {
1040 if ( my $hook = $self->sqlt_deploy_callback) {
1049 =item Arguments: $classname
1051 =item Return Value: $classname
1055 use My::Schema::ResultClass::Inflator;
1058 use My::Schema::Artist;
1060 __PACKAGE__->result_class('My::Schema::ResultClass::Inflator');
1062 Set the default result class for this source. You can use this to create
1063 and use your own result inflator. See L<DBIx::Class::ResultSet/result_class>
1066 Please note that setting this to something like
1067 L<DBIx::Class::ResultClass::HashRefInflator> will make every result unblessed
1068 and make life more difficult. Inflators like those are better suited to
1069 temporary usage via L<DBIx::Class::ResultSet/result_class>.
1075 =item Arguments: none
1077 =item Return Value: L<$resultset|DBIx::Class::ResultSet>
1081 Returns a resultset for the given source. This will initially be created
1082 on demand by calling
1084 $self->resultset_class->new($self, $self->resultset_attributes)
1086 but is cached from then on unless resultset_class changes.
1088 =head2 resultset_class
1092 =item Arguments: $classname
1094 =item Return Value: $classname
1098 package My::Schema::ResultSet::Artist;
1099 use base 'DBIx::Class::ResultSet';
1102 # In the result class
1103 __PACKAGE__->resultset_class('My::Schema::ResultSet::Artist');
1106 $source->resultset_class('My::Schema::ResultSet::Artist');
1108 Set the class of the resultset. This is useful if you want to create your
1109 own resultset methods. Create your own class derived from
1110 L<DBIx::Class::ResultSet>, and set it here. If called with no arguments,
1111 this method returns the name of the existing resultset class, if one
1114 =head2 resultset_attributes
1118 =item Arguments: L<\%attrs|DBIx::Class::ResultSet/ATTRIBUTES>
1120 =item Return Value: L<\%attrs|DBIx::Class::ResultSet/ATTRIBUTES>
1124 # In the result class
1125 __PACKAGE__->resultset_attributes({ order_by => [ 'id' ] });
1128 $source->resultset_attributes({ order_by => [ 'id' ] });
1130 Store a collection of resultset attributes, that will be set on every
1131 L<DBIx::Class::ResultSet> produced from this result source.
1133 B<CAVEAT>: C<resultset_attributes> comes with its own set of issues and
1134 bugs! While C<resultset_attributes> isn't deprecated per se, its usage is
1137 Since relationships use attributes to link tables together, the "default"
1138 attributes you set may cause unpredictable and undesired behavior. Furthermore,
1139 the defaults cannot be turned off, so you are stuck with them.
1141 In most cases, what you should actually be using are project-specific methods:
1143 package My::Schema::ResultSet::Artist;
1144 use base 'DBIx::Class::ResultSet';
1148 #__PACKAGE__->resultset_attributes({ prefetch => 'tracks' });
1151 sub with_tracks { shift->search({}, { prefetch => 'tracks' }) }
1154 $schema->resultset('Artist')->with_tracks->...
1156 This gives you the flexibility of not using it when you don't need it.
1158 For more complex situations, another solution would be to use a virtual view
1159 via L<DBIx::Class::ResultSource::View>.
1165 $self->throw_exception(
1166 'resultset does not take any arguments. If you want another resultset, '.
1167 'call it on the schema instead.'
1170 $self->resultset_class->new(
1173 try { %{$self->schema->default_resultset_attributes} },
1174 %{$self->{resultset_attributes}},
1183 =item Arguments: none
1185 =item Result value: $name
1189 Returns the name of the result source, which will typically be the table
1190 name. This may be a scalar reference if the result source has a non-standard
1197 =item Arguments: $source_name
1199 =item Result value: $source_name
1203 Set an alternate name for the result source when it is loaded into a schema.
1204 This is useful if you want to refer to a result source by a name other than
1207 package ArchivedBooks;
1208 use base qw/DBIx::Class/;
1209 __PACKAGE__->table('books_archive');
1210 __PACKAGE__->source_name('Books');
1212 # from your schema...
1213 $schema->resultset('Books')->find(1);
1219 =item Arguments: none
1221 =item Return Value: FROM clause
1225 my $from_clause = $source->from();
1227 Returns an expression of the source to be supplied to storage to specify
1228 retrieval from this source. In the case of a database, the required FROM
1233 sub from { die 'Virtual method!' }
1237 Stores a hashref of per-source metadata. No specific key names
1238 have yet been standardized, the examples below are purely hypothetical
1239 and don't actually accomplish anything on their own:
1241 __PACKAGE__->source_info({
1242 "_tablespace" => 'fast_disk_array_3',
1243 "_engine" => 'InnoDB',
1250 =item Arguments: L<$schema?|DBIx::Class::Schema>
1252 =item Return Value: L<$schema|DBIx::Class::Schema>
1256 my $schema = $source->schema();
1258 Sets and/or returns the L<DBIx::Class::Schema> object to which this
1259 result source instance has been attached to.
1265 $_[0]->{schema} = $_[1];
1268 $_[0]->{schema} || do {
1269 my $name = $_[0]->{source_name} || '_unnamed_';
1270 my $err = 'Unable to perform storage-dependent operations with a detached result source '
1271 . "(source '$name' is not associated with a schema).";
1273 $err .= ' You need to use $schema->thaw() or manually set'
1274 . ' $DBIx::Class::ResultSourceHandle::thaw_schema while thawing.'
1275 if $_[0]->{_detached_thaw};
1277 DBIx::Class::Exception->throw($err);
1286 =item Arguments: none
1288 =item Return Value: L<$storage|DBIx::Class::Storage>
1292 $source->storage->debug(1);
1294 Returns the L<storage handle|DBIx::Class::Storage> for the current schema.
1298 sub storage { shift->schema->storage; }
1300 =head2 add_relationship
1304 =item Arguments: $rel_name, $related_source_name, \%cond, \%attrs?
1306 =item Return Value: 1/true if it succeeded
1310 $source->add_relationship('rel_name', 'related_source', $cond, $attrs);
1312 L<DBIx::Class::Relationship> describes a series of methods which
1313 create pre-defined useful types of relationships. Look there first
1314 before using this method directly.
1316 The relationship name can be arbitrary, but must be unique for each
1317 relationship attached to this result source. 'related_source' should
1318 be the name with which the related result source was registered with
1319 the current schema. For example:
1321 $schema->source('Book')->add_relationship('reviews', 'Review', {
1322 'foreign.book_id' => 'self.id',
1325 The condition C<$cond> needs to be an L<SQL::Abstract>-style
1326 representation of the join between the tables. For example, if you're
1327 creating a relation from Author to Book,
1329 { 'foreign.author_id' => 'self.id' }
1331 will result in the JOIN clause
1333 author me JOIN book foreign ON foreign.author_id = me.id
1335 You can specify as many foreign => self mappings as necessary.
1337 Valid attributes are as follows:
1343 Explicitly specifies the type of join to use in the relationship. Any
1344 SQL join type is valid, e.g. C<LEFT> or C<RIGHT>. It will be placed in
1345 the SQL command immediately before C<JOIN>.
1349 An arrayref containing a list of accessors in the foreign class to proxy in
1350 the main class. If, for example, you do the following:
1352 CD->might_have(liner_notes => 'LinerNotes', undef, {
1353 proxy => [ qw/notes/ ],
1356 Then, assuming LinerNotes has an accessor named notes, you can do:
1358 my $cd = CD->find(1);
1359 # set notes -- LinerNotes object is created if it doesn't exist
1360 $cd->notes('Notes go here');
1364 Specifies the type of accessor that should be created for the
1365 relationship. Valid values are C<single> (for when there is only a single
1366 related object), C<multi> (when there can be many), and C<filter> (for
1367 when there is a single related object, but you also want the relationship
1368 accessor to double as a column accessor). For C<multi> accessors, an
1369 add_to_* method is also created, which calls C<create_related> for the
1374 Throws an exception if the condition is improperly supplied, or cannot
1379 sub add_relationship {
1380 my ($self, $rel, $f_source_name, $cond, $attrs) = @_;
1381 $self->throw_exception("Can't create relationship without join condition")
1385 # Check foreign and self are right in cond
1386 if ( (ref $cond ||'') eq 'HASH') {
1387 $_ =~ /^foreign\./ or $self->throw_exception("Malformed relationship condition key '$_': must be prefixed with 'foreign.'")
1390 $_ =~ /^self\./ or $self->throw_exception("Malformed relationship condition value '$_': must be prefixed with 'self.'")
1394 my %rels = %{ $self->_relationships };
1395 $rels{$rel} = { class => $f_source_name,
1396 source => $f_source_name,
1399 $self->_relationships(\%rels);
1403 # XXX disabled. doesn't work properly currently. skip in tests.
1405 my $f_source = $self->schema->source($f_source_name);
1406 unless ($f_source) {
1407 $self->ensure_class_loaded($f_source_name);
1408 $f_source = $f_source_name->result_source;
1409 #my $s_class = ref($self->schema);
1410 #$f_source_name =~ m/^${s_class}::(.*)$/;
1411 #$self->schema->register_class(($1 || $f_source_name), $f_source_name);
1412 #$f_source = $self->schema->source($f_source_name);
1414 return unless $f_source; # Can't test rel without f_source
1416 try { $self->_resolve_join($rel, 'me', {}, []) }
1418 # If the resolve failed, back out and re-throw the error
1420 $self->_relationships(\%rels);
1421 $self->throw_exception("Error creating relationship $rel: $_");
1427 =head2 relationships
1431 =item Arguments: none
1433 =item Return Value: L<@rel_names|DBIx::Class::Relationship>
1437 my @rel_names = $source->relationships();
1439 Returns all relationship names for this source.
1444 return keys %{shift->_relationships};
1447 =head2 relationship_info
1451 =item Arguments: L<$rel_name|DBIx::Class::Relationship>
1453 =item Return Value: L<\%rel_data|DBIx::Class::Relationship::Base/add_relationship>
1457 Returns a hash of relationship information for the specified relationship
1458 name. The keys/values are as specified for L<DBIx::Class::Relationship::Base/add_relationship>.
1462 sub relationship_info {
1463 #my ($self, $rel) = @_;
1464 return shift->_relationships->{+shift};
1467 =head2 has_relationship
1471 =item Arguments: L<$rel_name|DBIx::Class::Relationship>
1473 =item Return Value: 1/0 (true/false)
1477 Returns true if the source has a relationship of this name, false otherwise.
1481 sub has_relationship {
1482 #my ($self, $rel) = @_;
1483 return exists shift->_relationships->{+shift};
1486 =head2 reverse_relationship_info
1490 =item Arguments: L<$rel_name|DBIx::Class::Relationship>
1492 =item Return Value: L<\%rel_data|DBIx::Class::Relationship::Base/add_relationship>
1496 Looks through all the relationships on the source this relationship
1497 points to, looking for one whose condition is the reverse of the
1498 condition on this relationship.
1500 A common use of this is to find the name of the C<belongs_to> relation
1501 opposing a C<has_many> relation. For definition of these look in
1502 L<DBIx::Class::Relationship>.
1504 The returned hashref is keyed by the name of the opposing
1505 relationship, and contains its data in the same manner as
1506 L</relationship_info>.
1510 sub reverse_relationship_info {
1511 my ($self, $rel) = @_;
1513 my $rel_info = $self->relationship_info($rel)
1514 or $self->throw_exception("No such relationship '$rel'");
1518 return $ret unless ((ref $rel_info->{cond}) eq 'HASH');
1520 my $stripped_cond = $self->__strip_relcond ($rel_info->{cond});
1522 my $registered_source_name = $self->source_name;
1524 # this may be a partial schema or something else equally esoteric
1525 my $other_rsrc = $self->related_source($rel);
1527 # Get all the relationships for that source that related to this source
1528 # whose foreign column set are our self columns on $rel and whose self
1529 # columns are our foreign columns on $rel
1530 foreach my $other_rel ($other_rsrc->relationships) {
1532 # only consider stuff that points back to us
1533 # "us" here is tricky - if we are in a schema registration, we want
1534 # to use the source_names, otherwise we will use the actual classes
1536 # the schema may be partial
1537 my $roundtrip_rsrc = try { $other_rsrc->related_source($other_rel) }
1540 if ($registered_source_name) {
1541 next if $registered_source_name ne ($roundtrip_rsrc->source_name || '')
1544 next if $self->result_class ne $roundtrip_rsrc->result_class;
1547 my $other_rel_info = $other_rsrc->relationship_info($other_rel);
1549 # this can happen when we have a self-referential class
1550 next if $other_rel_info eq $rel_info;
1552 next unless ref $other_rel_info->{cond} eq 'HASH';
1553 my $other_stripped_cond = $self->__strip_relcond($other_rel_info->{cond});
1555 $ret->{$other_rel} = $other_rel_info if (
1556 $self->_compare_relationship_keys (
1557 [ keys %$stripped_cond ], [ values %$other_stripped_cond ]
1560 $self->_compare_relationship_keys (
1561 [ values %$stripped_cond ], [ keys %$other_stripped_cond ]
1569 # all this does is removes the foreign/self prefix from a condition
1570 sub __strip_relcond {
1573 { map { /^ (?:foreign|self) \. (\w+) $/x } ($_, $_[1]{$_}) }
1578 sub compare_relationship_keys {
1579 carp 'compare_relationship_keys is a private method, stop calling it';
1581 $self->_compare_relationship_keys (@_);
1584 # Returns true if both sets of keynames are the same, false otherwise.
1585 sub _compare_relationship_keys {
1586 # my ($self, $keys1, $keys2) = @_;
1588 join ("\x00", sort @{$_[1]})
1590 join ("\x00", sort @{$_[2]})
1594 # optionally takes either an arrayref of column names, or a hashref of already
1595 # retrieved colinfos
1596 # returns an arrayref of column names of the shortest unique constraint
1597 # (matching some of the input if any), giving preference to the PK
1598 sub _identifying_column_set {
1599 my ($self, $cols) = @_;
1601 my %unique = $self->unique_constraints;
1602 my $colinfos = ref $cols eq 'HASH' ? $cols : $self->columns_info($cols||());
1604 # always prefer the PK first, and then shortest constraints first
1606 for my $set (delete $unique{primary}, sort { @$a <=> @$b } (values %unique) ) {
1607 next unless $set && @$set;
1610 next USET unless ($colinfos->{$_} && !$colinfos->{$_}{is_nullable} );
1613 # copy so we can mangle it at will
1620 sub _minimal_valueset_satisfying_constraint {
1622 my $args = { ref $_[0] eq 'HASH' ? %{ $_[0] } : @_ };
1624 $args->{columns_info} ||= $self->columns_info;
1626 my $vals = $self->storage->_extract_fixed_condition_columns(
1628 ($args->{carp_on_nulls} ? 'consider_nulls' : undef ),
1632 for my $col ($self->unique_constraint_columns($args->{constraint_name}) ) {
1633 if( ! exists $vals->{$col} or ( $vals->{$col}||'' ) eq UNRESOLVABLE_CONDITION ) {
1634 $cols->{missing}{$col} = undef;
1636 elsif( ! defined $vals->{$col} ) {
1637 $cols->{$args->{carp_on_nulls} ? 'undefined' : 'missing'}{$col} = undef;
1640 # we need to inject back the '=' as _extract_fixed_condition_columns
1641 # will strip it from literals and values alike, resulting in an invalid
1642 # condition in the end
1643 $cols->{present}{$col} = { '=' => $vals->{$col} };
1646 $cols->{fc}{$col} = 1 if (
1647 ( ! $cols->{missing} or ! exists $cols->{missing}{$col} )
1649 keys %{ $args->{columns_info}{$col}{_filter_info} || {} }
1653 $self->throw_exception( sprintf ( "Unable to satisfy requested constraint '%s', missing values for column(s): %s",
1654 $args->{constraint_name},
1655 join (', ', map { "'$_'" } sort keys %{$cols->{missing}} ),
1656 ) ) if $cols->{missing};
1658 $self->throw_exception( sprintf (
1659 "Unable to satisfy requested constraint '%s', FilterColumn values not usable for column(s): %s",
1660 $args->{constraint_name},
1661 join (', ', map { "'$_'" } sort keys %{$cols->{fc}}),
1667 !$ENV{DBIC_NULLABLE_KEY_NOWARN}
1669 carp_unique ( sprintf (
1670 "NULL/undef values supplied for requested unique constraint '%s' (NULL "
1671 . 'values in column(s): %s). This is almost certainly not what you wanted, '
1672 . 'though you can set DBIC_NULLABLE_KEY_NOWARN to disable this warning.',
1673 $args->{constraint_name},
1674 join (', ', map { "'$_'" } sort keys %{$cols->{undefined}}),
1678 return { map { %{ $cols->{$_}||{} } } qw(present undefined) };
1681 # Returns the {from} structure used to express JOIN conditions
1683 my ($self, $join, $alias, $seen, $jpath, $parent_force_left) = @_;
1685 # we need a supplied one, because we do in-place modifications, no returns
1686 $self->throw_exception ('You must supply a seen hashref as the 3rd argument to _resolve_join')
1687 unless ref $seen eq 'HASH';
1689 $self->throw_exception ('You must supply a joinpath arrayref as the 4th argument to _resolve_join')
1690 unless ref $jpath eq 'ARRAY';
1692 $jpath = [@$jpath]; # copy
1694 if (not defined $join or not length $join) {
1697 elsif (ref $join eq 'ARRAY') {
1700 $self->_resolve_join($_, $alias, $seen, $jpath, $parent_force_left);
1703 elsif (ref $join eq 'HASH') {
1706 for my $rel (keys %$join) {
1708 my $rel_info = $self->relationship_info($rel)
1709 or $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
1711 my $force_left = $parent_force_left;
1712 $force_left ||= lc($rel_info->{attrs}{join_type}||'') eq 'left';
1714 # the actual seen value will be incremented by the recursion
1715 my $as = $self->storage->relname_to_table_alias(
1716 $rel, ($seen->{$rel} && $seen->{$rel} + 1)
1720 $self->_resolve_join($rel, $alias, $seen, [@$jpath], $force_left),
1721 $self->related_source($rel)->_resolve_join(
1722 $join->{$rel}, $as, $seen, [@$jpath, { $rel => $as }], $force_left
1730 $self->throw_exception("No idea how to resolve join reftype ".ref $join);
1733 my $count = ++$seen->{$join};
1734 my $as = $self->storage->relname_to_table_alias(
1735 $join, ($count > 1 && $count)
1738 my $rel_info = $self->relationship_info($join)
1739 or $self->throw_exception("No such relationship $join on " . $self->source_name);
1741 my $rel_src = $self->related_source($join);
1742 return [ { $as => $rel_src->from,
1744 -join_type => $parent_force_left
1746 : $rel_info->{attrs}{join_type}
1748 -join_path => [@$jpath, { $join => $as } ],
1750 ! $rel_info->{attrs}{accessor}
1752 $rel_info->{attrs}{accessor} eq 'single'
1754 $rel_info->{attrs}{accessor} eq 'filter'
1757 -relation_chain_depth => ( $seen->{-relation_chain_depth} || 0 ) + 1,
1759 $self->_resolve_relationship_condition(
1761 self_alias => $alias,
1762 foreign_alias => $as,
1769 carp 'pk_depends_on is a private method, stop calling it';
1771 $self->_pk_depends_on (@_);
1774 # Determines whether a relation is dependent on an object from this source
1775 # having already been inserted. Takes the name of the relationship and a
1776 # hashref of columns of the related object.
1777 sub _pk_depends_on {
1778 my ($self, $rel_name, $rel_data) = @_;
1780 my $relinfo = $self->relationship_info($rel_name);
1782 # don't assume things if the relationship direction is specified
1783 return $relinfo->{attrs}{is_foreign_key_constraint}
1784 if exists ($relinfo->{attrs}{is_foreign_key_constraint});
1786 my $cond = $relinfo->{cond};
1787 return 0 unless ref($cond) eq 'HASH';
1789 # map { foreign.foo => 'self.bar' } to { bar => 'foo' }
1790 my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond };
1792 # assume anything that references our PK probably is dependent on us
1793 # rather than vice versa, unless the far side is (a) defined or (b)
1795 my $rel_source = $self->related_source($rel_name);
1797 foreach my $p ($self->primary_columns) {
1798 if (exists $keyhash->{$p}) {
1799 unless (defined($rel_data->{$keyhash->{$p}})
1800 || $rel_source->column_info($keyhash->{$p})
1801 ->{is_auto_increment}) {
1810 sub resolve_condition {
1811 carp 'resolve_condition is a private method, stop calling it';
1812 shift->_resolve_condition (@_);
1815 sub _resolve_condition {
1816 # carp_unique sprintf
1817 # '_resolve_condition is a private method, and moreover is about to go '
1818 # . 'away. Please contact the development team at %s if you believe you '
1819 # . 'have a genuine use for this method, in order to discuss alternatives.',
1820 # DBIx::Class::_ENV_::HELP_URL,
1823 #######################
1824 ### API Design? What's that...? (a backwards compatible shim, kill me now)
1826 my ($self, $cond, @res_args, $rel_name);
1828 # we *SIMPLY DON'T KNOW YET* which arg is which, yay
1829 ($self, $cond, $res_args[0], $res_args[1], $rel_name) = @_;
1831 # assume that an undef is an object-like unset (set_from_related(undef))
1832 my @is_objlike = map { ! defined $_ or length ref $_ } (@res_args);
1834 # turn objlike into proper objects for saner code further down
1836 next unless $is_objlike[$_];
1838 if ( defined blessed $res_args[$_] ) {
1840 # but wait - there is more!!! WHAT THE FUCK?!?!?!?!
1841 if ($res_args[$_]->isa('DBIx::Class::ResultSet')) {
1842 carp('Passing a resultset for relationship resolution makes no sense - invoking __gremlins__');
1843 $is_objlike[$_] = 0;
1844 $res_args[$_] = '__gremlins__';
1848 $res_args[$_] ||= {};
1850 # hate everywhere - have to pass in as a plain hash
1851 # pretending to be an object at least for now
1852 $self->throw_exception("Unsupported object-like structure encountered: $res_args[$_]")
1853 unless ref $res_args[$_] eq 'HASH';
1858 # where-is-waldo block guesses relname, then further down we override it if available
1860 $is_objlike[1] ? ( rel_name => $res_args[0], self_alias => $res_args[0], foreign_alias => 'me', self_result_object => $res_args[1] )
1861 : $is_objlike[0] ? ( rel_name => $res_args[1], self_alias => 'me', foreign_alias => $res_args[1], foreign_values => $res_args[0] )
1862 : ( rel_name => $res_args[0], self_alias => $res_args[1], foreign_alias => $res_args[0] )
1865 ( $rel_name ? ( rel_name => $rel_name ) : () ),
1868 # Allowing passing relconds different than the relationshup itself is cute,
1869 # but likely dangerous. Remove that from the (still unofficial) API of
1870 # _resolve_relationship_condition, and instead make it "hard on purpose"
1871 local $self->relationship_info( $args->{rel_name} )->{cond} = $cond if defined $cond;
1873 #######################
1875 # now it's fucking easy isn't it?!
1876 my $rc = $self->_resolve_relationship_condition( $args );
1879 ( $rc->{join_free_condition} || $rc->{condition} ),
1880 ! $rc->{join_free_condition},
1883 # _resolve_relationship_condition always returns qualified cols even in the
1884 # case of join_free_condition, but nothing downstream expects this
1885 if ($rc->{join_free_condition} and ref $res[0] eq 'HASH') {
1887 { ($_ =~ /\.(.+)/) => $res[0]{$_} }
1893 return wantarray ? @res : $res[0];
1896 # Keep this indefinitely. There is evidence of both CPAN and
1897 # darkpan using it, and there isn't much harm in an extra var
1899 our $UNRESOLVABLE_CONDITION = UNRESOLVABLE_CONDITION;
1900 # YES I KNOW THIS IS EVIL
1901 # it is there to save darkpan from themselves, since internally
1902 # we are moving to a constant
1903 Internals::SvREADONLY($UNRESOLVABLE_CONDITION => 1);
1905 # Resolves the passed condition to a concrete query fragment and extra
1908 ## self-explanatory API, modeled on the custom cond coderef:
1909 # rel_name => (scalar)
1910 # foreign_alias => (scalar)
1911 # foreign_values => (either not supplied, or a hashref, or a foreign ResultObject (to be ->get_columns()ed), or plain undef )
1912 # self_alias => (scalar)
1913 # self_result_object => (either not supplied or a result object)
1914 # require_join_free_condition => (boolean, throws on failure to construct a JF-cond)
1915 # infer_values_based_on => (either not supplied or a hashref, implies require_join_free_condition)
1918 # condition => (a valid *likely fully qualified* sqla cond structure)
1919 # identity_map => (a hashref of foreign-to-self *unqualified* column equality names)
1920 # join_free_condition => (a valid *fully qualified* sqla cond structure, maybe unset)
1921 # inferred_values => (in case of an available join_free condition, this is a hashref of
1922 # *unqualified* column/value *EQUALITY* pairs, representing an amalgamation
1923 # of the JF-cond parse and infer_values_based_on
1924 # always either complete or unset)
1926 sub _resolve_relationship_condition {
1929 my $args = { ref $_[0] eq 'HASH' ? %{ $_[0] } : @_ };
1931 for ( qw( rel_name self_alias foreign_alias ) ) {
1932 $self->throw_exception("Mandatory argument '$_' to _resolve_relationship_condition() is not a plain string")
1933 if !defined $args->{$_} or length ref $args->{$_};
1936 $self->throw_exception("Arguments 'self_alias' and 'foreign_alias' may not be identical")
1937 if $args->{self_alias} eq $args->{foreign_alias};
1940 my $exception_rel_id = "relationship '$args->{rel_name}' on source '@{[ $self->source_name ]}'";
1942 my $rel_info = $self->relationship_info($args->{rel_name})
1944 # or $self->throw_exception( "No such $exception_rel_id" );
1945 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");
1948 $exception_rel_id = "relationship '$rel_info->{_original_name}' on source '@{[ $self->source_name ]}'"
1949 if $rel_info and exists $rel_info->{_original_name};
1951 $self->throw_exception("No practical way to resolve $exception_rel_id between two data structures")
1952 if exists $args->{self_result_object} and exists $args->{foreign_values};
1954 $self->throw_exception( "Argument to infer_values_based_on must be a hash" )
1955 if exists $args->{infer_values_based_on} and ref $args->{infer_values_based_on} ne 'HASH';
1957 $args->{require_join_free_condition} ||= !!$args->{infer_values_based_on};
1959 $self->throw_exception( "Argument 'self_result_object' must be an object inheriting from DBIx::Class::Row" )
1961 exists $args->{self_result_object}
1963 ( ! defined blessed $args->{self_result_object} or ! $args->{self_result_object}->isa('DBIx::Class::Row') )
1967 my $rel_rsrc = $self->related_source($args->{rel_name});
1968 my $storage = $self->schema->storage;
1970 if (exists $args->{foreign_values}) {
1972 if (! defined $args->{foreign_values} ) {
1973 # fallback: undef => {}
1974 $args->{foreign_values} = {};
1976 elsif (defined blessed $args->{foreign_values}) {
1978 $self->throw_exception( "Objects supplied as 'foreign_values' ($args->{foreign_values}) must inherit from DBIx::Class::Row" )
1979 unless $args->{foreign_values}->isa('DBIx::Class::Row');
1982 "Objects supplied as 'foreign_values' ($args->{foreign_values}) "
1983 . "usually should inherit from the related ResultClass ('@{[ $rel_rsrc->result_class ]}'), "
1984 . "perhaps you've made a mistake invoking the condition resolver?"
1985 ) unless $args->{foreign_values}->isa($rel_rsrc->result_class);
1987 $args->{foreign_values} = { $args->{foreign_values}->get_columns };
1989 elsif ( ref $args->{foreign_values} eq 'HASH' ) {
1991 # re-build {foreign_values} excluding identically named rels
1992 if( keys %{$args->{foreign_values}} ) {
1994 my ($col_idx, $rel_idx) = map
1995 { { map { $_ => 1 } $rel_rsrc->$_ } }
1996 qw( columns relationships )
1999 my $equivalencies = $storage->_extract_fixed_condition_columns(
2000 $args->{foreign_values},
2004 $args->{foreign_values} = { map {
2005 # skip if relationship *and* a non-literal ref
2006 # this means a multicreate stub was passed in
2010 length ref $args->{foreign_values}{$_}
2012 ! is_literal_value($args->{foreign_values}{$_})
2017 ? $self->throw_exception( "Key '$_' supplied as 'foreign_values' is not a column on related source '@{[ $rel_rsrc->source_name ]}'" )
2018 : ( !exists $equivalencies->{$_} or ($equivalencies->{$_}||'') eq UNRESOLVABLE_CONDITION )
2019 ? $self->throw_exception( "Value supplied for '...{foreign_values}{$_}' is not a direct equivalence expression" )
2020 : $args->{foreign_values}{$_}
2022 } keys %{$args->{foreign_values}} };
2026 $self->throw_exception(
2027 "Argument 'foreign_values' must be either an object inheriting from '@{[ $rel_rsrc->result_class ]}', "
2028 . "or a hash reference, or undef"
2035 if (ref $rel_info->{cond} eq 'CODE') {
2038 rel_name => $args->{rel_name},
2039 self_resultsource => $self,
2040 self_alias => $args->{self_alias},
2041 foreign_alias => $args->{foreign_alias},
2043 { (exists $args->{$_}) ? ( $_ => $args->{$_} ) : () }
2044 qw( self_result_object foreign_values )
2048 # legacy - never remove these!!!
2049 $cref_args->{foreign_relname} = $cref_args->{rel_name};
2051 $cref_args->{self_rowobj} = $cref_args->{self_result_object}
2052 if exists $cref_args->{self_result_object};
2054 ($ret->{condition}, $ret->{join_free_condition}, my @extra) = $rel_info->{cond}->($cref_args);
2057 $self->throw_exception("A custom condition coderef can return at most 2 conditions, but $exception_rel_id returned extra values: @extra")
2060 if (my $jfc = $ret->{join_free_condition}) {
2062 $self->throw_exception (
2063 "The join-free condition returned for $exception_rel_id must be a hash reference"
2064 ) unless ref $jfc eq 'HASH';
2066 my ($joinfree_alias, $joinfree_source);
2067 if (defined $args->{self_result_object}) {
2068 $joinfree_alias = $args->{foreign_alias};
2069 $joinfree_source = $rel_rsrc;
2071 elsif (defined $args->{foreign_values}) {
2072 $joinfree_alias = $args->{self_alias};
2073 $joinfree_source = $self;
2076 # FIXME sanity check until things stabilize, remove at some point
2077 $self->throw_exception (
2078 "A join-free condition returned for $exception_rel_id without a result object to chain from"
2079 ) unless $joinfree_alias;
2081 my $fq_col_list = { map
2082 { ( "$joinfree_alias.$_" => 1 ) }
2083 $joinfree_source->columns
2086 exists $fq_col_list->{$_} or $self->throw_exception (
2087 "The join-free condition returned for $exception_rel_id may only "
2088 . 'contain keys that are fully qualified column names of the corresponding source '
2089 . "'$joinfree_alias' (instead it returned '$_')"
2097 $_->isa('DBIx::Class::Row')
2099 $self->throw_exception (
2100 "The join-free condition returned for $exception_rel_id may not "
2101 . 'contain result objects as values - perhaps instead of invoking '
2102 . '->$something you meant to return ->get_column($something)'
2108 elsif (ref $rel_info->{cond} eq 'HASH') {
2110 # the condition is static - use parallel arrays
2111 # for a "pivot" depending on which side of the
2112 # rel did we get as an object
2113 my (@f_cols, @l_cols);
2114 for my $fc (keys %{ $rel_info->{cond} }) {
2115 my $lc = $rel_info->{cond}{$fc};
2117 # FIXME STRICTMODE should probably check these are valid columns
2118 $fc =~ s/^foreign\.// ||
2119 $self->throw_exception("Invalid rel cond key '$fc'");
2121 $lc =~ s/^self\.// ||
2122 $self->throw_exception("Invalid rel cond val '$lc'");
2128 # construct the crosstable condition and the identity map
2130 $ret->{condition}{"$args->{foreign_alias}.$f_cols[$_]"} = { -ident => "$args->{self_alias}.$l_cols[$_]" };
2131 $ret->{identity_map}{$l_cols[$_]} = $f_cols[$_];
2134 if ($args->{foreign_values}) {
2135 $ret->{join_free_condition}{"$args->{self_alias}.$l_cols[$_]"} = $args->{foreign_values}{$f_cols[$_]}
2138 elsif (defined $args->{self_result_object}) {
2140 for my $i (0..$#l_cols) {
2141 if ( $args->{self_result_object}->has_column_loaded($l_cols[$i]) ) {
2142 $ret->{join_free_condition}{"$args->{foreign_alias}.$f_cols[$i]"} = $args->{self_result_object}->get_column($l_cols[$i]);
2145 $self->throw_exception(sprintf
2146 "Unable to resolve relationship '%s' from object '%s': column '%s' not "
2147 . 'loaded from storage (or not passed to new() prior to insert()). You '
2148 . 'probably need to call ->discard_changes to get the server-side defaults '
2149 . 'from the database.',
2151 $args->{self_result_object},
2153 ) if $args->{self_result_object}->in_storage;
2155 # FIXME - temporarly force-override
2156 delete $args->{require_join_free_condition};
2157 $ret->{join_free_condition} = UNRESOLVABLE_CONDITION;
2163 elsif (ref $rel_info->{cond} eq 'ARRAY') {
2164 if (@{ $rel_info->{cond} } == 0) {
2166 condition => UNRESOLVABLE_CONDITION,
2167 join_free_condition => UNRESOLVABLE_CONDITION,
2171 my @subconds = map {
2172 local $rel_info->{cond} = $_;
2173 $self->_resolve_relationship_condition( $args );
2174 } @{ $rel_info->{cond} };
2176 if( @{ $rel_info->{cond} } == 1 ) {
2177 $ret = $subconds[0];
2180 # we are discarding inferred values here... likely incorrect...
2181 # then again - the entire thing is an OR, so we *can't* use them anyway
2182 for my $subcond ( @subconds ) {
2183 $self->throw_exception('Either all or none of the OR-condition members must resolve to a join-free condition')
2184 if ( $ret and ( $ret->{join_free_condition} xor $subcond->{join_free_condition} ) );
2186 $subcond->{$_} and push @{$ret->{$_}}, $subcond->{$_} for (qw(condition join_free_condition));
2192 $self->throw_exception ("Can't handle condition $rel_info->{cond} for $exception_rel_id yet :(");
2196 $args->{require_join_free_condition}
2198 ( ! $ret->{join_free_condition} or $ret->{join_free_condition} eq UNRESOLVABLE_CONDITION )
2200 $self->throw_exception(
2201 ucfirst sprintf "$exception_rel_id does not resolve to a %sjoin-free condition fragment",
2202 exists $args->{foreign_values}
2203 ? "'foreign_values'-based reversed-"
2208 # we got something back - sanity check and infer values if we can
2211 $ret->{join_free_condition}
2213 $ret->{join_free_condition} ne UNRESOLVABLE_CONDITION
2215 my $jfc = $storage->_collapse_cond( $ret->{join_free_condition} )
2218 my $jfc_eqs = $storage->_extract_fixed_condition_columns($jfc, 'consider_nulls');
2220 if (keys %$jfc_eqs) {
2223 # $jfc is fully qualified by definition
2224 my ($col) = $_ =~ /\.(.+)/;
2226 if (exists $jfc_eqs->{$_} and ($jfc_eqs->{$_}||'') ne UNRESOLVABLE_CONDITION) {
2227 $ret->{inferred_values}{$col} = $jfc_eqs->{$_};
2229 elsif ( !$args->{infer_values_based_on} or ! exists $args->{infer_values_based_on}{$col} ) {
2230 push @nonvalues, $col;
2235 delete $ret->{inferred_values} if @nonvalues;
2239 # did the user explicitly ask
2240 if ($args->{infer_values_based_on}) {
2242 $self->throw_exception(sprintf (
2243 "Unable to complete value inferrence - custom $exception_rel_id returns conditions instead of values for column(s): %s",
2244 map { "'$_'" } @nonvalues
2248 $ret->{inferred_values} ||= {};
2250 $ret->{inferred_values}{$_} = $args->{infer_values_based_on}{$_}
2251 for keys %{$args->{infer_values_based_on}};
2254 # add the identities based on the main condition
2255 # (may already be there, since easy to calculate on the fly in the HASH case)
2256 if ( ! $ret->{identity_map} ) {
2258 my $col_eqs = $storage->_extract_fixed_condition_columns($ret->{condition});
2261 for my $lhs (keys %$col_eqs) {
2263 next if $col_eqs->{$lhs} eq UNRESOLVABLE_CONDITION;
2265 # there is no way to know who is right and who is left in a cref
2266 # therefore a full blown resolution call, and figure out the
2267 # direction a bit further below
2268 $colinfos ||= $storage->_resolve_column_info([
2269 { -alias => $args->{self_alias}, -rsrc => $self },
2270 { -alias => $args->{foreign_alias}, -rsrc => $rel_rsrc },
2273 next unless $colinfos->{$lhs}; # someone is engaging in witchcraft
2275 if ( my $rhs_ref = is_literal_value( $col_eqs->{$lhs} ) ) {
2278 $colinfos->{$rhs_ref->[0]}
2280 $colinfos->{$lhs}{-source_alias} ne $colinfos->{$rhs_ref->[0]}{-source_alias}
2282 ( $colinfos->{$lhs}{-source_alias} eq $args->{self_alias} )
2283 ? ( $ret->{identity_map}{$colinfos->{$lhs}{-colname}} = $colinfos->{$rhs_ref->[0]}{-colname} )
2284 : ( $ret->{identity_map}{$colinfos->{$rhs_ref->[0]}{-colname}} = $colinfos->{$lhs}{-colname} )
2289 $col_eqs->{$lhs} =~ /^ ( \Q$args->{self_alias}\E \. .+ ) /x
2291 ($colinfos->{$1}||{})->{-result_source} == $rel_rsrc
2293 my ($lcol, $rcol) = map
2294 { $colinfos->{$_}{-colname} }
2298 "The $exception_rel_id specifies equality of column '$lcol' and the "
2299 . "*VALUE* '$rcol' (you did not use the { -ident => ... } operator)"
2305 # FIXME - temporary, to fool the idiotic check in SQLMaker::_join_condition
2306 $ret->{condition} = { -and => [ $ret->{condition} ] }
2307 unless $ret->{condition} eq UNRESOLVABLE_CONDITION;
2312 =head2 related_source
2316 =item Arguments: $rel_name
2318 =item Return Value: $source
2322 Returns the result source object for the given relationship.
2326 sub related_source {
2327 my ($self, $rel) = @_;
2328 if( !$self->has_relationship( $rel ) ) {
2329 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
2332 # if we are not registered with a schema - just use the prototype
2333 # however if we do have a schema - ask for the source by name (and
2334 # throw in the process if all fails)
2335 if (my $schema = try { $self->schema }) {
2336 $schema->source($self->relationship_info($rel)->{source});
2339 my $class = $self->relationship_info($rel)->{class};
2340 $self->ensure_class_loaded($class);
2341 $class->result_source_instance;
2345 =head2 related_class
2349 =item Arguments: $rel_name
2351 =item Return Value: $classname
2355 Returns the class name for objects in the given relationship.
2360 my ($self, $rel) = @_;
2361 if( !$self->has_relationship( $rel ) ) {
2362 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
2364 return $self->schema->class($self->relationship_info($rel)->{source});
2371 =item Arguments: none
2373 =item Return Value: L<$source_handle|DBIx::Class::ResultSourceHandle>
2377 Obtain a new L<result source handle instance|DBIx::Class::ResultSourceHandle>
2378 for this source. Used as a serializable pointer to this resultsource, as it is not
2379 easy (nor advisable) to serialize CODErefs which may very well be present in e.g.
2380 relationship definitions.
2385 return DBIx::Class::ResultSourceHandle->new({
2386 source_moniker => $_[0]->source_name,
2388 # so that a detached thaw can be re-frozen
2389 $_[0]->{_detached_thaw}
2390 ? ( _detached_source => $_[0] )
2391 : ( schema => $_[0]->schema )
2396 my $global_phase_destroy;
2398 ### NO detected_reinvoked_destructor check
2399 ### This code very much relies on being called multuple times
2401 return if $global_phase_destroy ||= in_global_destruction;
2407 # Under no circumstances shall $_[0] be stored anywhere else (like copied to
2408 # a lexical variable, or shifted, or anything else). Doing so will mess up
2409 # the refcount of this particular result source, and will allow the $schema
2410 # we are trying to save to reattach back to the source we are destroying.
2411 # The relevant code checking refcounts is in ::Schema::DESTROY()
2413 # if we are not a schema instance holder - we don't matter
2415 ! ref $_[0]->{schema}
2417 isweak $_[0]->{schema}
2420 # weaken our schema hold forcing the schema to find somewhere else to live
2421 # during global destruction (if we have not yet bailed out) this will throw
2422 # which will serve as a signal to not try doing anything else
2423 # however beware - on older perls the exception seems randomly untrappable
2424 # due to some weird race condition during thread joining :(((
2427 weaken $_[0]->{schema};
2429 # if schema is still there reintroduce ourselves with strong refs back to us
2430 if ($_[0]->{schema}) {
2431 my $srcregs = $_[0]->{schema}->source_registrations;
2432 for (keys %$srcregs) {
2433 next unless $srcregs->{$_};
2434 $srcregs->{$_} = $_[0] if $srcregs->{$_} == $_[0];
2440 $global_phase_destroy = 1;
2446 sub STORABLE_freeze { Storable::nfreeze($_[0]->handle) }
2449 my ($self, $cloning, $ice) = @_;
2450 %$self = %{ (Storable::thaw($ice))->resolve };
2453 =head2 throw_exception
2455 See L<DBIx::Class::Schema/"throw_exception">.
2459 sub throw_exception {
2463 ? $self->{schema}->throw_exception(@_)
2464 : DBIx::Class::Exception->throw(@_)
2468 =head2 column_info_from_storage
2472 =item Arguments: 1/0 (default: 0)
2474 =item Return Value: 1/0
2478 __PACKAGE__->column_info_from_storage(1);
2480 Enables the on-demand automatic loading of the above column
2481 metadata from storage as necessary. This is *deprecated*, and
2482 should not be used. It will be removed before 1.0.
2484 =head1 FURTHER QUESTIONS?
2486 Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
2488 =head1 COPYRIGHT AND LICENSE
2490 This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
2491 by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
2492 redistribute it and/or modify it under the same terms as the
2493 L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.