Remove dead code commented out since 2006 ( 953a18ef )
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / ResultSource.pm
1 package DBIx::Class::ResultSource;
2
3 use strict;
4 use warnings;
5
6 use base qw/DBIx::Class::ResultSource::RowParser DBIx::Class/;
7
8 use DBIx::Class::ResultSet;
9 use DBIx::Class::ResultSourceHandle;
10
11 use DBIx::Class::Carp;
12 use DBIx::Class::_Util 'UNRESOLVABLE_CONDITION';
13 use SQL::Abstract 'is_literal_value';
14 use Devel::GlobalDestruction;
15 use Try::Tiny;
16 use Scalar::Util qw/blessed weaken isweak/;
17
18 use namespace::clean;
19
20 __PACKAGE__->mk_group_accessors(simple => qw/
21   source_name name source_info
22   _ordered_columns _columns _primaries _unique_constraints
23   _relationships resultset_attributes
24   column_info_from_storage
25 /);
26
27 __PACKAGE__->mk_group_accessors(component_class => qw/
28   resultset_class
29   result_class
30 /);
31
32 __PACKAGE__->mk_classdata( sqlt_deploy_callback => 'default_sqlt_deploy_hook' );
33
34 =head1 NAME
35
36 DBIx::Class::ResultSource - Result source object
37
38 =head1 SYNOPSIS
39
40   # Create a table based result source, in a result class.
41
42   package MyApp::Schema::Result::Artist;
43   use base qw/DBIx::Class::Core/;
44
45   __PACKAGE__->table('artist');
46   __PACKAGE__->add_columns(qw/ artistid name /);
47   __PACKAGE__->set_primary_key('artistid');
48   __PACKAGE__->has_many(cds => 'MyApp::Schema::Result::CD');
49
50   1;
51
52   # Create a query (view) based result source, in a result class
53   package MyApp::Schema::Result::Year2000CDs;
54   use base qw/DBIx::Class::Core/;
55
56   __PACKAGE__->load_components('InflateColumn::DateTime');
57   __PACKAGE__->table_class('DBIx::Class::ResultSource::View');
58
59   __PACKAGE__->table('year2000cds');
60   __PACKAGE__->result_source_instance->is_virtual(1);
61   __PACKAGE__->result_source_instance->view_definition(
62       "SELECT cdid, artist, title FROM cd WHERE year ='2000'"
63       );
64
65
66 =head1 DESCRIPTION
67
68 A ResultSource is an object that represents a source of data for querying.
69
70 This class is a base class for various specialised types of result
71 sources, for example L<DBIx::Class::ResultSource::Table>. Table is the
72 default result source type, so one is created for you when defining a
73 result class as described in the synopsis above.
74
75 More specifically, the L<DBIx::Class::Core> base class pulls in the
76 L<DBIx::Class::ResultSourceProxy::Table> component, which defines
77 the L<table|DBIx::Class::ResultSourceProxy::Table/table> method.
78 When called, C<table> creates and stores an instance of
79 L<DBIx::Class::ResultSource::Table>. Luckily, to use tables as result
80 sources, you don't need to remember any of this.
81
82 Result sources representing select queries, or views, can also be
83 created, see L<DBIx::Class::ResultSource::View> for full details.
84
85 =head2 Finding result source objects
86
87 As mentioned above, a result source instance is created and stored for
88 you when you define a
89 L<Result Class|DBIx::Class::Manual::Glossary/Result Class>.
90
91 You can retrieve the result source at runtime in the following ways:
92
93 =over
94
95 =item From a Schema object:
96
97    $schema->source($source_name);
98
99 =item From a Result object:
100
101    $result->result_source;
102
103 =item From a ResultSet object:
104
105    $rs->result_source;
106
107 =back
108
109 =head1 METHODS
110
111 =head2 new
112
113   $class->new();
114
115   $class->new({attribute_name => value});
116
117 Creates a new ResultSource object.  Not normally called directly by end users.
118
119 =cut
120
121 sub new {
122   my ($class, $attrs) = @_;
123   $class = ref $class if ref $class;
124
125   my $new = bless { %{$attrs || {}} }, $class;
126   $new->{resultset_class} ||= 'DBIx::Class::ResultSet';
127   $new->{resultset_attributes} = { %{$new->{resultset_attributes} || {}} };
128   $new->{_ordered_columns} = [ @{$new->{_ordered_columns}||[]}];
129   $new->{_columns} = { %{$new->{_columns}||{}} };
130   $new->{_relationships} = { %{$new->{_relationships}||{}} };
131   $new->{name} ||= "!!NAME NOT SET!!";
132   $new->{_columns_info_loaded} ||= 0;
133   return $new;
134 }
135
136 =pod
137
138 =head2 add_columns
139
140 =over
141
142 =item Arguments: @columns
143
144 =item Return Value: L<$result_source|/new>
145
146 =back
147
148   $source->add_columns(qw/col1 col2 col3/);
149
150   $source->add_columns('col1' => \%col1_info, 'col2' => \%col2_info, ...);
151
152   $source->add_columns(
153     'col1' => { data_type => 'integer', is_nullable => 1, ... },
154     'col2' => { data_type => 'text',    is_auto_increment => 1, ... },
155   );
156
157 Adds columns to the result source. If supplied colname => hashref
158 pairs, uses the hashref as the L</column_info> for that column. Repeated
159 calls of this method will add more columns, not replace them.
160
161 The column names given will be created as accessor methods on your
162 L<Result|DBIx::Class::Manual::ResultClass> objects. You can change the name of the accessor
163 by supplying an L</accessor> in the column_info hash.
164
165 If a column name beginning with a plus sign ('+col1') is provided, the
166 attributes provided will be merged with any existing attributes for the
167 column, with the new attributes taking precedence in the case that an
168 attribute already exists. Using this without a hashref
169 (C<< $source->add_columns(qw/+col1 +col2/) >>) is legal, but useless --
170 it does the same thing it would do without the plus.
171
172 The contents of the column_info are not set in stone. The following
173 keys are currently recognised/used by DBIx::Class:
174
175 =over 4
176
177 =item accessor
178
179    { accessor => '_name' }
180
181    # example use, replace standard accessor with one of your own:
182    sub name {
183        my ($self, $value) = @_;
184
185        die "Name cannot contain digits!" if($value =~ /\d/);
186        $self->_name($value);
187
188        return $self->_name();
189    }
190
191 Use this to set the name of the accessor method for this column. If unset,
192 the name of the column will be used.
193
194 =item data_type
195
196    { data_type => 'integer' }
197
198 This contains the column type. It is automatically filled if you use the
199 L<SQL::Translator::Producer::DBIx::Class::File> producer, or the
200 L<DBIx::Class::Schema::Loader> module.
201
202 Currently there is no standard set of values for the data_type. Use
203 whatever your database supports.
204
205 =item size
206
207    { size => 20 }
208
209 The length of your column, if it is a column type that can have a size
210 restriction. This is currently only used to create tables from your
211 schema, see L<DBIx::Class::Schema/deploy>.
212
213    { size => [ 9, 6 ] }
214
215 For decimal or float values you can specify an ArrayRef in order to
216 control precision, assuming your database's
217 L<SQL::Translator::Producer> supports it.
218
219 =item is_nullable
220
221    { is_nullable => 1 }
222
223 Set this to a true value for a column that is allowed to contain NULL
224 values, default is false. This is currently only used to create tables
225 from your schema, see L<DBIx::Class::Schema/deploy>.
226
227 =item is_auto_increment
228
229    { is_auto_increment => 1 }
230
231 Set this to a true value for a column whose value is somehow
232 automatically set, defaults to false. This is used to determine which
233 columns to empty when cloning objects using
234 L<DBIx::Class::Row/copy>. It is also used by
235 L<DBIx::Class::Schema/deploy>.
236
237 =item is_numeric
238
239    { is_numeric => 1 }
240
241 Set this to a true or false value (not C<undef>) to explicitly specify
242 if this column contains numeric data. This controls how set_column
243 decides whether to consider a column dirty after an update: if
244 C<is_numeric> is true a numeric comparison C<< != >> will take place
245 instead of the usual C<eq>
246
247 If not specified the storage class will attempt to figure this out on
248 first access to the column, based on the column C<data_type>. The
249 result will be cached in this attribute.
250
251 =item is_foreign_key
252
253    { is_foreign_key => 1 }
254
255 Set this to a true value for a column that contains a key from a
256 foreign table, defaults to false. This is currently only used to
257 create tables from your schema, see L<DBIx::Class::Schema/deploy>.
258
259 =item default_value
260
261    { default_value => \'now()' }
262
263 Set this to the default value which will be inserted into a column by
264 the database. Can contain either a value or a function (use a
265 reference to a scalar e.g. C<\'now()'> if you want a function). This
266 is currently only used to create tables from your schema, see
267 L<DBIx::Class::Schema/deploy>.
268
269 See the note on L<DBIx::Class::Row/new> for more information about possible
270 issues related to db-side default values.
271
272 =item sequence
273
274    { sequence => 'my_table_seq' }
275
276 Set this on a primary key column to the name of the sequence used to
277 generate a new key value. If not specified, L<DBIx::Class::PK::Auto>
278 will attempt to retrieve the name of the sequence from the database
279 automatically.
280
281 =item retrieve_on_insert
282
283   { retrieve_on_insert => 1 }
284
285 For every column where this is set to true, DBIC will retrieve the RDBMS-side
286 value upon a new row insertion (normally only the autoincrement PK is
287 retrieved on insert). C<INSERT ... RETURNING> is used automatically if
288 supported by the underlying storage, otherwise an extra SELECT statement is
289 executed to retrieve the missing data.
290
291 =item auto_nextval
292
293    { auto_nextval => 1 }
294
295 Set this to a true value for a column whose value is retrieved automatically
296 from a sequence or function (if supported by your Storage driver.) For a
297 sequence, if you do not use a trigger to get the nextval, you have to set the
298 L</sequence> value as well.
299
300 Also set this for MSSQL columns with the 'uniqueidentifier'
301 L<data_type|DBIx::Class::ResultSource/data_type> whose values you want to
302 automatically generate using C<NEWID()>, unless they are a primary key in which
303 case this will be done anyway.
304
305 =item extra
306
307 This is used by L<DBIx::Class::Schema/deploy> and L<SQL::Translator>
308 to add extra non-generic data to the column. For example: C<< extra
309 => { unsigned => 1} >> is used by the MySQL producer to set an integer
310 column to unsigned. For more details, see
311 L<SQL::Translator::Producer::MySQL>.
312
313 =back
314
315 =head2 add_column
316
317 =over
318
319 =item Arguments: $colname, \%columninfo?
320
321 =item Return Value: 1/0 (true/false)
322
323 =back
324
325   $source->add_column('col' => \%info);
326
327 Add a single column and optional column info. Uses the same column
328 info keys as L</add_columns>.
329
330 =cut
331
332 sub add_columns {
333   my ($self, @cols) = @_;
334   $self->_ordered_columns(\@cols) unless $self->_ordered_columns;
335
336   my @added;
337   my $columns = $self->_columns;
338   while (my $col = shift @cols) {
339     my $column_info = {};
340     if ($col =~ s/^\+//) {
341       $column_info = $self->column_info($col);
342     }
343
344     # If next entry is { ... } use that for the column info, if not
345     # use an empty hashref
346     if (ref $cols[0]) {
347       my $new_info = shift(@cols);
348       %$column_info = (%$column_info, %$new_info);
349     }
350     push(@added, $col) unless exists $columns->{$col};
351     $columns->{$col} = $column_info;
352   }
353   push @{ $self->_ordered_columns }, @added;
354   return $self;
355 }
356
357 sub add_column { shift->add_columns(@_); } # DO NOT CHANGE THIS TO GLOB
358
359 =head2 has_column
360
361 =over
362
363 =item Arguments: $colname
364
365 =item Return Value: 1/0 (true/false)
366
367 =back
368
369   if ($source->has_column($colname)) { ... }
370
371 Returns true if the source has a column of this name, false otherwise.
372
373 =cut
374
375 sub has_column {
376   my ($self, $column) = @_;
377   return exists $self->_columns->{$column};
378 }
379
380 =head2 column_info
381
382 =over
383
384 =item Arguments: $colname
385
386 =item Return Value: Hashref of info
387
388 =back
389
390   my $info = $source->column_info($col);
391
392 Returns the column metadata hashref for a column, as originally passed
393 to L</add_columns>. See L</add_columns> above for information on the
394 contents of the hashref.
395
396 =cut
397
398 sub column_info {
399   my ($self, $column) = @_;
400   $self->throw_exception("No such column $column")
401     unless exists $self->_columns->{$column};
402
403   if ( ! $self->_columns->{$column}{data_type}
404        and ! $self->{_columns_info_loaded}
405        and $self->column_info_from_storage
406        and my $stor = try { $self->storage } )
407   {
408     $self->{_columns_info_loaded}++;
409
410     # try for the case of storage without table
411     try {
412       my $info = $stor->columns_info_for( $self->from );
413       my $lc_info = { map
414         { (lc $_) => $info->{$_} }
415         ( keys %$info )
416       };
417
418       foreach my $col ( keys %{$self->_columns} ) {
419         $self->_columns->{$col} = {
420           %{ $self->_columns->{$col} },
421           %{ $info->{$col} || $lc_info->{lc $col} || {} }
422         };
423       }
424     };
425   }
426
427   return $self->_columns->{$column};
428 }
429
430 =head2 columns
431
432 =over
433
434 =item Arguments: none
435
436 =item Return Value: Ordered list of column names
437
438 =back
439
440   my @column_names = $source->columns;
441
442 Returns all column names in the order they were declared to L</add_columns>.
443
444 =cut
445
446 sub columns {
447   my $self = shift;
448   $self->throw_exception(
449     "columns() is a read-only accessor, did you mean add_columns()?"
450   ) if @_;
451   return @{$self->{_ordered_columns}||[]};
452 }
453
454 =head2 columns_info
455
456 =over
457
458 =item Arguments: \@colnames ?
459
460 =item Return Value: Hashref of column name/info pairs
461
462 =back
463
464   my $columns_info = $source->columns_info;
465
466 Like L</column_info> but returns information for the requested columns. If
467 the optional column-list arrayref is omitted it returns info on all columns
468 currently defined on the ResultSource via L</add_columns>.
469
470 =cut
471
472 sub columns_info {
473   my ($self, $columns) = @_;
474
475   my $colinfo = $self->_columns;
476
477   if (
478     ! $self->{_columns_info_loaded}
479       and
480     $self->column_info_from_storage
481       and
482     grep { ! $_->{data_type} } values %$colinfo
483       and
484     my $stor = try { $self->storage }
485   ) {
486     $self->{_columns_info_loaded}++;
487
488     # try for the case of storage without table
489     try {
490       my $info = $stor->columns_info_for( $self->from );
491       my $lc_info = { map
492         { (lc $_) => $info->{$_} }
493         ( keys %$info )
494       };
495
496       foreach my $col ( keys %$colinfo ) {
497         $colinfo->{$col} = {
498           %{ $colinfo->{$col} },
499           %{ $info->{$col} || $lc_info->{lc $col} || {} }
500         };
501       }
502     };
503   }
504
505   my %ret;
506
507   if ($columns) {
508     for (@$columns) {
509       if (my $inf = $colinfo->{$_}) {
510         $ret{$_} = $inf;
511       }
512       else {
513         $self->throw_exception( sprintf (
514           "No such column '%s' on source '%s'",
515           $_,
516           $self->source_name || $self->name || 'Unknown source...?',
517         ));
518       }
519     }
520   }
521   else {
522     %ret = %$colinfo;
523   }
524
525   return \%ret;
526 }
527
528 =head2 remove_columns
529
530 =over
531
532 =item Arguments: @colnames
533
534 =item Return Value: not defined
535
536 =back
537
538   $source->remove_columns(qw/col1 col2 col3/);
539
540 Removes the given list of columns by name, from the result source.
541
542 B<Warning>: Removing a column that is also used in the sources primary
543 key, or in one of the sources unique constraints, B<will> result in a
544 broken result source.
545
546 =head2 remove_column
547
548 =over
549
550 =item Arguments: $colname
551
552 =item Return Value: not defined
553
554 =back
555
556   $source->remove_column('col');
557
558 Remove a single column by name from the result source, similar to
559 L</remove_columns>.
560
561 B<Warning>: Removing a column that is also used in the sources primary
562 key, or in one of the sources unique constraints, B<will> result in a
563 broken result source.
564
565 =cut
566
567 sub remove_columns {
568   my ($self, @to_remove) = @_;
569
570   my $columns = $self->_columns
571     or return;
572
573   my %to_remove;
574   for (@to_remove) {
575     delete $columns->{$_};
576     ++$to_remove{$_};
577   }
578
579   $self->_ordered_columns([ grep { not $to_remove{$_} } @{$self->_ordered_columns} ]);
580 }
581
582 sub remove_column { shift->remove_columns(@_); } # DO NOT CHANGE THIS TO GLOB
583
584 =head2 set_primary_key
585
586 =over 4
587
588 =item Arguments: @cols
589
590 =item Return Value: not defined
591
592 =back
593
594 Defines one or more columns as primary key for this source. Must be
595 called after L</add_columns>.
596
597 Additionally, defines a L<unique constraint|/add_unique_constraint>
598 named C<primary>.
599
600 Note: you normally do want to define a primary key on your sources
601 B<even if the underlying database table does not have a primary key>.
602 See
603 L<DBIx::Class::Manual::Intro/The Significance and Importance of Primary Keys>
604 for more info.
605
606 =cut
607
608 sub set_primary_key {
609   my ($self, @cols) = @_;
610
611   my $colinfo = $self->columns_info(\@cols);
612   for my $col (@cols) {
613     carp_unique(sprintf (
614       "Primary key of source '%s' includes the column '%s' which has its "
615     . "'is_nullable' attribute set to true. This is a mistake and will cause "
616     . 'various Result-object operations to fail',
617       $self->source_name || $self->name || 'Unknown source...?',
618       $col,
619     )) if $colinfo->{$col}{is_nullable};
620   }
621
622   $self->_primaries(\@cols);
623
624   $self->add_unique_constraint(primary => \@cols);
625 }
626
627 =head2 primary_columns
628
629 =over 4
630
631 =item Arguments: none
632
633 =item Return Value: Ordered list of primary column names
634
635 =back
636
637 Read-only accessor which returns the list of primary keys, supplied by
638 L</set_primary_key>.
639
640 =cut
641
642 sub primary_columns {
643   return @{shift->_primaries||[]};
644 }
645
646 # a helper method that will automatically die with a descriptive message if
647 # no pk is defined on the source in question. For internal use to save
648 # on if @pks... boilerplate
649 sub _pri_cols_or_die {
650   my $self = shift;
651   my @pcols = $self->primary_columns
652     or $self->throw_exception (sprintf(
653       "Operation requires a primary key to be declared on '%s' via set_primary_key",
654       # source_name is set only after schema-registration
655       $self->source_name || $self->result_class || $self->name || 'Unknown source...?',
656     ));
657   return @pcols;
658 }
659
660 # same as above but mandating single-column PK (used by relationship condition
661 # inference)
662 sub _single_pri_col_or_die {
663   my $self = shift;
664   my ($pri, @too_many) = $self->_pri_cols_or_die;
665
666   $self->throw_exception( sprintf(
667     "Operation requires a single-column primary key declared on '%s'",
668     $self->source_name || $self->result_class || $self->name || 'Unknown source...?',
669   )) if @too_many;
670   return $pri;
671 }
672
673
674 =head2 sequence
675
676 Manually define the correct sequence for your table, to avoid the overhead
677 associated with looking up the sequence automatically. The supplied sequence
678 will be applied to the L</column_info> of each L<primary_key|/set_primary_key>
679
680 =over 4
681
682 =item Arguments: $sequence_name
683
684 =item Return Value: not defined
685
686 =back
687
688 =cut
689
690 sub sequence {
691   my ($self,$seq) = @_;
692
693   my @pks = $self->primary_columns
694     or return;
695
696   $_->{sequence} = $seq
697     for values %{ $self->columns_info (\@pks) };
698 }
699
700
701 =head2 add_unique_constraint
702
703 =over 4
704
705 =item Arguments: $name?, \@colnames
706
707 =item Return Value: not defined
708
709 =back
710
711 Declare a unique constraint on this source. Call once for each unique
712 constraint.
713
714   # For UNIQUE (column1, column2)
715   __PACKAGE__->add_unique_constraint(
716     constraint_name => [ qw/column1 column2/ ],
717   );
718
719 Alternatively, you can specify only the columns:
720
721   __PACKAGE__->add_unique_constraint([ qw/column1 column2/ ]);
722
723 This will result in a unique constraint named
724 C<table_column1_column2>, where C<table> is replaced with the table
725 name.
726
727 Unique constraints are used, for example, when you pass the constraint
728 name as the C<key> attribute to L<DBIx::Class::ResultSet/find>. Then
729 only columns in the constraint are searched.
730
731 Throws an error if any of the given column names do not yet exist on
732 the result source.
733
734 =cut
735
736 sub add_unique_constraint {
737   my $self = shift;
738
739   if (@_ > 2) {
740     $self->throw_exception(
741         'add_unique_constraint() does not accept multiple constraints, use '
742       . 'add_unique_constraints() instead'
743     );
744   }
745
746   my $cols = pop @_;
747   if (ref $cols ne 'ARRAY') {
748     $self->throw_exception (
749       'Expecting an arrayref of constraint columns, got ' . ($cols||'NOTHING')
750     );
751   }
752
753   my $name = shift @_;
754
755   $name ||= $self->name_unique_constraint($cols);
756
757   foreach my $col (@$cols) {
758     $self->throw_exception("No such column $col on table " . $self->name)
759       unless $self->has_column($col);
760   }
761
762   my %unique_constraints = $self->unique_constraints;
763   $unique_constraints{$name} = $cols;
764   $self->_unique_constraints(\%unique_constraints);
765 }
766
767 =head2 add_unique_constraints
768
769 =over 4
770
771 =item Arguments: @constraints
772
773 =item Return Value: not defined
774
775 =back
776
777 Declare multiple unique constraints on this source.
778
779   __PACKAGE__->add_unique_constraints(
780     constraint_name1 => [ qw/column1 column2/ ],
781     constraint_name2 => [ qw/column2 column3/ ],
782   );
783
784 Alternatively, you can specify only the columns:
785
786   __PACKAGE__->add_unique_constraints(
787     [ qw/column1 column2/ ],
788     [ qw/column3 column4/ ]
789   );
790
791 This will result in unique constraints named C<table_column1_column2> and
792 C<table_column3_column4>, where C<table> is replaced with the table name.
793
794 Throws an error if any of the given column names do not yet exist on
795 the result source.
796
797 See also L</add_unique_constraint>.
798
799 =cut
800
801 sub add_unique_constraints {
802   my $self = shift;
803   my @constraints = @_;
804
805   if ( !(@constraints % 2) && grep { ref $_ ne 'ARRAY' } @constraints ) {
806     # with constraint name
807     while (my ($name, $constraint) = splice @constraints, 0, 2) {
808       $self->add_unique_constraint($name => $constraint);
809     }
810   }
811   else {
812     # no constraint name
813     foreach my $constraint (@constraints) {
814       $self->add_unique_constraint($constraint);
815     }
816   }
817 }
818
819 =head2 name_unique_constraint
820
821 =over 4
822
823 =item Arguments: \@colnames
824
825 =item Return Value: Constraint name
826
827 =back
828
829   $source->table('mytable');
830   $source->name_unique_constraint(['col1', 'col2']);
831   # returns
832   'mytable_col1_col2'
833
834 Return a name for a unique constraint containing the specified
835 columns. The name is created by joining the table name and each column
836 name, using an underscore character.
837
838 For example, a constraint on a table named C<cd> containing the columns
839 C<artist> and C<title> would result in a constraint name of C<cd_artist_title>.
840
841 This is used by L</add_unique_constraint> if you do not specify the
842 optional constraint name.
843
844 =cut
845
846 sub name_unique_constraint {
847   my ($self, $cols) = @_;
848
849   my $name = $self->name;
850   $name = $$name if (ref $name eq 'SCALAR');
851   $name =~ s/ ^ [^\.]+ \. //x;  # strip possible schema qualifier
852
853   return join '_', $name, @$cols;
854 }
855
856 =head2 unique_constraints
857
858 =over 4
859
860 =item Arguments: none
861
862 =item Return Value: Hash of unique constraint data
863
864 =back
865
866   $source->unique_constraints();
867
868 Read-only accessor which returns a hash of unique constraints on this
869 source.
870
871 The hash is keyed by constraint name, and contains an arrayref of
872 column names as values.
873
874 =cut
875
876 sub unique_constraints {
877   return %{shift->_unique_constraints||{}};
878 }
879
880 =head2 unique_constraint_names
881
882 =over 4
883
884 =item Arguments: none
885
886 =item Return Value: Unique constraint names
887
888 =back
889
890   $source->unique_constraint_names();
891
892 Returns the list of unique constraint names defined on this source.
893
894 =cut
895
896 sub unique_constraint_names {
897   my ($self) = @_;
898
899   my %unique_constraints = $self->unique_constraints;
900
901   return keys %unique_constraints;
902 }
903
904 =head2 unique_constraint_columns
905
906 =over 4
907
908 =item Arguments: $constraintname
909
910 =item Return Value: List of constraint columns
911
912 =back
913
914   $source->unique_constraint_columns('myconstraint');
915
916 Returns the list of columns that make up the specified unique constraint.
917
918 =cut
919
920 sub unique_constraint_columns {
921   my ($self, $constraint_name) = @_;
922
923   my %unique_constraints = $self->unique_constraints;
924
925   $self->throw_exception(
926     "Unknown unique constraint $constraint_name on '" . $self->name . "'"
927   ) unless exists $unique_constraints{$constraint_name};
928
929   return @{ $unique_constraints{$constraint_name} };
930 }
931
932 =head2 sqlt_deploy_callback
933
934 =over
935
936 =item Arguments: $callback_name | \&callback_code
937
938 =item Return Value: $callback_name | \&callback_code
939
940 =back
941
942   __PACKAGE__->sqlt_deploy_callback('mycallbackmethod');
943
944    or
945
946   __PACKAGE__->sqlt_deploy_callback(sub {
947     my ($source_instance, $sqlt_table) = @_;
948     ...
949   } );
950
951 An accessor to set a callback to be called during deployment of
952 the schema via L<DBIx::Class::Schema/create_ddl_dir> or
953 L<DBIx::Class::Schema/deploy>.
954
955 The callback can be set as either a code reference or the name of a
956 method in the current result class.
957
958 Defaults to L</default_sqlt_deploy_hook>.
959
960 Your callback will be passed the $source object representing the
961 ResultSource instance being deployed, and the
962 L<SQL::Translator::Schema::Table> object being created from it. The
963 callback can be used to manipulate the table object or add your own
964 customised indexes. If you need to manipulate a non-table object, use
965 the L<DBIx::Class::Schema/sqlt_deploy_hook>.
966
967 See L<DBIx::Class::Manual::Cookbook/Adding Indexes And Functions To
968 Your SQL> for examples.
969
970 This sqlt deployment callback can only be used to manipulate
971 SQL::Translator objects as they get turned into SQL. To execute
972 post-deploy statements which SQL::Translator does not currently
973 handle, override L<DBIx::Class::Schema/deploy> in your Schema class
974 and call L<dbh_do|DBIx::Class::Storage::DBI/dbh_do>.
975
976 =head2 default_sqlt_deploy_hook
977
978 This is the default deploy hook implementation which checks if your
979 current Result class has a C<sqlt_deploy_hook> method, and if present
980 invokes it B<on the Result class directly>. This is to preserve the
981 semantics of C<sqlt_deploy_hook> which was originally designed to expect
982 the Result class name and the
983 L<$sqlt_table instance|SQL::Translator::Schema::Table> of the table being
984 deployed.
985
986 =cut
987
988 sub default_sqlt_deploy_hook {
989   my $self = shift;
990
991   my $class = $self->result_class;
992
993   if ($class and $class->can('sqlt_deploy_hook')) {
994     $class->sqlt_deploy_hook(@_);
995   }
996 }
997
998 sub _invoke_sqlt_deploy_hook {
999   my $self = shift;
1000   if ( my $hook = $self->sqlt_deploy_callback) {
1001     $self->$hook(@_);
1002   }
1003 }
1004
1005 =head2 result_class
1006
1007 =over 4
1008
1009 =item Arguments: $classname
1010
1011 =item Return Value: $classname
1012
1013 =back
1014
1015  use My::Schema::ResultClass::Inflator;
1016  ...
1017
1018  use My::Schema::Artist;
1019  ...
1020  __PACKAGE__->result_class('My::Schema::ResultClass::Inflator');
1021
1022 Set the default result class for this source. You can use this to create
1023 and use your own result inflator. See L<DBIx::Class::ResultSet/result_class>
1024 for more details.
1025
1026 Please note that setting this to something like
1027 L<DBIx::Class::ResultClass::HashRefInflator> will make every result unblessed
1028 and make life more difficult.  Inflators like those are better suited to
1029 temporary usage via L<DBIx::Class::ResultSet/result_class>.
1030
1031 =head2 resultset
1032
1033 =over 4
1034
1035 =item Arguments: none
1036
1037 =item Return Value: L<$resultset|DBIx::Class::ResultSet>
1038
1039 =back
1040
1041 Returns a resultset for the given source. This will initially be created
1042 on demand by calling
1043
1044   $self->resultset_class->new($self, $self->resultset_attributes)
1045
1046 but is cached from then on unless resultset_class changes.
1047
1048 =head2 resultset_class
1049
1050 =over 4
1051
1052 =item Arguments: $classname
1053
1054 =item Return Value: $classname
1055
1056 =back
1057
1058   package My::Schema::ResultSet::Artist;
1059   use base 'DBIx::Class::ResultSet';
1060   ...
1061
1062   # In the result class
1063   __PACKAGE__->resultset_class('My::Schema::ResultSet::Artist');
1064
1065   # Or in code
1066   $source->resultset_class('My::Schema::ResultSet::Artist');
1067
1068 Set the class of the resultset. This is useful if you want to create your
1069 own resultset methods. Create your own class derived from
1070 L<DBIx::Class::ResultSet>, and set it here. If called with no arguments,
1071 this method returns the name of the existing resultset class, if one
1072 exists.
1073
1074 =head2 resultset_attributes
1075
1076 =over 4
1077
1078 =item Arguments: L<\%attrs|DBIx::Class::ResultSet/ATTRIBUTES>
1079
1080 =item Return Value: L<\%attrs|DBIx::Class::ResultSet/ATTRIBUTES>
1081
1082 =back
1083
1084   # In the result class
1085   __PACKAGE__->resultset_attributes({ order_by => [ 'id' ] });
1086
1087   # Or in code
1088   $source->resultset_attributes({ order_by => [ 'id' ] });
1089
1090 Store a collection of resultset attributes, that will be set on every
1091 L<DBIx::Class::ResultSet> produced from this result source.
1092
1093 B<CAVEAT>: C<resultset_attributes> comes with its own set of issues and
1094 bugs! While C<resultset_attributes> isn't deprecated per se, its usage is
1095 not recommended!
1096
1097 Since relationships use attributes to link tables together, the "default"
1098 attributes you set may cause unpredictable and undesired behavior.  Furthermore,
1099 the defaults cannot be turned off, so you are stuck with them.
1100
1101 In most cases, what you should actually be using are project-specific methods:
1102
1103   package My::Schema::ResultSet::Artist;
1104   use base 'DBIx::Class::ResultSet';
1105   ...
1106
1107   # BAD IDEA!
1108   #__PACKAGE__->resultset_attributes({ prefetch => 'tracks' });
1109
1110   # GOOD IDEA!
1111   sub with_tracks { shift->search({}, { prefetch => 'tracks' }) }
1112
1113   # in your code
1114   $schema->resultset('Artist')->with_tracks->...
1115
1116 This gives you the flexibility of not using it when you don't need it.
1117
1118 For more complex situations, another solution would be to use a virtual view
1119 via L<DBIx::Class::ResultSource::View>.
1120
1121 =cut
1122
1123 sub resultset {
1124   my $self = shift;
1125   $self->throw_exception(
1126     'resultset does not take any arguments. If you want another resultset, '.
1127     'call it on the schema instead.'
1128   ) if scalar @_;
1129
1130   $self->resultset_class->new(
1131     $self,
1132     {
1133       try { %{$self->schema->default_resultset_attributes} },
1134       %{$self->{resultset_attributes}},
1135     },
1136   );
1137 }
1138
1139 =head2 name
1140
1141 =over 4
1142
1143 =item Arguments: none
1144
1145 =item Result value: $name
1146
1147 =back
1148
1149 Returns the name of the result source, which will typically be the table
1150 name. This may be a scalar reference if the result source has a non-standard
1151 name.
1152
1153 =head2 source_name
1154
1155 =over 4
1156
1157 =item Arguments: $source_name
1158
1159 =item Result value: $source_name
1160
1161 =back
1162
1163 Set an alternate name for the result source when it is loaded into a schema.
1164 This is useful if you want to refer to a result source by a name other than
1165 its class name.
1166
1167   package ArchivedBooks;
1168   use base qw/DBIx::Class/;
1169   __PACKAGE__->table('books_archive');
1170   __PACKAGE__->source_name('Books');
1171
1172   # from your schema...
1173   $schema->resultset('Books')->find(1);
1174
1175 =head2 from
1176
1177 =over 4
1178
1179 =item Arguments: none
1180
1181 =item Return Value: FROM clause
1182
1183 =back
1184
1185   my $from_clause = $source->from();
1186
1187 Returns an expression of the source to be supplied to storage to specify
1188 retrieval from this source. In the case of a database, the required FROM
1189 clause contents.
1190
1191 =cut
1192
1193 sub from { die 'Virtual method!' }
1194
1195 =head2 source_info
1196
1197 Stores a hashref of per-source metadata.  No specific key names
1198 have yet been standardized, the examples below are purely hypothetical
1199 and don't actually accomplish anything on their own:
1200
1201   __PACKAGE__->source_info({
1202     "_tablespace" => 'fast_disk_array_3',
1203     "_engine" => 'InnoDB',
1204   });
1205
1206 =head2 schema
1207
1208 =over 4
1209
1210 =item Arguments: L<$schema?|DBIx::Class::Schema>
1211
1212 =item Return Value: L<$schema|DBIx::Class::Schema>
1213
1214 =back
1215
1216   my $schema = $source->schema();
1217
1218 Sets and/or returns the L<DBIx::Class::Schema> object to which this
1219 result source instance has been attached to.
1220
1221 =cut
1222
1223 sub schema {
1224   if (@_ > 1) {
1225     $_[0]->{schema} = $_[1];
1226   }
1227   else {
1228     $_[0]->{schema} || do {
1229       my $name = $_[0]->{source_name} || '_unnamed_';
1230       my $err = 'Unable to perform storage-dependent operations with a detached result source '
1231               . "(source '$name' is not associated with a schema).";
1232
1233       $err .= ' You need to use $schema->thaw() or manually set'
1234             . ' $DBIx::Class::ResultSourceHandle::thaw_schema while thawing.'
1235         if $_[0]->{_detached_thaw};
1236
1237       DBIx::Class::Exception->throw($err);
1238     };
1239   }
1240 }
1241
1242 =head2 storage
1243
1244 =over 4
1245
1246 =item Arguments: none
1247
1248 =item Return Value: L<$storage|DBIx::Class::Storage>
1249
1250 =back
1251
1252   $source->storage->debug(1);
1253
1254 Returns the L<storage handle|DBIx::Class::Storage> for the current schema.
1255
1256 =cut
1257
1258 sub storage { shift->schema->storage; }
1259
1260 =head2 add_relationship
1261
1262 =over 4
1263
1264 =item Arguments: $rel_name, $related_source_name, \%cond, \%attrs?
1265
1266 =item Return Value: 1/true if it succeeded
1267
1268 =back
1269
1270   $source->add_relationship('rel_name', 'related_source', $cond, $attrs);
1271
1272 L<DBIx::Class::Relationship> describes a series of methods which
1273 create pre-defined useful types of relationships. Look there first
1274 before using this method directly.
1275
1276 The relationship name can be arbitrary, but must be unique for each
1277 relationship attached to this result source. 'related_source' should
1278 be the name with which the related result source was registered with
1279 the current schema. For example:
1280
1281   $schema->source('Book')->add_relationship('reviews', 'Review', {
1282     'foreign.book_id' => 'self.id',
1283   });
1284
1285 The condition C<$cond> needs to be an L<SQL::Abstract>-style
1286 representation of the join between the tables. For example, if you're
1287 creating a relation from Author to Book,
1288
1289   { 'foreign.author_id' => 'self.id' }
1290
1291 will result in the JOIN clause
1292
1293   author me JOIN book foreign ON foreign.author_id = me.id
1294
1295 You can specify as many foreign => self mappings as necessary.
1296
1297 Valid attributes are as follows:
1298
1299 =over 4
1300
1301 =item join_type
1302
1303 Explicitly specifies the type of join to use in the relationship. Any
1304 SQL join type is valid, e.g. C<LEFT> or C<RIGHT>. It will be placed in
1305 the SQL command immediately before C<JOIN>.
1306
1307 =item proxy
1308
1309 An arrayref containing a list of accessors in the foreign class to proxy in
1310 the main class. If, for example, you do the following:
1311
1312   CD->might_have(liner_notes => 'LinerNotes', undef, {
1313     proxy => [ qw/notes/ ],
1314   });
1315
1316 Then, assuming LinerNotes has an accessor named notes, you can do:
1317
1318   my $cd = CD->find(1);
1319   # set notes -- LinerNotes object is created if it doesn't exist
1320   $cd->notes('Notes go here');
1321
1322 =item accessor
1323
1324 Specifies the type of accessor that should be created for the
1325 relationship. Valid values are C<single> (for when there is only a single
1326 related object), C<multi> (when there can be many), and C<filter> (for
1327 when there is a single related object, but you also want the relationship
1328 accessor to double as a column accessor). For C<multi> accessors, an
1329 add_to_* method is also created, which calls C<create_related> for the
1330 relationship.
1331
1332 =back
1333
1334 Throws an exception if the condition is improperly supplied, or cannot
1335 be resolved.
1336
1337 =cut
1338
1339 sub add_relationship {
1340   my ($self, $rel, $f_source_name, $cond, $attrs) = @_;
1341   $self->throw_exception("Can't create relationship without join condition")
1342     unless $cond;
1343   $attrs ||= {};
1344
1345   # Check foreign and self are right in cond
1346   if ( (ref $cond ||'') eq 'HASH') {
1347     $_ =~ /^foreign\./ or $self->throw_exception("Malformed relationship condition key '$_': must be prefixed with 'foreign.'")
1348       for keys %$cond;
1349
1350     $_ =~ /^self\./ or $self->throw_exception("Malformed relationship condition value '$_': must be prefixed with 'self.'")
1351       for values %$cond;
1352   }
1353
1354   my %rels = %{ $self->_relationships };
1355   $rels{$rel} = { class => $f_source_name,
1356                   source => $f_source_name,
1357                   cond  => $cond,
1358                   attrs => $attrs };
1359   $self->_relationships(\%rels);
1360
1361   return $self;
1362 }
1363
1364 =head2 relationships
1365
1366 =over 4
1367
1368 =item Arguments: none
1369
1370 =item Return Value: L<@rel_names|DBIx::Class::Relationship>
1371
1372 =back
1373
1374   my @rel_names = $source->relationships();
1375
1376 Returns all relationship names for this source.
1377
1378 =cut
1379
1380 sub relationships {
1381   return keys %{shift->_relationships};
1382 }
1383
1384 =head2 relationship_info
1385
1386 =over 4
1387
1388 =item Arguments: L<$rel_name|DBIx::Class::Relationship>
1389
1390 =item Return Value: L<\%rel_data|DBIx::Class::Relationship::Base/add_relationship>
1391
1392 =back
1393
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>.
1396
1397 =cut
1398
1399 sub relationship_info {
1400   #my ($self, $rel) = @_;
1401   return shift->_relationships->{+shift};
1402 }
1403
1404 =head2 has_relationship
1405
1406 =over 4
1407
1408 =item Arguments: L<$rel_name|DBIx::Class::Relationship>
1409
1410 =item Return Value: 1/0 (true/false)
1411
1412 =back
1413
1414 Returns true if the source has a relationship of this name, false otherwise.
1415
1416 =cut
1417
1418 sub has_relationship {
1419   #my ($self, $rel) = @_;
1420   return exists shift->_relationships->{+shift};
1421 }
1422
1423 =head2 reverse_relationship_info
1424
1425 =over 4
1426
1427 =item Arguments: L<$rel_name|DBIx::Class::Relationship>
1428
1429 =item Return Value: L<\%rel_data|DBIx::Class::Relationship::Base/add_relationship>
1430
1431 =back
1432
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.
1436
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>.
1440
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>.
1444
1445 =cut
1446
1447 sub reverse_relationship_info {
1448   my ($self, $rel) = @_;
1449
1450   my $rel_info = $self->relationship_info($rel)
1451     or $self->throw_exception("No such relationship '$rel'");
1452
1453   my $ret = {};
1454
1455   return $ret unless ((ref $rel_info->{cond}) eq 'HASH');
1456
1457   my $stripped_cond = $self->__strip_relcond ($rel_info->{cond});
1458
1459   my $registered_source_name = $self->source_name;
1460
1461   # this may be a partial schema or something else equally esoteric
1462   my $other_rsrc = $self->related_source($rel);
1463
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) {
1468
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
1472
1473     # the schema may be partial
1474     my $roundtrip_rsrc = try { $other_rsrc->related_source($other_rel) }
1475       or next;
1476
1477     if ($registered_source_name) {
1478       next if $registered_source_name ne ($roundtrip_rsrc->source_name || '')
1479     }
1480     else {
1481       next if $self->result_class ne $roundtrip_rsrc->result_class;
1482     }
1483
1484     my $other_rel_info = $other_rsrc->relationship_info($other_rel);
1485
1486     # this can happen when we have a self-referential class
1487     next if $other_rel_info eq $rel_info;
1488
1489     next unless ref $other_rel_info->{cond} eq 'HASH';
1490     my $other_stripped_cond = $self->__strip_relcond($other_rel_info->{cond});
1491
1492     $ret->{$other_rel} = $other_rel_info if (
1493       $self->_compare_relationship_keys (
1494         [ keys %$stripped_cond ], [ values %$other_stripped_cond ]
1495       )
1496         and
1497       $self->_compare_relationship_keys (
1498         [ values %$stripped_cond ], [ keys %$other_stripped_cond ]
1499       )
1500     );
1501   }
1502
1503   return $ret;
1504 }
1505
1506 # all this does is removes the foreign/self prefix from a condition
1507 sub __strip_relcond {
1508   +{
1509     map
1510       { map { /^ (?:foreign|self) \. (\w+) $/x } ($_, $_[1]{$_}) }
1511       keys %{$_[1]}
1512   }
1513 }
1514
1515 sub compare_relationship_keys {
1516   carp 'compare_relationship_keys is a private method, stop calling it';
1517   my $self = shift;
1518   $self->_compare_relationship_keys (@_);
1519 }
1520
1521 # Returns true if both sets of keynames are the same, false otherwise.
1522 sub _compare_relationship_keys {
1523 #  my ($self, $keys1, $keys2) = @_;
1524   return
1525     join ("\x00", sort @{$_[1]})
1526       eq
1527     join ("\x00", sort @{$_[2]})
1528   ;
1529 }
1530
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) = @_;
1537
1538   my %unique = $self->unique_constraints;
1539   my $colinfos = ref $cols eq 'HASH' ? $cols : $self->columns_info($cols||());
1540
1541   # always prefer the PK first, and then shortest constraints first
1542   USET:
1543   for my $set (delete $unique{primary}, sort { @$a <=> @$b } (values %unique) ) {
1544     next unless $set && @$set;
1545
1546     for (@$set) {
1547       next USET unless ($colinfos->{$_} && !$colinfos->{$_}{is_nullable} );
1548     }
1549
1550     # copy so we can mangle it at will
1551     return [ @$set ];
1552   }
1553
1554   return undef;
1555 }
1556
1557 sub _minimal_valueset_satisfying_constraint {
1558   my $self = shift;
1559   my $args = { ref $_[0] eq 'HASH' ? %{ $_[0] } : @_ };
1560
1561   $args->{columns_info} ||= $self->columns_info;
1562
1563   my $vals = $self->storage->_extract_fixed_condition_columns(
1564     $args->{values},
1565     ($args->{carp_on_nulls} ? 'consider_nulls' : undef ),
1566   );
1567
1568   my $cols;
1569   for my $col ($self->unique_constraint_columns($args->{constraint_name}) ) {
1570     if( ! exists $vals->{$col} or ( $vals->{$col}||'' ) eq UNRESOLVABLE_CONDITION ) {
1571       $cols->{missing}{$col} = undef;
1572     }
1573     elsif( ! defined $vals->{$col} ) {
1574       $cols->{$args->{carp_on_nulls} ? 'undefined' : 'missing'}{$col} = undef;
1575     }
1576     else {
1577       # we need to inject back the '=' as _extract_fixed_condition_columns
1578       # will strip it from literals and values alike, resulting in an invalid
1579       # condition in the end
1580       $cols->{present}{$col} = { '=' => $vals->{$col} };
1581     }
1582
1583     $cols->{fc}{$col} = 1 if (
1584       ( ! $cols->{missing} or ! exists $cols->{missing}{$col} )
1585         and
1586       keys %{ $args->{columns_info}{$col}{_filter_info} || {} }
1587     );
1588   }
1589
1590   $self->throw_exception( sprintf ( "Unable to satisfy requested constraint '%s', missing values for column(s): %s",
1591     $args->{constraint_name},
1592     join (', ', map { "'$_'" } sort keys %{$cols->{missing}} ),
1593   ) ) if $cols->{missing};
1594
1595   $self->throw_exception( sprintf (
1596     "Unable to satisfy requested constraint '%s', FilterColumn values not usable for column(s): %s",
1597     $args->{constraint_name},
1598     join (', ', map { "'$_'" } sort keys %{$cols->{fc}}),
1599   )) if $cols->{fc};
1600
1601   if (
1602     $cols->{undefined}
1603       and
1604     !$ENV{DBIC_NULLABLE_KEY_NOWARN}
1605   ) {
1606     carp_unique ( sprintf (
1607       "NULL/undef values supplied for requested unique constraint '%s' (NULL "
1608     . 'values in column(s): %s). This is almost certainly not what you wanted, '
1609     . 'though you can set DBIC_NULLABLE_KEY_NOWARN to disable this warning.',
1610       $args->{constraint_name},
1611       join (', ', map { "'$_'" } sort keys %{$cols->{undefined}}),
1612     ));
1613   }
1614
1615   return { map { %{ $cols->{$_}||{} } } qw(present undefined) };
1616 }
1617
1618 # Returns the {from} structure used to express JOIN conditions
1619 sub _resolve_join {
1620   my ($self, $join, $alias, $seen, $jpath, $parent_force_left) = @_;
1621
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';
1625
1626   $self->throw_exception ('You must supply a joinpath arrayref as the 4th argument to _resolve_join')
1627     unless ref $jpath eq 'ARRAY';
1628
1629   $jpath = [@$jpath]; # copy
1630
1631   if (not defined $join or not length $join) {
1632     return ();
1633   }
1634   elsif (ref $join eq 'ARRAY') {
1635     return
1636       map {
1637         $self->_resolve_join($_, $alias, $seen, $jpath, $parent_force_left);
1638       } @$join;
1639   }
1640   elsif (ref $join eq 'HASH') {
1641
1642     my @ret;
1643     for my $rel (keys %$join) {
1644
1645       my $rel_info = $self->relationship_info($rel)
1646         or $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
1647
1648       my $force_left = $parent_force_left;
1649       $force_left ||= lc($rel_info->{attrs}{join_type}||'') eq 'left';
1650
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)
1654       );
1655
1656       push @ret, (
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
1660         )
1661       );
1662     }
1663     return @ret;
1664
1665   }
1666   elsif (ref $join) {
1667     $self->throw_exception("No idea how to resolve join reftype ".ref $join);
1668   }
1669   else {
1670     my $count = ++$seen->{$join};
1671     my $as = $self->storage->relname_to_table_alias(
1672       $join, ($count > 1 && $count)
1673     );
1674
1675     my $rel_info = $self->relationship_info($join)
1676       or $self->throw_exception("No such relationship $join on " . $self->source_name);
1677
1678     my $rel_src = $self->related_source($join);
1679     return [ { $as => $rel_src->from,
1680                -rsrc => $rel_src,
1681                -join_type => $parent_force_left
1682                   ? 'left'
1683                   : $rel_info->{attrs}{join_type}
1684                 ,
1685                -join_path => [@$jpath, { $join => $as } ],
1686                -is_single => (
1687                   ! $rel_info->{attrs}{accessor}
1688                     or
1689                   $rel_info->{attrs}{accessor} eq 'single'
1690                     or
1691                   $rel_info->{attrs}{accessor} eq 'filter'
1692                 ),
1693                -alias => $as,
1694                -relation_chain_depth => ( $seen->{-relation_chain_depth} || 0 ) + 1,
1695              },
1696              $self->_resolve_relationship_condition(
1697                rel_name => $join,
1698                self_alias => $alias,
1699                foreign_alias => $as,
1700              )->{condition},
1701           ];
1702   }
1703 }
1704
1705 sub pk_depends_on {
1706   carp 'pk_depends_on is a private method, stop calling it';
1707   my $self = shift;
1708   $self->_pk_depends_on (@_);
1709 }
1710
1711 # Determines whether a relation is dependent on an object from this source
1712 # having already been inserted. Takes the name of the relationship and a
1713 # hashref of columns of the related object.
1714 sub _pk_depends_on {
1715   my ($self, $rel_name, $rel_data) = @_;
1716
1717   my $relinfo = $self->relationship_info($rel_name);
1718
1719   # don't assume things if the relationship direction is specified
1720   return $relinfo->{attrs}{is_foreign_key_constraint}
1721     if exists ($relinfo->{attrs}{is_foreign_key_constraint});
1722
1723   my $cond = $relinfo->{cond};
1724   return 0 unless ref($cond) eq 'HASH';
1725
1726   # map { foreign.foo => 'self.bar' } to { bar => 'foo' }
1727   my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond };
1728
1729   # assume anything that references our PK probably is dependent on us
1730   # rather than vice versa, unless the far side is (a) defined or (b)
1731   # auto-increment
1732   my $rel_source = $self->related_source($rel_name);
1733
1734   foreach my $p ($self->primary_columns) {
1735     if (exists $keyhash->{$p}) {
1736       unless (defined($rel_data->{$keyhash->{$p}})
1737               || $rel_source->column_info($keyhash->{$p})
1738                             ->{is_auto_increment}) {
1739         return 0;
1740       }
1741     }
1742   }
1743
1744   return 1;
1745 }
1746
1747 sub resolve_condition {
1748   carp 'resolve_condition is a private method, stop calling it';
1749   shift->_resolve_condition (@_);
1750 }
1751
1752 sub _resolve_condition {
1753 #  carp_unique sprintf
1754 #    '_resolve_condition is a private method, and moreover is about to go '
1755 #  . 'away. Please contact the development team at %s if you believe you '
1756 #  . 'have a genuine use for this method, in order to discuss alternatives.',
1757 #    DBIx::Class::_ENV_::HELP_URL,
1758 #  ;
1759
1760 #######################
1761 ### API Design? What's that...? (a backwards compatible shim, kill me now)
1762
1763   my ($self, $cond, @res_args, $rel_name);
1764
1765   # we *SIMPLY DON'T KNOW YET* which arg is which, yay
1766   ($self, $cond, $res_args[0], $res_args[1], $rel_name) = @_;
1767
1768   # assume that an undef is an object-like unset (set_from_related(undef))
1769   my @is_objlike = map { ! defined $_ or length ref $_ } (@res_args);
1770
1771   # turn objlike into proper objects for saner code further down
1772   for (0,1) {
1773     next unless $is_objlike[$_];
1774
1775     if ( defined blessed $res_args[$_] ) {
1776
1777       # but wait - there is more!!! WHAT THE FUCK?!?!?!?!
1778       if ($res_args[$_]->isa('DBIx::Class::ResultSet')) {
1779         carp('Passing a resultset for relationship resolution makes no sense - invoking __gremlins__');
1780         $is_objlike[$_] = 0;
1781         $res_args[$_] = '__gremlins__';
1782       }
1783     }
1784     else {
1785       $res_args[$_] ||= {};
1786
1787       # hate everywhere - have to pass in as a plain hash
1788       # pretending to be an object at least for now
1789       $self->throw_exception("Unsupported object-like structure encountered: $res_args[$_]")
1790         unless ref $res_args[$_] eq 'HASH';
1791     }
1792   }
1793
1794   my $args = {
1795     # where-is-waldo block guesses relname, then further down we override it if available
1796     (
1797       $is_objlike[1] ? ( rel_name => $res_args[0], self_alias => $res_args[0], foreign_alias => 'me',         self_result_object  => $res_args[1] )
1798     : $is_objlike[0] ? ( rel_name => $res_args[1], self_alias => 'me',         foreign_alias => $res_args[1], foreign_values      => $res_args[0] )
1799     :                  ( rel_name => $res_args[0], self_alias => $res_args[1], foreign_alias => $res_args[0]                                      )
1800     ),
1801
1802     ( $rel_name ? ( rel_name => $rel_name ) : () ),
1803   };
1804
1805   # Allowing passing relconds different than the relationshup itself is cute,
1806   # but likely dangerous. Remove that from the (still unofficial) API of
1807   # _resolve_relationship_condition, and instead make it "hard on purpose"
1808   local $self->relationship_info( $args->{rel_name} )->{cond} = $cond if defined $cond;
1809
1810 #######################
1811
1812   # now it's fucking easy isn't it?!
1813   my $rc = $self->_resolve_relationship_condition( $args );
1814
1815   my @res = (
1816     ( $rc->{join_free_condition} || $rc->{condition} ),
1817     ! $rc->{join_free_condition},
1818   );
1819
1820   # _resolve_relationship_condition always returns qualified cols even in the
1821   # case of join_free_condition, but nothing downstream expects this
1822   if ($rc->{join_free_condition} and ref $res[0] eq 'HASH') {
1823     $res[0] = { map
1824       { ($_ =~ /\.(.+)/) => $res[0]{$_} }
1825       keys %{$res[0]}
1826     };
1827   }
1828
1829   # and more legacy
1830   return wantarray ? @res : $res[0];
1831 }
1832
1833 # Keep this indefinitely. There is evidence of both CPAN and
1834 # darkpan using it, and there isn't much harm in an extra var
1835 # anyway.
1836 our $UNRESOLVABLE_CONDITION = UNRESOLVABLE_CONDITION;
1837 # YES I KNOW THIS IS EVIL
1838 # it is there to save darkpan from themselves, since internally
1839 # we are moving to a constant
1840 Internals::SvREADONLY($UNRESOLVABLE_CONDITION => 1);
1841
1842 # Resolves the passed condition to a concrete query fragment and extra
1843 # metadata
1844 #
1845 ## self-explanatory API, modeled on the custom cond coderef:
1846 # rel_name              => (scalar)
1847 # foreign_alias         => (scalar)
1848 # foreign_values        => (either not supplied, or a hashref, or a foreign ResultObject (to be ->get_columns()ed), or plain undef )
1849 # self_alias            => (scalar)
1850 # self_result_object    => (either not supplied or a result object)
1851 # require_join_free_condition => (boolean, throws on failure to construct a JF-cond)
1852 # infer_values_based_on => (either not supplied or a hashref, implies require_join_free_condition)
1853 #
1854 ## returns a hash
1855 # condition           => (a valid *likely fully qualified* sqla cond structure)
1856 # identity_map        => (a hashref of foreign-to-self *unqualified* column equality names)
1857 # join_free_condition => (a valid *fully qualified* sqla cond structure, maybe unset)
1858 # inferred_values     => (in case of an available join_free condition, this is a hashref of
1859 #                         *unqualified* column/value *EQUALITY* pairs, representing an amalgamation
1860 #                         of the JF-cond parse and infer_values_based_on
1861 #                         always either complete or unset)
1862 #
1863 sub _resolve_relationship_condition {
1864   my $self = shift;
1865
1866   my $args = { ref $_[0] eq 'HASH' ? %{ $_[0] } : @_ };
1867
1868   for ( qw( rel_name self_alias foreign_alias ) ) {
1869     $self->throw_exception("Mandatory argument '$_' to _resolve_relationship_condition() is not a plain string")
1870       if !defined $args->{$_} or length ref $args->{$_};
1871   }
1872
1873   $self->throw_exception("Arguments 'self_alias' and 'foreign_alias' may not be identical")
1874     if $args->{self_alias} eq $args->{foreign_alias};
1875
1876 # TEMP
1877   my $exception_rel_id = "relationship '$args->{rel_name}' on source '@{[ $self->source_name ]}'";
1878
1879   my $rel_info = $self->relationship_info($args->{rel_name})
1880 # TEMP
1881 #    or $self->throw_exception( "No such $exception_rel_id" );
1882     or carp_unique("Requesting resolution on non-existent relationship '$args->{rel_name}' on source '@{[ $self->source_name ]}': fix your code *soon*, as it will break with the next major version");
1883
1884 # TEMP
1885   $exception_rel_id = "relationship '$rel_info->{_original_name}' on source '@{[ $self->source_name ]}'"
1886     if $rel_info and exists $rel_info->{_original_name};
1887
1888   $self->throw_exception("No practical way to resolve $exception_rel_id between two data structures")
1889     if exists $args->{self_result_object} and exists $args->{foreign_values};
1890
1891   $self->throw_exception( "Argument to infer_values_based_on must be a hash" )
1892     if exists $args->{infer_values_based_on} and ref $args->{infer_values_based_on} ne 'HASH';
1893
1894   $args->{require_join_free_condition} ||= !!$args->{infer_values_based_on};
1895
1896   $self->throw_exception( "Argument 'self_result_object' must be an object inheriting from DBIx::Class::Row" )
1897     if (
1898       exists $args->{self_result_object}
1899         and
1900       ( ! defined blessed $args->{self_result_object} or ! $args->{self_result_object}->isa('DBIx::Class::Row') )
1901     )
1902   ;
1903
1904   my $rel_rsrc = $self->related_source($args->{rel_name});
1905   my $storage = $self->schema->storage;
1906
1907   if (exists $args->{foreign_values}) {
1908
1909     if (! defined $args->{foreign_values} ) {
1910       # fallback: undef => {}
1911       $args->{foreign_values} = {};
1912     }
1913     elsif (defined blessed $args->{foreign_values}) {
1914
1915       $self->throw_exception( "Objects supplied as 'foreign_values' ($args->{foreign_values}) must inherit from DBIx::Class::Row" )
1916         unless $args->{foreign_values}->isa('DBIx::Class::Row');
1917
1918       carp_unique(
1919         "Objects supplied as 'foreign_values' ($args->{foreign_values}) "
1920       . "usually should inherit from the related ResultClass ('@{[ $rel_rsrc->result_class ]}'), "
1921       . "perhaps you've made a mistake invoking the condition resolver?"
1922       ) unless $args->{foreign_values}->isa($rel_rsrc->result_class);
1923
1924       $args->{foreign_values} = { $args->{foreign_values}->get_columns };
1925     }
1926     elsif ( ref $args->{foreign_values} eq 'HASH' ) {
1927
1928       # re-build {foreign_values} excluding identically named rels
1929       if( keys %{$args->{foreign_values}} ) {
1930
1931         my ($col_idx, $rel_idx) = map
1932           { { map { $_ => 1 } $rel_rsrc->$_ } }
1933           qw( columns relationships )
1934         ;
1935
1936         my $equivalencies = $storage->_extract_fixed_condition_columns(
1937           $args->{foreign_values},
1938           'consider nulls',
1939         );
1940
1941         $args->{foreign_values} = { map {
1942           # skip if relationship *and* a non-literal ref
1943           # this means a multicreate stub was passed in
1944           (
1945             $rel_idx->{$_}
1946               and
1947             length ref $args->{foreign_values}{$_}
1948               and
1949             ! is_literal_value($args->{foreign_values}{$_})
1950           )
1951             ? ()
1952             : ( $_ => (
1953                 ! $col_idx->{$_}
1954                   ? $self->throw_exception( "Key '$_' supplied as 'foreign_values' is not a column on related source '@{[ $rel_rsrc->source_name ]}'" )
1955               : ( !exists $equivalencies->{$_} or ($equivalencies->{$_}||'') eq UNRESOLVABLE_CONDITION )
1956                   ? $self->throw_exception( "Value supplied for '...{foreign_values}{$_}' is not a direct equivalence expression" )
1957               : $args->{foreign_values}{$_}
1958             ))
1959         } keys %{$args->{foreign_values}} };
1960       }
1961     }
1962     else {
1963       $self->throw_exception(
1964         "Argument 'foreign_values' must be either an object inheriting from '@{[ $rel_rsrc->result_class ]}', "
1965       . "or a hash reference, or undef"
1966       );
1967     }
1968   }
1969
1970   my $ret;
1971
1972   if (ref $rel_info->{cond} eq 'CODE') {
1973
1974     my $cref_args = {
1975       rel_name => $args->{rel_name},
1976       self_resultsource => $self,
1977       self_alias => $args->{self_alias},
1978       foreign_alias => $args->{foreign_alias},
1979       ( map
1980         { (exists $args->{$_}) ? ( $_ => $args->{$_} ) : () }
1981         qw( self_result_object foreign_values )
1982       ),
1983     };
1984
1985     # legacy - never remove these!!!
1986     $cref_args->{foreign_relname} = $cref_args->{rel_name};
1987
1988     $cref_args->{self_rowobj} = $cref_args->{self_result_object}
1989       if exists $cref_args->{self_result_object};
1990
1991     ($ret->{condition}, $ret->{join_free_condition}, my @extra) = $rel_info->{cond}->($cref_args);
1992
1993     # sanity check
1994     $self->throw_exception("A custom condition coderef can return at most 2 conditions, but $exception_rel_id returned extra values: @extra")
1995       if @extra;
1996
1997     if (my $jfc = $ret->{join_free_condition}) {
1998
1999       $self->throw_exception (
2000         "The join-free condition returned for $exception_rel_id must be a hash reference"
2001       ) unless ref $jfc eq 'HASH';
2002
2003       my ($joinfree_alias, $joinfree_source);
2004       if (defined $args->{self_result_object}) {
2005         $joinfree_alias = $args->{foreign_alias};
2006         $joinfree_source = $rel_rsrc;
2007       }
2008       elsif (defined $args->{foreign_values}) {
2009         $joinfree_alias = $args->{self_alias};
2010         $joinfree_source = $self;
2011       }
2012
2013       # FIXME sanity check until things stabilize, remove at some point
2014       $self->throw_exception (
2015         "A join-free condition returned for $exception_rel_id without a result object to chain from"
2016       ) unless $joinfree_alias;
2017
2018       my $fq_col_list = { map
2019         { ( "$joinfree_alias.$_" => 1 ) }
2020         $joinfree_source->columns
2021       };
2022
2023       exists $fq_col_list->{$_} or $self->throw_exception (
2024         "The join-free condition returned for $exception_rel_id may only "
2025       . 'contain keys that are fully qualified column names of the corresponding source '
2026       . "'$joinfree_alias' (instead it returned '$_')"
2027       ) for keys %$jfc;
2028
2029       (
2030         length ref $_
2031           and
2032         defined blessed($_)
2033           and
2034         $_->isa('DBIx::Class::Row')
2035           and
2036         $self->throw_exception (
2037           "The join-free condition returned for $exception_rel_id may not "
2038         . 'contain result objects as values - perhaps instead of invoking '
2039         . '->$something you meant to return ->get_column($something)'
2040         )
2041       ) for values %$jfc;
2042
2043     }
2044   }
2045   elsif (ref $rel_info->{cond} eq 'HASH') {
2046
2047     # the condition is static - use parallel arrays
2048     # for a "pivot" depending on which side of the
2049     # rel did we get as an object
2050     my (@f_cols, @l_cols);
2051     for my $fc (keys %{ $rel_info->{cond} }) {
2052       my $lc = $rel_info->{cond}{$fc};
2053
2054       # FIXME STRICTMODE should probably check these are valid columns
2055       $fc =~ s/^foreign\.// ||
2056         $self->throw_exception("Invalid rel cond key '$fc'");
2057
2058       $lc =~ s/^self\.// ||
2059         $self->throw_exception("Invalid rel cond val '$lc'");
2060
2061       push @f_cols, $fc;
2062       push @l_cols, $lc;
2063     }
2064
2065     # construct the crosstable condition and the identity map
2066     for  (0..$#f_cols) {
2067       $ret->{condition}{"$args->{foreign_alias}.$f_cols[$_]"} = { -ident => "$args->{self_alias}.$l_cols[$_]" };
2068       $ret->{identity_map}{$l_cols[$_]} = $f_cols[$_];
2069     };
2070
2071     if ($args->{foreign_values}) {
2072       $ret->{join_free_condition}{"$args->{self_alias}.$l_cols[$_]"} = $args->{foreign_values}{$f_cols[$_]}
2073         for 0..$#f_cols;
2074     }
2075     elsif (defined $args->{self_result_object}) {
2076
2077       for my $i (0..$#l_cols) {
2078         if ( $args->{self_result_object}->has_column_loaded($l_cols[$i]) ) {
2079           $ret->{join_free_condition}{"$args->{foreign_alias}.$f_cols[$i]"} = $args->{self_result_object}->get_column($l_cols[$i]);
2080         }
2081         else {
2082           $self->throw_exception(sprintf
2083             "Unable to resolve relationship '%s' from object '%s': column '%s' not "
2084           . 'loaded from storage (or not passed to new() prior to insert()). You '
2085           . 'probably need to call ->discard_changes to get the server-side defaults '
2086           . 'from the database.',
2087             $args->{rel_name},
2088             $args->{self_result_object},
2089             $l_cols[$i],
2090           ) if $args->{self_result_object}->in_storage;
2091
2092           # FIXME - temporarly force-override
2093           delete $args->{require_join_free_condition};
2094           $ret->{join_free_condition} = UNRESOLVABLE_CONDITION;
2095           last;
2096         }
2097       }
2098     }
2099   }
2100   elsif (ref $rel_info->{cond} eq 'ARRAY') {
2101     if (@{ $rel_info->{cond} } == 0) {
2102       $ret = {
2103         condition => UNRESOLVABLE_CONDITION,
2104         join_free_condition => UNRESOLVABLE_CONDITION,
2105       };
2106     }
2107     else {
2108       my @subconds = map {
2109         local $rel_info->{cond} = $_;
2110         $self->_resolve_relationship_condition( $args );
2111       } @{ $rel_info->{cond} };
2112
2113       if( @{ $rel_info->{cond} } == 1 ) {
2114         $ret = $subconds[0];
2115       }
2116       else {
2117         # we are discarding inferred values here... likely incorrect...
2118         # then again - the entire thing is an OR, so we *can't* use them anyway
2119         for my $subcond ( @subconds ) {
2120           $self->throw_exception('Either all or none of the OR-condition members must resolve to a join-free condition')
2121             if ( $ret and ( $ret->{join_free_condition} xor $subcond->{join_free_condition} ) );
2122
2123           $subcond->{$_} and push @{$ret->{$_}}, $subcond->{$_} for (qw(condition join_free_condition));
2124         }
2125       }
2126     }
2127   }
2128   else {
2129     $self->throw_exception ("Can't handle condition $rel_info->{cond} for $exception_rel_id yet :(");
2130   }
2131
2132   if (
2133     $args->{require_join_free_condition}
2134       and
2135     ( ! $ret->{join_free_condition} or $ret->{join_free_condition} eq UNRESOLVABLE_CONDITION )
2136   ) {
2137     $self->throw_exception(
2138       ucfirst sprintf "$exception_rel_id does not resolve to a %sjoin-free condition fragment",
2139         exists $args->{foreign_values}
2140           ? "'foreign_values'-based reversed-"
2141           : ''
2142     );
2143   }
2144
2145   # we got something back - sanity check and infer values if we can
2146   my @nonvalues;
2147   if (
2148     $ret->{join_free_condition}
2149       and
2150     $ret->{join_free_condition} ne UNRESOLVABLE_CONDITION
2151       and
2152     my $jfc = $storage->_collapse_cond( $ret->{join_free_condition} )
2153   ) {
2154
2155     my $jfc_eqs = $storage->_extract_fixed_condition_columns($jfc, 'consider_nulls');
2156
2157     if (keys %$jfc_eqs) {
2158
2159       for (keys %$jfc) {
2160         # $jfc is fully qualified by definition
2161         my ($col) = $_ =~ /\.(.+)/;
2162
2163         if (exists $jfc_eqs->{$_} and ($jfc_eqs->{$_}||'') ne UNRESOLVABLE_CONDITION) {
2164           $ret->{inferred_values}{$col} = $jfc_eqs->{$_};
2165         }
2166         elsif ( !$args->{infer_values_based_on} or ! exists $args->{infer_values_based_on}{$col} ) {
2167           push @nonvalues, $col;
2168         }
2169       }
2170
2171       # all or nothing
2172       delete $ret->{inferred_values} if @nonvalues;
2173     }
2174   }
2175
2176   # did the user explicitly ask
2177   if ($args->{infer_values_based_on}) {
2178
2179     $self->throw_exception(sprintf (
2180       "Unable to complete value inferrence - custom $exception_rel_id returns conditions instead of values for column(s): %s",
2181       map { "'$_'" } @nonvalues
2182     )) if @nonvalues;
2183
2184
2185     $ret->{inferred_values} ||= {};
2186
2187     $ret->{inferred_values}{$_} = $args->{infer_values_based_on}{$_}
2188       for keys %{$args->{infer_values_based_on}};
2189   }
2190
2191   # add the identities based on the main condition
2192   # (may already be there, since easy to calculate on the fly in the HASH case)
2193   if ( ! $ret->{identity_map} ) {
2194
2195     my $col_eqs = $storage->_extract_fixed_condition_columns($ret->{condition});
2196
2197     my $colinfos;
2198     for my $lhs (keys %$col_eqs) {
2199
2200       next if $col_eqs->{$lhs} eq UNRESOLVABLE_CONDITION;
2201
2202       # there is no way to know who is right and who is left in a cref
2203       # therefore a full blown resolution call, and figure out the
2204       # direction a bit further below
2205       $colinfos ||= $storage->_resolve_column_info([
2206         { -alias => $args->{self_alias}, -rsrc => $self },
2207         { -alias => $args->{foreign_alias}, -rsrc => $rel_rsrc },
2208       ]);
2209
2210       next unless $colinfos->{$lhs};  # someone is engaging in witchcraft
2211
2212       if ( my $rhs_ref = is_literal_value( $col_eqs->{$lhs} ) ) {
2213
2214         if (
2215           $colinfos->{$rhs_ref->[0]}
2216             and
2217           $colinfos->{$lhs}{-source_alias} ne $colinfos->{$rhs_ref->[0]}{-source_alias}
2218         ) {
2219           ( $colinfos->{$lhs}{-source_alias} eq $args->{self_alias} )
2220             ? ( $ret->{identity_map}{$colinfos->{$lhs}{-colname}} = $colinfos->{$rhs_ref->[0]}{-colname} )
2221             : ( $ret->{identity_map}{$colinfos->{$rhs_ref->[0]}{-colname}} = $colinfos->{$lhs}{-colname} )
2222           ;
2223         }
2224       }
2225       elsif (
2226         $col_eqs->{$lhs} =~ /^ ( \Q$args->{self_alias}\E \. .+ ) /x
2227           and
2228         ($colinfos->{$1}||{})->{-result_source} == $rel_rsrc
2229       ) {
2230         my ($lcol, $rcol) = map
2231           { $colinfos->{$_}{-colname} }
2232           ( $lhs, $1 )
2233         ;
2234         carp_unique(
2235           "The $exception_rel_id specifies equality of column '$lcol' and the "
2236         . "*VALUE* '$rcol' (you did not use the { -ident => ... } operator)"
2237         );
2238       }
2239     }
2240   }
2241
2242   # FIXME - temporary, to fool the idiotic check in SQLMaker::_join_condition
2243   $ret->{condition} = { -and => [ $ret->{condition} ] }
2244     unless $ret->{condition} eq UNRESOLVABLE_CONDITION;
2245
2246   $ret;
2247 }
2248
2249 =head2 related_source
2250
2251 =over 4
2252
2253 =item Arguments: $rel_name
2254
2255 =item Return Value: $source
2256
2257 =back
2258
2259 Returns the result source object for the given relationship.
2260
2261 =cut
2262
2263 sub related_source {
2264   my ($self, $rel) = @_;
2265   if( !$self->has_relationship( $rel ) ) {
2266     $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
2267   }
2268
2269   # if we are not registered with a schema - just use the prototype
2270   # however if we do have a schema - ask for the source by name (and
2271   # throw in the process if all fails)
2272   if (my $schema = try { $self->schema }) {
2273     $schema->source($self->relationship_info($rel)->{source});
2274   }
2275   else {
2276     my $class = $self->relationship_info($rel)->{class};
2277     $self->ensure_class_loaded($class);
2278     $class->result_source_instance;
2279   }
2280 }
2281
2282 =head2 related_class
2283
2284 =over 4
2285
2286 =item Arguments: $rel_name
2287
2288 =item Return Value: $classname
2289
2290 =back
2291
2292 Returns the class name for objects in the given relationship.
2293
2294 =cut
2295
2296 sub related_class {
2297   my ($self, $rel) = @_;
2298   if( !$self->has_relationship( $rel ) ) {
2299     $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
2300   }
2301   return $self->schema->class($self->relationship_info($rel)->{source});
2302 }
2303
2304 =head2 handle
2305
2306 =over 4
2307
2308 =item Arguments: none
2309
2310 =item Return Value: L<$source_handle|DBIx::Class::ResultSourceHandle>
2311
2312 =back
2313
2314 Obtain a new L<result source handle instance|DBIx::Class::ResultSourceHandle>
2315 for this source. Used as a serializable pointer to this resultsource, as it is not
2316 easy (nor advisable) to serialize CODErefs which may very well be present in e.g.
2317 relationship definitions.
2318
2319 =cut
2320
2321 sub handle {
2322   return DBIx::Class::ResultSourceHandle->new({
2323     source_moniker => $_[0]->source_name,
2324
2325     # so that a detached thaw can be re-frozen
2326     $_[0]->{_detached_thaw}
2327       ? ( _detached_source  => $_[0]          )
2328       : ( schema            => $_[0]->schema  )
2329     ,
2330   });
2331 }
2332
2333 my $global_phase_destroy;
2334 sub DESTROY {
2335   ### NO detected_reinvoked_destructor check
2336   ### This code very much relies on being called multuple times
2337
2338   return if $global_phase_destroy ||= in_global_destruction;
2339
2340 ######
2341 # !!! ACHTUNG !!!!
2342 ######
2343 #
2344 # Under no circumstances shall $_[0] be stored anywhere else (like copied to
2345 # a lexical variable, or shifted, or anything else). Doing so will mess up
2346 # the refcount of this particular result source, and will allow the $schema
2347 # we are trying to save to reattach back to the source we are destroying.
2348 # The relevant code checking refcounts is in ::Schema::DESTROY()
2349
2350   # if we are not a schema instance holder - we don't matter
2351   return if(
2352     ! ref $_[0]->{schema}
2353       or
2354     isweak $_[0]->{schema}
2355   );
2356
2357   # weaken our schema hold forcing the schema to find somewhere else to live
2358   # during global destruction (if we have not yet bailed out) this will throw
2359   # which will serve as a signal to not try doing anything else
2360   # however beware - on older perls the exception seems randomly untrappable
2361   # due to some weird race condition during thread joining :(((
2362   local $@;
2363   eval {
2364     weaken $_[0]->{schema};
2365
2366     # if schema is still there reintroduce ourselves with strong refs back to us
2367     if ($_[0]->{schema}) {
2368       my $srcregs = $_[0]->{schema}->source_registrations;
2369       for (keys %$srcregs) {
2370         next unless $srcregs->{$_};
2371         $srcregs->{$_} = $_[0] if $srcregs->{$_} == $_[0];
2372       }
2373     }
2374
2375     1;
2376   } or do {
2377     $global_phase_destroy = 1;
2378   };
2379
2380   return;
2381 }
2382
2383 sub STORABLE_freeze { Storable::nfreeze($_[0]->handle) }
2384
2385 sub STORABLE_thaw {
2386   my ($self, $cloning, $ice) = @_;
2387   %$self = %{ (Storable::thaw($ice))->resolve };
2388 }
2389
2390 =head2 throw_exception
2391
2392 See L<DBIx::Class::Schema/"throw_exception">.
2393
2394 =cut
2395
2396 sub throw_exception {
2397   my $self = shift;
2398
2399   $self->{schema}
2400     ? $self->{schema}->throw_exception(@_)
2401     : DBIx::Class::Exception->throw(@_)
2402   ;
2403 }
2404
2405 =head2 column_info_from_storage
2406
2407 =over
2408
2409 =item Arguments: 1/0 (default: 0)
2410
2411 =item Return Value: 1/0
2412
2413 =back
2414
2415   __PACKAGE__->column_info_from_storage(1);
2416
2417 Enables the on-demand automatic loading of the above column
2418 metadata from storage as necessary.  This is *deprecated*, and
2419 should not be used.  It will be removed before 1.0.
2420
2421 =head1 FURTHER QUESTIONS?
2422
2423 Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
2424
2425 =head1 COPYRIGHT AND LICENSE
2426
2427 This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
2428 by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
2429 redistribute it and/or modify it under the same terms as the
2430 L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.
2431
2432 =cut
2433
2434 1;