As clear as it gets
[dbsrgits/DBIx-Class-Historic.git] / lib / DBIx / Class / ResultSource.pm
1 package DBIx::Class::ResultSource;
2
3 use strict;
4 use warnings;
5
6 use DBIx::Class::ResultSet;
7 use DBIx::Class::ResultSourceHandle;
8
9 use DBIx::Class::Exception;
10 use Carp::Clan qw/^DBIx::Class/;
11
12 use base qw/DBIx::Class/;
13
14 __PACKAGE__->mk_group_accessors('simple' => qw/_ordered_columns
15   _columns _primaries _unique_constraints name resultset_attributes
16   schema from _relationships column_info_from_storage source_info
17   source_name sqlt_deploy_callback/);
18
19 __PACKAGE__->mk_group_accessors('component_class' => qw/resultset_class
20   result_class/);
21
22 =head1 NAME
23
24 DBIx::Class::ResultSource - Result source object
25
26 =head1 SYNOPSIS
27
28   # Create a table based result source, in a result class.
29
30   package MyDB::Schema::Result::Artist;
31   use base qw/DBIx::Class::Core/;
32
33   __PACKAGE__->table('artist');
34   __PACKAGE__->add_columns(qw/ artistid name /);
35   __PACKAGE__->set_primary_key('artistid');
36   __PACKAGE__->has_many(cds => 'MyDB::Schema::Result::CD');
37
38   1;
39
40   # Create a query (view) based result source, in a result class
41   package MyDB::Schema::Result::Year2000CDs;
42   use base qw/DBIx::Class::Core/;
43
44   __PACKAGE__->load_components('InflateColumn::DateTime');
45   __PACKAGE__->table_class('DBIx::Class::ResultSource::View');
46
47   __PACKAGE__->table('year2000cds');
48   __PACKAGE__->result_source_instance->is_virtual(1);
49   __PACKAGE__->result_source_instance->view_definition(
50       "SELECT cdid, artist, title FROM cd WHERE year ='2000'"
51       );
52
53
54 =head1 DESCRIPTION
55
56 A ResultSource is an object that represents a source of data for querying.
57
58 This class is a base class for various specialised types of result
59 sources, for example L<DBIx::Class::ResultSource::Table>. Table is the
60 default result source type, so one is created for you when defining a
61 result class as described in the synopsis above.
62
63 More specifically, the L<DBIx::Class::Core> base class pulls in the
64 L<DBIx::Class::ResultSourceProxy::Table> component, which defines
65 the L<table|DBIx::Class::ResultSourceProxy::Table/table> method.
66 When called, C<table> creates and stores an instance of
67 L<DBIx::Class::ResultSoure::Table>. Luckily, to use tables as result
68 sources, you don't need to remember any of this.
69
70 Result sources representing select queries, or views, can also be
71 created, see L<DBIx::Class::ResultSource::View> for full details.
72
73 =head2 Finding result source objects
74
75 As mentioned above, a result source instance is created and stored for
76 you when you define a L<Result Class|DBIx::Class::Manual::Glossary/Result Class>.
77
78 You can retrieve the result source at runtime in the following ways:
79
80 =over
81
82 =item From a Schema object:
83
84    $schema->source($source_name);
85
86 =item From a Row object:
87
88    $row->result_source;
89
90 =item From a ResultSet object:
91
92    $rs->result_source;
93
94 =back
95
96 =head1 METHODS
97
98 =pod
99
100 =cut
101
102 sub new {
103   my ($class, $attrs) = @_;
104   $class = ref $class if ref $class;
105
106   my $new = bless { %{$attrs || {}} }, $class;
107   $new->{resultset_class} ||= 'DBIx::Class::ResultSet';
108   $new->{resultset_attributes} = { %{$new->{resultset_attributes} || {}} };
109   $new->{_ordered_columns} = [ @{$new->{_ordered_columns}||[]}];
110   $new->{_columns} = { %{$new->{_columns}||{}} };
111   $new->{_relationships} = { %{$new->{_relationships}||{}} };
112   $new->{name} ||= "!!NAME NOT SET!!";
113   $new->{_columns_info_loaded} ||= 0;
114   $new->{sqlt_deploy_callback} ||= "default_sqlt_deploy_hook";
115   return $new;
116 }
117
118 =pod
119
120 =head2 add_columns
121
122 =over
123
124 =item Arguments: @columns
125
126 =item Return value: The ResultSource object
127
128 =back
129
130   $source->add_columns(qw/col1 col2 col3/);
131
132   $source->add_columns('col1' => \%col1_info, 'col2' => \%col2_info, ...);
133
134 Adds columns to the result source. If supplied colname => hashref
135 pairs, uses the hashref as the L</column_info> for that column. Repeated
136 calls of this method will add more columns, not replace them.
137
138 The column names given will be created as accessor methods on your
139 L<DBIx::Class::Row> objects. You can change the name of the accessor
140 by supplying an L</accessor> in the column_info hash.
141
142 The contents of the column_info are not set in stone. The following
143 keys are currently recognised/used by DBIx::Class:
144
145 =over 4
146
147 =item accessor
148
149    { accessor => '_name' }
150
151    # example use, replace standard accessor with one of your own:
152    sub name {
153        my ($self, $value) = @_;
154
155        die "Name cannot contain digits!" if($value =~ /\d/);
156        $self->_name($value);
157
158        return $self->_name();
159    }
160
161 Use this to set the name of the accessor method for this column. If unset,
162 the name of the column will be used.
163
164 =item data_type
165
166    { data_type => 'integer' }
167
168 This contains the column type. It is automatically filled if you use the
169 L<SQL::Translator::Producer::DBIx::Class::File> producer, or the
170 L<DBIx::Class::Schema::Loader> module. 
171
172 Currently there is no standard set of values for the data_type. Use
173 whatever your database supports.
174
175 =item size
176
177    { size => 20 }
178
179 The length of your column, if it is a column type that can have a size
180 restriction. This is currently only used to create tables from your
181 schema, see L<DBIx::Class::Schema/deploy>.
182
183 =item is_nullable
184
185    { is_nullable => 1 }
186
187 Set this to a true value for a columns that is allowed to contain NULL
188 values, default is false. This is currently only used to create tables
189 from your schema, see L<DBIx::Class::Schema/deploy>.
190
191 =item is_auto_increment
192
193    { is_auto_increment => 1 }
194
195 Set this to a true value for a column whose value is somehow
196 automatically set, defaults to false. This is used to determine which
197 columns to empty when cloning objects using
198 L<DBIx::Class::Row/copy>. It is also used by
199 L<DBIx::Class::Schema/deploy>.
200
201 =item is_numeric
202
203    { is_numeric => 1 }
204
205 Set this to a true or false value (not C<undef>) to explicitly specify
206 if this column contains numeric data. This controls how set_column
207 decides whether to consider a column dirty after an update: if
208 C<is_numeric> is true a numeric comparison C<< != >> will take place
209 instead of the usual C<eq>
210
211 If not specified the storage class will attempt to figure this out on
212 first access to the column, based on the column C<data_type>. The
213 result will be cached in this attribute.
214
215 =item is_foreign_key
216
217    { is_foreign_key => 1 }
218
219 Set this to a true value for a column that contains a key from a
220 foreign table, defaults to false. This is currently only used to
221 create tables from your schema, see L<DBIx::Class::Schema/deploy>.
222
223 =item default_value
224
225    { default_value => \'now()' }
226
227 Set this to the default value which will be inserted into a column by
228 the database. Can contain either a value or a function (use a
229 reference to a scalar e.g. C<\'now()'> if you want a function). This
230 is currently only used to create tables from your schema, see
231 L<DBIx::Class::Schema/deploy>.
232
233 See the note on L<DBIx::Class::Row/new> for more information about possible
234 issues related to db-side default values.
235
236 =item sequence
237
238    { sequence => 'my_table_seq' }
239
240 Set this on a primary key column to the name of the sequence used to
241 generate a new key value. If not specified, L<DBIx::Class::PK::Auto>
242 will attempt to retrieve the name of the sequence from the database
243 automatically.
244
245 =item auto_nextval
246
247 Set this to a true value for a column whose value is retrieved automatically
248 from a sequence or function (if supported by your Storage driver.) For a
249 sequence, if you do not use a trigger to get the nextval, you have to set the
250 L</sequence> value as well.
251
252 Also set this for MSSQL columns with the 'uniqueidentifier'
253 L<DBIx::Class::ResultSource/data_type> whose values you want to automatically
254 generate using C<NEWID()>, unless they are a primary key in which case this will
255 be done anyway.
256
257 =item extra
258
259 This is used by L<DBIx::Class::Schema/deploy> and L<SQL::Translator>
260 to add extra non-generic data to the column. For example: C<< extra
261 => { unsigned => 1} >> is used by the MySQL producer to set an integer
262 column to unsigned. For more details, see
263 L<SQL::Translator::Producer::MySQL>.
264
265 =back
266
267 =head2 add_column
268
269 =over
270
271 =item Arguments: $colname, \%columninfo?
272
273 =item Return value: 1/0 (true/false)
274
275 =back
276
277   $source->add_column('col' => \%info);
278
279 Add a single column and optional column info. Uses the same column
280 info keys as L</add_columns>.
281
282 =cut
283
284 sub add_columns {
285   my ($self, @cols) = @_;
286   $self->_ordered_columns(\@cols) unless $self->_ordered_columns;
287
288   my @added;
289   my $columns = $self->_columns;
290   while (my $col = shift @cols) {
291     # If next entry is { ... } use that for the column info, if not
292     # use an empty hashref
293     my $column_info = ref $cols[0] ? shift(@cols) : {};
294     push(@added, $col) unless exists $columns->{$col};
295     $columns->{$col} = $column_info;
296   }
297   push @{ $self->_ordered_columns }, @added;
298   return $self;
299 }
300
301 sub add_column { shift->add_columns(@_); } # DO NOT CHANGE THIS TO GLOB
302
303 =head2 has_column
304
305 =over
306
307 =item Arguments: $colname
308
309 =item Return value: 1/0 (true/false)
310
311 =back
312
313   if ($source->has_column($colname)) { ... }
314
315 Returns true if the source has a column of this name, false otherwise.
316
317 =cut
318
319 sub has_column {
320   my ($self, $column) = @_;
321   return exists $self->_columns->{$column};
322 }
323
324 =head2 column_info
325
326 =over
327
328 =item Arguments: $colname
329
330 =item Return value: Hashref of info
331
332 =back
333
334   my $info = $source->column_info($col);
335
336 Returns the column metadata hashref for a column, as originally passed
337 to L</add_columns>. See L</add_columns> above for information on the
338 contents of the hashref.
339
340 =cut
341
342 sub column_info {
343   my ($self, $column) = @_;
344   $self->throw_exception("No such column $column")
345     unless exists $self->_columns->{$column};
346   #warn $self->{_columns_info_loaded}, "\n";
347   if ( ! $self->_columns->{$column}{data_type}
348        and $self->column_info_from_storage
349        and ! $self->{_columns_info_loaded}
350        and $self->schema and $self->storage )
351   {
352     $self->{_columns_info_loaded}++;
353     my $info = {};
354     my $lc_info = {};
355     # eval for the case of storage without table
356     eval { $info = $self->storage->columns_info_for( $self->from ) };
357     unless ($@) {
358       for my $realcol ( keys %{$info} ) {
359         $lc_info->{lc $realcol} = $info->{$realcol};
360       }
361       foreach my $col ( keys %{$self->_columns} ) {
362         $self->_columns->{$col} = {
363           %{ $self->_columns->{$col} },
364           %{ $info->{$col} || $lc_info->{lc $col} || {} }
365         };
366       }
367     }
368   }
369   return $self->_columns->{$column};
370 }
371
372 =head2 columns
373
374 =over
375
376 =item Arguments: None
377
378 =item Return value: Ordered list of column names
379
380 =back
381
382   my @column_names = $source->columns;
383
384 Returns all column names in the order they were declared to L</add_columns>.
385
386 =cut
387
388 sub columns {
389   my $self = shift;
390   $self->throw_exception(
391     "columns() is a read-only accessor, did you mean add_columns()?"
392   ) if @_;
393   return @{$self->{_ordered_columns}||[]};
394 }
395
396 =head2 remove_columns
397
398 =over
399
400 =item Arguments: @colnames
401
402 =item Return value: undefined
403
404 =back
405
406   $source->remove_columns(qw/col1 col2 col3/);
407
408 Removes the given list of columns by name, from the result source.
409
410 B<Warning>: Removing a column that is also used in the sources primary
411 key, or in one of the sources unique constraints, B<will> result in a
412 broken result source.
413
414 =head2 remove_column
415
416 =over
417
418 =item Arguments: $colname
419
420 =item Return value: undefined
421
422 =back
423
424   $source->remove_column('col');
425
426 Remove a single column by name from the result source, similar to
427 L</remove_columns>.
428
429 B<Warning>: Removing a column that is also used in the sources primary
430 key, or in one of the sources unique constraints, B<will> result in a
431 broken result source.
432
433 =cut
434
435 sub remove_columns {
436   my ($self, @to_remove) = @_;
437
438   my $columns = $self->_columns
439     or return;
440
441   my %to_remove;
442   for (@to_remove) {
443     delete $columns->{$_};
444     ++$to_remove{$_};
445   }
446
447   $self->_ordered_columns([ grep { not $to_remove{$_} } @{$self->_ordered_columns} ]);
448 }
449
450 sub remove_column { shift->remove_columns(@_); } # DO NOT CHANGE THIS TO GLOB
451
452 =head2 set_primary_key
453
454 =over 4
455
456 =item Arguments: @cols
457
458 =item Return value: undefined
459
460 =back
461
462 Defines one or more columns as primary key for this source. Must be
463 called after L</add_columns>.
464
465 Additionally, defines a L<unique constraint|add_unique_constraint>
466 named C<primary>.
467
468 The primary key columns are used by L<DBIx::Class::PK::Auto> to
469 retrieve automatically created values from the database. They are also
470 used as default joining columns when specifying relationships, see
471 L<DBIx::Class::Relationship>.
472
473 =cut
474
475 sub set_primary_key {
476   my ($self, @cols) = @_;
477   # check if primary key columns are valid columns
478   foreach my $col (@cols) {
479     $self->throw_exception("No such column $col on table " . $self->name)
480       unless $self->has_column($col);
481   }
482   $self->_primaries(\@cols);
483
484   $self->add_unique_constraint(primary => \@cols);
485 }
486
487 =head2 primary_columns
488
489 =over 4
490
491 =item Arguments: None
492
493 =item Return value: Ordered list of primary column names
494
495 =back
496
497 Read-only accessor which returns the list of primary keys, supplied by
498 L</set_primary_key>.
499
500 =cut
501
502 sub primary_columns {
503   return @{shift->_primaries||[]};
504 }
505
506 =head2 add_unique_constraint
507
508 =over 4
509
510 =item Arguments: $name?, \@colnames
511
512 =item Return value: undefined
513
514 =back
515
516 Declare a unique constraint on this source. Call once for each unique
517 constraint.
518
519   # For UNIQUE (column1, column2)
520   __PACKAGE__->add_unique_constraint(
521     constraint_name => [ qw/column1 column2/ ],
522   );
523
524 Alternatively, you can specify only the columns:
525
526   __PACKAGE__->add_unique_constraint([ qw/column1 column2/ ]);
527
528 This will result in a unique constraint named
529 C<table_column1_column2>, where C<table> is replaced with the table
530 name.
531
532 Unique constraints are used, for example, when you pass the constraint
533 name as the C<key> attribute to L<DBIx::Class::ResultSet/find>. Then
534 only columns in the constraint are searched.
535
536 Throws an error if any of the given column names do not yet exist on
537 the result source.
538
539 =cut
540
541 sub add_unique_constraint {
542   my $self = shift;
543   my $cols = pop @_;
544   my $name = shift;
545
546   $name ||= $self->name_unique_constraint($cols);
547
548   foreach my $col (@$cols) {
549     $self->throw_exception("No such column $col on table " . $self->name)
550       unless $self->has_column($col);
551   }
552
553   my %unique_constraints = $self->unique_constraints;
554   $unique_constraints{$name} = $cols;
555   $self->_unique_constraints(\%unique_constraints);
556 }
557
558 =head2 name_unique_constraint
559
560 =over 4
561
562 =item Arguments: @colnames
563
564 =item Return value: Constraint name
565
566 =back
567
568   $source->table('mytable');
569   $source->name_unique_constraint('col1', 'col2');
570   # returns
571   'mytable_col1_col2'
572
573 Return a name for a unique constraint containing the specified
574 columns. The name is created by joining the table name and each column
575 name, using an underscore character.
576
577 For example, a constraint on a table named C<cd> containing the columns
578 C<artist> and C<title> would result in a constraint name of C<cd_artist_title>.
579
580 This is used by L</add_unique_constraint> if you do not specify the
581 optional constraint name.
582
583 =cut
584
585 sub name_unique_constraint {
586   my ($self, $cols) = @_;
587
588   my $name = $self->name;
589   $name = $$name if (ref $name eq 'SCALAR');
590
591   return join '_', $name, @$cols;
592 }
593
594 =head2 unique_constraints
595
596 =over 4
597
598 =item Arguments: None
599
600 =item Return value: Hash of unique constraint data
601
602 =back
603
604   $source->unique_constraints();
605
606 Read-only accessor which returns a hash of unique constraints on this
607 source.
608
609 The hash is keyed by constraint name, and contains an arrayref of
610 column names as values.
611
612 =cut
613
614 sub unique_constraints {
615   return %{shift->_unique_constraints||{}};
616 }
617
618 =head2 unique_constraint_names
619
620 =over 4
621
622 =item Arguments: None
623
624 =item Return value: Unique constraint names
625
626 =back
627
628   $source->unique_constraint_names();
629
630 Returns the list of unique constraint names defined on this source.
631
632 =cut
633
634 sub unique_constraint_names {
635   my ($self) = @_;
636
637   my %unique_constraints = $self->unique_constraints;
638
639   return keys %unique_constraints;
640 }
641
642 =head2 unique_constraint_columns
643
644 =over 4
645
646 =item Arguments: $constraintname
647
648 =item Return value: List of constraint columns
649
650 =back
651
652   $source->unique_constraint_columns('myconstraint');
653
654 Returns the list of columns that make up the specified unique constraint.
655
656 =cut
657
658 sub unique_constraint_columns {
659   my ($self, $constraint_name) = @_;
660
661   my %unique_constraints = $self->unique_constraints;
662
663   $self->throw_exception(
664     "Unknown unique constraint $constraint_name on '" . $self->name . "'"
665   ) unless exists $unique_constraints{$constraint_name};
666
667   return @{ $unique_constraints{$constraint_name} };
668 }
669
670 =head2 sqlt_deploy_callback
671
672 =over
673
674 =item Arguments: $callback
675
676 =back
677
678   __PACKAGE__->sqlt_deploy_callback('mycallbackmethod');
679
680 An accessor to set a callback to be called during deployment of
681 the schema via L<DBIx::Class::Schema/create_ddl_dir> or
682 L<DBIx::Class::Schema/deploy>.
683
684 The callback can be set as either a code reference or the name of a
685 method in the current result class.
686
687 If not set, the L</default_sqlt_deploy_hook> is called.
688
689 Your callback will be passed the $source object representing the
690 ResultSource instance being deployed, and the
691 L<SQL::Translator::Schema::Table> object being created from it. The
692 callback can be used to manipulate the table object or add your own
693 customised indexes. If you need to manipulate a non-table object, use
694 the L<DBIx::Class::Schema/sqlt_deploy_hook>.
695
696 See L<DBIx::Class::Manual::Cookbook/Adding Indexes And Functions To
697 Your SQL> for examples.
698
699 This sqlt deployment callback can only be used to manipulate
700 SQL::Translator objects as they get turned into SQL. To execute
701 post-deploy statements which SQL::Translator does not currently
702 handle, override L<DBIx::Class::Schema/deploy> in your Schema class
703 and call L<dbh_do|DBIx::Class::Storage::DBI/dbh_do>.
704
705 =head2 default_sqlt_deploy_hook
706
707 =over
708
709 =item Arguments: $source, $sqlt_table
710
711 =item Return value: undefined
712
713 =back
714
715 This is the sensible default for L</sqlt_deploy_callback>.
716
717 If a method named C<sqlt_deploy_hook> exists in your Result class, it
718 will be called and passed the current C<$source> and the
719 C<$sqlt_table> being deployed.
720
721 =cut
722
723 sub default_sqlt_deploy_hook {
724   my $self = shift;
725
726   my $class = $self->result_class;
727
728   if ($class and $class->can('sqlt_deploy_hook')) {
729     $class->sqlt_deploy_hook(@_);
730   }
731 }
732
733 sub _invoke_sqlt_deploy_hook {
734   my $self = shift;
735   if ( my $hook = $self->sqlt_deploy_callback) {
736     $self->$hook(@_);
737   }
738 }
739
740 =head2 resultset
741
742 =over 4
743
744 =item Arguments: None
745
746 =item Return value: $resultset
747
748 =back
749
750 Returns a resultset for the given source. This will initially be created
751 on demand by calling
752
753   $self->resultset_class->new($self, $self->resultset_attributes)
754
755 but is cached from then on unless resultset_class changes.
756
757 =head2 resultset_class
758
759 =over 4
760
761 =item Arguments: $classname
762
763 =item Return value: $classname
764
765 =back
766
767   package My::Schema::ResultSet::Artist;
768   use base 'DBIx::Class::ResultSet';
769   ...
770
771   # In the result class
772   __PACKAGE__->resultset_class('My::Schema::ResultSet::Artist');
773
774   # Or in code
775   $source->resultset_class('My::Schema::ResultSet::Artist');
776
777 Set the class of the resultset. This is useful if you want to create your
778 own resultset methods. Create your own class derived from
779 L<DBIx::Class::ResultSet>, and set it here. If called with no arguments,
780 this method returns the name of the existing resultset class, if one
781 exists.
782
783 =head2 resultset_attributes
784
785 =over 4
786
787 =item Arguments: \%attrs
788
789 =item Return value: \%attrs
790
791 =back
792
793   # In the result class
794   __PACKAGE__->resultset_attributes({ order_by => [ 'id' ] });
795
796   # Or in code
797   $source->resultset_attributes({ order_by => [ 'id' ] });
798
799 Store a collection of resultset attributes, that will be set on every
800 L<DBIx::Class::ResultSet> produced from this result source. For a full
801 list see L<DBIx::Class::ResultSet/ATTRIBUTES>.
802
803 =cut
804
805 sub resultset {
806   my $self = shift;
807   $self->throw_exception(
808     'resultset does not take any arguments. If you want another resultset, '.
809     'call it on the schema instead.'
810   ) if scalar @_;
811
812   return $self->resultset_class->new(
813     $self,
814     {
815       %{$self->{resultset_attributes}},
816       %{$self->schema->default_resultset_attributes}
817     },
818   );
819 }
820
821 =head2 source_name
822
823 =over 4
824
825 =item Arguments: $source_name
826
827 =item Result value: $source_name
828
829 =back
830
831 Set an alternate name for the result source when it is loaded into a schema.
832 This is useful if you want to refer to a result source by a name other than
833 its class name.
834
835   package ArchivedBooks;
836   use base qw/DBIx::Class/;
837   __PACKAGE__->table('books_archive');
838   __PACKAGE__->source_name('Books');
839
840   # from your schema...
841   $schema->resultset('Books')->find(1);
842
843 =head2 from
844
845 =over 4
846
847 =item Arguments: None
848
849 =item Return value: FROM clause
850
851 =back
852
853   my $from_clause = $source->from();
854
855 Returns an expression of the source to be supplied to storage to specify
856 retrieval from this source. In the case of a database, the required FROM
857 clause contents.
858
859 =head2 schema
860
861 =over 4
862
863 =item Arguments: None
864
865 =item Return value: A schema object
866
867 =back
868
869   my $schema = $source->schema();
870
871 Returns the L<DBIx::Class::Schema> object that this result source 
872 belongs to.
873
874 =head2 storage
875
876 =over 4
877
878 =item Arguments: None
879
880 =item Return value: A Storage object
881
882 =back
883
884   $source->storage->debug(1);
885
886 Returns the storage handle for the current schema.
887
888 See also: L<DBIx::Class::Storage>
889
890 =cut
891
892 sub storage { shift->schema->storage; }
893
894 =head2 add_relationship
895
896 =over 4
897
898 =item Arguments: $relname, $related_source_name, \%cond, [ \%attrs ]
899
900 =item Return value: 1/true if it succeeded
901
902 =back
903
904   $source->add_relationship('relname', 'related_source', $cond, $attrs);
905
906 L<DBIx::Class::Relationship> describes a series of methods which
907 create pre-defined useful types of relationships. Look there first
908 before using this method directly.
909
910 The relationship name can be arbitrary, but must be unique for each
911 relationship attached to this result source. 'related_source' should
912 be the name with which the related result source was registered with
913 the current schema. For example:
914
915   $schema->source('Book')->add_relationship('reviews', 'Review', {
916     'foreign.book_id' => 'self.id',
917   });
918
919 The condition C<$cond> needs to be an L<SQL::Abstract>-style
920 representation of the join between the tables. For example, if you're
921 creating a relation from Author to Book,
922
923   { 'foreign.author_id' => 'self.id' }
924
925 will result in the JOIN clause
926
927   author me JOIN book foreign ON foreign.author_id = me.id
928
929 You can specify as many foreign => self mappings as necessary.
930
931 Valid attributes are as follows:
932
933 =over 4
934
935 =item join_type
936
937 Explicitly specifies the type of join to use in the relationship. Any
938 SQL join type is valid, e.g. C<LEFT> or C<RIGHT>. It will be placed in
939 the SQL command immediately before C<JOIN>.
940
941 =item proxy
942
943 An arrayref containing a list of accessors in the foreign class to proxy in
944 the main class. If, for example, you do the following:
945
946   CD->might_have(liner_notes => 'LinerNotes', undef, {
947     proxy => [ qw/notes/ ],
948   });
949
950 Then, assuming LinerNotes has an accessor named notes, you can do:
951
952   my $cd = CD->find(1);
953   # set notes -- LinerNotes object is created if it doesn't exist
954   $cd->notes('Notes go here');
955
956 =item accessor
957
958 Specifies the type of accessor that should be created for the
959 relationship. Valid values are C<single> (for when there is only a single
960 related object), C<multi> (when there can be many), and C<filter> (for
961 when there is a single related object, but you also want the relationship
962 accessor to double as a column accessor). For C<multi> accessors, an
963 add_to_* method is also created, which calls C<create_related> for the
964 relationship.
965
966 =back
967
968 Throws an exception if the condition is improperly supplied, or cannot
969 be resolved.
970
971 =cut
972
973 sub add_relationship {
974   my ($self, $rel, $f_source_name, $cond, $attrs) = @_;
975   $self->throw_exception("Can't create relationship without join condition")
976     unless $cond;
977   $attrs ||= {};
978
979   # Check foreign and self are right in cond
980   if ( (ref $cond ||'') eq 'HASH') {
981     for (keys %$cond) {
982       $self->throw_exception("Keys of condition should be of form 'foreign.col', not '$_'")
983         if /\./ && !/^foreign\./;
984     }
985   }
986
987   my %rels = %{ $self->_relationships };
988   $rels{$rel} = { class => $f_source_name,
989                   source => $f_source_name,
990                   cond  => $cond,
991                   attrs => $attrs };
992   $self->_relationships(\%rels);
993
994   return $self;
995
996   # XXX disabled. doesn't work properly currently. skip in tests.
997
998   my $f_source = $self->schema->source($f_source_name);
999   unless ($f_source) {
1000     $self->ensure_class_loaded($f_source_name);
1001     $f_source = $f_source_name->result_source;
1002     #my $s_class = ref($self->schema);
1003     #$f_source_name =~ m/^${s_class}::(.*)$/;
1004     #$self->schema->register_class(($1 || $f_source_name), $f_source_name);
1005     #$f_source = $self->schema->source($f_source_name);
1006   }
1007   return unless $f_source; # Can't test rel without f_source
1008
1009   eval { $self->_resolve_join($rel, 'me', {}, []) };
1010
1011   if ($@) { # If the resolve failed, back out and re-throw the error
1012     delete $rels{$rel}; #
1013     $self->_relationships(\%rels);
1014     $self->throw_exception("Error creating relationship $rel: $@");
1015   }
1016   1;
1017 }
1018
1019 =head2 relationships
1020
1021 =over 4
1022
1023 =item Arguments: None
1024
1025 =item Return value: List of relationship names
1026
1027 =back
1028
1029   my @relnames = $source->relationships();
1030
1031 Returns all relationship names for this source.
1032
1033 =cut
1034
1035 sub relationships {
1036   return keys %{shift->_relationships};
1037 }
1038
1039 =head2 relationship_info
1040
1041 =over 4
1042
1043 =item Arguments: $relname
1044
1045 =item Return value: Hashref of relation data,
1046
1047 =back
1048
1049 Returns a hash of relationship information for the specified relationship
1050 name. The keys/values are as specified for L</add_relationship>.
1051
1052 =cut
1053
1054 sub relationship_info {
1055   my ($self, $rel) = @_;
1056   return $self->_relationships->{$rel};
1057 }
1058
1059 =head2 has_relationship
1060
1061 =over 4
1062
1063 =item Arguments: $rel
1064
1065 =item Return value: 1/0 (true/false)
1066
1067 =back
1068
1069 Returns true if the source has a relationship of this name, false otherwise.
1070
1071 =cut
1072
1073 sub has_relationship {
1074   my ($self, $rel) = @_;
1075   return exists $self->_relationships->{$rel};
1076 }
1077
1078 =head2 reverse_relationship_info
1079
1080 =over 4
1081
1082 =item Arguments: $relname
1083
1084 =item Return value: Hashref of relationship data
1085
1086 =back
1087
1088 Looks through all the relationships on the source this relationship
1089 points to, looking for one whose condition is the reverse of the
1090 condition on this relationship.
1091
1092 A common use of this is to find the name of the C<belongs_to> relation
1093 opposing a C<has_many> relation. For definition of these look in
1094 L<DBIx::Class::Relationship>.
1095
1096 The returned hashref is keyed by the name of the opposing
1097 relationship, and contains its data in the same manner as
1098 L</relationship_info>.
1099
1100 =cut
1101
1102 sub reverse_relationship_info {
1103   my ($self, $rel) = @_;
1104   my $rel_info = $self->relationship_info($rel);
1105   my $ret = {};
1106
1107   return $ret unless ((ref $rel_info->{cond}) eq 'HASH');
1108
1109   my @cond = keys(%{$rel_info->{cond}});
1110   my @refkeys = map {/^\w+\.(\w+)$/} @cond;
1111   my @keys = map {$rel_info->{cond}->{$_} =~ /^\w+\.(\w+)$/} @cond;
1112
1113   # Get the related result source for this relationship
1114   my $othertable = $self->related_source($rel);
1115
1116   # Get all the relationships for that source that related to this source
1117   # whose foreign column set are our self columns on $rel and whose self
1118   # columns are our foreign columns on $rel.
1119   my @otherrels = $othertable->relationships();
1120   my $otherrelationship;
1121   foreach my $otherrel (@otherrels) {
1122     my $otherrel_info = $othertable->relationship_info($otherrel);
1123
1124     my $back = $othertable->related_source($otherrel);
1125     next unless $back->source_name eq $self->source_name;
1126
1127     my @othertestconds;
1128
1129     if (ref $otherrel_info->{cond} eq 'HASH') {
1130       @othertestconds = ($otherrel_info->{cond});
1131     }
1132     elsif (ref $otherrel_info->{cond} eq 'ARRAY') {
1133       @othertestconds = @{$otherrel_info->{cond}};
1134     }
1135     else {
1136       next;
1137     }
1138
1139     foreach my $othercond (@othertestconds) {
1140       my @other_cond = keys(%$othercond);
1141       my @other_refkeys = map {/^\w+\.(\w+)$/} @other_cond;
1142       my @other_keys = map {$othercond->{$_} =~ /^\w+\.(\w+)$/} @other_cond;
1143       next if (!$self->_compare_relationship_keys(\@refkeys, \@other_keys) ||
1144                !$self->_compare_relationship_keys(\@other_refkeys, \@keys));
1145       $ret->{$otherrel} =  $otherrel_info;
1146     }
1147   }
1148   return $ret;
1149 }
1150
1151 sub compare_relationship_keys {
1152   carp 'compare_relationship_keys is a private method, stop calling it';
1153   my $self = shift;
1154   $self->_compare_relationship_keys (@_);
1155 }
1156
1157 # Returns true if both sets of keynames are the same, false otherwise.
1158 sub _compare_relationship_keys {
1159   my ($self, $keys1, $keys2) = @_;
1160
1161   # Make sure every keys1 is in keys2
1162   my $found;
1163   foreach my $key (@$keys1) {
1164     $found = 0;
1165     foreach my $prim (@$keys2) {
1166       if ($prim eq $key) {
1167         $found = 1;
1168         last;
1169       }
1170     }
1171     last unless $found;
1172   }
1173
1174   # Make sure every key2 is in key1
1175   if ($found) {
1176     foreach my $prim (@$keys2) {
1177       $found = 0;
1178       foreach my $key (@$keys1) {
1179         if ($prim eq $key) {
1180           $found = 1;
1181           last;
1182         }
1183       }
1184       last unless $found;
1185     }
1186   }
1187
1188   return $found;
1189 }
1190
1191 sub resolve_join {
1192   carp 'resolve_join is a private method, stop calling it';
1193   my $self = shift;
1194   $self->_resolve_join (@_);
1195 }
1196
1197 # Returns the {from} structure used to express JOIN conditions
1198 sub _resolve_join {
1199   my ($self, $join, $alias, $seen, $jpath, $parent_force_left) = @_;
1200
1201   # we need a supplied one, because we do in-place modifications, no returns
1202   $self->throw_exception ('You must supply a seen hashref as the 3rd argument to _resolve_join')
1203     unless ref $seen eq 'HASH';
1204
1205   $self->throw_exception ('You must supply a joinpath arrayref as the 4th argument to _resolve_join')
1206     unless ref $jpath eq 'ARRAY';
1207
1208   $jpath = [@$jpath];
1209
1210   if (not defined $join) {
1211     return ();
1212   }
1213   elsif (ref $join eq 'ARRAY') {
1214     return
1215       map {
1216         $self->_resolve_join($_, $alias, $seen, $jpath, $parent_force_left);
1217       } @$join;
1218   }
1219   elsif (ref $join eq 'HASH') {
1220
1221     my @ret;
1222     for my $rel (keys %$join) {
1223
1224       my $rel_info = $self->relationship_info($rel)
1225         or $self->throw_exception("No such relationship ${rel}");
1226
1227       my $force_left = $parent_force_left;
1228       $force_left ||= lc($rel_info->{attrs}{join_type}||'') eq 'left';
1229
1230       # the actual seen value will be incremented by the recursion
1231       my $as = ($seen->{$rel} ? join ('_', $rel, $seen->{$rel} + 1) : $rel);
1232
1233       push @ret, (
1234         $self->_resolve_join($rel, $alias, $seen, [@$jpath], $force_left),
1235         $self->related_source($rel)->_resolve_join(
1236           $join->{$rel}, $as, $seen, [@$jpath, $rel], $force_left
1237         )
1238       );
1239     }
1240     return @ret;
1241
1242   }
1243   elsif (ref $join) {
1244     $self->throw_exception("No idea how to resolve join reftype ".ref $join);
1245   }
1246   else {
1247     my $count = ++$seen->{$join};
1248     my $as = ($count > 1 ? "${join}_${count}" : $join);
1249
1250     my $rel_info = $self->relationship_info($join)
1251       or $self->throw_exception("No such relationship ${join}");
1252
1253     my $rel_src = $self->related_source($join);
1254     return [ { $as => $rel_src->from,
1255                -source_handle => $rel_src->handle,
1256                -join_type => $parent_force_left
1257                   ? 'left'
1258                   : $rel_info->{attrs}{join_type}
1259                 ,
1260                -join_path => [@$jpath, $join],
1261                -alias => $as,
1262                -relation_chain_depth => $seen->{-relation_chain_depth} || 0,
1263              },
1264              $self->_resolve_condition($rel_info->{cond}, $as, $alias) ];
1265   }
1266 }
1267
1268 sub pk_depends_on {
1269   carp 'pk_depends_on is a private method, stop calling it';
1270   my $self = shift;
1271   $self->_pk_depends_on (@_);
1272 }
1273
1274 # Determines whether a relation is dependent on an object from this source
1275 # having already been inserted. Takes the name of the relationship and a
1276 # hashref of columns of the related object.
1277 sub _pk_depends_on {
1278   my ($self, $relname, $rel_data) = @_;
1279
1280   my $relinfo = $self->relationship_info($relname);
1281
1282   # don't assume things if the relationship direction is specified
1283   return $relinfo->{attrs}{is_foreign_key_constraint}
1284     if exists ($relinfo->{attrs}{is_foreign_key_constraint});
1285
1286   my $cond = $relinfo->{cond};
1287   return 0 unless ref($cond) eq 'HASH';
1288
1289   # map { foreign.foo => 'self.bar' } to { bar => 'foo' }
1290   my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond };
1291
1292   # assume anything that references our PK probably is dependent on us
1293   # rather than vice versa, unless the far side is (a) defined or (b)
1294   # auto-increment
1295   my $rel_source = $self->related_source($relname);
1296
1297   foreach my $p ($self->primary_columns) {
1298     if (exists $keyhash->{$p}) {
1299       unless (defined($rel_data->{$keyhash->{$p}})
1300               || $rel_source->column_info($keyhash->{$p})
1301                             ->{is_auto_increment}) {
1302         return 0;
1303       }
1304     }
1305   }
1306
1307   return 1;
1308 }
1309
1310 sub resolve_condition {
1311   carp 'resolve_condition is a private method, stop calling it';
1312   my $self = shift;
1313   $self->_resolve_condition (@_);
1314 }
1315
1316 # Resolves the passed condition to a concrete query fragment. If given an alias,
1317 # returns a join condition; if given an object, inverts that object to produce
1318 # a related conditional from that object.
1319 our $UNRESOLVABLE_CONDITION = \'1 = 0';
1320
1321 sub _resolve_condition {
1322   my ($self, $cond, $as, $for) = @_;
1323   if (ref $cond eq 'HASH') {
1324     my %ret;
1325     foreach my $k (keys %{$cond}) {
1326       my $v = $cond->{$k};
1327       # XXX should probably check these are valid columns
1328       $k =~ s/^foreign\.// ||
1329         $self->throw_exception("Invalid rel cond key ${k}");
1330       $v =~ s/^self\.// ||
1331         $self->throw_exception("Invalid rel cond val ${v}");
1332       if (ref $for) { # Object
1333         #warn "$self $k $for $v";
1334         unless ($for->has_column_loaded($v)) {
1335           if ($for->in_storage) {
1336             $self->throw_exception(sprintf
1337               "Unable to resolve relationship '%s' from object %s: column '%s' not "
1338             . 'loaded from storage (or not passed to new() prior to insert()). You '
1339             . 'probably need to call ->discard_changes to get the server-side defaults '
1340             . 'from the database.',
1341               $as,
1342               $for,
1343               $v,
1344             );
1345           }
1346           return $UNRESOLVABLE_CONDITION;
1347         }
1348         $ret{$k} = $for->get_column($v);
1349         #$ret{$k} = $for->get_column($v) if $for->has_column_loaded($v);
1350         #warn %ret;
1351       } elsif (!defined $for) { # undef, i.e. "no object"
1352         $ret{$k} = undef;
1353       } elsif (ref $as eq 'HASH') { # reverse hashref
1354         $ret{$v} = $as->{$k};
1355       } elsif (ref $as) { # reverse object
1356         $ret{$v} = $as->get_column($k);
1357       } elsif (!defined $as) { # undef, i.e. "no reverse object"
1358         $ret{$v} = undef;
1359       } else {
1360         $ret{"${as}.${k}"} = "${for}.${v}";
1361       }
1362     }
1363     return \%ret;
1364   } elsif (ref $cond eq 'ARRAY') {
1365     return [ map { $self->_resolve_condition($_, $as, $for) } @$cond ];
1366   } else {
1367    die("Can't handle condition $cond yet :(");
1368   }
1369 }
1370
1371 # Legacy code, needs to go entirely away (fully replaced by _resolve_prefetch)
1372 sub resolve_prefetch {
1373   carp 'resolve_prefetch is a private method, stop calling it';
1374
1375   my ($self, $pre, $alias, $seen, $order, $collapse) = @_;
1376   $seen ||= {};
1377   if( ref $pre eq 'ARRAY' ) {
1378     return
1379       map { $self->resolve_prefetch( $_, $alias, $seen, $order, $collapse ) }
1380         @$pre;
1381   }
1382   elsif( ref $pre eq 'HASH' ) {
1383     my @ret =
1384     map {
1385       $self->resolve_prefetch($_, $alias, $seen, $order, $collapse),
1386       $self->related_source($_)->resolve_prefetch(
1387                $pre->{$_}, "${alias}.$_", $seen, $order, $collapse)
1388     } keys %$pre;
1389     return @ret;
1390   }
1391   elsif( ref $pre ) {
1392     $self->throw_exception(
1393       "don't know how to resolve prefetch reftype ".ref($pre));
1394   }
1395   else {
1396     my $count = ++$seen->{$pre};
1397     my $as = ($count > 1 ? "${pre}_${count}" : $pre);
1398     my $rel_info = $self->relationship_info( $pre );
1399     $self->throw_exception( $self->name . " has no such relationship '$pre'" )
1400       unless $rel_info;
1401     my $as_prefix = ($alias =~ /^.*?\.(.+)$/ ? $1.'.' : '');
1402     my $rel_source = $self->related_source($pre);
1403
1404     if (exists $rel_info->{attrs}{accessor}
1405          && $rel_info->{attrs}{accessor} eq 'multi') {
1406       $self->throw_exception(
1407         "Can't prefetch has_many ${pre} (join cond too complex)")
1408         unless ref($rel_info->{cond}) eq 'HASH';
1409       my $dots = @{[$as_prefix =~ m/\./g]} + 1; # +1 to match the ".${as_prefix}"
1410       if (my ($fail) = grep { @{[$_ =~ m/\./g]} == $dots }
1411                          keys %{$collapse}) {
1412         my ($last) = ($fail =~ /([^\.]+)$/);
1413         carp (
1414           "Prefetching multiple has_many rels ${last} and ${pre} "
1415           .(length($as_prefix)
1416             ? "at the same level (${as_prefix}) "
1417             : "at top level "
1418           )
1419           . 'will explode the number of row objects retrievable via ->next or ->all. '
1420           . 'Use at your own risk.'
1421         );
1422       }
1423       #my @col = map { (/^self\.(.+)$/ ? ("${as_prefix}.$1") : ()); }
1424       #              values %{$rel_info->{cond}};
1425       $collapse->{".${as_prefix}${pre}"} = [ $rel_source->primary_columns ];
1426         # action at a distance. prepending the '.' allows simpler code
1427         # in ResultSet->_collapse_result
1428       my @key = map { (/^foreign\.(.+)$/ ? ($1) : ()); }
1429                     keys %{$rel_info->{cond}};
1430       my @ord = (ref($rel_info->{attrs}{order_by}) eq 'ARRAY'
1431                    ? @{$rel_info->{attrs}{order_by}}
1432                    : (defined $rel_info->{attrs}{order_by}
1433                        ? ($rel_info->{attrs}{order_by})
1434                        : ()));
1435       push(@$order, map { "${as}.$_" } (@key, @ord));
1436     }
1437
1438     return map { [ "${as}.$_", "${as_prefix}${pre}.$_", ] }
1439       $rel_source->columns;
1440   }
1441 }
1442
1443 # Accepts one or more relationships for the current source and returns an
1444 # array of column names for each of those relationships. Column names are
1445 # prefixed relative to the current source, in accordance with where they appear
1446 # in the supplied relationships. Needs an alias_map generated by
1447 # $rs->_joinpath_aliases
1448
1449 sub _resolve_prefetch {
1450   my ($self, $pre, $alias, $alias_map, $order, $collapse, $pref_path) = @_;
1451   $pref_path ||= [];
1452
1453   if (not defined $pre) {
1454     return ();
1455   }
1456   elsif( ref $pre eq 'ARRAY' ) {
1457     return
1458       map { $self->_resolve_prefetch( $_, $alias, $alias_map, $order, $collapse, [ @$pref_path ] ) }
1459         @$pre;
1460   }
1461   elsif( ref $pre eq 'HASH' ) {
1462     my @ret =
1463     map {
1464       $self->_resolve_prefetch($_, $alias, $alias_map, $order, $collapse, [ @$pref_path ] ),
1465       $self->related_source($_)->_resolve_prefetch(
1466                $pre->{$_}, "${alias}.$_", $alias_map, $order, $collapse, [ @$pref_path, $_] )
1467     } keys %$pre;
1468     return @ret;
1469   }
1470   elsif( ref $pre ) {
1471     $self->throw_exception(
1472       "don't know how to resolve prefetch reftype ".ref($pre));
1473   }
1474   else {
1475     my $p = $alias_map;
1476     $p = $p->{$_} for (@$pref_path, $pre);
1477
1478     $self->throw_exception (
1479       "Unable to resolve prefetch '$pre' - join alias map does not contain an entry for path: "
1480       . join (' -> ', @$pref_path, $pre)
1481     ) if (ref $p->{-join_aliases} ne 'ARRAY' or not @{$p->{-join_aliases}} );
1482
1483     my $as = shift @{$p->{-join_aliases}};
1484
1485     my $rel_info = $self->relationship_info( $pre );
1486     $self->throw_exception( $self->name . " has no such relationship '$pre'" )
1487       unless $rel_info;
1488     my $as_prefix = ($alias =~ /^.*?\.(.+)$/ ? $1.'.' : '');
1489     my $rel_source = $self->related_source($pre);
1490
1491     if (exists $rel_info->{attrs}{accessor}
1492          && $rel_info->{attrs}{accessor} eq 'multi') {
1493       $self->throw_exception(
1494         "Can't prefetch has_many ${pre} (join cond too complex)")
1495         unless ref($rel_info->{cond}) eq 'HASH';
1496       my $dots = @{[$as_prefix =~ m/\./g]} + 1; # +1 to match the ".${as_prefix}"
1497       if (my ($fail) = grep { @{[$_ =~ m/\./g]} == $dots }
1498                          keys %{$collapse}) {
1499         my ($last) = ($fail =~ /([^\.]+)$/);
1500         carp (
1501           "Prefetching multiple has_many rels ${last} and ${pre} "
1502           .(length($as_prefix)
1503             ? "at the same level (${as_prefix}) "
1504             : "at top level "
1505           )
1506           . 'will explode the number of row objects retrievable via ->next or ->all. '
1507           . 'Use at your own risk.'
1508         );
1509       }
1510       #my @col = map { (/^self\.(.+)$/ ? ("${as_prefix}.$1") : ()); }
1511       #              values %{$rel_info->{cond}};
1512       $collapse->{".${as_prefix}${pre}"} = [ $rel_source->primary_columns ];
1513         # action at a distance. prepending the '.' allows simpler code
1514         # in ResultSet->_collapse_result
1515       my @key = map { (/^foreign\.(.+)$/ ? ($1) : ()); }
1516                     keys %{$rel_info->{cond}};
1517       my @ord = (ref($rel_info->{attrs}{order_by}) eq 'ARRAY'
1518                    ? @{$rel_info->{attrs}{order_by}}
1519                    : (defined $rel_info->{attrs}{order_by}
1520                        ? ($rel_info->{attrs}{order_by})
1521                        : ()));
1522       push(@$order, map { "${as}.$_" } (@key, @ord));
1523     }
1524
1525     return map { [ "${as}.$_", "${as_prefix}${pre}.$_", ] }
1526       $rel_source->columns;
1527   }
1528 }
1529
1530 =head2 related_source
1531
1532 =over 4
1533
1534 =item Arguments: $relname
1535
1536 =item Return value: $source
1537
1538 =back
1539
1540 Returns the result source object for the given relationship.
1541
1542 =cut
1543
1544 sub related_source {
1545   my ($self, $rel) = @_;
1546   if( !$self->has_relationship( $rel ) ) {
1547     $self->throw_exception("No such relationship '$rel'");
1548   }
1549   return $self->schema->source($self->relationship_info($rel)->{source});
1550 }
1551
1552 =head2 related_class
1553
1554 =over 4
1555
1556 =item Arguments: $relname
1557
1558 =item Return value: $classname
1559
1560 =back
1561
1562 Returns the class name for objects in the given relationship.
1563
1564 =cut
1565
1566 sub related_class {
1567   my ($self, $rel) = @_;
1568   if( !$self->has_relationship( $rel ) ) {
1569     $self->throw_exception("No such relationship '$rel'");
1570   }
1571   return $self->schema->class($self->relationship_info($rel)->{source});
1572 }
1573
1574 =head2 handle
1575
1576 Obtain a new handle to this source. Returns an instance of a 
1577 L<DBIx::Class::ResultSourceHandle>.
1578
1579 =cut
1580
1581 sub handle {
1582     return new DBIx::Class::ResultSourceHandle({
1583         schema         => $_[0]->schema,
1584         source_moniker => $_[0]->source_name
1585     });
1586 }
1587
1588 =head2 throw_exception
1589
1590 See L<DBIx::Class::Schema/"throw_exception">.
1591
1592 =cut
1593
1594 sub throw_exception {
1595   my $self = shift;
1596
1597   if (defined $self->schema) {
1598     $self->schema->throw_exception(@_);
1599   }
1600   else {
1601     DBIx::Class::Exception->throw(@_);
1602   }
1603 }
1604
1605 =head2 source_info
1606
1607 Stores a hashref of per-source metadata.  No specific key names
1608 have yet been standardized, the examples below are purely hypothetical
1609 and don't actually accomplish anything on their own:
1610
1611   __PACKAGE__->source_info({
1612     "_tablespace" => 'fast_disk_array_3',
1613     "_engine" => 'InnoDB',
1614   });
1615
1616 =head2 new
1617
1618   $class->new();
1619
1620   $class->new({attribute_name => value});
1621
1622 Creates a new ResultSource object.  Not normally called directly by end users.
1623
1624 =head2 column_info_from_storage
1625
1626 =over
1627
1628 =item Arguments: 1/0 (default: 0)
1629
1630 =item Return value: 1/0
1631
1632 =back
1633
1634   __PACKAGE__->column_info_from_storage(1);
1635
1636 Enables the on-demand automatic loading of the above column
1637 metadata from storage as neccesary.  This is *deprecated*, and
1638 should not be used.  It will be removed before 1.0.
1639
1640
1641 =head1 AUTHORS
1642
1643 Matt S. Trout <mst@shadowcatsystems.co.uk>
1644
1645 =head1 LICENSE
1646
1647 You may distribute this code under the same terms as Perl itself.
1648
1649 =cut
1650
1651 1;