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 List::Util 'first';
17 use Scalar::Util qw/blessed weaken isweak/;
21 __PACKAGE__->mk_group_accessors(simple => qw/
22 source_name name source_info
23 _ordered_columns _columns _primaries _unique_constraints
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:
117 my ($class, $attrs) = @_;
118 $class = ref $class if ref $class;
120 my $new = bless { %{$attrs || {}} }, $class;
121 $new->{resultset_class} ||= 'DBIx::Class::ResultSet';
122 $new->{resultset_attributes} = { %{$new->{resultset_attributes} || {}} };
123 $new->{_ordered_columns} = [ @{$new->{_ordered_columns}||[]}];
124 $new->{_columns} = { %{$new->{_columns}||{}} };
125 $new->{_relationships} = { %{$new->{_relationships}||{}} };
126 $new->{name} ||= "!!NAME NOT SET!!";
127 $new->{_columns_info_loaded} ||= 0;
137 =item Arguments: @columns
139 =item Return Value: L<$result_source|/new>
143 $source->add_columns(qw/col1 col2 col3/);
145 $source->add_columns('col1' => \%col1_info, 'col2' => \%col2_info, ...);
147 $source->add_columns(
148 'col1' => { data_type => 'integer', is_nullable => 1, ... },
149 'col2' => { data_type => 'text', is_auto_increment => 1, ... },
152 Adds columns to the result source. If supplied colname => hashref
153 pairs, uses the hashref as the L</column_info> for that column. Repeated
154 calls of this method will add more columns, not replace them.
156 The column names given will be created as accessor methods on your
157 L<Result|DBIx::Class::Manual::ResultClass> objects. You can change the name of the accessor
158 by supplying an L</accessor> in the column_info hash.
160 If a column name beginning with a plus sign ('+col1') is provided, the
161 attributes provided will be merged with any existing attributes for the
162 column, with the new attributes taking precedence in the case that an
163 attribute already exists. Using this without a hashref
164 (C<< $source->add_columns(qw/+col1 +col2/) >>) is legal, but useless --
165 it does the same thing it would do without the plus.
167 The contents of the column_info are not set in stone. The following
168 keys are currently recognised/used by DBIx::Class:
174 { accessor => '_name' }
176 # example use, replace standard accessor with one of your own:
178 my ($self, $value) = @_;
180 die "Name cannot contain digits!" if($value =~ /\d/);
181 $self->_name($value);
183 return $self->_name();
186 Use this to set the name of the accessor method for this column. If unset,
187 the name of the column will be used.
191 { data_type => 'integer' }
193 This contains the column type. It is automatically filled if you use the
194 L<SQL::Translator::Producer::DBIx::Class::File> producer, or the
195 L<DBIx::Class::Schema::Loader> module.
197 Currently there is no standard set of values for the data_type. Use
198 whatever your database supports.
204 The length of your column, if it is a column type that can have a size
205 restriction. This is currently only used to create tables from your
206 schema, see L<DBIx::Class::Schema/deploy>.
212 Set this to a true value for a column that is allowed to contain NULL
213 values, default is false. This is currently only used to create tables
214 from your schema, see L<DBIx::Class::Schema/deploy>.
216 =item is_auto_increment
218 { is_auto_increment => 1 }
220 Set this to a true value for a column whose value is somehow
221 automatically set, defaults to false. This is used to determine which
222 columns to empty when cloning objects using
223 L<DBIx::Class::Row/copy>. It is also used by
224 L<DBIx::Class::Schema/deploy>.
230 Set this to a true or false value (not C<undef>) to explicitly specify
231 if this column contains numeric data. This controls how set_column
232 decides whether to consider a column dirty after an update: if
233 C<is_numeric> is true a numeric comparison C<< != >> will take place
234 instead of the usual C<eq>
236 If not specified the storage class will attempt to figure this out on
237 first access to the column, based on the column C<data_type>. The
238 result will be cached in this attribute.
242 { is_foreign_key => 1 }
244 Set this to a true value for a column that contains a key from a
245 foreign table, defaults to false. This is currently only used to
246 create tables from your schema, see L<DBIx::Class::Schema/deploy>.
250 { default_value => \'now()' }
252 Set this to the default value which will be inserted into a column by
253 the database. Can contain either a value or a function (use a
254 reference to a scalar e.g. C<\'now()'> if you want a function). This
255 is currently only used to create tables from your schema, see
256 L<DBIx::Class::Schema/deploy>.
258 See the note on L<DBIx::Class::Row/new> for more information about possible
259 issues related to db-side default values.
263 { sequence => 'my_table_seq' }
265 Set this on a primary key column to the name of the sequence used to
266 generate a new key value. If not specified, L<DBIx::Class::PK::Auto>
267 will attempt to retrieve the name of the sequence from the database
270 =item retrieve_on_insert
272 { retrieve_on_insert => 1 }
274 For every column where this is set to true, DBIC will retrieve the RDBMS-side
275 value upon a new row insertion (normally only the autoincrement PK is
276 retrieved on insert). C<INSERT ... RETURNING> is used automatically if
277 supported by the underlying storage, otherwise an extra SELECT statement is
278 executed to retrieve the missing data.
282 { auto_nextval => 1 }
284 Set this to a true value for a column whose value is retrieved automatically
285 from a sequence or function (if supported by your Storage driver.) For a
286 sequence, if you do not use a trigger to get the nextval, you have to set the
287 L</sequence> value as well.
289 Also set this for MSSQL columns with the 'uniqueidentifier'
290 L<data_type|DBIx::Class::ResultSource/data_type> whose values you want to
291 automatically generate using C<NEWID()>, unless they are a primary key in which
292 case this will be done anyway.
296 This is used by L<DBIx::Class::Schema/deploy> and L<SQL::Translator>
297 to add extra non-generic data to the column. For example: C<< extra
298 => { unsigned => 1} >> is used by the MySQL producer to set an integer
299 column to unsigned. For more details, see
300 L<SQL::Translator::Producer::MySQL>.
308 =item Arguments: $colname, \%columninfo?
310 =item Return Value: 1/0 (true/false)
314 $source->add_column('col' => \%info);
316 Add a single column and optional column info. Uses the same column
317 info keys as L</add_columns>.
322 my ($self, @cols) = @_;
323 $self->_ordered_columns(\@cols) unless $self->_ordered_columns;
326 my $columns = $self->_columns;
327 while (my $col = shift @cols) {
328 my $column_info = {};
329 if ($col =~ s/^\+//) {
330 $column_info = $self->column_info($col);
333 # If next entry is { ... } use that for the column info, if not
334 # use an empty hashref
336 my $new_info = shift(@cols);
337 %$column_info = (%$column_info, %$new_info);
339 push(@added, $col) unless exists $columns->{$col};
340 $columns->{$col} = $column_info;
342 push @{ $self->_ordered_columns }, @added;
346 sub add_column { shift->add_columns(@_); } # DO NOT CHANGE THIS TO GLOB
352 =item Arguments: $colname
354 =item Return Value: 1/0 (true/false)
358 if ($source->has_column($colname)) { ... }
360 Returns true if the source has a column of this name, false otherwise.
365 my ($self, $column) = @_;
366 return exists $self->_columns->{$column};
373 =item Arguments: $colname
375 =item Return Value: Hashref of info
379 my $info = $source->column_info($col);
381 Returns the column metadata hashref for a column, as originally passed
382 to L</add_columns>. See L</add_columns> above for information on the
383 contents of the hashref.
388 my ($self, $column) = @_;
389 $self->throw_exception("No such column $column")
390 unless exists $self->_columns->{$column};
392 if ( ! $self->_columns->{$column}{data_type}
393 and ! $self->{_columns_info_loaded}
394 and $self->column_info_from_storage
395 and my $stor = try { $self->storage } )
397 $self->{_columns_info_loaded}++;
399 # try for the case of storage without table
401 my $info = $stor->columns_info_for( $self->from );
403 { (lc $_) => $info->{$_} }
407 foreach my $col ( keys %{$self->_columns} ) {
408 $self->_columns->{$col} = {
409 %{ $self->_columns->{$col} },
410 %{ $info->{$col} || $lc_info->{lc $col} || {} }
416 return $self->_columns->{$column};
423 =item Arguments: none
425 =item Return Value: Ordered list of column names
429 my @column_names = $source->columns;
431 Returns all column names in the order they were declared to L</add_columns>.
437 $self->throw_exception(
438 "columns() is a read-only accessor, did you mean add_columns()?"
440 return @{$self->{_ordered_columns}||[]};
447 =item Arguments: \@colnames ?
449 =item Return Value: Hashref of column name/info pairs
453 my $columns_info = $source->columns_info;
455 Like L</column_info> but returns information for the requested columns. If
456 the optional column-list arrayref is omitted it returns info on all columns
457 currently defined on the ResultSource via L</add_columns>.
462 my ($self, $columns) = @_;
464 my $colinfo = $self->_columns;
467 first { ! $_->{data_type} } values %$colinfo
469 ! $self->{_columns_info_loaded}
471 $self->column_info_from_storage
473 my $stor = try { $self->storage }
475 $self->{_columns_info_loaded}++;
477 # try for the case of storage without table
479 my $info = $stor->columns_info_for( $self->from );
481 { (lc $_) => $info->{$_} }
485 foreach my $col ( keys %$colinfo ) {
487 %{ $colinfo->{$col} },
488 %{ $info->{$col} || $lc_info->{lc $col} || {} }
498 if (my $inf = $colinfo->{$_}) {
502 $self->throw_exception( sprintf (
503 "No such column '%s' on source '%s'",
505 $self->source_name || $self->name || 'Unknown source...?',
517 =head2 remove_columns
521 =item Arguments: @colnames
523 =item Return Value: not defined
527 $source->remove_columns(qw/col1 col2 col3/);
529 Removes the given list of columns by name, from the result source.
531 B<Warning>: Removing a column that is also used in the sources primary
532 key, or in one of the sources unique constraints, B<will> result in a
533 broken result source.
539 =item Arguments: $colname
541 =item Return Value: not defined
545 $source->remove_column('col');
547 Remove a single column by name from the result source, similar to
550 B<Warning>: Removing a column that is also used in the sources primary
551 key, or in one of the sources unique constraints, B<will> result in a
552 broken result source.
557 my ($self, @to_remove) = @_;
559 my $columns = $self->_columns
564 delete $columns->{$_};
568 $self->_ordered_columns([ grep { not $to_remove{$_} } @{$self->_ordered_columns} ]);
571 sub remove_column { shift->remove_columns(@_); } # DO NOT CHANGE THIS TO GLOB
573 =head2 set_primary_key
577 =item Arguments: @cols
579 =item Return Value: not defined
583 Defines one or more columns as primary key for this source. Must be
584 called after L</add_columns>.
586 Additionally, defines a L<unique constraint|/add_unique_constraint>
589 Note: you normally do want to define a primary key on your sources
590 B<even if the underlying database table does not have a primary key>.
592 L<DBIx::Class::Manual::Intro/The Significance and Importance of Primary Keys>
597 sub set_primary_key {
598 my ($self, @cols) = @_;
600 my $colinfo = $self->columns_info(\@cols);
601 for my $col (@cols) {
602 carp_unique(sprintf (
603 "Primary key of source '%s' includes the column '%s' which has its "
604 . "'is_nullable' attribute set to true. This is a mistake and will cause "
605 . 'various Result-object operations to fail',
606 $self->source_name || $self->name || 'Unknown source...?',
608 )) if $colinfo->{$col}{is_nullable};
611 $self->_primaries(\@cols);
613 $self->add_unique_constraint(primary => \@cols);
616 =head2 primary_columns
620 =item Arguments: none
622 =item Return Value: Ordered list of primary column names
626 Read-only accessor which returns the list of primary keys, supplied by
631 sub primary_columns {
632 return @{shift->_primaries||[]};
635 # a helper method that will automatically die with a descriptive message if
636 # no pk is defined on the source in question. For internal use to save
637 # on if @pks... boilerplate
638 sub _pri_cols_or_die {
640 my @pcols = $self->primary_columns
641 or $self->throw_exception (sprintf(
642 "Operation requires a primary key to be declared on '%s' via set_primary_key",
643 # source_name is set only after schema-registration
644 $self->source_name || $self->result_class || $self->name || 'Unknown source...?',
649 # same as above but mandating single-column PK (used by relationship condition
651 sub _single_pri_col_or_die {
653 my ($pri, @too_many) = $self->_pri_cols_or_die;
655 $self->throw_exception( sprintf(
656 "Operation requires a single-column primary key declared on '%s'",
657 $self->source_name || $self->result_class || $self->name || 'Unknown source...?',
665 Manually define the correct sequence for your table, to avoid the overhead
666 associated with looking up the sequence automatically. The supplied sequence
667 will be applied to the L</column_info> of each L<primary_key|/set_primary_key>
671 =item Arguments: $sequence_name
673 =item Return Value: not defined
680 my ($self,$seq) = @_;
682 my @pks = $self->primary_columns
685 $_->{sequence} = $seq
686 for values %{ $self->columns_info (\@pks) };
690 =head2 add_unique_constraint
694 =item Arguments: $name?, \@colnames
696 =item Return Value: not defined
700 Declare a unique constraint on this source. Call once for each unique
703 # For UNIQUE (column1, column2)
704 __PACKAGE__->add_unique_constraint(
705 constraint_name => [ qw/column1 column2/ ],
708 Alternatively, you can specify only the columns:
710 __PACKAGE__->add_unique_constraint([ qw/column1 column2/ ]);
712 This will result in a unique constraint named
713 C<table_column1_column2>, where C<table> is replaced with the table
716 Unique constraints are used, for example, when you pass the constraint
717 name as the C<key> attribute to L<DBIx::Class::ResultSet/find>. Then
718 only columns in the constraint are searched.
720 Throws an error if any of the given column names do not yet exist on
725 sub add_unique_constraint {
729 $self->throw_exception(
730 'add_unique_constraint() does not accept multiple constraints, use '
731 . 'add_unique_constraints() instead'
736 if (ref $cols ne 'ARRAY') {
737 $self->throw_exception (
738 'Expecting an arrayref of constraint columns, got ' . ($cols||'NOTHING')
744 $name ||= $self->name_unique_constraint($cols);
746 foreach my $col (@$cols) {
747 $self->throw_exception("No such column $col on table " . $self->name)
748 unless $self->has_column($col);
751 my %unique_constraints = $self->unique_constraints;
752 $unique_constraints{$name} = $cols;
753 $self->_unique_constraints(\%unique_constraints);
756 =head2 add_unique_constraints
760 =item Arguments: @constraints
762 =item Return Value: not defined
766 Declare multiple unique constraints on this source.
768 __PACKAGE__->add_unique_constraints(
769 constraint_name1 => [ qw/column1 column2/ ],
770 constraint_name2 => [ qw/column2 column3/ ],
773 Alternatively, you can specify only the columns:
775 __PACKAGE__->add_unique_constraints(
776 [ qw/column1 column2/ ],
777 [ qw/column3 column4/ ]
780 This will result in unique constraints named C<table_column1_column2> and
781 C<table_column3_column4>, where C<table> is replaced with the table name.
783 Throws an error if any of the given column names do not yet exist on
786 See also L</add_unique_constraint>.
790 sub add_unique_constraints {
792 my @constraints = @_;
794 if ( !(@constraints % 2) && first { ref $_ ne 'ARRAY' } @constraints ) {
795 # with constraint name
796 while (my ($name, $constraint) = splice @constraints, 0, 2) {
797 $self->add_unique_constraint($name => $constraint);
802 foreach my $constraint (@constraints) {
803 $self->add_unique_constraint($constraint);
808 =head2 name_unique_constraint
812 =item Arguments: \@colnames
814 =item Return Value: Constraint name
818 $source->table('mytable');
819 $source->name_unique_constraint(['col1', 'col2']);
823 Return a name for a unique constraint containing the specified
824 columns. The name is created by joining the table name and each column
825 name, using an underscore character.
827 For example, a constraint on a table named C<cd> containing the columns
828 C<artist> and C<title> would result in a constraint name of C<cd_artist_title>.
830 This is used by L</add_unique_constraint> if you do not specify the
831 optional constraint name.
835 sub name_unique_constraint {
836 my ($self, $cols) = @_;
838 my $name = $self->name;
839 $name = $$name if (ref $name eq 'SCALAR');
840 $name =~ s/ ^ [^\.]+ \. //x; # strip possible schema qualifier
842 return join '_', $name, @$cols;
845 =head2 unique_constraints
849 =item Arguments: none
851 =item Return Value: Hash of unique constraint data
855 $source->unique_constraints();
857 Read-only accessor which returns a hash of unique constraints on this
860 The hash is keyed by constraint name, and contains an arrayref of
861 column names as values.
865 sub unique_constraints {
866 return %{shift->_unique_constraints||{}};
869 =head2 unique_constraint_names
873 =item Arguments: none
875 =item Return Value: Unique constraint names
879 $source->unique_constraint_names();
881 Returns the list of unique constraint names defined on this source.
885 sub unique_constraint_names {
888 my %unique_constraints = $self->unique_constraints;
890 return keys %unique_constraints;
893 =head2 unique_constraint_columns
897 =item Arguments: $constraintname
899 =item Return Value: List of constraint columns
903 $source->unique_constraint_columns('myconstraint');
905 Returns the list of columns that make up the specified unique constraint.
909 sub unique_constraint_columns {
910 my ($self, $constraint_name) = @_;
912 my %unique_constraints = $self->unique_constraints;
914 $self->throw_exception(
915 "Unknown unique constraint $constraint_name on '" . $self->name . "'"
916 ) unless exists $unique_constraints{$constraint_name};
918 return @{ $unique_constraints{$constraint_name} };
921 =head2 sqlt_deploy_callback
925 =item Arguments: $callback_name | \&callback_code
927 =item Return Value: $callback_name | \&callback_code
931 __PACKAGE__->sqlt_deploy_callback('mycallbackmethod');
935 __PACKAGE__->sqlt_deploy_callback(sub {
936 my ($source_instance, $sqlt_table) = @_;
940 An accessor to set a callback to be called during deployment of
941 the schema via L<DBIx::Class::Schema/create_ddl_dir> or
942 L<DBIx::Class::Schema/deploy>.
944 The callback can be set as either a code reference or the name of a
945 method in the current result class.
947 Defaults to L</default_sqlt_deploy_hook>.
949 Your callback will be passed the $source object representing the
950 ResultSource instance being deployed, and the
951 L<SQL::Translator::Schema::Table> object being created from it. The
952 callback can be used to manipulate the table object or add your own
953 customised indexes. If you need to manipulate a non-table object, use
954 the L<DBIx::Class::Schema/sqlt_deploy_hook>.
956 See L<DBIx::Class::Manual::Cookbook/Adding Indexes And Functions To
957 Your SQL> for examples.
959 This sqlt deployment callback can only be used to manipulate
960 SQL::Translator objects as they get turned into SQL. To execute
961 post-deploy statements which SQL::Translator does not currently
962 handle, override L<DBIx::Class::Schema/deploy> in your Schema class
963 and call L<dbh_do|DBIx::Class::Storage::DBI/dbh_do>.
965 =head2 default_sqlt_deploy_hook
967 This is the default deploy hook implementation which checks if your
968 current Result class has a C<sqlt_deploy_hook> method, and if present
969 invokes it B<on the Result class directly>. This is to preserve the
970 semantics of C<sqlt_deploy_hook> which was originally designed to expect
971 the Result class name and the
972 L<$sqlt_table instance|SQL::Translator::Schema::Table> of the table being
977 sub default_sqlt_deploy_hook {
980 my $class = $self->result_class;
982 if ($class and $class->can('sqlt_deploy_hook')) {
983 $class->sqlt_deploy_hook(@_);
987 sub _invoke_sqlt_deploy_hook {
989 if ( my $hook = $self->sqlt_deploy_callback) {
998 =item Arguments: $classname
1000 =item Return Value: $classname
1004 use My::Schema::ResultClass::Inflator;
1007 use My::Schema::Artist;
1009 __PACKAGE__->result_class('My::Schema::ResultClass::Inflator');
1011 Set the default result class for this source. You can use this to create
1012 and use your own result inflator. See L<DBIx::Class::ResultSet/result_class>
1015 Please note that setting this to something like
1016 L<DBIx::Class::ResultClass::HashRefInflator> will make every result unblessed
1017 and make life more difficult. Inflators like those are better suited to
1018 temporary usage via L<DBIx::Class::ResultSet/result_class>.
1024 =item Arguments: none
1026 =item Return Value: L<$resultset|DBIx::Class::ResultSet>
1030 Returns a resultset for the given source. This will initially be created
1031 on demand by calling
1033 $self->resultset_class->new($self, $self->resultset_attributes)
1035 but is cached from then on unless resultset_class changes.
1037 =head2 resultset_class
1041 =item Arguments: $classname
1043 =item Return Value: $classname
1047 package My::Schema::ResultSet::Artist;
1048 use base 'DBIx::Class::ResultSet';
1051 # In the result class
1052 __PACKAGE__->resultset_class('My::Schema::ResultSet::Artist');
1055 $source->resultset_class('My::Schema::ResultSet::Artist');
1057 Set the class of the resultset. This is useful if you want to create your
1058 own resultset methods. Create your own class derived from
1059 L<DBIx::Class::ResultSet>, and set it here. If called with no arguments,
1060 this method returns the name of the existing resultset class, if one
1063 =head2 resultset_attributes
1067 =item Arguments: L<\%attrs|DBIx::Class::ResultSet/ATTRIBUTES>
1069 =item Return Value: L<\%attrs|DBIx::Class::ResultSet/ATTRIBUTES>
1073 # In the result class
1074 __PACKAGE__->resultset_attributes({ order_by => [ 'id' ] });
1077 $source->resultset_attributes({ order_by => [ 'id' ] });
1079 Store a collection of resultset attributes, that will be set on every
1080 L<DBIx::Class::ResultSet> produced from this result source.
1082 B<CAVEAT>: C<resultset_attributes> comes with its own set of issues and
1083 bugs! While C<resultset_attributes> isn't deprecated per se, its usage is
1086 Since relationships use attributes to link tables together, the "default"
1087 attributes you set may cause unpredictable and undesired behavior. Furthermore,
1088 the defaults cannot be turned off, so you are stuck with them.
1090 In most cases, what you should actually be using are project-specific methods:
1092 package My::Schema::ResultSet::Artist;
1093 use base 'DBIx::Class::ResultSet';
1097 #__PACKAGE__->resultset_attributes({ prefetch => 'tracks' });
1100 sub with_tracks { shift->search({}, { prefetch => 'tracks' }) }
1103 $schema->resultset('Artist')->with_tracks->...
1105 This gives you the flexibility of not using it when you don't need it.
1107 For more complex situations, another solution would be to use a virtual view
1108 via L<DBIx::Class::ResultSource::View>.
1114 $self->throw_exception(
1115 'resultset does not take any arguments. If you want another resultset, '.
1116 'call it on the schema instead.'
1119 $self->resultset_class->new(
1122 try { %{$self->schema->default_resultset_attributes} },
1123 %{$self->{resultset_attributes}},
1132 =item Arguments: none
1134 =item Result value: $name
1138 Returns the name of the result source, which will typically be the table
1139 name. This may be a scalar reference if the result source has a non-standard
1146 =item Arguments: $source_name
1148 =item Result value: $source_name
1152 Set an alternate name for the result source when it is loaded into a schema.
1153 This is useful if you want to refer to a result source by a name other than
1156 package ArchivedBooks;
1157 use base qw/DBIx::Class/;
1158 __PACKAGE__->table('books_archive');
1159 __PACKAGE__->source_name('Books');
1161 # from your schema...
1162 $schema->resultset('Books')->find(1);
1168 =item Arguments: none
1170 =item Return Value: FROM clause
1174 my $from_clause = $source->from();
1176 Returns an expression of the source to be supplied to storage to specify
1177 retrieval from this source. In the case of a database, the required FROM
1182 sub from { die 'Virtual method!' }
1188 =item Arguments: L<$schema?|DBIx::Class::Schema>
1190 =item Return Value: L<$schema|DBIx::Class::Schema>
1194 my $schema = $source->schema();
1196 Sets and/or returns the L<DBIx::Class::Schema> object to which this
1197 result source instance has been attached to.
1203 $_[0]->{schema} = $_[1];
1206 $_[0]->{schema} || do {
1207 my $name = $_[0]->{source_name} || '_unnamed_';
1208 my $err = 'Unable to perform storage-dependent operations with a detached result source '
1209 . "(source '$name' is not associated with a schema).";
1211 $err .= ' You need to use $schema->thaw() or manually set'
1212 . ' $DBIx::Class::ResultSourceHandle::thaw_schema while thawing.'
1213 if $_[0]->{_detached_thaw};
1215 DBIx::Class::Exception->throw($err);
1224 =item Arguments: none
1226 =item Return Value: L<$storage|DBIx::Class::Storage>
1230 $source->storage->debug(1);
1232 Returns the L<storage handle|DBIx::Class::Storage> for the current schema.
1236 sub storage { shift->schema->storage; }
1238 =head2 add_relationship
1242 =item Arguments: $rel_name, $related_source_name, \%cond, \%attrs?
1244 =item Return Value: 1/true if it succeeded
1248 $source->add_relationship('rel_name', 'related_source', $cond, $attrs);
1250 L<DBIx::Class::Relationship> describes a series of methods which
1251 create pre-defined useful types of relationships. Look there first
1252 before using this method directly.
1254 The relationship name can be arbitrary, but must be unique for each
1255 relationship attached to this result source. 'related_source' should
1256 be the name with which the related result source was registered with
1257 the current schema. For example:
1259 $schema->source('Book')->add_relationship('reviews', 'Review', {
1260 'foreign.book_id' => 'self.id',
1263 The condition C<$cond> needs to be an L<SQL::Abstract>-style
1264 representation of the join between the tables. For example, if you're
1265 creating a relation from Author to Book,
1267 { 'foreign.author_id' => 'self.id' }
1269 will result in the JOIN clause
1271 author me JOIN book foreign ON foreign.author_id = me.id
1273 You can specify as many foreign => self mappings as necessary.
1275 Valid attributes are as follows:
1281 Explicitly specifies the type of join to use in the relationship. Any
1282 SQL join type is valid, e.g. C<LEFT> or C<RIGHT>. It will be placed in
1283 the SQL command immediately before C<JOIN>.
1287 An arrayref containing a list of accessors in the foreign class to proxy in
1288 the main class. If, for example, you do the following:
1290 CD->might_have(liner_notes => 'LinerNotes', undef, {
1291 proxy => [ qw/notes/ ],
1294 Then, assuming LinerNotes has an accessor named notes, you can do:
1296 my $cd = CD->find(1);
1297 # set notes -- LinerNotes object is created if it doesn't exist
1298 $cd->notes('Notes go here');
1302 Specifies the type of accessor that should be created for the
1303 relationship. Valid values are C<single> (for when there is only a single
1304 related object), C<multi> (when there can be many), and C<filter> (for
1305 when there is a single related object, but you also want the relationship
1306 accessor to double as a column accessor). For C<multi> accessors, an
1307 add_to_* method is also created, which calls C<create_related> for the
1312 Throws an exception if the condition is improperly supplied, or cannot
1317 sub add_relationship {
1318 my ($self, $rel, $f_source_name, $cond, $attrs) = @_;
1319 $self->throw_exception("Can't create relationship without join condition")
1323 # Check foreign and self are right in cond
1324 if ( (ref $cond ||'') eq 'HASH') {
1325 $_ =~ /^foreign\./ or $self->throw_exception("Malformed relationship condition key '$_': must be prefixed with 'foreign.'")
1328 $_ =~ /^self\./ or $self->throw_exception("Malformed relationship condition value '$_': must be prefixed with 'self.'")
1332 my %rels = %{ $self->_relationships };
1333 $rels{$rel} = { class => $f_source_name,
1334 source => $f_source_name,
1337 $self->_relationships(\%rels);
1341 # XXX disabled. doesn't work properly currently. skip in tests.
1343 my $f_source = $self->schema->source($f_source_name);
1344 unless ($f_source) {
1345 $self->ensure_class_loaded($f_source_name);
1346 $f_source = $f_source_name->result_source;
1347 #my $s_class = ref($self->schema);
1348 #$f_source_name =~ m/^${s_class}::(.*)$/;
1349 #$self->schema->register_class(($1 || $f_source_name), $f_source_name);
1350 #$f_source = $self->schema->source($f_source_name);
1352 return unless $f_source; # Can't test rel without f_source
1354 try { $self->_resolve_join($rel, 'me', {}, []) }
1356 # If the resolve failed, back out and re-throw the error
1358 $self->_relationships(\%rels);
1359 $self->throw_exception("Error creating relationship $rel: $_");
1365 =head2 relationships
1369 =item Arguments: none
1371 =item Return Value: L<@rel_names|DBIx::Class::Relationship>
1375 my @rel_names = $source->relationships();
1377 Returns all relationship names for this source.
1382 return keys %{shift->_relationships};
1385 =head2 relationship_info
1389 =item Arguments: L<$rel_name|DBIx::Class::Relationship>
1391 =item Return Value: L<\%rel_data|DBIx::Class::Relationship::Base/add_relationship>
1395 Returns a hash of relationship information for the specified relationship
1396 name. The keys/values are as specified for L<DBIx::Class::Relationship::Base/add_relationship>.
1400 sub relationship_info {
1401 #my ($self, $rel) = @_;
1402 return shift->_relationships->{+shift};
1405 =head2 has_relationship
1409 =item Arguments: L<$rel_name|DBIx::Class::Relationship>
1411 =item Return Value: 1/0 (true/false)
1415 Returns true if the source has a relationship of this name, false otherwise.
1419 sub has_relationship {
1420 #my ($self, $rel) = @_;
1421 return exists shift->_relationships->{+shift};
1424 =head2 reverse_relationship_info
1428 =item Arguments: L<$rel_name|DBIx::Class::Relationship>
1430 =item Return Value: L<\%rel_data|DBIx::Class::Relationship::Base/add_relationship>
1434 Looks through all the relationships on the source this relationship
1435 points to, looking for one whose condition is the reverse of the
1436 condition on this relationship.
1438 A common use of this is to find the name of the C<belongs_to> relation
1439 opposing a C<has_many> relation. For definition of these look in
1440 L<DBIx::Class::Relationship>.
1442 The returned hashref is keyed by the name of the opposing
1443 relationship, and contains its data in the same manner as
1444 L</relationship_info>.
1448 sub reverse_relationship_info {
1449 my ($self, $rel) = @_;
1451 my $rel_info = $self->relationship_info($rel)
1452 or $self->throw_exception("No such relationship '$rel'");
1456 return $ret unless ((ref $rel_info->{cond}) eq 'HASH');
1458 my $stripped_cond = $self->__strip_relcond ($rel_info->{cond});
1460 my $registered_source_name = $self->source_name;
1462 # this may be a partial schema or something else equally esoteric
1463 my $other_rsrc = $self->related_source($rel);
1465 # Get all the relationships for that source that related to this source
1466 # whose foreign column set are our self columns on $rel and whose self
1467 # columns are our foreign columns on $rel
1468 foreach my $other_rel ($other_rsrc->relationships) {
1470 # only consider stuff that points back to us
1471 # "us" here is tricky - if we are in a schema registration, we want
1472 # to use the source_names, otherwise we will use the actual classes
1474 # the schema may be partial
1475 my $roundtrip_rsrc = try { $other_rsrc->related_source($other_rel) }
1478 if ($registered_source_name) {
1479 next if $registered_source_name ne ($roundtrip_rsrc->source_name || '')
1482 next if $self->result_class ne $roundtrip_rsrc->result_class;
1485 my $other_rel_info = $other_rsrc->relationship_info($other_rel);
1487 # this can happen when we have a self-referential class
1488 next if $other_rel_info eq $rel_info;
1490 next unless ref $other_rel_info->{cond} eq 'HASH';
1491 my $other_stripped_cond = $self->__strip_relcond($other_rel_info->{cond});
1493 $ret->{$other_rel} = $other_rel_info if (
1494 $self->_compare_relationship_keys (
1495 [ keys %$stripped_cond ], [ values %$other_stripped_cond ]
1498 $self->_compare_relationship_keys (
1499 [ values %$stripped_cond ], [ keys %$other_stripped_cond ]
1507 # all this does is removes the foreign/self prefix from a condition
1508 sub __strip_relcond {
1511 { map { /^ (?:foreign|self) \. (\w+) $/x } ($_, $_[1]{$_}) }
1516 sub compare_relationship_keys {
1517 carp 'compare_relationship_keys is a private method, stop calling it';
1519 $self->_compare_relationship_keys (@_);
1522 # Returns true if both sets of keynames are the same, false otherwise.
1523 sub _compare_relationship_keys {
1524 # my ($self, $keys1, $keys2) = @_;
1526 join ("\x00", sort @{$_[1]})
1528 join ("\x00", sort @{$_[2]})
1532 # optionally takes either an arrayref of column names, or a hashref of already
1533 # retrieved colinfos
1534 # returns an arrayref of column names of the shortest unique constraint
1535 # (matching some of the input if any), giving preference to the PK
1536 sub _identifying_column_set {
1537 my ($self, $cols) = @_;
1539 my %unique = $self->unique_constraints;
1540 my $colinfos = ref $cols eq 'HASH' ? $cols : $self->columns_info($cols||());
1542 # always prefer the PK first, and then shortest constraints first
1544 for my $set (delete $unique{primary}, sort { @$a <=> @$b } (values %unique) ) {
1545 next unless $set && @$set;
1548 next USET unless ($colinfos->{$_} && !$colinfos->{$_}{is_nullable} );
1551 # copy so we can mangle it at will
1558 sub _minimal_valueset_satisfying_constraint {
1560 my $args = { ref $_[0] eq 'HASH' ? %{ $_[0] } : @_ };
1562 $args->{columns_info} ||= $self->columns_info;
1564 my $vals = $self->storage->_extract_fixed_condition_columns(
1566 ($args->{carp_on_nulls} ? 'consider_nulls' : undef ),
1570 for my $col ($self->unique_constraint_columns($args->{constraint_name}) ) {
1571 if( ! exists $vals->{$col} or ( $vals->{$col}||'' ) eq UNRESOLVABLE_CONDITION ) {
1572 $cols->{missing}{$col} = undef;
1574 elsif( ! defined $vals->{$col} ) {
1575 $cols->{$args->{carp_on_nulls} ? 'undefined' : 'missing'}{$col} = undef;
1578 # we need to inject back the '=' as _extract_fixed_condition_columns
1579 # will strip it from literals and values alike, resulting in an invalid
1580 # condition in the end
1581 $cols->{present}{$col} = { '=' => $vals->{$col} };
1584 $cols->{fc}{$col} = 1 if (
1585 ( ! $cols->{missing} or ! exists $cols->{missing}{$col} )
1587 keys %{ $args->{columns_info}{$col}{_filter_info} || {} }
1591 $self->throw_exception( sprintf ( "Unable to satisfy requested constraint '%s', missing values for column(s): %s",
1592 $args->{constraint_name},
1593 join (', ', map { "'$_'" } sort keys %{$cols->{missing}} ),
1594 ) ) if $cols->{missing};
1596 $self->throw_exception( sprintf (
1597 "Unable to satisfy requested constraint '%s', FilterColumn values not usable for column(s): %s",
1598 $args->{constraint_name},
1599 join (', ', map { "'$_'" } sort keys %{$cols->{fc}}),
1605 !$ENV{DBIC_NULLABLE_KEY_NOWARN}
1607 carp_unique ( sprintf (
1608 "NULL/undef values supplied for requested unique constraint '%s' (NULL "
1609 . 'values in column(s): %s). This is almost certainly not what you wanted, '
1610 . 'though you can set DBIC_NULLABLE_KEY_NOWARN to disable this warning.',
1611 $args->{constraint_name},
1612 join (', ', map { "'$_'" } sort keys %{$cols->{undefined}}),
1616 return { map { %{ $cols->{$_}||{} } } qw(present undefined) };
1619 # Returns the {from} structure used to express JOIN conditions
1621 my ($self, $join, $alias, $seen, $jpath, $parent_force_left) = @_;
1623 # we need a supplied one, because we do in-place modifications, no returns
1624 $self->throw_exception ('You must supply a seen hashref as the 3rd argument to _resolve_join')
1625 unless ref $seen eq 'HASH';
1627 $self->throw_exception ('You must supply a joinpath arrayref as the 4th argument to _resolve_join')
1628 unless ref $jpath eq 'ARRAY';
1630 $jpath = [@$jpath]; # copy
1632 if (not defined $join or not length $join) {
1635 elsif (ref $join eq 'ARRAY') {
1638 $self->_resolve_join($_, $alias, $seen, $jpath, $parent_force_left);
1641 elsif (ref $join eq 'HASH') {
1644 for my $rel (keys %$join) {
1646 my $rel_info = $self->relationship_info($rel)
1647 or $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
1649 my $force_left = $parent_force_left;
1650 $force_left ||= lc($rel_info->{attrs}{join_type}||'') eq 'left';
1652 # the actual seen value will be incremented by the recursion
1653 my $as = $self->storage->relname_to_table_alias(
1654 $rel, ($seen->{$rel} && $seen->{$rel} + 1)
1658 $self->_resolve_join($rel, $alias, $seen, [@$jpath], $force_left),
1659 $self->related_source($rel)->_resolve_join(
1660 $join->{$rel}, $as, $seen, [@$jpath, { $rel => $as }], $force_left
1668 $self->throw_exception("No idea how to resolve join reftype ".ref $join);
1671 my $count = ++$seen->{$join};
1672 my $as = $self->storage->relname_to_table_alias(
1673 $join, ($count > 1 && $count)
1676 my $rel_info = $self->relationship_info($join)
1677 or $self->throw_exception("No such relationship $join on " . $self->source_name);
1679 my $rel_src = $self->related_source($join);
1680 return [ { $as => $rel_src->from,
1682 -join_type => $parent_force_left
1684 : $rel_info->{attrs}{join_type}
1686 -join_path => [@$jpath, { $join => $as } ],
1688 (! $rel_info->{attrs}{accessor})
1690 first { $rel_info->{attrs}{accessor} eq $_ } (qw/single filter/)
1693 -relation_chain_depth => ( $seen->{-relation_chain_depth} || 0 ) + 1,
1695 scalar $self->_resolve_condition($rel_info->{cond}, $as, $alias, $join)
1701 carp 'pk_depends_on is a private method, stop calling it';
1703 $self->_pk_depends_on (@_);
1706 # Determines whether a relation is dependent on an object from this source
1707 # having already been inserted. Takes the name of the relationship and a
1708 # hashref of columns of the related object.
1709 sub _pk_depends_on {
1710 my ($self, $rel_name, $rel_data) = @_;
1712 my $relinfo = $self->relationship_info($rel_name);
1714 # don't assume things if the relationship direction is specified
1715 return $relinfo->{attrs}{is_foreign_key_constraint}
1716 if exists ($relinfo->{attrs}{is_foreign_key_constraint});
1718 my $cond = $relinfo->{cond};
1719 return 0 unless ref($cond) eq 'HASH';
1721 # map { foreign.foo => 'self.bar' } to { bar => 'foo' }
1722 my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond };
1724 # assume anything that references our PK probably is dependent on us
1725 # rather than vice versa, unless the far side is (a) defined or (b)
1727 my $rel_source = $self->related_source($rel_name);
1729 foreach my $p ($self->primary_columns) {
1730 if (exists $keyhash->{$p}) {
1731 unless (defined($rel_data->{$keyhash->{$p}})
1732 || $rel_source->column_info($keyhash->{$p})
1733 ->{is_auto_increment}) {
1742 sub resolve_condition {
1743 carp 'resolve_condition is a private method, stop calling it';
1744 shift->_resolve_condition (@_);
1747 sub _resolve_condition {
1748 # carp_unique sprintf
1749 # '_resolve_condition is a private method, and moreover is about to go '
1750 # . 'away. Please contact the development team at %s if you believe you '
1751 # . 'have a genuine use for this method, in order to discuss alternatives.',
1752 # DBIx::Class::_ENV_::HELP_URL,
1755 #######################
1756 ### API Design? What's that...? (a backwards compatible shim, kill me now)
1758 my ($self, $cond, @res_args, $rel_name);
1760 # we *SIMPLY DON'T KNOW YET* which arg is which, yay
1761 ($self, $cond, $res_args[0], $res_args[1], $rel_name) = @_;
1763 # assume that an undef is an object-like unset (set_from_related(undef))
1764 my @is_objlike = map { ! defined $_ or length ref $_ } (@res_args);
1766 # turn objlike into proper objects for saner code further down
1768 next unless $is_objlike[$_];
1770 if ( defined blessed $res_args[$_] ) {
1772 # but wait - there is more!!! WHAT THE FUCK?!?!?!?!
1773 if ($res_args[$_]->isa('DBIx::Class::ResultSet')) {
1774 carp('Passing a resultset for relationship resolution makes no sense - invoking __gremlins__');
1775 $is_objlike[$_] = 0;
1776 $res_args[$_] = '__gremlins__';
1780 $res_args[$_] ||= {};
1782 # hate everywhere - have to pass in as a plain hash
1783 # pretending to be an object at least for now
1784 $self->throw_exception("Unsupported object-like structure encountered: $res_args[$_]")
1785 unless ref $res_args[$_] eq 'HASH';
1792 # where-is-waldo block guesses relname, then further down we override it if available
1794 $is_objlike[1] ? ( rel_name => $res_args[0], self_alias => $res_args[0], foreign_alias => 'me', self_result_object => $res_args[1] )
1795 : $is_objlike[0] ? ( rel_name => $res_args[1], self_alias => 'me', foreign_alias => $res_args[1], foreign_values => $res_args[0] )
1796 : ( rel_name => $res_args[0], self_alias => $res_args[1], foreign_alias => $res_args[0] )
1799 ( $rel_name ? ( rel_name => $rel_name ) : () ),
1801 #######################
1803 # now it's fucking easy isn't it?!
1804 my $rc = $self->_resolve_relationship_condition( $args );
1807 ( $rc->{join_free_condition} || $rc->{condition} ),
1808 ! $rc->{join_free_condition},
1811 # _resolve_relationship_condition always returns qualified cols even in the
1812 # case of join_free_condition, but nothing downstream expects this
1813 if ($rc->{join_free_condition} and ref $res[0] eq 'HASH') {
1815 { ($_ =~ /\.(.+)/) => $res[0]{$_} }
1821 return wantarray ? @res : $res[0];
1824 # Keep this indefinitely. There is evidence of both CPAN and
1825 # darkpan using it, and there isn't much harm in an extra var
1827 our $UNRESOLVABLE_CONDITION = UNRESOLVABLE_CONDITION;
1828 # YES I KNOW THIS IS EVIL
1829 # it is there to save darkpan from themselves, since internally
1830 # we are moving to a constant
1831 Internals::SvREADONLY($UNRESOLVABLE_CONDITION => 1);
1833 # Resolves the passed condition to a concrete query fragment and extra
1836 ## self-explanatory API, modeled on the custom cond coderef:
1837 # rel_name => (scalar)
1838 # foreign_alias => (scalar)
1839 # foreign_values => (either not supplied, or a hashref, or a foreign ResultObject (to be ->get_columns()ed), or plain undef )
1840 # self_alias => (scalar)
1841 # self_result_object => (either not supplied or a result object)
1842 # require_join_free_condition => (boolean, throws on failure to construct a JF-cond)
1843 # infer_values_based_on => (either not supplied or a hashref, implies require_join_free_condition)
1844 # condition => (sqla cond struct, optional, defeaults to from $self->rel_info(rel_name)->{cond})
1847 # condition => (a valid *likely fully qualified* sqla cond structure)
1848 # identity_map => (a hashref of foreign-to-self *unqualified* column equality names)
1849 # join_free_condition => (a valid *fully qualified* sqla cond structure, maybe unset)
1850 # inferred_values => (in case of an available join_free condition, this is a hashref of
1851 # *unqualified* column/value *EQUALITY* pairs, representing an amalgamation
1852 # of the JF-cond parse and infer_values_based_on
1853 # always either complete or unset)
1855 sub _resolve_relationship_condition {
1858 my $args = { ref $_[0] eq 'HASH' ? %{ $_[0] } : @_ };
1860 for ( qw( rel_name self_alias foreign_alias ) ) {
1861 $self->throw_exception("Mandatory argument '$_' to _resolve_relationship_condition() is not a plain string")
1862 if !defined $args->{$_} or length ref $args->{$_};
1865 $self->throw_exception("Arguments 'self_alias' and 'foreign_alias' may not be identical")
1866 if $args->{self_alias} eq $args->{foreign_alias};
1869 my $exception_rel_id = "relationship '$args->{rel_name}' on source '@{[ $self->source_name ]}'";
1871 my $rel_info = $self->relationship_info($args->{rel_name})
1873 # or $self->throw_exception( "No such $exception_rel_id" );
1874 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");
1877 $exception_rel_id = "relationship '$rel_info->{_original_name}' on source '@{[ $self->source_name ]}'"
1878 if $rel_info and exists $rel_info->{_original_name};
1880 $self->throw_exception("No practical way to resolve $exception_rel_id between two data structures")
1881 if exists $args->{self_result_object} and exists $args->{foreign_values};
1883 $self->throw_exception( "Argument to infer_values_based_on must be a hash" )
1884 if exists $args->{infer_values_based_on} and ref $args->{infer_values_based_on} ne 'HASH';
1886 $args->{require_join_free_condition} ||= !!$args->{infer_values_based_on};
1888 $args->{condition} ||= $rel_info->{cond};
1890 $self->throw_exception( "Argument 'self_result_object' must be an object of class '@{[ $self->result_class ]}'" )
1892 exists $args->{self_result_object}
1894 ( ! defined blessed $args->{self_result_object} or ! $args->{self_result_object}->isa($self->result_class) )
1899 my $rel_rsrc;# = $self->related_source($args->{rel_name});
1901 if (exists $args->{foreign_values}) {
1903 $rel_rsrc ||= $self->related_source($args->{rel_name});
1905 if (defined blessed $args->{foreign_values}) {
1907 $self->throw_exception( "Objects supplied as 'foreign_values' ($args->{foreign_values}) must inherit from DBIx::Class::Row" )
1908 unless $args->{foreign_values}->isa('DBIx::Class::Row');
1911 "Objects supplied as 'foreign_values' ($args->{foreign_values}) "
1912 . "usually should inherit from the related ResultClass ('@{[ $rel_rsrc->result_class ]}'), "
1913 . "perhaps you've made a mistake invoking the condition resolver?"
1914 ) unless $args->{foreign_values}->isa($rel_rsrc->result_class);
1916 $args->{foreign_values} = { $args->{foreign_values}->get_columns };
1918 elsif (! defined $args->{foreign_values} or ref $args->{foreign_values} eq 'HASH') {
1919 my $ri = { map { $_ => 1 } $rel_rsrc->relationships };
1920 my $ci = $rel_rsrc->columns_info;
1921 ! exists $ci->{$_} and ! exists $ri->{$_} and $self->throw_exception(
1922 "Key '$_' supplied as 'foreign_values' is not a column on related source '@{[ $rel_rsrc->source_name ]}'"
1923 ) for keys %{ $args->{foreign_values} ||= {} };
1926 $self->throw_exception(
1927 "Argument 'foreign_values' must be either an object inheriting from '@{[ $rel_rsrc->result_class ]}', "
1928 . "or a hash reference, or undef"
1935 if (ref $args->{condition} eq 'CODE') {
1938 rel_name => $args->{rel_name},
1939 self_resultsource => $self,
1940 self_alias => $args->{self_alias},
1941 foreign_alias => $args->{foreign_alias},
1943 { (exists $args->{$_}) ? ( $_ => $args->{$_} ) : () }
1944 qw( self_result_object foreign_values )
1948 # legacy - never remove these!!!
1949 $cref_args->{foreign_relname} = $cref_args->{rel_name};
1951 $cref_args->{self_rowobj} = $cref_args->{self_result_object}
1952 if exists $cref_args->{self_result_object};
1954 ($ret->{condition}, $ret->{join_free_condition}, my @extra) = $args->{condition}->($cref_args);
1957 $self->throw_exception("A custom condition coderef can return at most 2 conditions, but $exception_rel_id returned extra values: @extra")
1960 if (my $jfc = $ret->{join_free_condition}) {
1962 $self->throw_exception (
1963 "The join-free condition returned for $exception_rel_id must be a hash reference"
1964 ) unless ref $jfc eq 'HASH';
1967 $rel_rsrc ||= $self->related_source($args->{rel_name});
1969 my ($joinfree_alias, $joinfree_source);
1970 if (defined $args->{self_result_object}) {
1971 $joinfree_alias = $args->{foreign_alias};
1972 $joinfree_source = $rel_rsrc;
1974 elsif (defined $args->{foreign_values}) {
1975 $joinfree_alias = $args->{self_alias};
1976 $joinfree_source = $self;
1979 # FIXME sanity check until things stabilize, remove at some point
1980 $self->throw_exception (
1981 "A join-free condition returned for $exception_rel_id without a result object to chain from"
1982 ) unless $joinfree_alias;
1984 my $fq_col_list = { map
1985 { ( "$joinfree_alias.$_" => 1 ) }
1986 $joinfree_source->columns
1989 exists $fq_col_list->{$_} or $self->throw_exception (
1990 "The join-free condition returned for $exception_rel_id may only "
1991 . 'contain keys that are fully qualified column names of the corresponding source '
1992 . "(it returned '$_')"
2000 $_->isa('DBIx::Class::Row')
2002 $self->throw_exception (
2003 "The join-free condition returned for $exception_rel_id may not "
2004 . 'contain result objects as values - perhaps instead of invoking '
2005 . '->$something you meant to return ->get_column($something)'
2011 elsif (ref $args->{condition} eq 'HASH') {
2013 # the condition is static - use parallel arrays
2014 # for a "pivot" depending on which side of the
2015 # rel did we get as an object
2016 my (@f_cols, @l_cols);
2017 for my $fc (keys %{$args->{condition}}) {
2018 my $lc = $args->{condition}{$fc};
2020 # FIXME STRICTMODE should probably check these are valid columns
2021 $fc =~ s/^foreign\.// ||
2022 $self->throw_exception("Invalid rel cond key '$fc'");
2024 $lc =~ s/^self\.// ||
2025 $self->throw_exception("Invalid rel cond val '$lc'");
2031 # construct the crosstable condition and the identity map
2033 $ret->{condition}{"$args->{foreign_alias}.$f_cols[$_]"} = { -ident => "$args->{self_alias}.$l_cols[$_]" };
2034 $ret->{identity_map}{$l_cols[$_]} = $f_cols[$_];
2037 if ($args->{foreign_values}) {
2038 $ret->{join_free_condition}{"$args->{self_alias}.$l_cols[$_]"} = $args->{foreign_values}{$f_cols[$_]}
2041 elsif (defined $args->{self_result_object}) {
2043 for my $i (0..$#l_cols) {
2044 if ( $args->{self_result_object}->has_column_loaded($l_cols[$i]) ) {
2045 $ret->{join_free_condition}{"$args->{foreign_alias}.$f_cols[$i]"} = $args->{self_result_object}->get_column($l_cols[$i]);
2048 $self->throw_exception(sprintf
2049 "Unable to resolve relationship '%s' from object '%s': column '%s' not "
2050 . 'loaded from storage (or not passed to new() prior to insert()). You '
2051 . 'probably need to call ->discard_changes to get the server-side defaults '
2052 . 'from the database.',
2054 $args->{self_result_object},
2056 ) if $args->{self_result_object}->in_storage;
2058 # FIXME - temporarly force-override
2059 delete $args->{require_join_free_condition};
2060 $ret->{join_free_condition} = UNRESOLVABLE_CONDITION;
2066 elsif (ref $args->{condition} eq 'ARRAY') {
2067 if (@{$args->{condition}} == 0) {
2069 condition => UNRESOLVABLE_CONDITION,
2070 join_free_condition => UNRESOLVABLE_CONDITION,
2073 elsif (@{$args->{condition}} == 1) {
2074 $ret = $self->_resolve_relationship_condition({
2076 condition => $args->{condition}[0],
2080 # we are discarding inferred values here... likely incorrect...
2081 # then again - the entire thing is an OR, so we *can't* use them anyway
2082 for my $subcond ( map
2083 { $self->_resolve_relationship_condition({ %$args, condition => $_ }) }
2084 @{$args->{condition}}
2086 $self->throw_exception('Either all or none of the OR-condition members must resolve to a join-free condition')
2087 if ( $ret and ( $ret->{join_free_condition} xor $subcond->{join_free_condition} ) );
2089 $subcond->{$_} and push @{$ret->{$_}}, $subcond->{$_} for (qw(condition join_free_condition));
2094 $self->throw_exception ("Can't handle condition $args->{condition} for $exception_rel_id yet :(");
2097 $self->throw_exception(ucfirst "$exception_rel_id does not resolve to a join-free condition fragment") if (
2098 $args->{require_join_free_condition}
2100 ( ! $ret->{join_free_condition} or $ret->{join_free_condition} eq UNRESOLVABLE_CONDITION )
2103 my $storage = $self->schema->storage;
2105 # we got something back - sanity check and infer values if we can
2107 if ( my $jfc = $ret->{join_free_condition} and $ret->{join_free_condition} ne UNRESOLVABLE_CONDITION ) {
2109 my $jfc_eqs = $storage->_extract_fixed_condition_columns($jfc, 'consider_nulls');
2111 if (keys %$jfc_eqs) {
2114 # $jfc is fully qualified by definition
2115 my ($col) = $_ =~ /\.(.+)/;
2117 if (exists $jfc_eqs->{$_} and ($jfc_eqs->{$_}||'') ne UNRESOLVABLE_CONDITION) {
2118 $ret->{inferred_values}{$col} = $jfc_eqs->{$_};
2120 elsif ( !$args->{infer_values_based_on} or ! exists $args->{infer_values_based_on}{$col} ) {
2121 push @nonvalues, $col;
2126 delete $ret->{inferred_values} if @nonvalues;
2130 # did the user explicitly ask
2131 if ($args->{infer_values_based_on}) {
2133 $self->throw_exception(sprintf (
2134 "Unable to complete value inferrence - custom $exception_rel_id returns conditions instead of values for column(s): %s",
2135 map { "'$_'" } @nonvalues
2139 $ret->{inferred_values} ||= {};
2141 $ret->{inferred_values}{$_} = $args->{infer_values_based_on}{$_}
2142 for keys %{$args->{infer_values_based_on}};
2145 # add the identities based on the main condition
2146 # (may already be there, since easy to calculate on the fly in the HASH case)
2147 if ( ! $ret->{identity_map} ) {
2149 my $col_eqs = $storage->_extract_fixed_condition_columns($ret->{condition});
2152 for my $lhs (keys %$col_eqs) {
2154 next if $col_eqs->{$lhs} eq UNRESOLVABLE_CONDITION;
2157 $rel_rsrc ||= $self->related_source($args->{rel_name});
2159 # there is no way to know who is right and who is left in a cref
2160 # therefore a full blown resolution call, and figure out the
2161 # direction a bit further below
2162 $colinfos ||= $storage->_resolve_column_info([
2163 { -alias => $args->{self_alias}, -rsrc => $self },
2164 { -alias => $args->{foreign_alias}, -rsrc => $rel_rsrc },
2167 next unless $colinfos->{$lhs}; # someone is engaging in witchcraft
2169 if ( my $rhs_ref = is_literal_value( $col_eqs->{$lhs} ) ) {
2172 $colinfos->{$rhs_ref->[0]}
2174 $colinfos->{$lhs}{-source_alias} ne $colinfos->{$rhs_ref->[0]}{-source_alias}
2176 ( $colinfos->{$lhs}{-source_alias} eq $args->{self_alias} )
2177 ? ( $ret->{identity_map}{$colinfos->{$lhs}{-colname}} = $colinfos->{$rhs_ref->[0]}{-colname} )
2178 : ( $ret->{identity_map}{$colinfos->{$rhs_ref->[0]}{-colname}} = $colinfos->{$lhs}{-colname} )
2183 $col_eqs->{$lhs} =~ /^ ( \Q$args->{self_alias}\E \. .+ ) /x
2185 ($colinfos->{$1}||{})->{-result_source} == $rel_rsrc
2187 my ($lcol, $rcol) = map
2188 { $colinfos->{$_}{-colname} }
2192 "The $exception_rel_id specifies equality of column '$lcol' and the "
2193 . "*VALUE* '$rcol' (you did not use the { -ident => ... } operator)"
2199 # FIXME - temporary, to fool the idiotic check in SQLMaker::_join_condition
2200 $ret->{condition} = { -and => [ $ret->{condition} ] }
2201 unless $ret->{condition} eq UNRESOLVABLE_CONDITION;
2206 =head2 related_source
2210 =item Arguments: $rel_name
2212 =item Return Value: $source
2216 Returns the result source object for the given relationship.
2220 sub related_source {
2221 my ($self, $rel) = @_;
2222 if( !$self->has_relationship( $rel ) ) {
2223 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
2226 # if we are not registered with a schema - just use the prototype
2227 # however if we do have a schema - ask for the source by name (and
2228 # throw in the process if all fails)
2229 if (my $schema = try { $self->schema }) {
2230 $schema->source($self->relationship_info($rel)->{source});
2233 my $class = $self->relationship_info($rel)->{class};
2234 $self->ensure_class_loaded($class);
2235 $class->result_source_instance;
2239 =head2 related_class
2243 =item Arguments: $rel_name
2245 =item Return Value: $classname
2249 Returns the class name for objects in the given relationship.
2254 my ($self, $rel) = @_;
2255 if( !$self->has_relationship( $rel ) ) {
2256 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
2258 return $self->schema->class($self->relationship_info($rel)->{source});
2265 =item Arguments: none
2267 =item Return Value: L<$source_handle|DBIx::Class::ResultSourceHandle>
2271 Obtain a new L<result source handle instance|DBIx::Class::ResultSourceHandle>
2272 for this source. Used as a serializable pointer to this resultsource, as it is not
2273 easy (nor advisable) to serialize CODErefs which may very well be present in e.g.
2274 relationship definitions.
2279 return DBIx::Class::ResultSourceHandle->new({
2280 source_moniker => $_[0]->source_name,
2282 # so that a detached thaw can be re-frozen
2283 $_[0]->{_detached_thaw}
2284 ? ( _detached_source => $_[0] )
2285 : ( schema => $_[0]->schema )
2290 my $global_phase_destroy;
2292 return if $global_phase_destroy ||= in_global_destruction;
2298 # Under no circumstances shall $_[0] be stored anywhere else (like copied to
2299 # a lexical variable, or shifted, or anything else). Doing so will mess up
2300 # the refcount of this particular result source, and will allow the $schema
2301 # we are trying to save to reattach back to the source we are destroying.
2302 # The relevant code checking refcounts is in ::Schema::DESTROY()
2304 # if we are not a schema instance holder - we don't matter
2306 ! ref $_[0]->{schema}
2308 isweak $_[0]->{schema}
2311 # weaken our schema hold forcing the schema to find somewhere else to live
2312 # during global destruction (if we have not yet bailed out) this will throw
2313 # which will serve as a signal to not try doing anything else
2314 # however beware - on older perls the exception seems randomly untrappable
2315 # due to some weird race condition during thread joining :(((
2318 weaken $_[0]->{schema};
2320 # if schema is still there reintroduce ourselves with strong refs back to us
2321 if ($_[0]->{schema}) {
2322 my $srcregs = $_[0]->{schema}->source_registrations;
2323 for (keys %$srcregs) {
2324 next unless $srcregs->{$_};
2325 $srcregs->{$_} = $_[0] if $srcregs->{$_} == $_[0];
2331 $global_phase_destroy = 1;
2337 sub STORABLE_freeze { Storable::nfreeze($_[0]->handle) }
2340 my ($self, $cloning, $ice) = @_;
2341 %$self = %{ (Storable::thaw($ice))->resolve };
2344 =head2 throw_exception
2346 See L<DBIx::Class::Schema/"throw_exception">.
2350 sub throw_exception {
2354 ? $self->{schema}->throw_exception(@_)
2355 : DBIx::Class::Exception->throw(@_)
2361 Stores a hashref of per-source metadata. No specific key names
2362 have yet been standardized, the examples below are purely hypothetical
2363 and don't actually accomplish anything on their own:
2365 __PACKAGE__->source_info({
2366 "_tablespace" => 'fast_disk_array_3',
2367 "_engine" => 'InnoDB',
2374 $class->new({attribute_name => value});
2376 Creates a new ResultSource object. Not normally called directly by end users.
2378 =head2 column_info_from_storage
2382 =item Arguments: 1/0 (default: 0)
2384 =item Return Value: 1/0
2388 __PACKAGE__->column_info_from_storage(1);
2390 Enables the on-demand automatic loading of the above column
2391 metadata from storage as necessary. This is *deprecated*, and
2392 should not be used. It will be removed before 1.0.
2395 =head1 AUTHOR AND CONTRIBUTORS
2397 See L<AUTHOR|DBIx::Class/AUTHOR> and L<CONTRIBUTORS|DBIx::Class/CONTRIBUTORS> in DBIx::Class
2401 You may distribute this code under the same terms as Perl itself.