1 package DBIx::Class::ResultSource;
6 use base qw/DBIx::Class/;
8 use DBIx::Class::ResultSet;
9 use DBIx::Class::ResultSourceHandle;
11 use DBIx::Class::Exception;
12 use Carp::Clan qw/^DBIx::Class/;
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/);
19 __PACKAGE__->mk_group_accessors('component_class' => qw/resultset_class
24 DBIx::Class::ResultSource - Result source object
28 # Create a table based result source, in a result class.
30 package MyDB::Schema::Result::Artist;
31 use base qw/DBIx::Class::Core/;
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');
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/;
44 __PACKAGE__->load_components('InflateColumn::DateTime');
45 __PACKAGE__->table_class('DBIx::Class::ResultSource::View');
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'"
56 A ResultSource is an object that represents a source of data for querying.
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.
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.
70 Result sources representing select queries, or views, can also be
71 created, see L<DBIx::Class::ResultSource::View> for full details.
73 =head2 Finding result source objects
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>.
78 You can retrieve the result source at runtime in the following ways:
82 =item From a Schema object:
84 $schema->source($source_name);
86 =item From a Row object:
90 =item From a ResultSet object:
103 my ($class, $attrs) = @_;
104 $class = ref $class if ref $class;
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";
124 =item Arguments: @columns
126 =item Return value: The ResultSource object
130 $source->add_columns(qw/col1 col2 col3/);
132 $source->add_columns('col1' => \%col1_info, 'col2' => \%col2_info, ...);
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.
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.
142 The contents of the column_info are not set in stone. The following
143 keys are currently recognised/used by DBIx::Class:
149 { accessor => '_name' }
151 # example use, replace standard accessor with one of your own:
153 my ($self, $value) = @_;
155 die "Name cannot contain digits!" if($value =~ /\d/);
156 $self->_name($value);
158 return $self->_name();
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.
166 { data_type => 'integer' }
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.
172 Currently there is no standard set of values for the data_type. Use
173 whatever your database supports.
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>.
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>.
191 =item is_auto_increment
193 { is_auto_increment => 1 }
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>.
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>
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.
217 { is_foreign_key => 1 }
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>.
225 { default_value => \'now()' }
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>.
233 See the note on L<DBIx::Class::Row/new> for more information about possible
234 issues related to db-side default values.
238 { sequence => 'my_table_seq' }
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
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.
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
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>.
271 =item Arguments: $colname, \%columninfo?
273 =item Return value: 1/0 (true/false)
277 $source->add_column('col' => \%info);
279 Add a single column and optional column info. Uses the same column
280 info keys as L</add_columns>.
285 my ($self, @cols) = @_;
286 $self->_ordered_columns(\@cols) unless $self->_ordered_columns;
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;
297 push @{ $self->_ordered_columns }, @added;
301 sub add_column { shift->add_columns(@_); } # DO NOT CHANGE THIS TO GLOB
307 =item Arguments: $colname
309 =item Return value: 1/0 (true/false)
313 if ($source->has_column($colname)) { ... }
315 Returns true if the source has a column of this name, false otherwise.
320 my ($self, $column) = @_;
321 return exists $self->_columns->{$column};
328 =item Arguments: $colname
330 =item Return value: Hashref of info
334 my $info = $source->column_info($col);
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.
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 )
352 $self->{_columns_info_loaded}++;
355 # eval for the case of storage without table
356 eval { $info = $self->storage->columns_info_for( $self->from ) };
358 for my $realcol ( keys %{$info} ) {
359 $lc_info->{lc $realcol} = $info->{$realcol};
361 foreach my $col ( keys %{$self->_columns} ) {
362 $self->_columns->{$col} = {
363 %{ $self->_columns->{$col} },
364 %{ $info->{$col} || $lc_info->{lc $col} || {} }
369 return $self->_columns->{$column};
376 =item Arguments: None
378 =item Return value: Ordered list of column names
382 my @column_names = $source->columns;
384 Returns all column names in the order they were declared to L</add_columns>.
390 $self->throw_exception(
391 "columns() is a read-only accessor, did you mean add_columns()?"
393 return @{$self->{_ordered_columns}||[]};
396 =head2 remove_columns
400 =item Arguments: @colnames
402 =item Return value: undefined
406 $source->remove_columns(qw/col1 col2 col3/);
408 Removes the given list of columns by name, from the result source.
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.
418 =item Arguments: $colname
420 =item Return value: undefined
424 $source->remove_column('col');
426 Remove a single column by name from the result source, similar to
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.
436 my ($self, @to_remove) = @_;
438 my $columns = $self->_columns
443 delete $columns->{$_};
447 $self->_ordered_columns([ grep { not $to_remove{$_} } @{$self->_ordered_columns} ]);
450 sub remove_column { shift->remove_columns(@_); } # DO NOT CHANGE THIS TO GLOB
452 =head2 set_primary_key
456 =item Arguments: @cols
458 =item Return value: undefined
462 Defines one or more columns as primary key for this source. Must be
463 called after L</add_columns>.
465 Additionally, defines a L<unique constraint|add_unique_constraint>
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>.
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);
482 $self->_primaries(\@cols);
484 $self->add_unique_constraint(primary => \@cols);
487 =head2 primary_columns
491 =item Arguments: None
493 =item Return value: Ordered list of primary column names
497 Read-only accessor which returns the list of primary keys, supplied by
502 sub primary_columns {
503 return @{shift->_primaries||[]};
508 my @pcols = $self->primary_columns
509 or $self->throw_exception (sprintf(
510 'Operation requires a primary key to be declared on %s via set_primary_key',
516 =head2 add_unique_constraint
520 =item Arguments: $name?, \@colnames
522 =item Return value: undefined
526 Declare a unique constraint on this source. Call once for each unique
529 # For UNIQUE (column1, column2)
530 __PACKAGE__->add_unique_constraint(
531 constraint_name => [ qw/column1 column2/ ],
534 Alternatively, you can specify only the columns:
536 __PACKAGE__->add_unique_constraint([ qw/column1 column2/ ]);
538 This will result in a unique constraint named
539 C<table_column1_column2>, where C<table> is replaced with the table
542 Unique constraints are used, for example, when you pass the constraint
543 name as the C<key> attribute to L<DBIx::Class::ResultSet/find>. Then
544 only columns in the constraint are searched.
546 Throws an error if any of the given column names do not yet exist on
551 sub add_unique_constraint {
556 $name ||= $self->name_unique_constraint($cols);
558 foreach my $col (@$cols) {
559 $self->throw_exception("No such column $col on table " . $self->name)
560 unless $self->has_column($col);
563 my %unique_constraints = $self->unique_constraints;
564 $unique_constraints{$name} = $cols;
565 $self->_unique_constraints(\%unique_constraints);
568 =head2 name_unique_constraint
572 =item Arguments: @colnames
574 =item Return value: Constraint name
578 $source->table('mytable');
579 $source->name_unique_constraint('col1', 'col2');
583 Return a name for a unique constraint containing the specified
584 columns. The name is created by joining the table name and each column
585 name, using an underscore character.
587 For example, a constraint on a table named C<cd> containing the columns
588 C<artist> and C<title> would result in a constraint name of C<cd_artist_title>.
590 This is used by L</add_unique_constraint> if you do not specify the
591 optional constraint name.
595 sub name_unique_constraint {
596 my ($self, $cols) = @_;
598 my $name = $self->name;
599 $name = $$name if (ref $name eq 'SCALAR');
601 return join '_', $name, @$cols;
604 =head2 unique_constraints
608 =item Arguments: None
610 =item Return value: Hash of unique constraint data
614 $source->unique_constraints();
616 Read-only accessor which returns a hash of unique constraints on this
619 The hash is keyed by constraint name, and contains an arrayref of
620 column names as values.
624 sub unique_constraints {
625 return %{shift->_unique_constraints||{}};
628 =head2 unique_constraint_names
632 =item Arguments: None
634 =item Return value: Unique constraint names
638 $source->unique_constraint_names();
640 Returns the list of unique constraint names defined on this source.
644 sub unique_constraint_names {
647 my %unique_constraints = $self->unique_constraints;
649 return keys %unique_constraints;
652 =head2 unique_constraint_columns
656 =item Arguments: $constraintname
658 =item Return value: List of constraint columns
662 $source->unique_constraint_columns('myconstraint');
664 Returns the list of columns that make up the specified unique constraint.
668 sub unique_constraint_columns {
669 my ($self, $constraint_name) = @_;
671 my %unique_constraints = $self->unique_constraints;
673 $self->throw_exception(
674 "Unknown unique constraint $constraint_name on '" . $self->name . "'"
675 ) unless exists $unique_constraints{$constraint_name};
677 return @{ $unique_constraints{$constraint_name} };
680 =head2 sqlt_deploy_callback
684 =item Arguments: $callback
688 __PACKAGE__->sqlt_deploy_callback('mycallbackmethod');
690 An accessor to set a callback to be called during deployment of
691 the schema via L<DBIx::Class::Schema/create_ddl_dir> or
692 L<DBIx::Class::Schema/deploy>.
694 The callback can be set as either a code reference or the name of a
695 method in the current result class.
697 If not set, the L</default_sqlt_deploy_hook> is called.
699 Your callback will be passed the $source object representing the
700 ResultSource instance being deployed, and the
701 L<SQL::Translator::Schema::Table> object being created from it. The
702 callback can be used to manipulate the table object or add your own
703 customised indexes. If you need to manipulate a non-table object, use
704 the L<DBIx::Class::Schema/sqlt_deploy_hook>.
706 See L<DBIx::Class::Manual::Cookbook/Adding Indexes And Functions To
707 Your SQL> for examples.
709 This sqlt deployment callback can only be used to manipulate
710 SQL::Translator objects as they get turned into SQL. To execute
711 post-deploy statements which SQL::Translator does not currently
712 handle, override L<DBIx::Class::Schema/deploy> in your Schema class
713 and call L<dbh_do|DBIx::Class::Storage::DBI/dbh_do>.
715 =head2 default_sqlt_deploy_hook
719 =item Arguments: $source, $sqlt_table
721 =item Return value: undefined
725 This is the sensible default for L</sqlt_deploy_callback>.
727 If a method named C<sqlt_deploy_hook> exists in your Result class, it
728 will be called and passed the current C<$source> and the
729 C<$sqlt_table> being deployed.
733 sub default_sqlt_deploy_hook {
736 my $class = $self->result_class;
738 if ($class and $class->can('sqlt_deploy_hook')) {
739 $class->sqlt_deploy_hook(@_);
743 sub _invoke_sqlt_deploy_hook {
745 if ( my $hook = $self->sqlt_deploy_callback) {
754 =item Arguments: None
756 =item Return value: $resultset
760 Returns a resultset for the given source. This will initially be created
763 $self->resultset_class->new($self, $self->resultset_attributes)
765 but is cached from then on unless resultset_class changes.
767 =head2 resultset_class
771 =item Arguments: $classname
773 =item Return value: $classname
777 package My::Schema::ResultSet::Artist;
778 use base 'DBIx::Class::ResultSet';
781 # In the result class
782 __PACKAGE__->resultset_class('My::Schema::ResultSet::Artist');
785 $source->resultset_class('My::Schema::ResultSet::Artist');
787 Set the class of the resultset. This is useful if you want to create your
788 own resultset methods. Create your own class derived from
789 L<DBIx::Class::ResultSet>, and set it here. If called with no arguments,
790 this method returns the name of the existing resultset class, if one
793 =head2 resultset_attributes
797 =item Arguments: \%attrs
799 =item Return value: \%attrs
803 # In the result class
804 __PACKAGE__->resultset_attributes({ order_by => [ 'id' ] });
807 $source->resultset_attributes({ order_by => [ 'id' ] });
809 Store a collection of resultset attributes, that will be set on every
810 L<DBIx::Class::ResultSet> produced from this result source. For a full
811 list see L<DBIx::Class::ResultSet/ATTRIBUTES>.
817 $self->throw_exception(
818 'resultset does not take any arguments. If you want another resultset, '.
819 'call it on the schema instead.'
822 return $self->resultset_class->new(
825 %{$self->{resultset_attributes}},
826 %{$self->schema->default_resultset_attributes}
835 =item Arguments: $source_name
837 =item Result value: $source_name
841 Set an alternate name for the result source when it is loaded into a schema.
842 This is useful if you want to refer to a result source by a name other than
845 package ArchivedBooks;
846 use base qw/DBIx::Class/;
847 __PACKAGE__->table('books_archive');
848 __PACKAGE__->source_name('Books');
850 # from your schema...
851 $schema->resultset('Books')->find(1);
857 =item Arguments: None
859 =item Return value: FROM clause
863 my $from_clause = $source->from();
865 Returns an expression of the source to be supplied to storage to specify
866 retrieval from this source. In the case of a database, the required FROM
873 =item Arguments: None
875 =item Return value: A schema object
879 my $schema = $source->schema();
881 Returns the L<DBIx::Class::Schema> object that this result source
888 =item Arguments: None
890 =item Return value: A Storage object
894 $source->storage->debug(1);
896 Returns the storage handle for the current schema.
898 See also: L<DBIx::Class::Storage>
902 sub storage { shift->schema->storage; }
904 =head2 add_relationship
908 =item Arguments: $relname, $related_source_name, \%cond, [ \%attrs ]
910 =item Return value: 1/true if it succeeded
914 $source->add_relationship('relname', 'related_source', $cond, $attrs);
916 L<DBIx::Class::Relationship> describes a series of methods which
917 create pre-defined useful types of relationships. Look there first
918 before using this method directly.
920 The relationship name can be arbitrary, but must be unique for each
921 relationship attached to this result source. 'related_source' should
922 be the name with which the related result source was registered with
923 the current schema. For example:
925 $schema->source('Book')->add_relationship('reviews', 'Review', {
926 'foreign.book_id' => 'self.id',
929 The condition C<$cond> needs to be an L<SQL::Abstract>-style
930 representation of the join between the tables. For example, if you're
931 creating a relation from Author to Book,
933 { 'foreign.author_id' => 'self.id' }
935 will result in the JOIN clause
937 author me JOIN book foreign ON foreign.author_id = me.id
939 You can specify as many foreign => self mappings as necessary.
941 Valid attributes are as follows:
947 Explicitly specifies the type of join to use in the relationship. Any
948 SQL join type is valid, e.g. C<LEFT> or C<RIGHT>. It will be placed in
949 the SQL command immediately before C<JOIN>.
953 An arrayref containing a list of accessors in the foreign class to proxy in
954 the main class. If, for example, you do the following:
956 CD->might_have(liner_notes => 'LinerNotes', undef, {
957 proxy => [ qw/notes/ ],
960 Then, assuming LinerNotes has an accessor named notes, you can do:
962 my $cd = CD->find(1);
963 # set notes -- LinerNotes object is created if it doesn't exist
964 $cd->notes('Notes go here');
968 Specifies the type of accessor that should be created for the
969 relationship. Valid values are C<single> (for when there is only a single
970 related object), C<multi> (when there can be many), and C<filter> (for
971 when there is a single related object, but you also want the relationship
972 accessor to double as a column accessor). For C<multi> accessors, an
973 add_to_* method is also created, which calls C<create_related> for the
978 Throws an exception if the condition is improperly supplied, or cannot
983 sub add_relationship {
984 my ($self, $rel, $f_source_name, $cond, $attrs) = @_;
985 $self->throw_exception("Can't create relationship without join condition")
989 # Check foreign and self are right in cond
990 if ( (ref $cond ||'') eq 'HASH') {
992 $self->throw_exception("Keys of condition should be of form 'foreign.col', not '$_'")
993 if /\./ && !/^foreign\./;
997 my %rels = %{ $self->_relationships };
998 $rels{$rel} = { class => $f_source_name,
999 source => $f_source_name,
1002 $self->_relationships(\%rels);
1006 # XXX disabled. doesn't work properly currently. skip in tests.
1008 my $f_source = $self->schema->source($f_source_name);
1009 unless ($f_source) {
1010 $self->ensure_class_loaded($f_source_name);
1011 $f_source = $f_source_name->result_source;
1012 #my $s_class = ref($self->schema);
1013 #$f_source_name =~ m/^${s_class}::(.*)$/;
1014 #$self->schema->register_class(($1 || $f_source_name), $f_source_name);
1015 #$f_source = $self->schema->source($f_source_name);
1017 return unless $f_source; # Can't test rel without f_source
1019 eval { $self->_resolve_join($rel, 'me', {}, []) };
1021 if ($@) { # If the resolve failed, back out and re-throw the error
1022 delete $rels{$rel}; #
1023 $self->_relationships(\%rels);
1024 $self->throw_exception("Error creating relationship $rel: $@");
1029 =head2 relationships
1033 =item Arguments: None
1035 =item Return value: List of relationship names
1039 my @relnames = $source->relationships();
1041 Returns all relationship names for this source.
1046 return keys %{shift->_relationships};
1049 =head2 relationship_info
1053 =item Arguments: $relname
1055 =item Return value: Hashref of relation data,
1059 Returns a hash of relationship information for the specified relationship
1060 name. The keys/values are as specified for L</add_relationship>.
1064 sub relationship_info {
1065 my ($self, $rel) = @_;
1066 return $self->_relationships->{$rel};
1069 =head2 has_relationship
1073 =item Arguments: $rel
1075 =item Return value: 1/0 (true/false)
1079 Returns true if the source has a relationship of this name, false otherwise.
1083 sub has_relationship {
1084 my ($self, $rel) = @_;
1085 return exists $self->_relationships->{$rel};
1088 =head2 reverse_relationship_info
1092 =item Arguments: $relname
1094 =item Return value: Hashref of relationship data
1098 Looks through all the relationships on the source this relationship
1099 points to, looking for one whose condition is the reverse of the
1100 condition on this relationship.
1102 A common use of this is to find the name of the C<belongs_to> relation
1103 opposing a C<has_many> relation. For definition of these look in
1104 L<DBIx::Class::Relationship>.
1106 The returned hashref is keyed by the name of the opposing
1107 relationship, and contains its data in the same manner as
1108 L</relationship_info>.
1112 sub reverse_relationship_info {
1113 my ($self, $rel) = @_;
1114 my $rel_info = $self->relationship_info($rel);
1117 return $ret unless ((ref $rel_info->{cond}) eq 'HASH');
1119 my @cond = keys(%{$rel_info->{cond}});
1120 my @refkeys = map {/^\w+\.(\w+)$/} @cond;
1121 my @keys = map {$rel_info->{cond}->{$_} =~ /^\w+\.(\w+)$/} @cond;
1123 # Get the related result source for this relationship
1124 my $othertable = $self->related_source($rel);
1126 # Get all the relationships for that source that related to this source
1127 # whose foreign column set are our self columns on $rel and whose self
1128 # columns are our foreign columns on $rel.
1129 my @otherrels = $othertable->relationships();
1130 my $otherrelationship;
1131 foreach my $otherrel (@otherrels) {
1132 my $otherrel_info = $othertable->relationship_info($otherrel);
1134 my $back = $othertable->related_source($otherrel);
1135 next unless $back->source_name eq $self->source_name;
1139 if (ref $otherrel_info->{cond} eq 'HASH') {
1140 @othertestconds = ($otherrel_info->{cond});
1142 elsif (ref $otherrel_info->{cond} eq 'ARRAY') {
1143 @othertestconds = @{$otherrel_info->{cond}};
1149 foreach my $othercond (@othertestconds) {
1150 my @other_cond = keys(%$othercond);
1151 my @other_refkeys = map {/^\w+\.(\w+)$/} @other_cond;
1152 my @other_keys = map {$othercond->{$_} =~ /^\w+\.(\w+)$/} @other_cond;
1153 next if (!$self->_compare_relationship_keys(\@refkeys, \@other_keys) ||
1154 !$self->_compare_relationship_keys(\@other_refkeys, \@keys));
1155 $ret->{$otherrel} = $otherrel_info;
1161 sub compare_relationship_keys {
1162 carp 'compare_relationship_keys is a private method, stop calling it';
1164 $self->_compare_relationship_keys (@_);
1167 # Returns true if both sets of keynames are the same, false otherwise.
1168 sub _compare_relationship_keys {
1169 my ($self, $keys1, $keys2) = @_;
1171 # Make sure every keys1 is in keys2
1173 foreach my $key (@$keys1) {
1175 foreach my $prim (@$keys2) {
1176 if ($prim eq $key) {
1184 # Make sure every key2 is in key1
1186 foreach my $prim (@$keys2) {
1188 foreach my $key (@$keys1) {
1189 if ($prim eq $key) {
1201 # Returns the {from} structure used to express JOIN conditions
1203 my ($self, $join, $alias, $seen, $jpath, $parent_force_left) = @_;
1205 # we need a supplied one, because we do in-place modifications, no returns
1206 $self->throw_exception ('You must supply a seen hashref as the 3rd argument to _resolve_join')
1207 unless ref $seen eq 'HASH';
1209 $self->throw_exception ('You must supply a joinpath arrayref as the 4th argument to _resolve_join')
1210 unless ref $jpath eq 'ARRAY';
1212 $jpath = [@$jpath]; # copy
1214 if (not defined $join) {
1217 elsif (ref $join eq 'ARRAY') {
1220 $self->_resolve_join($_, $alias, $seen, $jpath, $parent_force_left);
1223 elsif (ref $join eq 'HASH') {
1226 for my $rel (keys %$join) {
1228 my $rel_info = $self->relationship_info($rel)
1229 or $self->throw_exception("No such relationship ${rel}");
1231 my $force_left = $parent_force_left;
1232 $force_left ||= lc($rel_info->{attrs}{join_type}||'') eq 'left';
1234 # the actual seen value will be incremented by the recursion
1235 my $as = $self->storage->relname_to_table_alias(
1236 $rel, ($seen->{$rel} && $seen->{$rel} + 1)
1240 $self->_resolve_join($rel, $alias, $seen, [@$jpath], $force_left),
1241 $self->related_source($rel)->_resolve_join(
1242 $join->{$rel}, $as, $seen, [@$jpath, { $rel => $as }], $force_left
1250 $self->throw_exception("No idea how to resolve join reftype ".ref $join);
1253 my $count = ++$seen->{$join};
1254 my $as = $self->storage->relname_to_table_alias(
1255 $join, ($count > 1 && $count)
1258 my $rel_info = $self->relationship_info($join)
1259 or $self->throw_exception("No such relationship ${join}");
1261 my $rel_src = $self->related_source($join);
1262 return [ { $as => $rel_src->from,
1263 -source_handle => $rel_src->handle,
1264 -join_type => $parent_force_left
1266 : $rel_info->{attrs}{join_type}
1268 -join_path => [@$jpath, { $join => $as } ],
1270 $rel_info->{attrs}{accessor}
1272 List::Util::first { $rel_info->{attrs}{accessor} eq $_ } (qw/single filter/)
1275 -relation_chain_depth => $seen->{-relation_chain_depth} || 0,
1277 $self->_resolve_condition($rel_info->{cond}, $as, $alias) ];
1282 carp 'pk_depends_on is a private method, stop calling it';
1284 $self->_pk_depends_on (@_);
1287 # Determines whether a relation is dependent on an object from this source
1288 # having already been inserted. Takes the name of the relationship and a
1289 # hashref of columns of the related object.
1290 sub _pk_depends_on {
1291 my ($self, $relname, $rel_data) = @_;
1293 my $relinfo = $self->relationship_info($relname);
1295 # don't assume things if the relationship direction is specified
1296 return $relinfo->{attrs}{is_foreign_key_constraint}
1297 if exists ($relinfo->{attrs}{is_foreign_key_constraint});
1299 my $cond = $relinfo->{cond};
1300 return 0 unless ref($cond) eq 'HASH';
1302 # map { foreign.foo => 'self.bar' } to { bar => 'foo' }
1303 my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond };
1305 # assume anything that references our PK probably is dependent on us
1306 # rather than vice versa, unless the far side is (a) defined or (b)
1308 my $rel_source = $self->related_source($relname);
1310 foreach my $p ($self->primary_columns) {
1311 if (exists $keyhash->{$p}) {
1312 unless (defined($rel_data->{$keyhash->{$p}})
1313 || $rel_source->column_info($keyhash->{$p})
1314 ->{is_auto_increment}) {
1323 sub resolve_condition {
1324 carp 'resolve_condition is a private method, stop calling it';
1326 $self->_resolve_condition (@_);
1329 # Resolves the passed condition to a concrete query fragment. If given an alias,
1330 # returns a join condition; if given an object, inverts that object to produce
1331 # a related conditional from that object.
1332 our $UNRESOLVABLE_CONDITION = \ '1 = 0';
1334 sub _resolve_condition {
1335 my ($self, $cond, $as, $for) = @_;
1336 if (ref $cond eq 'HASH') {
1338 foreach my $k (keys %{$cond}) {
1339 my $v = $cond->{$k};
1340 # XXX should probably check these are valid columns
1341 $k =~ s/^foreign\.// ||
1342 $self->throw_exception("Invalid rel cond key ${k}");
1343 $v =~ s/^self\.// ||
1344 $self->throw_exception("Invalid rel cond val ${v}");
1345 if (ref $for) { # Object
1346 #warn "$self $k $for $v";
1347 unless ($for->has_column_loaded($v)) {
1348 if ($for->in_storage) {
1349 $self->throw_exception(sprintf
1350 "Unable to resolve relationship '%s' from object %s: column '%s' not "
1351 . 'loaded from storage (or not passed to new() prior to insert()). You '
1352 . 'probably need to call ->discard_changes to get the server-side defaults '
1353 . 'from the database.',
1359 return $UNRESOLVABLE_CONDITION;
1361 $ret{$k} = $for->get_column($v);
1362 #$ret{$k} = $for->get_column($v) if $for->has_column_loaded($v);
1364 } elsif (!defined $for) { # undef, i.e. "no object"
1366 } elsif (ref $as eq 'HASH') { # reverse hashref
1367 $ret{$v} = $as->{$k};
1368 } elsif (ref $as) { # reverse object
1369 $ret{$v} = $as->get_column($k);
1370 } elsif (!defined $as) { # undef, i.e. "no reverse object"
1373 $ret{"${as}.${k}"} = "${for}.${v}";
1377 } elsif (ref $cond eq 'ARRAY') {
1378 return [ map { $self->_resolve_condition($_, $as, $for) } @$cond ];
1380 die("Can't handle condition $cond yet :(");
1385 # Accepts one or more relationships for the current source and returns an
1386 # array of column names for each of those relationships. Column names are
1387 # prefixed relative to the current source, in accordance with where they appear
1388 # in the supplied relationships.
1390 sub _resolve_prefetch {
1391 my ($self, $pre, $alias, $alias_map, $order, $pref_path) = @_;
1394 if (not defined $pre) {
1397 elsif( ref $pre eq 'ARRAY' ) {
1399 map { $self->_resolve_prefetch( $_, $alias, $alias_map, $order, [ @$pref_path ] ) }
1402 elsif( ref $pre eq 'HASH' ) {
1405 $self->_resolve_prefetch($_, $alias, $alias_map, $order, [ @$pref_path ] ),
1406 $self->related_source($_)->_resolve_prefetch(
1407 $pre->{$_}, "${alias}.$_", $alias_map, $order, [ @$pref_path, $_] )
1412 $self->throw_exception(
1413 "don't know how to resolve prefetch reftype ".ref($pre));
1417 $p = $p->{$_} for (@$pref_path, $pre);
1419 $self->throw_exception (
1420 "Unable to resolve prefetch '$pre' - join alias map does not contain an entry for path: "
1421 . join (' -> ', @$pref_path, $pre)
1422 ) if (ref $p->{-join_aliases} ne 'ARRAY' or not @{$p->{-join_aliases}} );
1424 my $as = shift @{$p->{-join_aliases}};
1426 my $rel_info = $self->relationship_info( $pre );
1427 $self->throw_exception( $self->name . " has no such relationship '$pre'" )
1429 my $as_prefix = ($alias =~ /^.*?\.(.+)$/ ? $1.'.' : '');
1430 my $rel_source = $self->related_source($pre);
1432 if ($rel_info->{attrs}{accessor} && $rel_info->{attrs}{accessor} eq 'multi') {
1433 $self->throw_exception(
1434 "Can't prefetch has_many ${pre} (join cond too complex)")
1435 unless ref($rel_info->{cond}) eq 'HASH';
1436 my $dots = @{[$as_prefix =~ m/\./g]} + 1; # +1 to match the ".${as_prefix}"
1438 #my @col = map { (/^self\.(.+)$/ ? ("${as_prefix}.$1") : ()); }
1439 # values %{$rel_info->{cond}};
1440 my @key = map { (/^foreign\.(.+)$/ ? ($1) : ()); }
1441 keys %{$rel_info->{cond}};
1442 my @ord = (ref($rel_info->{attrs}{order_by}) eq 'ARRAY'
1443 ? @{$rel_info->{attrs}{order_by}}
1445 : (defined $rel_info->{attrs}{order_by}
1446 ? ($rel_info->{attrs}{order_by})
1449 push(@$order, map { "${as}.$_" } (@key, @ord));
1452 return map { [ "${as}.$_", "${as_prefix}${pre}.$_", ] }
1453 $rel_source->columns;
1457 # Takes a selection list and generates a collapse-map representing
1458 # row-object fold-points. Every relationship is assigned a set of unique,
1459 # non-nullable columns (which may *not even be* from the same resultset)
1460 # and the collapser will use this information to correctly distinguish
1461 # data of individual to-be-row-objects.
1462 sub _resolve_collapse {
1463 my ($self, $as, $as_fq_idx, $rel_chain, $parent_info) = @_;
1465 # for comprehensible error messages put ourselves at the head of the relationship chain
1466 $rel_chain ||= [ $self->source_name ];
1468 # record top-level fully-qualified column index
1469 $as_fq_idx ||= { %$as };
1471 my ($my_cols, $rel_cols);
1473 if ($_ =~ /^ ([^\.]+) \. (.+) /x) {
1474 $rel_cols->{$1}{$2} = 1;
1477 $my_cols->{$_} = {}; # important for ||= below
1482 # run through relationships, collect metadata, inject non-left fk-bridges from
1483 # *INNER-JOINED* children (if any)
1484 for my $rel (keys %$rel_cols) {
1485 my $rel_src = $self->related_source ($rel);
1486 my $inf = $self->relationship_info ($rel);
1488 $relinfo->{$rel}{is_single} = $inf->{attrs}{accessor} && $inf->{attrs}{accessor} ne 'multi';
1489 $relinfo->{$rel}{is_inner} = ( $inf->{attrs}{join_type} || '' ) !~ /^left/i;
1490 $relinfo->{$rel}{rsrc} = $rel_src;
1492 my $cond = $inf->{cond};
1499 ! List::Util::first { $_ !~ /^foreign\./ } (keys %$cond)
1501 ! List::Util::first { $_ !~ /^self\./ } (values %$cond)
1503 for my $f (keys %$cond) {
1504 my $s = $cond->{$f};
1505 $_ =~ s/^ (?: foreign | self ) \.//x for ($f, $s);
1506 $relinfo->{$rel}{fk_map}{$s} = $f;
1508 $my_cols->{$s} ||= { via_fk => "$rel.$f" } # need to know source from *our* pov
1509 if ($relinfo->{$rel}{is_inner} && defined $rel_cols->{$rel}{$f}); # only if it is inner and in fact selected of course
1514 # if the parent is already defined, assume all of its related FKs are selected
1515 # (even if they in fact are NOT in the select list). Keep a record of what we
1516 # assumed, and if any such phantom-column becomes part of our own collapser,
1517 # throw everything assumed-from-parent away and replace with the collapser of
1518 # the parent (whatever it may be)
1519 my $assumed_from_parent;
1520 unless ($parent_info->{underdefined}) {
1521 $assumed_from_parent->{columns} = { map
1522 # only add to the list if we do not already select said columns
1523 { ! exists $my_cols->{$_} ? ( $_ => 1 ) : () }
1524 values %{$parent_info->{rel_condition} || {}}
1527 $my_cols->{$_} = { via_collapse => $parent_info->{collapse_on} }
1528 for keys %{$assumed_from_parent->{columns}};
1531 # get colinfo for everything
1533 $my_cols->{$_}{colinfo} = (
1534 $self->has_column ($_) ? $self->column_info ($_) : undef
1535 ) for keys %$my_cols;
1540 # try to resolve based on our columns (plus already inserted FK bridges)
1544 my $uset = $self->_unique_column_set ($my_cols)
1546 # see if the resulting collapser relies on any implied columns,
1547 # and fix stuff up if this is the case
1549 my $parent_collapser_used;
1551 if (List::Util::first
1552 { exists $assumed_from_parent->{columns}{$_} }
1555 # remove implied stuff from the uset, we will inject the equivalent collapser a bit below
1556 delete @{$uset}{keys %{$assumed_from_parent->{columns}}};
1557 $parent_collapser_used = 1;
1560 $collapse_map->{-collapse_on} = {
1561 %{ $parent_collapser_used ? $parent_info->{collapse_on} : {} },
1564 my $fqc = join ('.',
1565 @{$rel_chain}[1 .. $#$rel_chain],
1566 ( $my_cols->{$_}{via_fk} || $_ ),
1569 $fqc => $as_fq_idx->{$fqc};
1576 # don't know how to collapse - keep descending down 1:1 chains - if
1577 # a related non-LEFT 1:1 is resolvable - its condition will collapse us
1579 unless ($collapse_map->{-collapse_on}) {
1582 for my $rel (keys %$relinfo) {
1583 next unless ($relinfo->{$rel}{is_single} && $relinfo->{$rel}{is_inner});
1585 if ( my $rel_collapse = $relinfo->{$rel}{rsrc}->_resolve_collapse (
1588 [ @$rel_chain, $rel ],
1589 { underdefined => 1 }
1591 push @candidates, $rel_collapse->{-collapse_on};
1595 # get the set with least amount of columns
1596 # FIXME - maybe need to implement a data type order as well (i.e. prefer several ints
1597 # to a single varchar)
1599 ($collapse_map->{-collapse_on}) = sort { keys %$a <=> keys %$b } (@candidates);
1603 # Still dont know how to collapse - see if the parent passed us anything
1604 # (i.e. reuse collapser over 1:1)
1605 unless ($collapse_map->{-collapse_on}) {
1606 $collapse_map->{-collapse_on} = $parent_info->{collapse_on}
1607 if $parent_info->{collapser_reusable};
1611 # stop descending into children if we were called by a parent for first-pass
1612 # and don't despair if nothing was found (there may be other parallel branches
1614 if ($parent_info->{underdefined}) {
1615 return $collapse_map->{-collapse_on} ? $collapse_map : undef
1617 # nothing down the chain resolved - can't calculate a collapse-map
1618 elsif (! $collapse_map->{-collapse_on}) {
1619 $self->throw_exception ( sprintf
1620 "Unable to calculate a definitive collapse column set for %s%s: fetch more unique non-nullable columns",
1623 ? sprintf (' (last member of the %s chain)', join ' -> ', @$rel_chain )
1630 # If we got that far - we are collapsable - GREAT! Now go down all children
1631 # a second time, and fill in the rest
1633 for my $rel (keys %$relinfo) {
1635 $collapse_map->{$rel} = $relinfo->{$rel}{rsrc}->_resolve_collapse (
1636 { map { $_ => 1 } ( keys %{$rel_cols->{$rel}} ) },
1640 [ @$rel_chain, $rel],
1643 collapse_on => { %{$collapse_map->{-collapse_on}} },
1645 rel_condition => $relinfo->{$rel}{fk_map},
1647 # if this is a 1:1 our own collapser can be used as a collapse-map
1648 # (regardless of left or not)
1649 collapser_reusable => $relinfo->{$rel}{is_single},
1654 return $collapse_map;
1657 sub _unique_column_set {
1658 my ($self, $cols) = @_;
1660 my %unique = $self->unique_constraints;
1662 # always prefer the PK first, and then shortest constraints first
1664 for my $set (delete $unique{primary}, sort { @$a <=> @$b } (values %unique) ) {
1665 next unless $set && @$set;
1668 next USET unless ($cols->{$_} && $cols->{$_}{colinfo} && !$cols->{$_}{colinfo}{is_nullable} );
1671 return { map { $_ => 1 } @$set };
1677 # Takes an arrayref of {as} dbic column aliases and the collapse and select
1678 # attributes from the same $rs (the slector requirement is a temporary
1679 # workaround), and returns a coderef capable of:
1680 # my $me_pref_clps = $coderef->([$rs->cursor->next])
1681 # Where the $me_pref_clps arrayref is the future argument to
1682 # ::ResultSet::_collapse_result.
1684 # $me_pref_clps->[0] is always returned (even if as an empty hash with no
1685 # rowdata), however branches of related data in $me_pref_clps->[1] may be
1686 # pruned short of what was originally requested based on {as}, depending
1689 # * If collapse is requested, a definitive collapse map is calculated for
1690 # every relationship "fold-point", consisting of a set of values (which
1691 # may not even be contained in the future 'me' of said relationship
1692 # (for example a cd.artist_id defines the related inner-joined artist)).
1693 # Thus a definedness check is carried on all collapse-condition values
1694 # and if at least one is undef it is assumed that we are dealing with a
1695 # NULLed right-side of a left-join, so we don't return a related data
1696 # container at all, which implies no related objects
1698 # * If we are not collapsing, there is no constraint on having a selector
1699 # uniquely identifying all possible objects, and the user might have very
1700 # well requested a column that just *happens* to be all NULLs. What we do
1701 # in this case is fallback to the old behavior (which is a potential FIXME)
1702 # by always returning a data container, but only filling it with columns
1703 # IFF at least one of them is defined. This way we do not get an object
1704 # with a bunch of has_column_loaded to undef, but at the same time do not
1705 # further relationships based off this "null" object (e.g. in case the user
1706 # deliberately skipped link-table values). I am pretty sure there are some
1707 # tests that codify this behavior, need to find the exact testname.
1709 # For an example of this coderef in action (and to see its guts) look at
1710 # t/prefetch/_internals.t
1712 # This is a huge performance win, as we call the same code for
1713 # every row returned from the db, thus avoiding repeated method
1714 # lookups when traversing relationships
1716 # Also since the coderef is completely stateless (the returned structure is
1717 # always fresh on every new invocation) this is a very good opportunity for
1718 # memoization if further speed improvements are needed
1720 # The way we construct this coderef is somewhat fugly, although I am not
1721 # sure if the string eval is *that* bad of an idea. The alternative is to
1722 # have a *very* large number of anon coderefs calling each other in a twisty
1723 # maze, whereas the current result is a nice, smooth, single-pass function.
1724 # In any case - the output of this thing is meticulously micro-tested, so
1725 # any sort of rewrite should be relatively easy
1727 sub _mk_row_parser {
1728 my ($self, $as, $with_collapse, $select) = @_;
1730 my $as_indexed = { map
1735 # calculate collapse fold-points if needed
1736 my $collapse_on = do {
1738 # only consider real columns (not functions) during collapse resolution
1739 # this check shouldn't really be here, as fucktards are not supposed to
1740 # alias random crap to existing column names anyway, but still - just in
1741 # case (also saves us from select/as mismatches which need fixing as well...)
1743 my $plain_as = { %$as_indexed };
1744 for (keys %$plain_as) {
1745 delete $plain_as->{$_} if ref $select->[$plain_as->{$_}];
1747 $self->_resolve_collapse ($plain_as);
1749 } if $with_collapse;
1751 my $perl = $self->__visit_as ($as_indexed, $collapse_on);
1752 my $cref = eval "sub { $perl }"
1753 or die "Oops! _mk_row_parser generated invalid perl:\n$@\n\n$perl\n";
1758 my $visit_as_dumper; # keep our own DD object around so we don't have to fitz with quoting
1761 my ($self, $as, $collapse_on, $known_defined) = @_;
1762 $known_defined ||= {};
1764 # prepopulate the known defined map with our own collapse value positions
1765 # the rationale is that if an Artist needs column 0 to be uniquely
1766 # identified, and related CDs need columns 0 and 1, by the time we get to
1767 # CDs we already know that column 0 is defined (otherwise there would be
1768 # no related CDs as there is no Artist in the 1st place). So we use this
1769 # index to cut on repetitive defined() checks.
1770 $known_defined->{$_}++ for ( values %{$collapse_on->{-collapse_on} || {}} );
1775 if ($_ =~ /^ ([^\.]+) \. (.+) /x) {
1776 $rel_cols->{$1}{$2} = $as->{$_};
1779 $my_cols->{$_} = $as->{$_};
1784 for my $rel (sort keys %$rel_cols) {
1785 my $rel_node = $self->__visit_as($rel_cols->{$rel}, $collapse_on->{$rel}, {%$known_defined} );
1788 if ($collapse_on->{$rel}{-collapse_on}) {
1790 { "(! defined '__VALPOS__${_}__')" }
1792 { ! $known_defined->{$_} }
1795 values %{$collapse_on->{$rel}{-collapse_on}}
1802 push @relperl, sprintf ( '(%s) ? () : ( %s => %s )',
1803 join (' || ', @null_checks ),
1809 push @relperl, "$rel => $rel_node";
1813 ? sprintf ('{ %s }', join (',', @relperl))
1818 map { $_ => "__VALPOS__$my_cols->{$_}__" } (keys %$my_cols)
1822 map { "__VALPOS__${_}__" } ( sort { $a <=> $b } (values %{$collapse_on->{-collapse_on}}) )
1823 ] if $collapse_on->{-collapse_on};
1825 # we actually will be producing functional perl code here,
1826 # thus no second-guessing of what these globals might have
1827 # been set to. DO NOT CHANGE!
1828 $visit_as_dumper ||= do {
1829 require Data::Dumper;
1830 Data::Dumper->new([])
1842 $_ = $visit_as_dumper->Values ([$_])->Dump;
1845 unless ($collapse_on->{-collapse_on}) { # we are not collapsing, insert a definedness check on 'me'
1846 $me = sprintf ( '(%s) ? %s : {}',
1847 join (' || ', map { "( defined '__VALPOS__${_}__')" } (sort { $a <=> $b } values %$my_cols) ),
1852 my @rv_list = ($me, $rels, $clps);
1853 pop @rv_list while ($rv_list[-1] eq 'undef'); # strip trailing undefs
1855 # change the quoted placeholders to unquoted alias-references
1856 $_ =~ s/ \' __VALPOS__(\d+)__ \' /sprintf ('$_[0][%d]', $1)/gex
1857 for grep { defined $_ } @rv_list;
1859 return sprintf '[%s]', join (',', @rv_list);
1863 =head2 related_source
1867 =item Arguments: $relname
1869 =item Return value: $source
1873 Returns the result source object for the given relationship.
1877 sub related_source {
1878 my ($self, $rel) = @_;
1879 if( !$self->has_relationship( $rel ) ) {
1880 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
1882 return $self->schema->source($self->relationship_info($rel)->{source});
1885 =head2 related_class
1889 =item Arguments: $relname
1891 =item Return value: $classname
1895 Returns the class name for objects in the given relationship.
1900 my ($self, $rel) = @_;
1901 if( !$self->has_relationship( $rel ) ) {
1902 $self->throw_exception("No such relationship '$rel'");
1904 return $self->schema->class($self->relationship_info($rel)->{source});
1909 Obtain a new handle to this source. Returns an instance of a
1910 L<DBIx::Class::ResultSourceHandle>.
1915 return DBIx::Class::ResultSourceHandle->new({
1916 schema => $_[0]->schema,
1917 source_moniker => $_[0]->source_name
1921 =head2 throw_exception
1923 See L<DBIx::Class::Schema/"throw_exception">.
1927 sub throw_exception {
1930 if (defined $self->schema) {
1931 $self->schema->throw_exception(@_);
1934 DBIx::Class::Exception->throw(@_);
1940 Stores a hashref of per-source metadata. No specific key names
1941 have yet been standardized, the examples below are purely hypothetical
1942 and don't actually accomplish anything on their own:
1944 __PACKAGE__->source_info({
1945 "_tablespace" => 'fast_disk_array_3',
1946 "_engine" => 'InnoDB',
1953 $class->new({attribute_name => value});
1955 Creates a new ResultSource object. Not normally called directly by end users.
1957 =head2 column_info_from_storage
1961 =item Arguments: 1/0 (default: 0)
1963 =item Return value: 1/0
1967 __PACKAGE__->column_info_from_storage(1);
1969 Enables the on-demand automatic loading of the above column
1970 metadata from storage as necessary. This is *deprecated*, and
1971 should not be used. It will be removed before 1.0.
1976 Matt S. Trout <mst@shadowcatsystems.co.uk>
1980 You may distribute this code under the same terms as Perl itself.