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::ResultSoure::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
89 you when you define a L<result class|DBIx::Class::Manual::Glossary/Result class>.
91 You can retrieve the result source at runtime in the following ways:
95 =item From a Schema object:
97 $schema->source($source_name);
99 =item From a Result object:
101 $result->result_source;
103 =item From a ResultSet object:
116 my ($class, $attrs) = @_;
117 $class = ref $class if ref $class;
119 my $new = bless { %{$attrs || {}} }, $class;
120 $new->{resultset_class} ||= 'DBIx::Class::ResultSet';
121 $new->{resultset_attributes} = { %{$new->{resultset_attributes} || {}} };
122 $new->{_ordered_columns} = [ @{$new->{_ordered_columns}||[]}];
123 $new->{_columns} = { %{$new->{_columns}||{}} };
124 $new->{_relationships} = { %{$new->{_relationships}||{}} };
125 $new->{name} ||= "!!NAME NOT SET!!";
126 $new->{_columns_info_loaded} ||= 0;
136 =item Arguments: @columns
138 =item Return Value: L<$result_source|/new>
142 $source->add_columns(qw/col1 col2 col3/);
144 $source->add_columns('col1' => \%col1_info, 'col2' => \%col2_info, ...);
146 $source->add_columns(
147 'col1' => { data_type => 'integer', is_nullable => 1, ... },
148 'col2' => { data_type => 'text', is_auto_increment => 1, ... },
151 Adds columns to the result source. If supplied colname => hashref
152 pairs, uses the hashref as the L</column_info> for that column. Repeated
153 calls of this method will add more columns, not replace them.
155 The column names given will be created as accessor methods on your
156 L<Result|DBIx::Class::Manual::ResultClass> objects. You can change the name of the accessor
157 by supplying an L</accessor> in the column_info hash.
159 If a column name beginning with a plus sign ('+col1') is provided, the
160 attributes provided will be merged with any existing attributes for the
161 column, with the new attributes taking precedence in the case that an
162 attribute already exists. Using this without a hashref
163 (C<< $source->add_columns(qw/+col1 +col2/) >>) is legal, but useless --
164 it does the same thing it would do without the plus.
166 The contents of the column_info are not set in stone. The following
167 keys are currently recognised/used by DBIx::Class:
173 { accessor => '_name' }
175 # example use, replace standard accessor with one of your own:
177 my ($self, $value) = @_;
179 die "Name cannot contain digits!" if($value =~ /\d/);
180 $self->_name($value);
182 return $self->_name();
185 Use this to set the name of the accessor method for this column. If unset,
186 the name of the column will be used.
190 { data_type => 'integer' }
192 This contains the column type. It is automatically filled if you use the
193 L<SQL::Translator::Producer::DBIx::Class::File> producer, or the
194 L<DBIx::Class::Schema::Loader> module.
196 Currently there is no standard set of values for the data_type. Use
197 whatever your database supports.
203 The length of your column, if it is a column type that can have a size
204 restriction. This is currently only used to create tables from your
205 schema, see L<DBIx::Class::Schema/deploy>.
211 Set this to a true value for a column that is allowed to contain NULL
212 values, default is false. This is currently only used to create tables
213 from your schema, see L<DBIx::Class::Schema/deploy>.
215 =item is_auto_increment
217 { is_auto_increment => 1 }
219 Set this to a true value for a column whose value is somehow
220 automatically set, defaults to false. This is used to determine which
221 columns to empty when cloning objects using
222 L<DBIx::Class::Row/copy>. It is also used by
223 L<DBIx::Class::Schema/deploy>.
229 Set this to a true or false value (not C<undef>) to explicitly specify
230 if this column contains numeric data. This controls how set_column
231 decides whether to consider a column dirty after an update: if
232 C<is_numeric> is true a numeric comparison C<< != >> will take place
233 instead of the usual C<eq>
235 If not specified the storage class will attempt to figure this out on
236 first access to the column, based on the column C<data_type>. The
237 result will be cached in this attribute.
241 { is_foreign_key => 1 }
243 Set this to a true value for a column that contains a key from a
244 foreign table, defaults to false. This is currently only used to
245 create tables from your schema, see L<DBIx::Class::Schema/deploy>.
249 { default_value => \'now()' }
251 Set this to the default value which will be inserted into a column by
252 the database. Can contain either a value or a function (use a
253 reference to a scalar e.g. C<\'now()'> if you want a function). This
254 is currently only used to create tables from your schema, see
255 L<DBIx::Class::Schema/deploy>.
257 See the note on L<DBIx::Class::Row/new> for more information about possible
258 issues related to db-side default values.
262 { sequence => 'my_table_seq' }
264 Set this on a primary key column to the name of the sequence used to
265 generate a new key value. If not specified, L<DBIx::Class::PK::Auto>
266 will attempt to retrieve the name of the sequence from the database
269 =item retrieve_on_insert
271 { retrieve_on_insert => 1 }
273 For every column where this is set to true, DBIC will retrieve the RDBMS-side
274 value upon a new row insertion (normally only the autoincrement PK is
275 retrieved on insert). C<INSERT ... RETURNING> is used automatically if
276 supported by the underlying storage, otherwise an extra SELECT statement is
277 executed to retrieve the missing data.
281 { auto_nextval => 1 }
283 Set this to a true value for a column whose value is retrieved automatically
284 from a sequence or function (if supported by your Storage driver.) For a
285 sequence, if you do not use a trigger to get the nextval, you have to set the
286 L</sequence> value as well.
288 Also set this for MSSQL columns with the 'uniqueidentifier'
289 L<data_type|DBIx::Class::ResultSource/data_type> whose values you want to
290 automatically generate using C<NEWID()>, unless they are a primary key in which
291 case this will be done anyway.
295 This is used by L<DBIx::Class::Schema/deploy> and L<SQL::Translator>
296 to add extra non-generic data to the column. For example: C<< extra
297 => { unsigned => 1} >> is used by the MySQL producer to set an integer
298 column to unsigned. For more details, see
299 L<SQL::Translator::Producer::MySQL>.
307 =item Arguments: $colname, \%columninfo?
309 =item Return Value: 1/0 (true/false)
313 $source->add_column('col' => \%info);
315 Add a single column and optional column info. Uses the same column
316 info keys as L</add_columns>.
321 my ($self, @cols) = @_;
322 $self->_ordered_columns(\@cols) unless $self->_ordered_columns;
325 my $columns = $self->_columns;
326 while (my $col = shift @cols) {
327 my $column_info = {};
328 if ($col =~ s/^\+//) {
329 $column_info = $self->column_info($col);
332 # If next entry is { ... } use that for the column info, if not
333 # use an empty hashref
335 my $new_info = shift(@cols);
336 %$column_info = (%$column_info, %$new_info);
338 push(@added, $col) unless exists $columns->{$col};
339 $columns->{$col} = $column_info;
341 push @{ $self->_ordered_columns }, @added;
345 sub add_column { shift->add_columns(@_); } # DO NOT CHANGE THIS TO GLOB
351 =item Arguments: $colname
353 =item Return Value: 1/0 (true/false)
357 if ($source->has_column($colname)) { ... }
359 Returns true if the source has a column of this name, false otherwise.
364 my ($self, $column) = @_;
365 return exists $self->_columns->{$column};
372 =item Arguments: $colname
374 =item Return Value: Hashref of info
378 my $info = $source->column_info($col);
380 Returns the column metadata hashref for a column, as originally passed
381 to L</add_columns>. See L</add_columns> above for information on the
382 contents of the hashref.
387 my ($self, $column) = @_;
388 $self->throw_exception("No such column $column")
389 unless exists $self->_columns->{$column};
391 if ( ! $self->_columns->{$column}{data_type}
392 and ! $self->{_columns_info_loaded}
393 and $self->column_info_from_storage
394 and my $stor = try { $self->storage } )
396 $self->{_columns_info_loaded}++;
398 # try for the case of storage without table
400 my $info = $stor->columns_info_for( $self->from );
402 { (lc $_) => $info->{$_} }
406 foreach my $col ( keys %{$self->_columns} ) {
407 $self->_columns->{$col} = {
408 %{ $self->_columns->{$col} },
409 %{ $info->{$col} || $lc_info->{lc $col} || {} }
415 return $self->_columns->{$column};
422 =item Arguments: none
424 =item Return Value: Ordered list of column names
428 my @column_names = $source->columns;
430 Returns all column names in the order they were declared to L</add_columns>.
436 $self->throw_exception(
437 "columns() is a read-only accessor, did you mean add_columns()?"
439 return @{$self->{_ordered_columns}||[]};
446 =item Arguments: \@colnames ?
448 =item Return Value: Hashref of column name/info pairs
452 my $columns_info = $source->columns_info;
454 Like L</column_info> but returns information for the requested columns. If
455 the optional column-list arrayref is omitted it returns info on all columns
456 currently defined on the ResultSource via L</add_columns>.
461 my ($self, $columns) = @_;
463 my $colinfo = $self->_columns;
466 first { ! $_->{data_type} } values %$colinfo
468 ! $self->{_columns_info_loaded}
470 $self->column_info_from_storage
472 my $stor = try { $self->storage }
474 $self->{_columns_info_loaded}++;
476 # try for the case of storage without table
478 my $info = $stor->columns_info_for( $self->from );
480 { (lc $_) => $info->{$_} }
484 foreach my $col ( keys %$colinfo ) {
486 %{ $colinfo->{$col} },
487 %{ $info->{$col} || $lc_info->{lc $col} || {} }
497 if (my $inf = $colinfo->{$_}) {
501 $self->throw_exception( sprintf (
502 "No such column '%s' on source '%s'",
504 $self->source_name || $self->name || 'Unknown source...?',
516 =head2 remove_columns
520 =item Arguments: @colnames
522 =item Return Value: not defined
526 $source->remove_columns(qw/col1 col2 col3/);
528 Removes the given list of columns by name, from the result source.
530 B<Warning>: Removing a column that is also used in the sources primary
531 key, or in one of the sources unique constraints, B<will> result in a
532 broken result source.
538 =item Arguments: $colname
540 =item Return Value: not defined
544 $source->remove_column('col');
546 Remove a single column by name from the result source, similar to
549 B<Warning>: Removing a column that is also used in the sources primary
550 key, or in one of the sources unique constraints, B<will> result in a
551 broken result source.
556 my ($self, @to_remove) = @_;
558 my $columns = $self->_columns
563 delete $columns->{$_};
567 $self->_ordered_columns([ grep { not $to_remove{$_} } @{$self->_ordered_columns} ]);
570 sub remove_column { shift->remove_columns(@_); } # DO NOT CHANGE THIS TO GLOB
572 =head2 set_primary_key
576 =item Arguments: @cols
578 =item Return Value: not defined
582 Defines one or more columns as primary key for this source. Must be
583 called after L</add_columns>.
585 Additionally, defines a L<unique constraint|add_unique_constraint>
588 Note: you normally do want to define a primary key on your sources
589 B<even if the underlying database table does not have a primary key>.
591 L<DBIx::Class::Manual::Intro/The Significance and Importance of Primary Keys>
596 sub set_primary_key {
597 my ($self, @cols) = @_;
599 my $colinfo = $self->columns_info(\@cols);
600 for my $col (@cols) {
601 carp_unique(sprintf (
602 "Primary key of source '%s' includes the column '%s' which has its "
603 . "'is_nullable' attribute set to true. This is a mistake and will cause "
604 . 'various Result-object operations to fail',
605 $self->source_name || $self->name || 'Unknown source...?',
607 )) if $colinfo->{$col}{is_nullable};
610 $self->_primaries(\@cols);
612 $self->add_unique_constraint(primary => \@cols);
615 =head2 primary_columns
619 =item Arguments: none
621 =item Return Value: Ordered list of primary column names
625 Read-only accessor which returns the list of primary keys, supplied by
630 sub primary_columns {
631 return @{shift->_primaries||[]};
634 # a helper method that will automatically die with a descriptive message if
635 # no pk is defined on the source in question. For internal use to save
636 # on if @pks... boilerplate
637 sub _pri_cols_or_die {
639 my @pcols = $self->primary_columns
640 or $self->throw_exception (sprintf(
641 "Operation requires a primary key to be declared on '%s' via set_primary_key",
642 # source_name is set only after schema-registration
643 $self->source_name || $self->result_class || $self->name || 'Unknown source...?',
648 # same as above but mandating single-column PK (used by relationship condition
650 sub _single_pri_col_or_die {
652 my ($pri, @too_many) = $self->_pri_cols_or_die;
654 $self->throw_exception( sprintf(
655 "Operation requires a single-column primary key declared on '%s'",
656 $self->source_name || $self->result_class || $self->name || 'Unknown source...?',
664 Manually define the correct sequence for your table, to avoid the overhead
665 associated with looking up the sequence automatically. The supplied sequence
666 will be applied to the L</column_info> of each L<primary_key|/set_primary_key>
670 =item Arguments: $sequence_name
672 =item Return Value: not defined
679 my ($self,$seq) = @_;
681 my @pks = $self->primary_columns
684 $_->{sequence} = $seq
685 for values %{ $self->columns_info (\@pks) };
689 =head2 add_unique_constraint
693 =item Arguments: $name?, \@colnames
695 =item Return Value: not defined
699 Declare a unique constraint on this source. Call once for each unique
702 # For UNIQUE (column1, column2)
703 __PACKAGE__->add_unique_constraint(
704 constraint_name => [ qw/column1 column2/ ],
707 Alternatively, you can specify only the columns:
709 __PACKAGE__->add_unique_constraint([ qw/column1 column2/ ]);
711 This will result in a unique constraint named
712 C<table_column1_column2>, where C<table> is replaced with the table
715 Unique constraints are used, for example, when you pass the constraint
716 name as the C<key> attribute to L<DBIx::Class::ResultSet/find>. Then
717 only columns in the constraint are searched.
719 Throws an error if any of the given column names do not yet exist on
724 sub add_unique_constraint {
728 $self->throw_exception(
729 'add_unique_constraint() does not accept multiple constraints, use '
730 . 'add_unique_constraints() instead'
735 if (ref $cols ne 'ARRAY') {
736 $self->throw_exception (
737 'Expecting an arrayref of constraint columns, got ' . ($cols||'NOTHING')
743 $name ||= $self->name_unique_constraint($cols);
745 foreach my $col (@$cols) {
746 $self->throw_exception("No such column $col on table " . $self->name)
747 unless $self->has_column($col);
750 my %unique_constraints = $self->unique_constraints;
751 $unique_constraints{$name} = $cols;
752 $self->_unique_constraints(\%unique_constraints);
755 =head2 add_unique_constraints
759 =item Arguments: @constraints
761 =item Return Value: not defined
765 Declare multiple unique constraints on this source.
767 __PACKAGE__->add_unique_constraints(
768 constraint_name1 => [ qw/column1 column2/ ],
769 constraint_name2 => [ qw/column2 column3/ ],
772 Alternatively, you can specify only the columns:
774 __PACKAGE__->add_unique_constraints(
775 [ qw/column1 column2/ ],
776 [ qw/column3 column4/ ]
779 This will result in unique constraints named C<table_column1_column2> and
780 C<table_column3_column4>, where C<table> is replaced with the table name.
782 Throws an error if any of the given column names do not yet exist on
785 See also L</add_unique_constraint>.
789 sub add_unique_constraints {
791 my @constraints = @_;
793 if ( !(@constraints % 2) && first { ref $_ ne 'ARRAY' } @constraints ) {
794 # with constraint name
795 while (my ($name, $constraint) = splice @constraints, 0, 2) {
796 $self->add_unique_constraint($name => $constraint);
801 foreach my $constraint (@constraints) {
802 $self->add_unique_constraint($constraint);
807 =head2 name_unique_constraint
811 =item Arguments: \@colnames
813 =item Return Value: Constraint name
817 $source->table('mytable');
818 $source->name_unique_constraint(['col1', 'col2']);
822 Return a name for a unique constraint containing the specified
823 columns. The name is created by joining the table name and each column
824 name, using an underscore character.
826 For example, a constraint on a table named C<cd> containing the columns
827 C<artist> and C<title> would result in a constraint name of C<cd_artist_title>.
829 This is used by L</add_unique_constraint> if you do not specify the
830 optional constraint name.
834 sub name_unique_constraint {
835 my ($self, $cols) = @_;
837 my $name = $self->name;
838 $name = $$name if (ref $name eq 'SCALAR');
839 $name =~ s/ ^ [^\.]+ \. //x; # strip possible schema qualifier
841 return join '_', $name, @$cols;
844 =head2 unique_constraints
848 =item Arguments: none
850 =item Return Value: Hash of unique constraint data
854 $source->unique_constraints();
856 Read-only accessor which returns a hash of unique constraints on this
859 The hash is keyed by constraint name, and contains an arrayref of
860 column names as values.
864 sub unique_constraints {
865 return %{shift->_unique_constraints||{}};
868 =head2 unique_constraint_names
872 =item Arguments: none
874 =item Return Value: Unique constraint names
878 $source->unique_constraint_names();
880 Returns the list of unique constraint names defined on this source.
884 sub unique_constraint_names {
887 my %unique_constraints = $self->unique_constraints;
889 return keys %unique_constraints;
892 =head2 unique_constraint_columns
896 =item Arguments: $constraintname
898 =item Return Value: List of constraint columns
902 $source->unique_constraint_columns('myconstraint');
904 Returns the list of columns that make up the specified unique constraint.
908 sub unique_constraint_columns {
909 my ($self, $constraint_name) = @_;
911 my %unique_constraints = $self->unique_constraints;
913 $self->throw_exception(
914 "Unknown unique constraint $constraint_name on '" . $self->name . "'"
915 ) unless exists $unique_constraints{$constraint_name};
917 return @{ $unique_constraints{$constraint_name} };
920 =head2 sqlt_deploy_callback
924 =item Arguments: $callback_name | \&callback_code
926 =item Return Value: $callback_name | \&callback_code
930 __PACKAGE__->sqlt_deploy_callback('mycallbackmethod');
934 __PACKAGE__->sqlt_deploy_callback(sub {
935 my ($source_instance, $sqlt_table) = @_;
939 An accessor to set a callback to be called during deployment of
940 the schema via L<DBIx::Class::Schema/create_ddl_dir> or
941 L<DBIx::Class::Schema/deploy>.
943 The callback can be set as either a code reference or the name of a
944 method in the current result class.
946 Defaults to L</default_sqlt_deploy_hook>.
948 Your callback will be passed the $source object representing the
949 ResultSource instance being deployed, and the
950 L<SQL::Translator::Schema::Table> object being created from it. The
951 callback can be used to manipulate the table object or add your own
952 customised indexes. If you need to manipulate a non-table object, use
953 the L<DBIx::Class::Schema/sqlt_deploy_hook>.
955 See L<DBIx::Class::Manual::Cookbook/Adding Indexes And Functions To
956 Your SQL> for examples.
958 This sqlt deployment callback can only be used to manipulate
959 SQL::Translator objects as they get turned into SQL. To execute
960 post-deploy statements which SQL::Translator does not currently
961 handle, override L<DBIx::Class::Schema/deploy> in your Schema class
962 and call L<dbh_do|DBIx::Class::Storage::DBI/dbh_do>.
964 =head2 default_sqlt_deploy_hook
966 This is the default deploy hook implementation which checks if your
967 current Result class has a C<sqlt_deploy_hook> method, and if present
968 invokes it B<on the Result class directly>. This is to preserve the
969 semantics of C<sqlt_deploy_hook> which was originally designed to expect
970 the Result class name and the
971 L<$sqlt_table instance|SQL::Translator::Schema::Table> of the table being
976 sub default_sqlt_deploy_hook {
979 my $class = $self->result_class;
981 if ($class and $class->can('sqlt_deploy_hook')) {
982 $class->sqlt_deploy_hook(@_);
986 sub _invoke_sqlt_deploy_hook {
988 if ( my $hook = $self->sqlt_deploy_callback) {
997 =item Arguments: $classname
999 =item Return Value: $classname
1003 use My::Schema::ResultClass::Inflator;
1006 use My::Schema::Artist;
1008 __PACKAGE__->result_class('My::Schema::ResultClass::Inflator');
1010 Set the default result class for this source. You can use this to create
1011 and use your own result inflator. See L<DBIx::Class::ResultSet/result_class>
1014 Please note that setting this to something like
1015 L<DBIx::Class::ResultClass::HashRefInflator> will make every result unblessed
1016 and make life more difficult. Inflators like those are better suited to
1017 temporary usage via L<DBIx::Class::ResultSet/result_class>.
1023 =item Arguments: none
1025 =item Return Value: L<$resultset|DBIx::Class::ResultSet>
1029 Returns a resultset for the given source. This will initially be created
1030 on demand by calling
1032 $self->resultset_class->new($self, $self->resultset_attributes)
1034 but is cached from then on unless resultset_class changes.
1036 =head2 resultset_class
1040 =item Arguments: $classname
1042 =item Return Value: $classname
1046 package My::Schema::ResultSet::Artist;
1047 use base 'DBIx::Class::ResultSet';
1050 # In the result class
1051 __PACKAGE__->resultset_class('My::Schema::ResultSet::Artist');
1054 $source->resultset_class('My::Schema::ResultSet::Artist');
1056 Set the class of the resultset. This is useful if you want to create your
1057 own resultset methods. Create your own class derived from
1058 L<DBIx::Class::ResultSet>, and set it here. If called with no arguments,
1059 this method returns the name of the existing resultset class, if one
1062 =head2 resultset_attributes
1066 =item Arguments: L<\%attrs|DBIx::Class::ResultSet/ATTRIBUTES>
1068 =item Return Value: L<\%attrs|DBIx::Class::ResultSet/ATTRIBUTES>
1072 # In the result class
1073 __PACKAGE__->resultset_attributes({ order_by => [ 'id' ] });
1076 $source->resultset_attributes({ order_by => [ 'id' ] });
1078 Store a collection of resultset attributes, that will be set on every
1079 L<DBIx::Class::ResultSet> produced from this result source.
1081 B<CAVEAT>: C<resultset_attributes> comes with its own set of issues and
1082 bugs! While C<resultset_attributes> isn't deprecated per se, its usage is
1085 Since relationships use attributes to link tables together, the "default"
1086 attributes you set may cause unpredictable and undesired behavior. Furthermore,
1087 the defaults cannot be turned off, so you are stuck with them.
1089 In most cases, what you should actually be using are project-specific methods:
1091 package My::Schema::ResultSet::Artist;
1092 use base 'DBIx::Class::ResultSet';
1096 #__PACKAGE__->resultset_attributes({ prefetch => 'tracks' });
1099 sub with_tracks { shift->search({}, { prefetch => 'tracks' }) }
1102 $schema->resultset('Artist')->with_tracks->...
1104 This gives you the flexibility of not using it when you don't need it.
1106 For more complex situations, another solution would be to use a virtual view
1107 via L<DBIx::Class::ResultSource::View>.
1113 $self->throw_exception(
1114 'resultset does not take any arguments. If you want another resultset, '.
1115 'call it on the schema instead.'
1118 $self->resultset_class->new(
1121 try { %{$self->schema->default_resultset_attributes} },
1122 %{$self->{resultset_attributes}},
1131 =item Arguments: none
1133 =item Result value: $name
1137 Returns the name of the result source, which will typically be the table
1138 name. This may be a scalar reference if the result source has a non-standard
1145 =item Arguments: $source_name
1147 =item Result value: $source_name
1151 Set an alternate name for the result source when it is loaded into a schema.
1152 This is useful if you want to refer to a result source by a name other than
1155 package ArchivedBooks;
1156 use base qw/DBIx::Class/;
1157 __PACKAGE__->table('books_archive');
1158 __PACKAGE__->source_name('Books');
1160 # from your schema...
1161 $schema->resultset('Books')->find(1);
1167 =item Arguments: none
1169 =item Return Value: FROM clause
1173 my $from_clause = $source->from();
1175 Returns an expression of the source to be supplied to storage to specify
1176 retrieval from this source. In the case of a database, the required FROM
1181 sub from { die 'Virtual method!' }
1187 =item Arguments: L<$schema?|DBIx::Class::Schema>
1189 =item Return Value: L<$schema|DBIx::Class::Schema>
1193 my $schema = $source->schema();
1195 Sets and/or returns the L<DBIx::Class::Schema> object to which this
1196 result source instance has been attached to.
1202 $_[0]->{schema} = $_[1];
1205 $_[0]->{schema} || do {
1206 my $name = $_[0]->{source_name} || '_unnamed_';
1207 my $err = 'Unable to perform storage-dependent operations with a detached result source '
1208 . "(source '$name' is not associated with a schema).";
1210 $err .= ' You need to use $schema->thaw() or manually set'
1211 . ' $DBIx::Class::ResultSourceHandle::thaw_schema while thawing.'
1212 if $_[0]->{_detached_thaw};
1214 DBIx::Class::Exception->throw($err);
1223 =item Arguments: none
1225 =item Return Value: L<$storage|DBIx::Class::Storage>
1229 $source->storage->debug(1);
1231 Returns the L<storage handle|DBIx::Class::Storage> for the current schema.
1235 sub storage { shift->schema->storage; }
1237 =head2 add_relationship
1241 =item Arguments: $rel_name, $related_source_name, \%cond, \%attrs?
1243 =item Return Value: 1/true if it succeeded
1247 $source->add_relationship('rel_name', 'related_source', $cond, $attrs);
1249 L<DBIx::Class::Relationship> describes a series of methods which
1250 create pre-defined useful types of relationships. Look there first
1251 before using this method directly.
1253 The relationship name can be arbitrary, but must be unique for each
1254 relationship attached to this result source. 'related_source' should
1255 be the name with which the related result source was registered with
1256 the current schema. For example:
1258 $schema->source('Book')->add_relationship('reviews', 'Review', {
1259 'foreign.book_id' => 'self.id',
1262 The condition C<$cond> needs to be an L<SQL::Abstract>-style
1263 representation of the join between the tables. For example, if you're
1264 creating a relation from Author to Book,
1266 { 'foreign.author_id' => 'self.id' }
1268 will result in the JOIN clause
1270 author me JOIN book foreign ON foreign.author_id = me.id
1272 You can specify as many foreign => self mappings as necessary.
1274 Valid attributes are as follows:
1280 Explicitly specifies the type of join to use in the relationship. Any
1281 SQL join type is valid, e.g. C<LEFT> or C<RIGHT>. It will be placed in
1282 the SQL command immediately before C<JOIN>.
1286 An arrayref containing a list of accessors in the foreign class to proxy in
1287 the main class. If, for example, you do the following:
1289 CD->might_have(liner_notes => 'LinerNotes', undef, {
1290 proxy => [ qw/notes/ ],
1293 Then, assuming LinerNotes has an accessor named notes, you can do:
1295 my $cd = CD->find(1);
1296 # set notes -- LinerNotes object is created if it doesn't exist
1297 $cd->notes('Notes go here');
1301 Specifies the type of accessor that should be created for the
1302 relationship. Valid values are C<single> (for when there is only a single
1303 related object), C<multi> (when there can be many), and C<filter> (for
1304 when there is a single related object, but you also want the relationship
1305 accessor to double as a column accessor). For C<multi> accessors, an
1306 add_to_* method is also created, which calls C<create_related> for the
1311 Throws an exception if the condition is improperly supplied, or cannot
1316 sub add_relationship {
1317 my ($self, $rel, $f_source_name, $cond, $attrs) = @_;
1318 $self->throw_exception("Can't create relationship without join condition")
1322 # Check foreign and self are right in cond
1323 if ( (ref $cond ||'') eq 'HASH') {
1324 $_ =~ /^foreign\./ or $self->throw_exception("Malformed relationship condition key '$_': must be prefixed with 'foreign.'")
1327 $_ =~ /^self\./ or $self->throw_exception("Malformed relationship condition value '$_': must be prefixed with 'self.'")
1331 my %rels = %{ $self->_relationships };
1332 $rels{$rel} = { class => $f_source_name,
1333 source => $f_source_name,
1336 $self->_relationships(\%rels);
1340 # XXX disabled. doesn't work properly currently. skip in tests.
1342 my $f_source = $self->schema->source($f_source_name);
1343 unless ($f_source) {
1344 $self->ensure_class_loaded($f_source_name);
1345 $f_source = $f_source_name->result_source;
1346 #my $s_class = ref($self->schema);
1347 #$f_source_name =~ m/^${s_class}::(.*)$/;
1348 #$self->schema->register_class(($1 || $f_source_name), $f_source_name);
1349 #$f_source = $self->schema->source($f_source_name);
1351 return unless $f_source; # Can't test rel without f_source
1353 try { $self->_resolve_join($rel, 'me', {}, []) }
1355 # If the resolve failed, back out and re-throw the error
1357 $self->_relationships(\%rels);
1358 $self->throw_exception("Error creating relationship $rel: $_");
1364 =head2 relationships
1368 =item Arguments: none
1370 =item Return Value: L<@rel_names|DBIx::Class::Relationship>
1374 my @rel_names = $source->relationships();
1376 Returns all relationship names for this source.
1381 return keys %{shift->_relationships};
1384 =head2 relationship_info
1388 =item Arguments: L<$rel_name|DBIx::Class::Relationship>
1390 =item Return Value: L<\%rel_data|DBIx::Class::Relationship::Base/add_relationship>
1394 Returns a hash of relationship information for the specified relationship
1395 name. The keys/values are as specified for L<DBIx::Class::Relationship::Base/add_relationship>.
1399 sub relationship_info {
1400 #my ($self, $rel) = @_;
1401 return shift->_relationships->{+shift};
1404 =head2 has_relationship
1408 =item Arguments: L<$rel_name|DBIx::Class::Relationship>
1410 =item Return Value: 1/0 (true/false)
1414 Returns true if the source has a relationship of this name, false otherwise.
1418 sub has_relationship {
1419 #my ($self, $rel) = @_;
1420 return exists shift->_relationships->{+shift};
1423 =head2 reverse_relationship_info
1427 =item Arguments: L<$rel_name|DBIx::Class::Relationship>
1429 =item Return Value: L<\%rel_data|DBIx::Class::Relationship::Base/add_relationship>
1433 Looks through all the relationships on the source this relationship
1434 points to, looking for one whose condition is the reverse of the
1435 condition on this relationship.
1437 A common use of this is to find the name of the C<belongs_to> relation
1438 opposing a C<has_many> relation. For definition of these look in
1439 L<DBIx::Class::Relationship>.
1441 The returned hashref is keyed by the name of the opposing
1442 relationship, and contains its data in the same manner as
1443 L</relationship_info>.
1447 sub reverse_relationship_info {
1448 my ($self, $rel) = @_;
1450 my $rel_info = $self->relationship_info($rel)
1451 or $self->throw_exception("No such relationship '$rel'");
1455 return $ret unless ((ref $rel_info->{cond}) eq 'HASH');
1457 my $stripped_cond = $self->__strip_relcond ($rel_info->{cond});
1459 my $registered_source_name = $self->source_name;
1461 # this may be a partial schema or something else equally esoteric
1462 my $other_rsrc = $self->related_source($rel);
1464 # Get all the relationships for that source that related to this source
1465 # whose foreign column set are our self columns on $rel and whose self
1466 # columns are our foreign columns on $rel
1467 foreach my $other_rel ($other_rsrc->relationships) {
1469 # only consider stuff that points back to us
1470 # "us" here is tricky - if we are in a schema registration, we want
1471 # to use the source_names, otherwise we will use the actual classes
1473 # the schema may be partial
1474 my $roundtrip_rsrc = try { $other_rsrc->related_source($other_rel) }
1477 if ($registered_source_name) {
1478 next if $registered_source_name ne ($roundtrip_rsrc->source_name || '')
1481 next if $self->result_class ne $roundtrip_rsrc->result_class;
1484 my $other_rel_info = $other_rsrc->relationship_info($other_rel);
1486 # this can happen when we have a self-referential class
1487 next if $other_rel_info eq $rel_info;
1489 next unless ref $other_rel_info->{cond} eq 'HASH';
1490 my $other_stripped_cond = $self->__strip_relcond($other_rel_info->{cond});
1492 $ret->{$other_rel} = $other_rel_info if (
1493 $self->_compare_relationship_keys (
1494 [ keys %$stripped_cond ], [ values %$other_stripped_cond ]
1497 $self->_compare_relationship_keys (
1498 [ values %$stripped_cond ], [ keys %$other_stripped_cond ]
1506 # all this does is removes the foreign/self prefix from a condition
1507 sub __strip_relcond {
1510 { map { /^ (?:foreign|self) \. (\w+) $/x } ($_, $_[1]{$_}) }
1515 sub compare_relationship_keys {
1516 carp 'compare_relationship_keys is a private method, stop calling it';
1518 $self->_compare_relationship_keys (@_);
1521 # Returns true if both sets of keynames are the same, false otherwise.
1522 sub _compare_relationship_keys {
1523 # my ($self, $keys1, $keys2) = @_;
1525 join ("\x00", sort @{$_[1]})
1527 join ("\x00", sort @{$_[2]})
1531 # optionally takes either an arrayref of column names, or a hashref of already
1532 # retrieved colinfos
1533 # returns an arrayref of column names of the shortest unique constraint
1534 # (matching some of the input if any), giving preference to the PK
1535 sub _identifying_column_set {
1536 my ($self, $cols) = @_;
1538 my %unique = $self->unique_constraints;
1539 my $colinfos = ref $cols eq 'HASH' ? $cols : $self->columns_info($cols||());
1541 # always prefer the PK first, and then shortest constraints first
1543 for my $set (delete $unique{primary}, sort { @$a <=> @$b } (values %unique) ) {
1544 next unless $set && @$set;
1547 next USET unless ($colinfos->{$_} && !$colinfos->{$_}{is_nullable} );
1550 # copy so we can mangle it at will
1557 sub _minimal_valueset_satisfying_constraint {
1559 my $args = { ref $_[0] eq 'HASH' ? %{ $_[0] } : @_ };
1561 $args->{columns_info} ||= $self->columns_info;
1563 my $vals = $self->storage->_extract_fixed_condition_columns(
1565 ($args->{carp_on_nulls} ? 'consider_nulls' : undef ),
1569 for my $col ($self->unique_constraint_columns($args->{constraint_name}) ) {
1570 if( ! exists $vals->{$col} ) {
1571 $cols->{missing}{$col} = 1;
1573 elsif( ! defined $vals->{$col} ) {
1574 $cols->{$args->{carp_on_nulls} ? 'undefined' : 'missing'}{$col} = 1;
1577 $cols->{present}{$col} = 1;
1580 $cols->{fc}{$col} = 1 if (
1581 ! ( $cols->{missing} || {})->{$col}
1583 $args->{columns_info}{$col}{_filter_info}
1587 $self->throw_exception( sprintf ( "Unable to satisfy requested constraint '%s', missing values for column(s): %s",
1588 $args->{constraint_name},
1589 join (', ', map { "'$_'" } sort keys %{$cols->{missing}} ),
1590 ) ) if $cols->{missing};
1592 $self->throw_exception( sprintf (
1593 "Unable to satisfy requested constraint '%s', FilterColumn values not usable for column(s): %s",
1594 $args->{constraint_name},
1595 join (', ', map { "'$_'" } sort keys %{$cols->{fc}}),
1601 !$ENV{DBIC_NULLABLE_KEY_NOWARN}
1603 carp_unique ( sprintf (
1604 "NULL/undef values supplied for requested unique constraint '%s' (NULL "
1605 . 'values in column(s): %s). This is almost certainly not what you wanted, '
1606 . 'though you can set DBIC_NULLABLE_KEY_NOWARN to disable this warning.',
1607 $args->{constraint_name},
1608 join (', ', map { "'$_'" } sort keys %{$cols->{undefined}}),
1613 { $_ => $vals->{$_} }
1614 ( keys %{$cols->{present}}, keys %{$cols->{undefined}} )
1618 # Returns the {from} structure used to express JOIN conditions
1620 my ($self, $join, $alias, $seen, $jpath, $parent_force_left) = @_;
1622 # we need a supplied one, because we do in-place modifications, no returns
1623 $self->throw_exception ('You must supply a seen hashref as the 3rd argument to _resolve_join')
1624 unless ref $seen eq 'HASH';
1626 $self->throw_exception ('You must supply a joinpath arrayref as the 4th argument to _resolve_join')
1627 unless ref $jpath eq 'ARRAY';
1629 $jpath = [@$jpath]; # copy
1631 if (not defined $join or not length $join) {
1634 elsif (ref $join eq 'ARRAY') {
1637 $self->_resolve_join($_, $alias, $seen, $jpath, $parent_force_left);
1640 elsif (ref $join eq 'HASH') {
1643 for my $rel (keys %$join) {
1645 my $rel_info = $self->relationship_info($rel)
1646 or $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
1648 my $force_left = $parent_force_left;
1649 $force_left ||= lc($rel_info->{attrs}{join_type}||'') eq 'left';
1651 # the actual seen value will be incremented by the recursion
1652 my $as = $self->storage->relname_to_table_alias(
1653 $rel, ($seen->{$rel} && $seen->{$rel} + 1)
1657 $self->_resolve_join($rel, $alias, $seen, [@$jpath], $force_left),
1658 $self->related_source($rel)->_resolve_join(
1659 $join->{$rel}, $as, $seen, [@$jpath, { $rel => $as }], $force_left
1667 $self->throw_exception("No idea how to resolve join reftype ".ref $join);
1670 my $count = ++$seen->{$join};
1671 my $as = $self->storage->relname_to_table_alias(
1672 $join, ($count > 1 && $count)
1675 my $rel_info = $self->relationship_info($join)
1676 or $self->throw_exception("No such relationship $join on " . $self->source_name);
1678 my $rel_src = $self->related_source($join);
1679 return [ { $as => $rel_src->from,
1681 -join_type => $parent_force_left
1683 : $rel_info->{attrs}{join_type}
1685 -join_path => [@$jpath, { $join => $as } ],
1687 (! $rel_info->{attrs}{accessor})
1689 first { $rel_info->{attrs}{accessor} eq $_ } (qw/single filter/)
1692 -relation_chain_depth => ( $seen->{-relation_chain_depth} || 0 ) + 1,
1694 scalar $self->_resolve_condition($rel_info->{cond}, $as, $alias, $join)
1700 carp 'pk_depends_on is a private method, stop calling it';
1702 $self->_pk_depends_on (@_);
1705 # Determines whether a relation is dependent on an object from this source
1706 # having already been inserted. Takes the name of the relationship and a
1707 # hashref of columns of the related object.
1708 sub _pk_depends_on {
1709 my ($self, $rel_name, $rel_data) = @_;
1711 my $relinfo = $self->relationship_info($rel_name);
1713 # don't assume things if the relationship direction is specified
1714 return $relinfo->{attrs}{is_foreign_key_constraint}
1715 if exists ($relinfo->{attrs}{is_foreign_key_constraint});
1717 my $cond = $relinfo->{cond};
1718 return 0 unless ref($cond) eq 'HASH';
1720 # map { foreign.foo => 'self.bar' } to { bar => 'foo' }
1721 my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond };
1723 # assume anything that references our PK probably is dependent on us
1724 # rather than vice versa, unless the far side is (a) defined or (b)
1726 my $rel_source = $self->related_source($rel_name);
1728 foreach my $p ($self->primary_columns) {
1729 if (exists $keyhash->{$p}) {
1730 unless (defined($rel_data->{$keyhash->{$p}})
1731 || $rel_source->column_info($keyhash->{$p})
1732 ->{is_auto_increment}) {
1741 sub resolve_condition {
1742 carp 'resolve_condition is a private method, stop calling it';
1743 shift->_resolve_condition (@_);
1746 sub _resolve_condition {
1747 # carp_unique sprintf
1748 # '_resolve_condition is a private method, and moreover is about to go '
1749 # . 'away. Please contact the development team at %s if you believe you '
1750 # . 'have a genuine use for this method, in order to discuss alternatives.',
1751 # DBIx::Class::_ENV_::HELP_URL,
1754 #######################
1755 ### API Design? What's that...? (a backwards compatible shim, kill me now)
1757 my ($self, $cond, @res_args, $rel_name);
1759 # we *SIMPLY DON'T KNOW YET* which arg is which, yay
1760 ($self, $cond, $res_args[0], $res_args[1], $rel_name) = @_;
1762 # assume that an undef is an object-like unset (set_from_related(undef))
1763 my @is_objlike = map { ! defined $_ or length ref $_ } (@res_args);
1765 # turn objlike into proper objects for saner code further down
1767 next unless $is_objlike[$_];
1769 if ( defined blessed $res_args[$_] ) {
1771 # but wait - there is more!!! WHAT THE FUCK?!?!?!?!
1772 if ($res_args[$_]->isa('DBIx::Class::ResultSet')) {
1773 carp('Passing a resultset for relationship resolution makes no sense - invoking __gremlins__');
1774 $is_objlike[$_] = 0;
1775 $res_args[$_] = '__gremlins__';
1779 $res_args[$_] ||= {};
1781 # hate everywhere - have to pass in as a plain hash
1782 # pretending to be an object at least for now
1783 $self->throw_exception("Unsupported object-like structure encountered: $res_args[$_]")
1784 unless ref $res_args[$_] eq 'HASH';
1791 # where-is-waldo block guesses relname, then further down we override it if available
1793 $is_objlike[1] ? ( rel_name => $res_args[0], self_alias => $res_args[0], foreign_alias => 'me', self_result_object => $res_args[1] )
1794 : $is_objlike[0] ? ( rel_name => $res_args[1], self_alias => 'me', foreign_alias => $res_args[1], foreign_values => $res_args[0] )
1795 : ( rel_name => $res_args[0], self_alias => $res_args[1], foreign_alias => $res_args[0] )
1798 ( $rel_name ? ( rel_name => $rel_name ) : () ),
1800 #######################
1802 # now it's fucking easy isn't it?!
1803 my $rc = $self->_resolve_relationship_condition( $args );
1806 ( $rc->{join_free_condition} || $rc->{condition} ),
1807 ! $rc->{join_free_condition},
1810 # _resolve_relationship_condition always returns qualified cols even in the
1811 # case of join_free_condition, but nothing downstream expects this
1812 if ($rc->{join_free_condition} and ref $res[0] eq 'HASH') {
1814 { ($_ =~ /\.(.+)/) => $res[0]{$_} }
1820 return wantarray ? @res : $res[0];
1823 # Keep this indefinitely. There is evidence of both CPAN and
1824 # darkpan using it, and there isn't much harm in an extra var
1826 our $UNRESOLVABLE_CONDITION = UNRESOLVABLE_CONDITION;
1827 # YES I KNOW THIS IS EVIL
1828 # it is there to save darkpan from themselves, since internally
1829 # we are moving to a constant
1830 Internals::SvREADONLY($UNRESOLVABLE_CONDITION => 1);
1832 # Resolves the passed condition to a concrete query fragment and extra
1835 ## self-explanatory API, modeled on the custom cond coderef:
1836 # rel_name => (scalar)
1837 # foreign_alias => (scalar)
1838 # foreign_values => (either not supplied or a hashref)
1839 # self_alias => (scalar)
1840 # self_result_object => (either not supplied or a result object)
1841 # require_join_free_condition => (boolean, throws on failure to construct a JF-cond)
1842 # infer_values_based_on => (either not supplied or a hashref, implies require_join_free_condition)
1843 # condition => (sqla cond struct, optional, defeaults to from $self->rel_info(rel_name)->{cond})
1846 # condition => (a valid *likely fully qualified* sqla cond structure)
1847 # identity_map => (a hashref of foreign-to-self *unqualified* column equality names)
1848 # join_free_condition => (a valid *fully qualified* sqla cond structure, maybe unset)
1849 # inferred_values => (in case of an available join_free condition, this is a hashref of
1850 # *unqualified* column/value *EQUALITY* pairs, representing an amalgamation
1851 # of the JF-cond parse and infer_values_based_on
1852 # always either complete or unset)
1854 sub _resolve_relationship_condition {
1857 my $args = { ref $_[0] eq 'HASH' ? %{ $_[0] } : @_ };
1859 for ( qw( rel_name self_alias foreign_alias ) ) {
1860 $self->throw_exception("Mandatory argument '$_' to _resolve_relationship_condition() is not a plain string")
1861 if !defined $args->{$_} or length ref $args->{$_};
1864 $self->throw_exception("Arguments 'self_alias' and 'foreign_alias' may not be identical")
1865 if $args->{self_alias} eq $args->{foreign_alias};
1867 my $exception_rel_id = "relationship '$args->{rel_name}' on source '@{[ $self->source_name ]}'";
1869 my $rel_info = $self->relationship_info($args->{rel_name})
1871 # or $self->throw_exception( "No such $exception_rel_id" );
1872 or carp_unique("Requesting resolution on non-existent $exception_rel_id: fix your code *soon*, as it will break with the next major version");
1874 $self->throw_exception("No practical way to resolve $exception_rel_id between two data structures")
1875 if exists $args->{self_result_object} and exists $args->{foreign_values};
1877 $self->throw_exception( "Argument to infer_values_based_on must be a hash" )
1878 if exists $args->{infer_values_based_on} and ref $args->{infer_values_based_on} ne 'HASH';
1880 $args->{require_join_free_condition} ||= !!$args->{infer_values_based_on};
1882 $args->{condition} ||= $rel_info->{cond};
1885 # my $rel_rsrc = $self->related_source($args->{rel_name});
1887 if (exists $args->{self_result_object}) {
1888 $self->throw_exception( "Argument 'self_result_object' must be an object of class '@{[ $self->result_class ]}'" )
1889 unless defined blessed $args->{self_result_object};
1891 $self->throw_exception( "Object '$args->{self_result_object}' must be of class '@{[ $self->result_class ]}'" )
1892 unless $args->{self_result_object}->isa($self->result_class);
1895 if (exists $args->{foreign_values}) {
1896 if (defined blessed $args->{foreign_values}) {
1897 $self->throw_exception( "Object supplied as 'foreign_values' ($args->{foreign_values}) must be of class '$rel_info->{class}'" )
1898 unless $args->{foreign_values}->isa($rel_info->{class});
1900 $args->{foreign_values} = { $args->{foreign_values}->get_columns };
1902 elsif (! defined $args->{foreign_values} or ref $args->{foreign_values} eq 'HASH') {
1904 my $rel_rsrc = $self->related_source($args->{rel_name});
1905 my $ci = $rel_rsrc->columns_info;
1906 ! exists $ci->{$_} and $self->throw_exception(
1907 "Key '$_' supplied as 'foreign_values' is not a column on related source '@{[ $rel_rsrc->source_name ]}'"
1908 ) for keys %{ $args->{foreign_values} ||= {} };
1911 $self->throw_exception( "Argument 'foreign_values' must be either an object inheriting from '$rel_info->{class}' or a hash reference or undef" );
1917 if (ref $args->{condition} eq 'CODE') {
1920 rel_name => $args->{rel_name},
1921 self_resultsource => $self,
1922 self_alias => $args->{self_alias},
1923 foreign_alias => $args->{foreign_alias},
1925 { (exists $args->{$_}) ? ( $_ => $args->{$_} ) : () }
1926 qw( self_result_object foreign_values )
1930 # legacy - never remove these!!!
1931 $cref_args->{foreign_relname} = $cref_args->{rel_name};
1933 $cref_args->{self_rowobj} = $cref_args->{self_result_object}
1934 if exists $cref_args->{self_result_object};
1936 ($ret->{condition}, $ret->{join_free_condition}, my @extra) = $args->{condition}->($cref_args);
1939 $self->throw_exception("A custom condition coderef can return at most 2 conditions, but $exception_rel_id returned extra values: @extra")
1942 if (my $jfc = $ret->{join_free_condition}) {
1944 $self->throw_exception (
1945 "The join-free condition returned for $exception_rel_id must be a hash reference"
1946 ) unless ref $jfc eq 'HASH';
1948 my ($joinfree_alias, $joinfree_source);
1949 if (defined $args->{self_result_object}) {
1951 my $rel_rsrc = $self->related_source($args->{rel_name});
1952 $joinfree_alias = $args->{foreign_alias};
1953 $joinfree_source = $rel_rsrc;
1955 elsif (defined $args->{foreign_values}) {
1956 $joinfree_alias = $args->{self_alias};
1957 $joinfree_source = $self;
1960 # FIXME sanity check until things stabilize, remove at some point
1961 $self->throw_exception (
1962 "A join-free condition returned for $exception_rel_id without a result object to chain from"
1963 ) unless $joinfree_alias;
1965 my $fq_col_list = { map
1966 { ( "$joinfree_alias.$_" => 1 ) }
1967 $joinfree_source->columns
1970 $fq_col_list->{$_} or $self->throw_exception (
1971 "The join-free condition returned for $exception_rel_id may only "
1972 . 'contain keys that are fully qualified column names of the corresponding source'
1977 elsif (ref $args->{condition} eq 'HASH') {
1979 # the condition is static - use parallel arrays
1980 # for a "pivot" depending on which side of the
1981 # rel did we get as an object
1982 my (@f_cols, @l_cols);
1983 for my $fc (keys %{$args->{condition}}) {
1984 my $lc = $args->{condition}{$fc};
1986 # FIXME STRICTMODE should probably check these are valid columns
1987 $fc =~ s/^foreign\.// ||
1988 $self->throw_exception("Invalid rel cond key '$fc'");
1990 $lc =~ s/^self\.// ||
1991 $self->throw_exception("Invalid rel cond val '$lc'");
1997 # construct the crosstable condition and the identity map
1999 $ret->{condition}{"$args->{foreign_alias}.$f_cols[$_]"} = { -ident => "$args->{self_alias}.$l_cols[$_]" };
2000 $ret->{identity_map}{$l_cols[$_]} = $f_cols[$_];
2003 if ($args->{foreign_values}) {
2004 $ret->{join_free_condition}{"$args->{self_alias}.$l_cols[$_]"} = $args->{foreign_values}{$f_cols[$_]}
2007 elsif (defined $args->{self_result_object}) {
2009 for my $i (0..$#l_cols) {
2010 if ( $args->{self_result_object}->has_column_loaded($l_cols[$i]) ) {
2011 $ret->{join_free_condition}{"$args->{foreign_alias}.$f_cols[$i]"} = $args->{self_result_object}->get_column($l_cols[$i]);
2014 $self->throw_exception(sprintf
2015 "Unable to resolve relationship '%s' from object '%s': column '%s' not "
2016 . 'loaded from storage (or not passed to new() prior to insert()). You '
2017 . 'probably need to call ->discard_changes to get the server-side defaults '
2018 . 'from the database.',
2020 $args->{self_result_object},
2022 ) if $args->{self_result_object}->in_storage;
2024 # FIXME - temporarly force-override
2025 delete $args->{require_join_free_condition};
2026 $ret->{join_free_condition} = UNRESOLVABLE_CONDITION;
2032 elsif (ref $args->{condition} eq 'ARRAY') {
2033 if (@{$args->{condition}} == 0) {
2035 condition => UNRESOLVABLE_CONDITION,
2036 join_free_condition => UNRESOLVABLE_CONDITION,
2039 elsif (@{$args->{condition}} == 1) {
2040 $ret = $self->_resolve_relationship_condition({
2042 condition => $args->{condition}[0],
2046 # we are discarding inferred values here... likely incorrect...
2047 # then again - the entire thing is an OR, so we *can't* use them anyway
2048 for my $subcond ( map
2049 { $self->_resolve_relationship_condition({ %$args, condition => $_ }) }
2050 @{$args->{condition}}
2052 $self->throw_exception('Either all or none of the OR-condition members must resolve to a join-free condition')
2053 if ( $ret and ( $ret->{join_free_condition} xor $subcond->{join_free_condition} ) );
2055 $subcond->{$_} and push @{$ret->{$_}}, $subcond->{$_} for (qw(condition join_free_condition));
2060 $self->throw_exception ("Can't handle condition $args->{condition} for $exception_rel_id yet :(");
2063 $self->throw_exception(ucfirst "$exception_rel_id does not resolve to a join-free condition fragment") if (
2064 $args->{require_join_free_condition}
2066 ( ! $ret->{join_free_condition} or $ret->{join_free_condition} eq UNRESOLVABLE_CONDITION )
2069 my $storage = $self->schema->storage;
2071 # we got something back - sanity check and infer values if we can
2073 if ( my $jfc = $ret->{join_free_condition} and $ret->{join_free_condition} ne UNRESOLVABLE_CONDITION ) {
2075 my $jfc_eqs = $storage->_extract_fixed_condition_columns($jfc, 'consider_nulls');
2077 if (keys %$jfc_eqs) {
2080 # $jfc is fully qualified by definition
2081 my ($col) = $_ =~ /\.(.+)/;
2083 if (exists $jfc_eqs->{$_} and ($jfc_eqs->{$_}||'') ne UNRESOLVABLE_CONDITION) {
2084 $ret->{inferred_values}{$col} = $jfc_eqs->{$_};
2086 elsif ( !$args->{infer_values_based_on} or ! exists $args->{infer_values_based_on}{$col} ) {
2087 push @nonvalues, $col;
2092 delete $ret->{inferred_values} if @nonvalues;
2096 # did the user explicitly ask
2097 if ($args->{infer_values_based_on}) {
2099 $self->throw_exception(sprintf (
2100 "Unable to complete value inferrence - custom $exception_rel_id returns conditions instead of values for column(s): %s",
2101 map { "'$_'" } @nonvalues
2105 $ret->{inferred_values} ||= {};
2107 $ret->{inferred_values}{$_} = $args->{infer_values_based_on}{$_}
2108 for keys %{$args->{infer_values_based_on}};
2111 # add the identities based on the main condition
2112 # (may already be there, since easy to calculate on the fly in the HASH case)
2113 if ( ! $ret->{identity_map} ) {
2115 my $col_eqs = $storage->_extract_fixed_condition_columns($ret->{condition});
2118 for my $lhs (keys %$col_eqs) {
2120 next if $col_eqs->{$lhs} eq UNRESOLVABLE_CONDITION;
2121 my ($rhs) = @{ is_literal_value( $ret->{condition}{$lhs} ) || next };
2123 # there is no way to know who is right and who is left in a cref
2124 # therefore a full blown resolution call
2126 my $rel_rsrc = $self->related_source($args->{rel_name});
2127 $colinfos ||= $storage->_resolve_column_info([
2128 { -alias => $args->{self_alias}, -rsrc => $self },
2129 { -alias => $args->{foreign_alias}, -rsrc => $rel_rsrc },
2132 my ($l_col, $r_col) = map { $_ =~ / ([^\.]+) $ /x } ($lhs, $rhs);
2139 $colinfos->{$l_col}{-source_alias} ne $colinfos->{$r_col}{-source_alias}
2141 ( $colinfos->{$l_col}{-source_alias} eq $args->{self_alias} )
2142 ? ( $ret->{identity_map}{$l_col} = $r_col )
2143 : ( $ret->{identity_map}{$r_col} = $l_col )
2152 =head2 related_source
2156 =item Arguments: $rel_name
2158 =item Return Value: $source
2162 Returns the result source object for the given relationship.
2166 sub related_source {
2167 my ($self, $rel) = @_;
2168 if( !$self->has_relationship( $rel ) ) {
2169 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
2172 # if we are not registered with a schema - just use the prototype
2173 # however if we do have a schema - ask for the source by name (and
2174 # throw in the process if all fails)
2175 if (my $schema = try { $self->schema }) {
2176 $schema->source($self->relationship_info($rel)->{source});
2179 my $class = $self->relationship_info($rel)->{class};
2180 $self->ensure_class_loaded($class);
2181 $class->result_source_instance;
2185 =head2 related_class
2189 =item Arguments: $rel_name
2191 =item Return Value: $classname
2195 Returns the class name for objects in the given relationship.
2200 my ($self, $rel) = @_;
2201 if( !$self->has_relationship( $rel ) ) {
2202 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
2204 return $self->schema->class($self->relationship_info($rel)->{source});
2211 =item Arguments: none
2213 =item Return Value: L<$source_handle|DBIx::Class::ResultSourceHandle>
2217 Obtain a new L<result source handle instance|DBIx::Class::ResultSourceHandle>
2218 for this source. Used as a serializable pointer to this resultsource, as it is not
2219 easy (nor advisable) to serialize CODErefs which may very well be present in e.g.
2220 relationship definitions.
2225 return DBIx::Class::ResultSourceHandle->new({
2226 source_moniker => $_[0]->source_name,
2228 # so that a detached thaw can be re-frozen
2229 $_[0]->{_detached_thaw}
2230 ? ( _detached_source => $_[0] )
2231 : ( schema => $_[0]->schema )
2236 my $global_phase_destroy;
2238 return if $global_phase_destroy ||= in_global_destruction;
2244 # Under no circumstances shall $_[0] be stored anywhere else (like copied to
2245 # a lexical variable, or shifted, or anything else). Doing so will mess up
2246 # the refcount of this particular result source, and will allow the $schema
2247 # we are trying to save to reattach back to the source we are destroying.
2248 # The relevant code checking refcounts is in ::Schema::DESTROY()
2250 # if we are not a schema instance holder - we don't matter
2252 ! ref $_[0]->{schema}
2254 isweak $_[0]->{schema}
2257 # weaken our schema hold forcing the schema to find somewhere else to live
2258 # during global destruction (if we have not yet bailed out) this will throw
2259 # which will serve as a signal to not try doing anything else
2260 # however beware - on older perls the exception seems randomly untrappable
2261 # due to some weird race condition during thread joining :(((
2264 weaken $_[0]->{schema};
2266 # if schema is still there reintroduce ourselves with strong refs back to us
2267 if ($_[0]->{schema}) {
2268 my $srcregs = $_[0]->{schema}->source_registrations;
2269 for (keys %$srcregs) {
2270 next unless $srcregs->{$_};
2271 $srcregs->{$_} = $_[0] if $srcregs->{$_} == $_[0];
2277 $global_phase_destroy = 1;
2283 sub STORABLE_freeze { Storable::nfreeze($_[0]->handle) }
2286 my ($self, $cloning, $ice) = @_;
2287 %$self = %{ (Storable::thaw($ice))->resolve };
2290 =head2 throw_exception
2292 See L<DBIx::Class::Schema/"throw_exception">.
2296 sub throw_exception {
2300 ? $self->{schema}->throw_exception(@_)
2301 : DBIx::Class::Exception->throw(@_)
2307 Stores a hashref of per-source metadata. No specific key names
2308 have yet been standardized, the examples below are purely hypothetical
2309 and don't actually accomplish anything on their own:
2311 __PACKAGE__->source_info({
2312 "_tablespace" => 'fast_disk_array_3',
2313 "_engine" => 'InnoDB',
2320 $class->new({attribute_name => value});
2322 Creates a new ResultSource object. Not normally called directly by end users.
2324 =head2 column_info_from_storage
2328 =item Arguments: 1/0 (default: 0)
2330 =item Return Value: 1/0
2334 __PACKAGE__->column_info_from_storage(1);
2336 Enables the on-demand automatic loading of the above column
2337 metadata from storage as necessary. This is *deprecated*, and
2338 should not be used. It will be removed before 1.0.
2341 =head1 AUTHOR AND CONTRIBUTORS
2343 See L<AUTHOR|DBIx::Class/AUTHOR> and L<CONTRIBUTORS|DBIx::Class/CONTRIBUTORS> in DBIx::Class
2347 You may distribute this code under the same terms as Perl itself.