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 Adds columns to the result source. If supplied colname => hashref
147 pairs, uses the hashref as the L</column_info> for that column. Repeated
148 calls of this method will add more columns, not replace them.
150 The column names given will be created as accessor methods on your
151 L<Result|DBIx::Class::Manual::ResultClass> objects. You can change the name of the accessor
152 by supplying an L</accessor> in the column_info hash.
154 If a column name beginning with a plus sign ('+col1') is provided, the
155 attributes provided will be merged with any existing attributes for the
156 column, with the new attributes taking precedence in the case that an
157 attribute already exists. Using this without a hashref
158 (C<< $source->add_columns(qw/+col1 +col2/) >>) is legal, but useless --
159 it does the same thing it would do without the plus.
161 The contents of the column_info are not set in stone. The following
162 keys are currently recognised/used by DBIx::Class:
168 { accessor => '_name' }
170 # example use, replace standard accessor with one of your own:
172 my ($self, $value) = @_;
174 die "Name cannot contain digits!" if($value =~ /\d/);
175 $self->_name($value);
177 return $self->_name();
180 Use this to set the name of the accessor method for this column. If unset,
181 the name of the column will be used.
185 { data_type => 'integer' }
187 This contains the column type. It is automatically filled if you use the
188 L<SQL::Translator::Producer::DBIx::Class::File> producer, or the
189 L<DBIx::Class::Schema::Loader> module.
191 Currently there is no standard set of values for the data_type. Use
192 whatever your database supports.
198 The length of your column, if it is a column type that can have a size
199 restriction. This is currently only used to create tables from your
200 schema, see L<DBIx::Class::Schema/deploy>.
206 Set this to a true value for a column that is allowed to contain NULL
207 values, default is false. This is currently only used to create tables
208 from your schema, see L<DBIx::Class::Schema/deploy>.
210 =item is_auto_increment
212 { is_auto_increment => 1 }
214 Set this to a true value for a column whose value is somehow
215 automatically set, defaults to false. This is used to determine which
216 columns to empty when cloning objects using
217 L<DBIx::Class::Row/copy>. It is also used by
218 L<DBIx::Class::Schema/deploy>.
224 Set this to a true or false value (not C<undef>) to explicitly specify
225 if this column contains numeric data. This controls how set_column
226 decides whether to consider a column dirty after an update: if
227 C<is_numeric> is true a numeric comparison C<< != >> will take place
228 instead of the usual C<eq>
230 If not specified the storage class will attempt to figure this out on
231 first access to the column, based on the column C<data_type>. The
232 result will be cached in this attribute.
236 { is_foreign_key => 1 }
238 Set this to a true value for a column that contains a key from a
239 foreign table, defaults to false. This is currently only used to
240 create tables from your schema, see L<DBIx::Class::Schema/deploy>.
244 { default_value => \'now()' }
246 Set this to the default value which will be inserted into a column by
247 the database. Can contain either a value or a function (use a
248 reference to a scalar e.g. C<\'now()'> if you want a function). This
249 is currently only used to create tables from your schema, see
250 L<DBIx::Class::Schema/deploy>.
252 See the note on L<DBIx::Class::Row/new> for more information about possible
253 issues related to db-side default values.
257 { sequence => 'my_table_seq' }
259 Set this on a primary key column to the name of the sequence used to
260 generate a new key value. If not specified, L<DBIx::Class::PK::Auto>
261 will attempt to retrieve the name of the sequence from the database
264 =item retrieve_on_insert
266 { retrieve_on_insert => 1 }
268 For every column where this is set to true, DBIC will retrieve the RDBMS-side
269 value upon a new row insertion (normally only the autoincrement PK is
270 retrieved on insert). C<INSERT ... RETURNING> is used automatically if
271 supported by the underlying storage, otherwise an extra SELECT statement is
272 executed to retrieve the missing data.
276 { auto_nextval => 1 }
278 Set this to a true value for a column whose value is retrieved automatically
279 from a sequence or function (if supported by your Storage driver.) For a
280 sequence, if you do not use a trigger to get the nextval, you have to set the
281 L</sequence> value as well.
283 Also set this for MSSQL columns with the 'uniqueidentifier'
284 L<data_type|DBIx::Class::ResultSource/data_type> whose values you want to
285 automatically generate using C<NEWID()>, unless they are a primary key in which
286 case this will be done anyway.
290 This is used by L<DBIx::Class::Schema/deploy> and L<SQL::Translator>
291 to add extra non-generic data to the column. For example: C<< extra
292 => { unsigned => 1} >> is used by the MySQL producer to set an integer
293 column to unsigned. For more details, see
294 L<SQL::Translator::Producer::MySQL>.
302 =item Arguments: $colname, \%columninfo?
304 =item Return Value: 1/0 (true/false)
308 $source->add_column('col' => \%info);
310 Add a single column and optional column info. Uses the same column
311 info keys as L</add_columns>.
316 my ($self, @cols) = @_;
317 $self->_ordered_columns(\@cols) unless $self->_ordered_columns;
320 my $columns = $self->_columns;
321 while (my $col = shift @cols) {
322 my $column_info = {};
323 if ($col =~ s/^\+//) {
324 $column_info = $self->column_info($col);
327 # If next entry is { ... } use that for the column info, if not
328 # use an empty hashref
330 my $new_info = shift(@cols);
331 %$column_info = (%$column_info, %$new_info);
333 push(@added, $col) unless exists $columns->{$col};
334 $columns->{$col} = $column_info;
336 push @{ $self->_ordered_columns }, @added;
340 sub add_column { shift->add_columns(@_); } # DO NOT CHANGE THIS TO GLOB
346 =item Arguments: $colname
348 =item Return Value: 1/0 (true/false)
352 if ($source->has_column($colname)) { ... }
354 Returns true if the source has a column of this name, false otherwise.
359 my ($self, $column) = @_;
360 return exists $self->_columns->{$column};
367 =item Arguments: $colname
369 =item Return Value: Hashref of info
373 my $info = $source->column_info($col);
375 Returns the column metadata hashref for a column, as originally passed
376 to L</add_columns>. See L</add_columns> above for information on the
377 contents of the hashref.
382 my ($self, $column) = @_;
383 $self->throw_exception("No such column $column")
384 unless exists $self->_columns->{$column};
386 if ( ! $self->_columns->{$column}{data_type}
387 and ! $self->{_columns_info_loaded}
388 and $self->column_info_from_storage
389 and my $stor = try { $self->storage } )
391 $self->{_columns_info_loaded}++;
393 # try for the case of storage without table
395 my $info = $stor->columns_info_for( $self->from );
397 { (lc $_) => $info->{$_} }
401 foreach my $col ( keys %{$self->_columns} ) {
402 $self->_columns->{$col} = {
403 %{ $self->_columns->{$col} },
404 %{ $info->{$col} || $lc_info->{lc $col} || {} }
410 return $self->_columns->{$column};
417 =item Arguments: none
419 =item Return Value: Ordered list of column names
423 my @column_names = $source->columns;
425 Returns all column names in the order they were declared to L</add_columns>.
431 $self->throw_exception(
432 "columns() is a read-only accessor, did you mean add_columns()?"
434 return @{$self->{_ordered_columns}||[]};
441 =item Arguments: \@colnames ?
443 =item Return Value: Hashref of column name/info pairs
447 my $columns_info = $source->columns_info;
449 Like L</column_info> but returns information for the requested columns. If
450 the optional column-list arrayref is omitted it returns info on all columns
451 currently defined on the ResultSource via L</add_columns>.
456 my ($self, $columns) = @_;
458 my $colinfo = $self->_columns;
461 first { ! $_->{data_type} } values %$colinfo
463 ! $self->{_columns_info_loaded}
465 $self->column_info_from_storage
467 my $stor = try { $self->storage }
469 $self->{_columns_info_loaded}++;
471 # try for the case of storage without table
473 my $info = $stor->columns_info_for( $self->from );
475 { (lc $_) => $info->{$_} }
479 foreach my $col ( keys %$colinfo ) {
481 %{ $colinfo->{$col} },
482 %{ $info->{$col} || $lc_info->{lc $col} || {} }
492 if (my $inf = $colinfo->{$_}) {
496 $self->throw_exception( sprintf (
497 "No such column '%s' on source '%s'",
499 $self->source_name || $self->name || 'Unknown source...?',
511 =head2 remove_columns
515 =item Arguments: @colnames
517 =item Return Value: not defined
521 $source->remove_columns(qw/col1 col2 col3/);
523 Removes the given list of columns by name, from the result source.
525 B<Warning>: Removing a column that is also used in the sources primary
526 key, or in one of the sources unique constraints, B<will> result in a
527 broken result source.
533 =item Arguments: $colname
535 =item Return Value: not defined
539 $source->remove_column('col');
541 Remove a single column by name from the result source, similar to
544 B<Warning>: Removing a column that is also used in the sources primary
545 key, or in one of the sources unique constraints, B<will> result in a
546 broken result source.
551 my ($self, @to_remove) = @_;
553 my $columns = $self->_columns
558 delete $columns->{$_};
562 $self->_ordered_columns([ grep { not $to_remove{$_} } @{$self->_ordered_columns} ]);
565 sub remove_column { shift->remove_columns(@_); } # DO NOT CHANGE THIS TO GLOB
567 =head2 set_primary_key
571 =item Arguments: @cols
573 =item Return Value: not defined
577 Defines one or more columns as primary key for this source. Must be
578 called after L</add_columns>.
580 Additionally, defines a L<unique constraint|add_unique_constraint>
583 Note: you normally do want to define a primary key on your sources
584 B<even if the underlying database table does not have a primary key>.
586 L<DBIx::Class::Manual::Intro/The Significance and Importance of Primary Keys>
591 sub set_primary_key {
592 my ($self, @cols) = @_;
594 my $colinfo = $self->columns_info(\@cols);
595 for my $col (@cols) {
596 carp_unique(sprintf (
597 "Primary key of source '%s' includes the column '%s' which has its "
598 . "'is_nullable' attribute set to true. This is a mistake and will cause "
599 . 'various Result-object operations to fail',
600 $self->source_name || $self->name || 'Unknown source...?',
602 )) if $colinfo->{$col}{is_nullable};
605 $self->_primaries(\@cols);
607 $self->add_unique_constraint(primary => \@cols);
610 =head2 primary_columns
614 =item Arguments: none
616 =item Return Value: Ordered list of primary column names
620 Read-only accessor which returns the list of primary keys, supplied by
625 sub primary_columns {
626 return @{shift->_primaries||[]};
629 # a helper method that will automatically die with a descriptive message if
630 # no pk is defined on the source in question. For internal use to save
631 # on if @pks... boilerplate
632 sub _pri_cols_or_die {
634 my @pcols = $self->primary_columns
635 or $self->throw_exception (sprintf(
636 "Operation requires a primary key to be declared on '%s' via set_primary_key",
637 # source_name is set only after schema-registration
638 $self->source_name || $self->result_class || $self->name || 'Unknown source...?',
643 # same as above but mandating single-column PK (used by relationship condition
645 sub _single_pri_col_or_die {
647 my ($pri, @too_many) = $self->_pri_cols_or_die;
649 $self->throw_exception( sprintf(
650 "Operation requires a single-column primary key declared on '%s'",
651 $self->source_name || $self->result_class || $self->name || 'Unknown source...?',
659 Manually define the correct sequence for your table, to avoid the overhead
660 associated with looking up the sequence automatically. The supplied sequence
661 will be applied to the L</column_info> of each L<primary_key|/set_primary_key>
665 =item Arguments: $sequence_name
667 =item Return Value: not defined
674 my ($self,$seq) = @_;
676 my @pks = $self->primary_columns
679 $_->{sequence} = $seq
680 for values %{ $self->columns_info (\@pks) };
684 =head2 add_unique_constraint
688 =item Arguments: $name?, \@colnames
690 =item Return Value: not defined
694 Declare a unique constraint on this source. Call once for each unique
697 # For UNIQUE (column1, column2)
698 __PACKAGE__->add_unique_constraint(
699 constraint_name => [ qw/column1 column2/ ],
702 Alternatively, you can specify only the columns:
704 __PACKAGE__->add_unique_constraint([ qw/column1 column2/ ]);
706 This will result in a unique constraint named
707 C<table_column1_column2>, where C<table> is replaced with the table
710 Unique constraints are used, for example, when you pass the constraint
711 name as the C<key> attribute to L<DBIx::Class::ResultSet/find>. Then
712 only columns in the constraint are searched.
714 Throws an error if any of the given column names do not yet exist on
719 sub add_unique_constraint {
723 $self->throw_exception(
724 'add_unique_constraint() does not accept multiple constraints, use '
725 . 'add_unique_constraints() instead'
730 if (ref $cols ne 'ARRAY') {
731 $self->throw_exception (
732 'Expecting an arrayref of constraint columns, got ' . ($cols||'NOTHING')
738 $name ||= $self->name_unique_constraint($cols);
740 foreach my $col (@$cols) {
741 $self->throw_exception("No such column $col on table " . $self->name)
742 unless $self->has_column($col);
745 my %unique_constraints = $self->unique_constraints;
746 $unique_constraints{$name} = $cols;
747 $self->_unique_constraints(\%unique_constraints);
750 =head2 add_unique_constraints
754 =item Arguments: @constraints
756 =item Return Value: not defined
760 Declare multiple unique constraints on this source.
762 __PACKAGE__->add_unique_constraints(
763 constraint_name1 => [ qw/column1 column2/ ],
764 constraint_name2 => [ qw/column2 column3/ ],
767 Alternatively, you can specify only the columns:
769 __PACKAGE__->add_unique_constraints(
770 [ qw/column1 column2/ ],
771 [ qw/column3 column4/ ]
774 This will result in unique constraints named C<table_column1_column2> and
775 C<table_column3_column4>, where C<table> is replaced with the table name.
777 Throws an error if any of the given column names do not yet exist on
780 See also L</add_unique_constraint>.
784 sub add_unique_constraints {
786 my @constraints = @_;
788 if ( !(@constraints % 2) && first { ref $_ ne 'ARRAY' } @constraints ) {
789 # with constraint name
790 while (my ($name, $constraint) = splice @constraints, 0, 2) {
791 $self->add_unique_constraint($name => $constraint);
796 foreach my $constraint (@constraints) {
797 $self->add_unique_constraint($constraint);
802 =head2 name_unique_constraint
806 =item Arguments: \@colnames
808 =item Return Value: Constraint name
812 $source->table('mytable');
813 $source->name_unique_constraint(['col1', 'col2']);
817 Return a name for a unique constraint containing the specified
818 columns. The name is created by joining the table name and each column
819 name, using an underscore character.
821 For example, a constraint on a table named C<cd> containing the columns
822 C<artist> and C<title> would result in a constraint name of C<cd_artist_title>.
824 This is used by L</add_unique_constraint> if you do not specify the
825 optional constraint name.
829 sub name_unique_constraint {
830 my ($self, $cols) = @_;
832 my $name = $self->name;
833 $name = $$name if (ref $name eq 'SCALAR');
835 return join '_', $name, @$cols;
838 =head2 unique_constraints
842 =item Arguments: none
844 =item Return Value: Hash of unique constraint data
848 $source->unique_constraints();
850 Read-only accessor which returns a hash of unique constraints on this
853 The hash is keyed by constraint name, and contains an arrayref of
854 column names as values.
858 sub unique_constraints {
859 return %{shift->_unique_constraints||{}};
862 =head2 unique_constraint_names
866 =item Arguments: none
868 =item Return Value: Unique constraint names
872 $source->unique_constraint_names();
874 Returns the list of unique constraint names defined on this source.
878 sub unique_constraint_names {
881 my %unique_constraints = $self->unique_constraints;
883 return keys %unique_constraints;
886 =head2 unique_constraint_columns
890 =item Arguments: $constraintname
892 =item Return Value: List of constraint columns
896 $source->unique_constraint_columns('myconstraint');
898 Returns the list of columns that make up the specified unique constraint.
902 sub unique_constraint_columns {
903 my ($self, $constraint_name) = @_;
905 my %unique_constraints = $self->unique_constraints;
907 $self->throw_exception(
908 "Unknown unique constraint $constraint_name on '" . $self->name . "'"
909 ) unless exists $unique_constraints{$constraint_name};
911 return @{ $unique_constraints{$constraint_name} };
914 =head2 sqlt_deploy_callback
918 =item Arguments: $callback_name | \&callback_code
920 =item Return Value: $callback_name | \&callback_code
924 __PACKAGE__->sqlt_deploy_callback('mycallbackmethod');
928 __PACKAGE__->sqlt_deploy_callback(sub {
929 my ($source_instance, $sqlt_table) = @_;
933 An accessor to set a callback to be called during deployment of
934 the schema via L<DBIx::Class::Schema/create_ddl_dir> or
935 L<DBIx::Class::Schema/deploy>.
937 The callback can be set as either a code reference or the name of a
938 method in the current result class.
940 Defaults to L</default_sqlt_deploy_hook>.
942 Your callback will be passed the $source object representing the
943 ResultSource instance being deployed, and the
944 L<SQL::Translator::Schema::Table> object being created from it. The
945 callback can be used to manipulate the table object or add your own
946 customised indexes. If you need to manipulate a non-table object, use
947 the L<DBIx::Class::Schema/sqlt_deploy_hook>.
949 See L<DBIx::Class::Manual::Cookbook/Adding Indexes And Functions To
950 Your SQL> for examples.
952 This sqlt deployment callback can only be used to manipulate
953 SQL::Translator objects as they get turned into SQL. To execute
954 post-deploy statements which SQL::Translator does not currently
955 handle, override L<DBIx::Class::Schema/deploy> in your Schema class
956 and call L<dbh_do|DBIx::Class::Storage::DBI/dbh_do>.
958 =head2 default_sqlt_deploy_hook
960 This is the default deploy hook implementation which checks if your
961 current Result class has a C<sqlt_deploy_hook> method, and if present
962 invokes it B<on the Result class directly>. This is to preserve the
963 semantics of C<sqlt_deploy_hook> which was originally designed to expect
964 the Result class name and the
965 L<$sqlt_table instance|SQL::Translator::Schema::Table> of the table being
970 sub default_sqlt_deploy_hook {
973 my $class = $self->result_class;
975 if ($class and $class->can('sqlt_deploy_hook')) {
976 $class->sqlt_deploy_hook(@_);
980 sub _invoke_sqlt_deploy_hook {
982 if ( my $hook = $self->sqlt_deploy_callback) {
991 =item Arguments: $classname
993 =item Return Value: $classname
997 use My::Schema::ResultClass::Inflator;
1000 use My::Schema::Artist;
1002 __PACKAGE__->result_class('My::Schema::ResultClass::Inflator');
1004 Set the default result class for this source. You can use this to create
1005 and use your own result inflator. See L<DBIx::Class::ResultSet/result_class>
1008 Please note that setting this to something like
1009 L<DBIx::Class::ResultClass::HashRefInflator> will make every result unblessed
1010 and make life more difficult. Inflators like those are better suited to
1011 temporary usage via L<DBIx::Class::ResultSet/result_class>.
1017 =item Arguments: none
1019 =item Return Value: L<$resultset|DBIx::Class::ResultSet>
1023 Returns a resultset for the given source. This will initially be created
1024 on demand by calling
1026 $self->resultset_class->new($self, $self->resultset_attributes)
1028 but is cached from then on unless resultset_class changes.
1030 =head2 resultset_class
1034 =item Arguments: $classname
1036 =item Return Value: $classname
1040 package My::Schema::ResultSet::Artist;
1041 use base 'DBIx::Class::ResultSet';
1044 # In the result class
1045 __PACKAGE__->resultset_class('My::Schema::ResultSet::Artist');
1048 $source->resultset_class('My::Schema::ResultSet::Artist');
1050 Set the class of the resultset. This is useful if you want to create your
1051 own resultset methods. Create your own class derived from
1052 L<DBIx::Class::ResultSet>, and set it here. If called with no arguments,
1053 this method returns the name of the existing resultset class, if one
1056 =head2 resultset_attributes
1060 =item Arguments: L<\%attrs|DBIx::Class::ResultSet/ATTRIBUTES>
1062 =item Return Value: L<\%attrs|DBIx::Class::ResultSet/ATTRIBUTES>
1066 # In the result class
1067 __PACKAGE__->resultset_attributes({ order_by => [ 'id' ] });
1070 $source->resultset_attributes({ order_by => [ 'id' ] });
1072 Store a collection of resultset attributes, that will be set on every
1073 L<DBIx::Class::ResultSet> produced from this result source.
1075 B<CAVEAT>: C<resultset_attributes> comes with its own set of issues and
1076 bugs! While C<resultset_attributes> isn't deprecated per se, its usage is
1079 Since relationships use attributes to link tables together, the "default"
1080 attributes you set may cause unpredictable and undesired behavior. Furthermore,
1081 the defaults cannot be turned off, so you are stuck with them.
1083 In most cases, what you should actually be using are project-specific methods:
1085 package My::Schema::ResultSet::Artist;
1086 use base 'DBIx::Class::ResultSet';
1090 #__PACKAGE__->resultset_attributes({ prefetch => 'tracks' });
1093 sub with_tracks { shift->search({}, { prefetch => 'tracks' }) }
1096 $schema->resultset('Artist')->with_tracks->...
1098 This gives you the flexibility of not using it when you don't need it.
1100 For more complex situations, another solution would be to use a virtual view
1101 via L<DBIx::Class::ResultSource::View>.
1107 $self->throw_exception(
1108 'resultset does not take any arguments. If you want another resultset, '.
1109 'call it on the schema instead.'
1112 $self->resultset_class->new(
1115 try { %{$self->schema->default_resultset_attributes} },
1116 %{$self->{resultset_attributes}},
1125 =item Arguments: none
1127 =item Result value: $name
1131 Returns the name of the result source, which will typically be the table
1132 name. This may be a scalar reference if the result source has a non-standard
1139 =item Arguments: $source_name
1141 =item Result value: $source_name
1145 Set an alternate name for the result source when it is loaded into a schema.
1146 This is useful if you want to refer to a result source by a name other than
1149 package ArchivedBooks;
1150 use base qw/DBIx::Class/;
1151 __PACKAGE__->table('books_archive');
1152 __PACKAGE__->source_name('Books');
1154 # from your schema...
1155 $schema->resultset('Books')->find(1);
1161 =item Arguments: none
1163 =item Return Value: FROM clause
1167 my $from_clause = $source->from();
1169 Returns an expression of the source to be supplied to storage to specify
1170 retrieval from this source. In the case of a database, the required FROM
1175 sub from { die 'Virtual method!' }
1181 =item Arguments: L<$schema?|DBIx::Class::Schema>
1183 =item Return Value: L<$schema|DBIx::Class::Schema>
1187 my $schema = $source->schema();
1189 Sets and/or returns the L<DBIx::Class::Schema> object to which this
1190 result source instance has been attached to.
1196 $_[0]->{schema} = $_[1];
1199 $_[0]->{schema} || do {
1200 my $name = $_[0]->{source_name} || '_unnamed_';
1201 my $err = 'Unable to perform storage-dependent operations with a detached result source '
1202 . "(source '$name' is not associated with a schema).";
1204 $err .= ' You need to use $schema->thaw() or manually set'
1205 . ' $DBIx::Class::ResultSourceHandle::thaw_schema while thawing.'
1206 if $_[0]->{_detached_thaw};
1208 DBIx::Class::Exception->throw($err);
1217 =item Arguments: none
1219 =item Return Value: L<$storage|DBIx::Class::Storage>
1223 $source->storage->debug(1);
1225 Returns the L<storage handle|DBIx::Class::Storage> for the current schema.
1229 sub storage { shift->schema->storage; }
1231 =head2 add_relationship
1235 =item Arguments: $rel_name, $related_source_name, \%cond, \%attrs?
1237 =item Return Value: 1/true if it succeeded
1241 $source->add_relationship('rel_name', 'related_source', $cond, $attrs);
1243 L<DBIx::Class::Relationship> describes a series of methods which
1244 create pre-defined useful types of relationships. Look there first
1245 before using this method directly.
1247 The relationship name can be arbitrary, but must be unique for each
1248 relationship attached to this result source. 'related_source' should
1249 be the name with which the related result source was registered with
1250 the current schema. For example:
1252 $schema->source('Book')->add_relationship('reviews', 'Review', {
1253 'foreign.book_id' => 'self.id',
1256 The condition C<$cond> needs to be an L<SQL::Abstract>-style
1257 representation of the join between the tables. For example, if you're
1258 creating a relation from Author to Book,
1260 { 'foreign.author_id' => 'self.id' }
1262 will result in the JOIN clause
1264 author me JOIN book foreign ON foreign.author_id = me.id
1266 You can specify as many foreign => self mappings as necessary.
1268 Valid attributes are as follows:
1274 Explicitly specifies the type of join to use in the relationship. Any
1275 SQL join type is valid, e.g. C<LEFT> or C<RIGHT>. It will be placed in
1276 the SQL command immediately before C<JOIN>.
1280 An arrayref containing a list of accessors in the foreign class to proxy in
1281 the main class. If, for example, you do the following:
1283 CD->might_have(liner_notes => 'LinerNotes', undef, {
1284 proxy => [ qw/notes/ ],
1287 Then, assuming LinerNotes has an accessor named notes, you can do:
1289 my $cd = CD->find(1);
1290 # set notes -- LinerNotes object is created if it doesn't exist
1291 $cd->notes('Notes go here');
1295 Specifies the type of accessor that should be created for the
1296 relationship. Valid values are C<single> (for when there is only a single
1297 related object), C<multi> (when there can be many), and C<filter> (for
1298 when there is a single related object, but you also want the relationship
1299 accessor to double as a column accessor). For C<multi> accessors, an
1300 add_to_* method is also created, which calls C<create_related> for the
1305 Throws an exception if the condition is improperly supplied, or cannot
1310 sub add_relationship {
1311 my ($self, $rel, $f_source_name, $cond, $attrs) = @_;
1312 $self->throw_exception("Can't create relationship without join condition")
1316 # Check foreign and self are right in cond
1317 if ( (ref $cond ||'') eq 'HASH') {
1319 $self->throw_exception("Keys of condition should be of form 'foreign.col', not '$_'")
1320 if /\./ && !/^foreign\./;
1324 my %rels = %{ $self->_relationships };
1325 $rels{$rel} = { class => $f_source_name,
1326 source => $f_source_name,
1329 $self->_relationships(\%rels);
1333 # XXX disabled. doesn't work properly currently. skip in tests.
1335 my $f_source = $self->schema->source($f_source_name);
1336 unless ($f_source) {
1337 $self->ensure_class_loaded($f_source_name);
1338 $f_source = $f_source_name->result_source;
1339 #my $s_class = ref($self->schema);
1340 #$f_source_name =~ m/^${s_class}::(.*)$/;
1341 #$self->schema->register_class(($1 || $f_source_name), $f_source_name);
1342 #$f_source = $self->schema->source($f_source_name);
1344 return unless $f_source; # Can't test rel without f_source
1346 try { $self->_resolve_join($rel, 'me', {}, []) }
1348 # If the resolve failed, back out and re-throw the error
1350 $self->_relationships(\%rels);
1351 $self->throw_exception("Error creating relationship $rel: $_");
1357 =head2 relationships
1361 =item Arguments: none
1363 =item Return Value: L<@rel_names|DBIx::Class::Relationship>
1367 my @rel_names = $source->relationships();
1369 Returns all relationship names for this source.
1374 return keys %{shift->_relationships};
1377 =head2 relationship_info
1381 =item Arguments: L<$rel_name|DBIx::Class::Relationship>
1383 =item Return Value: L<\%rel_data|DBIx::Class::Relationship::Base/add_relationship>
1387 Returns a hash of relationship information for the specified relationship
1388 name. The keys/values are as specified for L<DBIx::Class::Relationship::Base/add_relationship>.
1392 sub relationship_info {
1393 #my ($self, $rel) = @_;
1394 return shift->_relationships->{+shift};
1397 =head2 has_relationship
1401 =item Arguments: L<$rel_name|DBIx::Class::Relationship>
1403 =item Return Value: 1/0 (true/false)
1407 Returns true if the source has a relationship of this name, false otherwise.
1411 sub has_relationship {
1412 #my ($self, $rel) = @_;
1413 return exists shift->_relationships->{+shift};
1416 =head2 reverse_relationship_info
1420 =item Arguments: L<$rel_name|DBIx::Class::Relationship>
1422 =item Return Value: L<\%rel_data|DBIx::Class::Relationship::Base/add_relationship>
1426 Looks through all the relationships on the source this relationship
1427 points to, looking for one whose condition is the reverse of the
1428 condition on this relationship.
1430 A common use of this is to find the name of the C<belongs_to> relation
1431 opposing a C<has_many> relation. For definition of these look in
1432 L<DBIx::Class::Relationship>.
1434 The returned hashref is keyed by the name of the opposing
1435 relationship, and contains its data in the same manner as
1436 L</relationship_info>.
1440 sub reverse_relationship_info {
1441 my ($self, $rel) = @_;
1443 my $rel_info = $self->relationship_info($rel)
1444 or $self->throw_exception("No such relationship '$rel'");
1448 return $ret unless ((ref $rel_info->{cond}) eq 'HASH');
1450 my $stripped_cond = $self->__strip_relcond ($rel_info->{cond});
1452 my $registered_source_name = $self->source_name;
1454 # this may be a partial schema or something else equally esoteric
1455 my $other_rsrc = $self->related_source($rel);
1457 # Get all the relationships for that source that related to this source
1458 # whose foreign column set are our self columns on $rel and whose self
1459 # columns are our foreign columns on $rel
1460 foreach my $other_rel ($other_rsrc->relationships) {
1462 # only consider stuff that points back to us
1463 # "us" here is tricky - if we are in a schema registration, we want
1464 # to use the source_names, otherwise we will use the actual classes
1466 # the schema may be partial
1467 my $roundtrip_rsrc = try { $other_rsrc->related_source($other_rel) }
1470 if ($registered_source_name) {
1471 next if $registered_source_name ne ($roundtrip_rsrc->source_name || '')
1474 next if $self->result_class ne $roundtrip_rsrc->result_class;
1477 my $other_rel_info = $other_rsrc->relationship_info($other_rel);
1479 # this can happen when we have a self-referential class
1480 next if $other_rel_info eq $rel_info;
1482 next unless ref $other_rel_info->{cond} eq 'HASH';
1483 my $other_stripped_cond = $self->__strip_relcond($other_rel_info->{cond});
1485 $ret->{$other_rel} = $other_rel_info if (
1486 $self->_compare_relationship_keys (
1487 [ keys %$stripped_cond ], [ values %$other_stripped_cond ]
1490 $self->_compare_relationship_keys (
1491 [ values %$stripped_cond ], [ keys %$other_stripped_cond ]
1499 # all this does is removes the foreign/self prefix from a condition
1500 sub __strip_relcond {
1503 { map { /^ (?:foreign|self) \. (\w+) $/x } ($_, $_[1]{$_}) }
1508 sub compare_relationship_keys {
1509 carp 'compare_relationship_keys is a private method, stop calling it';
1511 $self->_compare_relationship_keys (@_);
1514 # Returns true if both sets of keynames are the same, false otherwise.
1515 sub _compare_relationship_keys {
1516 # my ($self, $keys1, $keys2) = @_;
1518 join ("\x00", sort @{$_[1]})
1520 join ("\x00", sort @{$_[2]})
1524 # optionally takes either an arrayref of column names, or a hashref of already
1525 # retrieved colinfos
1526 # returns an arrayref of column names of the shortest unique constraint
1527 # (matching some of the input if any), giving preference to the PK
1528 sub _identifying_column_set {
1529 my ($self, $cols) = @_;
1531 my %unique = $self->unique_constraints;
1532 my $colinfos = ref $cols eq 'HASH' ? $cols : $self->columns_info($cols||());
1534 # always prefer the PK first, and then shortest constraints first
1536 for my $set (delete $unique{primary}, sort { @$a <=> @$b } (values %unique) ) {
1537 next unless $set && @$set;
1540 next USET unless ($colinfos->{$_} && !$colinfos->{$_}{is_nullable} );
1543 # copy so we can mangle it at will
1550 # Returns the {from} structure used to express JOIN conditions
1552 my ($self, $join, $alias, $seen, $jpath, $parent_force_left) = @_;
1554 # we need a supplied one, because we do in-place modifications, no returns
1555 $self->throw_exception ('You must supply a seen hashref as the 3rd argument to _resolve_join')
1556 unless ref $seen eq 'HASH';
1558 $self->throw_exception ('You must supply a joinpath arrayref as the 4th argument to _resolve_join')
1559 unless ref $jpath eq 'ARRAY';
1561 $jpath = [@$jpath]; # copy
1563 if (not defined $join or not length $join) {
1566 elsif (ref $join eq 'ARRAY') {
1569 $self->_resolve_join($_, $alias, $seen, $jpath, $parent_force_left);
1572 elsif (ref $join eq 'HASH') {
1575 for my $rel (keys %$join) {
1577 my $rel_info = $self->relationship_info($rel)
1578 or $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
1580 my $force_left = $parent_force_left;
1581 $force_left ||= lc($rel_info->{attrs}{join_type}||'') eq 'left';
1583 # the actual seen value will be incremented by the recursion
1584 my $as = $self->storage->relname_to_table_alias(
1585 $rel, ($seen->{$rel} && $seen->{$rel} + 1)
1589 $self->_resolve_join($rel, $alias, $seen, [@$jpath], $force_left),
1590 $self->related_source($rel)->_resolve_join(
1591 $join->{$rel}, $as, $seen, [@$jpath, { $rel => $as }], $force_left
1599 $self->throw_exception("No idea how to resolve join reftype ".ref $join);
1602 my $count = ++$seen->{$join};
1603 my $as = $self->storage->relname_to_table_alias(
1604 $join, ($count > 1 && $count)
1607 my $rel_info = $self->relationship_info($join)
1608 or $self->throw_exception("No such relationship $join on " . $self->source_name);
1610 my $rel_src = $self->related_source($join);
1611 return [ { $as => $rel_src->from,
1613 -join_type => $parent_force_left
1615 : $rel_info->{attrs}{join_type}
1617 -join_path => [@$jpath, { $join => $as } ],
1619 (! $rel_info->{attrs}{accessor})
1621 first { $rel_info->{attrs}{accessor} eq $_ } (qw/single filter/)
1624 -relation_chain_depth => ( $seen->{-relation_chain_depth} || 0 ) + 1,
1626 scalar $self->_resolve_condition($rel_info->{cond}, $as, $alias, $join)
1632 carp 'pk_depends_on is a private method, stop calling it';
1634 $self->_pk_depends_on (@_);
1637 # Determines whether a relation is dependent on an object from this source
1638 # having already been inserted. Takes the name of the relationship and a
1639 # hashref of columns of the related object.
1640 sub _pk_depends_on {
1641 my ($self, $rel_name, $rel_data) = @_;
1643 my $relinfo = $self->relationship_info($rel_name);
1645 # don't assume things if the relationship direction is specified
1646 return $relinfo->{attrs}{is_foreign_key_constraint}
1647 if exists ($relinfo->{attrs}{is_foreign_key_constraint});
1649 my $cond = $relinfo->{cond};
1650 return 0 unless ref($cond) eq 'HASH';
1652 # map { foreign.foo => 'self.bar' } to { bar => 'foo' }
1653 my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond };
1655 # assume anything that references our PK probably is dependent on us
1656 # rather than vice versa, unless the far side is (a) defined or (b)
1658 my $rel_source = $self->related_source($rel_name);
1660 foreach my $p ($self->primary_columns) {
1661 if (exists $keyhash->{$p}) {
1662 unless (defined($rel_data->{$keyhash->{$p}})
1663 || $rel_source->column_info($keyhash->{$p})
1664 ->{is_auto_increment}) {
1673 sub _resolve_condition {
1674 # carp_unique sprintf
1675 # '_resolve_condition is a private method, and moreover is about to go '
1676 # . 'away. Please contact the development team at %s if you believe you '
1677 # . 'have a genuine use for this method, in order to discuss alternatives.',
1678 # DBIx::Class::_ENV_::HELP_URL,
1681 #######################
1682 ### API Design? What's that...? (a backwards compatible shim, kill me now)
1684 my ($self, $cond, @res_args, $rel_name);
1686 # we *SIMPLY DON'T KNOW YET* which arg is which, yay
1687 ($self, $cond, $res_args[0], $res_args[1], $rel_name) = @_;
1689 # assume that an undef is an object-like unset (set_from_related(undef))
1690 my @is_objlike = map { ! defined $_ or length ref $_ } (@res_args);
1692 # turn objlike into proper objects for saner code further down
1694 next unless $is_objlike[$_];
1696 if ( defined blessed $res_args[$_] ) {
1698 # but wait - there is more!!! WHAT THE FUCK?!?!?!?!
1699 if ($res_args[$_]->isa('DBIx::Class::ResultSet')) {
1700 carp('Passing a resultset for relationship resolution makes no sense - invoking __gremlins__');
1701 $is_objlike[$_] = 0;
1702 $res_args[$_] = '__gremlins__';
1706 $res_args[$_] ||= {};
1708 # hate everywhere - have to pass in as a plain hash
1709 # pretending to be an object at least for now
1710 $self->throw_exception("Unsupported object-like structure encountered: $res_args[$_]")
1711 unless ref $res_args[$_] eq 'HASH';
1718 # where-is-waldo block guesses relname, then further down we override it if available
1720 $is_objlike[1] ? ( rel_name => $res_args[0], self_alias => $res_args[0], foreign_alias => 'me', self_result_object => $res_args[1] )
1721 : $is_objlike[0] ? ( rel_name => $res_args[1], self_alias => 'me', foreign_alias => $res_args[1], foreign_result_object => $res_args[0] )
1722 : ( rel_name => $res_args[0], self_alias => $res_args[1], foreign_alias => $res_args[0] )
1725 ( $rel_name ? ( rel_name => $rel_name ) : () ),
1727 #######################
1729 # now it's fucking easy isn't it?!
1730 my $rc = $self->_resolve_relationship_condition( $args );
1733 ( $rc->{join_free_condition} || $rc->{condition} ),
1734 ! $rc->{join_free_condition},
1737 # _resolve_relationship_condition always returns qualified cols even in the
1738 # case of join_free_condition, but nothing downstream expects this
1739 if (ref $res[0] eq 'HASH' and ($is_objlike[0] or $is_objlike[1]) ) {
1741 { ($_ =~ /\.(.+)/) => $res[0]{$_} }
1747 return wantarray ? @res : $res[0];
1750 # Keep this indefinitely. There is evidence of both CPAN and
1751 # darkpan using it, and there isn't much harm in an extra var
1753 our $UNRESOLVABLE_CONDITION = UNRESOLVABLE_CONDITION;
1754 # YES I KNOW THIS IS EVIL
1755 # it is there to save darkpan from themselves, since internally
1756 # we are moving to a constant
1757 Internals::SvREADONLY($UNRESOLVABLE_CONDITION => 1);
1759 # Resolves the passed condition to a concrete query fragment and extra
1762 ## self-explanatory API, modeled on the custom cond coderef:
1765 # foreign_result_object
1767 # self_result_object
1768 # require_join_free_condition
1769 # infer_values_based_on (optional, mandatory hashref argument)
1770 # condition (optional, derived from $self->rel_info(rel_name))
1775 # join_free_condition (maybe unset)
1776 # inferred_values (always either complete or unset)
1778 sub _resolve_relationship_condition {
1781 my $args = { ref $_[0] eq 'HASH' ? %{ $_[0] } : @_ };
1783 for ( qw( rel_name self_alias foreign_alias ) ) {
1784 $self->throw_exception("Mandatory argument '$_' to _resolve_relationship_condition() is not a plain string")
1785 if !defined $args->{$_} or length ref $args->{$_};
1788 $self->throw_exception("Arguments 'self_alias' and 'foreign_alias' may not be identical")
1789 if $args->{self_alias} eq $args->{foreign_alias};
1791 my $exception_rel_id = "relationship '$args->{rel_name}' on source '@{[ $self->source_name ]}'";
1793 my $rel_info = $self->relationship_info($args->{rel_name})
1794 or $self->throw_exception( "No such $exception_rel_id" );
1796 $self->throw_exception("No practical way to resolve $exception_rel_id between two data structures")
1797 if defined $args->{self_result_object} and defined $args->{foreign_result_object};
1799 $self->throw_exception( "Argument to infer_values_based_on must be a hash" )
1800 if exists $args->{infer_values_based_on} and ref $args->{infer_values_based_on} ne 'HASH';
1802 $args->{require_join_free_condition} ||= !!$args->{infer_values_based_on};
1804 $args->{condition} ||= $rel_info->{cond};
1806 if (exists $args->{self_result_object}) {
1807 if (defined blessed $args->{self_result_object}) {
1808 $self->throw_exception( "Object '$args->{self_result_object}' must be of class '@{[ $self->result_class ]}'" )
1809 unless $args->{self_result_object}->isa($self->result_class);
1812 $args->{self_result_object} = DBIx::Class::Core->new({
1813 -result_source => $self,
1814 %{ $args->{self_result_object}||{} }
1819 if (exists $args->{foreign_result_object}) {
1820 if (defined blessed $args->{foreign_result_object}) {
1821 $self->throw_exception( "Object '$args->{foreign_result_object}' must be of class '$rel_info->{class}'" )
1822 unless $args->{foreign_result_object}->isa($rel_info->{class});
1825 $args->{foreign_result_object} = DBIx::Class::Core->new({
1826 -result_source => $self->related_source($args->{rel_name}),
1827 %{ $args->{foreign_result_object}||{} }
1834 if (ref $args->{condition} eq 'CODE') {
1837 rel_name => $args->{rel_name},
1838 self_resultsource => $self,
1839 self_alias => $args->{self_alias},
1840 foreign_alias => $args->{foreign_alias},
1842 { (exists $args->{$_}) ? ( $_ => $args->{$_} ) : () }
1843 qw( self_result_object foreign_result_object )
1847 # legacy - never remove these!!!
1848 $cref_args->{foreign_relname} = $cref_args->{rel_name};
1850 $cref_args->{self_rowobj} = $cref_args->{self_result_object}
1851 if exists $cref_args->{self_result_object};
1853 ($ret->{condition}, $ret->{join_free_condition}, my @extra) = $args->{condition}->($cref_args);
1855 # FIXME sanity check
1856 carp_unique('A custom condition coderef can return at most 2 conditions: extra return values discarded')
1859 if (my $jfc = $ret->{join_free_condition}) {
1861 $self->throw_exception (
1862 "The join-free condition returned for $exception_rel_id must be a hash reference"
1863 ) unless ref $jfc eq 'HASH';
1865 my ($joinfree_alias, $joinfree_source);
1866 if (defined $args->{self_result_object}) {
1867 $joinfree_alias = $args->{foreign_alias};
1868 $joinfree_source = $self->related_source($args->{rel_name});
1870 elsif (defined $args->{foreign_result_object}) {
1871 $joinfree_alias = $args->{self_alias};
1872 $joinfree_source = $self;
1875 # FIXME sanity check until things stabilize, remove at some point
1876 $self->throw_exception (
1877 "A join-free condition returned for $exception_rel_id without a result object to chain from"
1878 ) unless $joinfree_alias;
1880 my $fq_col_list = { map
1881 { ( "$joinfree_alias.$_" => 1 ) }
1882 $joinfree_source->columns
1885 $fq_col_list->{$_} or $self->throw_exception (
1886 "The join-free condition returned for $exception_rel_id may only "
1887 . 'contain keys that are fully qualified column names of the corresponding source'
1892 elsif (ref $args->{condition} eq 'HASH') {
1894 # the condition is static - use parallel arrays
1895 # for a "pivot" depending on which side of the
1896 # rel did we get as an object
1897 my (@f_cols, @l_cols);
1898 for my $fc (keys %{$args->{condition}}) {
1899 my $lc = $args->{condition}{$fc};
1901 # FIXME STRICTMODE should probably check these are valid columns
1902 $fc =~ s/^foreign\.// ||
1903 $self->throw_exception("Invalid rel cond key '$fc'");
1905 $lc =~ s/^self\.// ||
1906 $self->throw_exception("Invalid rel cond val '$lc'");
1912 # construct the crosstable condition and the identity map
1914 $ret->{condition}{"$args->{foreign_alias}.$f_cols[$_]"} = { -ident => "$args->{self_alias}.$l_cols[$_]" };
1915 $ret->{identity_map}{$l_cols[$_]} = $f_cols[$_];
1918 if (exists $args->{self_result_object} or exists $args->{foreign_result_object}) {
1920 my ($obj, $obj_alias, $plain_alias, $obj_cols, $plain_cols) = defined $args->{self_result_object}
1921 ? ( @{$args}{qw( self_result_object self_alias foreign_alias )}, \@l_cols, \@f_cols )
1922 : ( @{$args}{qw( foreign_result_object foreign_alias self_alias )}, \@f_cols, \@l_cols )
1925 for my $i (0..$#$obj_cols) {
1928 defined $args->{self_result_object}
1930 ! $obj->has_column_loaded($obj_cols->[$i])
1933 $self->throw_exception(sprintf
1934 "Unable to resolve relationship '%s' from object '%s': column '%s' not "
1935 . 'loaded from storage (or not passed to new() prior to insert()). You '
1936 . 'probably need to call ->discard_changes to get the server-side defaults '
1937 . 'from the database.',
1941 ) if $obj->in_storage;
1943 # FIXME - temporarly force-override
1944 delete $args->{require_join_free_condition};
1945 $ret->{join_free_condition} = UNRESOLVABLE_CONDITION;
1949 $ret->{join_free_condition}{"$plain_alias.$plain_cols->[$i]"} = $obj->get_column($obj_cols->[$i]);
1954 elsif (ref $args->{condition} eq 'ARRAY') {
1955 if (@{$args->{condition}} == 0) {
1957 condition => UNRESOLVABLE_CONDITION,
1958 join_free_condition => UNRESOLVABLE_CONDITION,
1961 elsif (@{$args->{condition}} == 1) {
1962 $ret = $self->_resolve_relationship_condition({
1964 condition => $args->{condition}[0],
1968 # we are discarding inferred values here... likely incorrect...
1969 # then again - the entire thing is an OR, so we *can't* use them anyway
1970 for my $subcond ( map
1971 { $self->_resolve_relationship_condition({ %$args, condition => $_ }) }
1972 @{$args->{condition}}
1974 $self->throw_exception('Either all or none of the OR-condition members can resolve to a join-free condition')
1975 if $ret->{join_free_condition} and ! $subcond->{join_free_condition};
1977 $subcond->{$_} and push @{$ret->{$_}}, $subcond->{$_} for (qw(condition join_free_condition));
1982 $self->throw_exception ("Can't handle condition $args->{condition} for $exception_rel_id yet :(");
1985 $self->throw_exception(ucfirst "$exception_rel_id does not resolve to a join-free condition fragment") if (
1986 $args->{require_join_free_condition}
1988 ( ! $ret->{join_free_condition} or $ret->{join_free_condition} eq UNRESOLVABLE_CONDITION )
1991 # we got something back - sanity check and infer values if we can
1993 if ( my $jfc = $ret->{join_free_condition} and $ret->{join_free_condition} ne UNRESOLVABLE_CONDITION ) {
1995 my $jfc_eqs = $self->schema->storage->_extract_fixed_condition_columns($jfc, 'consider_nulls');
1997 if (keys %$jfc_eqs) {
2000 # $jfc is fully qualified by definition
2001 my ($col) = $_ =~ /\.(.+)/;
2003 if (exists $jfc_eqs->{$_} and ($jfc_eqs->{$_}||'') ne UNRESOLVABLE_CONDITION) {
2004 $ret->{inferred_values}{$col} = $jfc_eqs->{$_};
2006 elsif ( !$args->{infer_values_based_on} or ! exists $args->{infer_values_based_on}{$col} ) {
2007 push @nonvalues, $col;
2012 delete $ret->{inferred_values} if @nonvalues;
2016 # did the user explicitly ask
2017 if ($args->{infer_values_based_on}) {
2019 $self->throw_exception(sprintf (
2020 "Unable to complete value inferrence - custom $exception_rel_id returns conditions instead of values for column(s): %s",
2021 map { "'$_'" } @nonvalues
2025 $ret->{inferred_values} ||= {};
2027 $ret->{inferred_values}{$_} = $args->{infer_values_based_on}{$_}
2028 for keys %{$args->{infer_values_based_on}};
2031 # add the identities based on the main condition
2032 # (may already be there, since easy to calculate on the fly in the HASH case)
2033 if ( ! $ret->{identity_map} ) {
2035 my $col_eqs = $self->schema->storage->_extract_fixed_condition_columns($ret->{condition});
2038 for my $lhs (keys %$col_eqs) {
2040 next if $col_eqs->{$lhs} eq UNRESOLVABLE_CONDITION;
2041 my ($rhs) = @{ is_literal_value( $ret->{condition}{$lhs} ) || next };
2043 # there is no way to know who is right and who is left
2044 # therefore the ugly scan below
2045 $colinfos ||= $self->schema->storage->_resolve_column_info([
2046 { -alias => $args->{self_alias}, -rsrc => $self },
2047 { -alias => $args->{foreign_alias}, -rsrc => $self->related_source($args->{rel_name}) },
2050 my ($l_col, $l_alias, $r_col, $r_alias) = map {
2051 ( reverse $_ =~ / ^ (?: ([^\.]+) $ | ([^\.]+) \. (.+) ) /x )[0,1]
2059 $colinfos->{$l_col}{-source_alias} ne $colinfos->{$r_col}{-source_alias}
2061 ( $colinfos->{$l_col}{-source_alias} eq $args->{self_alias} )
2062 ? ( $ret->{identity_map}{$l_col} = $r_col )
2063 : ( $ret->{identity_map}{$r_col} = $l_col )
2072 =head2 related_source
2076 =item Arguments: $rel_name
2078 =item Return Value: $source
2082 Returns the result source object for the given relationship.
2086 sub related_source {
2087 my ($self, $rel) = @_;
2088 if( !$self->has_relationship( $rel ) ) {
2089 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
2092 # if we are not registered with a schema - just use the prototype
2093 # however if we do have a schema - ask for the source by name (and
2094 # throw in the process if all fails)
2095 if (my $schema = try { $self->schema }) {
2096 $schema->source($self->relationship_info($rel)->{source});
2099 my $class = $self->relationship_info($rel)->{class};
2100 $self->ensure_class_loaded($class);
2101 $class->result_source_instance;
2105 =head2 related_class
2109 =item Arguments: $rel_name
2111 =item Return Value: $classname
2115 Returns the class name for objects in the given relationship.
2120 my ($self, $rel) = @_;
2121 if( !$self->has_relationship( $rel ) ) {
2122 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
2124 return $self->schema->class($self->relationship_info($rel)->{source});
2131 =item Arguments: none
2133 =item Return Value: L<$source_handle|DBIx::Class::ResultSourceHandle>
2137 Obtain a new L<result source handle instance|DBIx::Class::ResultSourceHandle>
2138 for this source. Used as a serializable pointer to this resultsource, as it is not
2139 easy (nor advisable) to serialize CODErefs which may very well be present in e.g.
2140 relationship definitions.
2145 return DBIx::Class::ResultSourceHandle->new({
2146 source_moniker => $_[0]->source_name,
2148 # so that a detached thaw can be re-frozen
2149 $_[0]->{_detached_thaw}
2150 ? ( _detached_source => $_[0] )
2151 : ( schema => $_[0]->schema )
2156 my $global_phase_destroy;
2158 return if $global_phase_destroy ||= in_global_destruction;
2164 # Under no circumstances shall $_[0] be stored anywhere else (like copied to
2165 # a lexical variable, or shifted, or anything else). Doing so will mess up
2166 # the refcount of this particular result source, and will allow the $schema
2167 # we are trying to save to reattach back to the source we are destroying.
2168 # The relevant code checking refcounts is in ::Schema::DESTROY()
2170 # if we are not a schema instance holder - we don't matter
2172 ! ref $_[0]->{schema}
2174 isweak $_[0]->{schema}
2177 # weaken our schema hold forcing the schema to find somewhere else to live
2178 # during global destruction (if we have not yet bailed out) this will throw
2179 # which will serve as a signal to not try doing anything else
2180 # however beware - on older perls the exception seems randomly untrappable
2181 # due to some weird race condition during thread joining :(((
2184 weaken $_[0]->{schema};
2186 # if schema is still there reintroduce ourselves with strong refs back to us
2187 if ($_[0]->{schema}) {
2188 my $srcregs = $_[0]->{schema}->source_registrations;
2189 for (keys %$srcregs) {
2190 next unless $srcregs->{$_};
2191 $srcregs->{$_} = $_[0] if $srcregs->{$_} == $_[0];
2197 $global_phase_destroy = 1;
2203 sub STORABLE_freeze { Storable::nfreeze($_[0]->handle) }
2206 my ($self, $cloning, $ice) = @_;
2207 %$self = %{ (Storable::thaw($ice))->resolve };
2210 =head2 throw_exception
2212 See L<DBIx::Class::Schema/"throw_exception">.
2216 sub throw_exception {
2220 ? $self->{schema}->throw_exception(@_)
2221 : DBIx::Class::Exception->throw(@_)
2227 Stores a hashref of per-source metadata. No specific key names
2228 have yet been standardized, the examples below are purely hypothetical
2229 and don't actually accomplish anything on their own:
2231 __PACKAGE__->source_info({
2232 "_tablespace" => 'fast_disk_array_3',
2233 "_engine" => 'InnoDB',
2240 $class->new({attribute_name => value});
2242 Creates a new ResultSource object. Not normally called directly by end users.
2244 =head2 column_info_from_storage
2248 =item Arguments: 1/0 (default: 0)
2250 =item Return Value: 1/0
2254 __PACKAGE__->column_info_from_storage(1);
2256 Enables the on-demand automatic loading of the above column
2257 metadata from storage as necessary. This is *deprecated*, and
2258 should not be used. It will be removed before 1.0.
2261 =head1 AUTHOR AND CONTRIBUTORS
2263 See L<AUTHOR|DBIx::Class/AUTHOR> and L<CONTRIBUTORS|DBIx::Class/CONTRIBUTORS> in DBIx::Class
2267 You may distribute this code under the same terms as Perl itself.