1 package DBIx::Class::ResultSource;
6 use DBIx::Class::ResultSet;
7 use DBIx::Class::ResultSourceHandle;
8 use Carp::Clan qw/^DBIx::Class/;
11 use base qw/DBIx::Class/;
13 __PACKAGE__->mk_group_accessors('simple' => qw/_ordered_columns
14 _columns _primaries _unique_constraints name resultset_attributes
15 schema from _relationships column_info_from_storage source_info
16 source_name sqlt_deploy_callback/);
18 __PACKAGE__->mk_group_accessors('component_class' => qw/resultset_class
23 DBIx::Class::ResultSource - Result source object
29 A ResultSource is a component of a schema from which results can be directly
30 retrieved, most usually a table (see L<DBIx::Class::ResultSource::Table>)
32 Basic view support also exists, see L<<DBIx::Class::ResultSource::View>.
41 my ($class, $attrs) = @_;
42 $class = ref $class if ref $class;
44 my $new = bless { %{$attrs || {}} }, $class;
45 $new->{resultset_class} ||= 'DBIx::Class::ResultSet';
46 $new->{resultset_attributes} = { %{$new->{resultset_attributes} || {}} };
47 $new->{_ordered_columns} = [ @{$new->{_ordered_columns}||[]}];
48 $new->{_columns} = { %{$new->{_columns}||{}} };
49 $new->{_relationships} = { %{$new->{_relationships}||{}} };
50 $new->{name} ||= "!!NAME NOT SET!!";
51 $new->{_columns_info_loaded} ||= 0;
52 $new->{sqlt_deploy_callback} ||= "default_sqlt_deploy_hook";
62 =item Arguments: @columns
64 =item Return value: The ResultSource object
68 $source->add_columns(qw/col1 col2 col3/);
70 $source->add_columns('col1' => \%col1_info, 'col2' => \%col2_info, ...);
72 Adds columns to the result source. If supplied key => hashref pairs, uses
73 the hashref as the column_info for that column. Repeated calls of this
74 method will add more columns, not replace them.
76 The column names given will be created as accessor methods on your
77 L<DBIx::Class::Row> objects. You can change the name of the accessor
78 by supplying an L</accessor> in the column_info hash.
80 The contents of the column_info are not set in stone. The following
81 keys are currently recognised/used by DBIx::Class:
87 Use this to set the name of the accessor method for this column. If unset,
88 the name of the column will be used.
92 This contains the column type. It is automatically filled by the
93 L<SQL::Translator::Producer::DBIx::Class::File> producer, and the
94 L<DBIx::Class::Schema::Loader> module. If you do not enter a
95 data_type, DBIx::Class will attempt to retrieve it from the
96 database for you, using L<DBI>'s column_info method. The values of this
97 key are typically upper-cased.
99 Currently there is no standard set of values for the data_type. Use
100 whatever your database supports.
104 The length of your column, if it is a column type that can have a size
105 restriction. This is currently only used by L<DBIx::Class::Schema/deploy>.
109 Set this to a true value for a columns that is allowed to contain
110 NULL values. This is currently only used by L<DBIx::Class::Schema/deploy>.
112 =item is_auto_increment
114 Set this to a true value for a column whose value is somehow
115 automatically set. This is used to determine which columns to empty
116 when cloning objects using C<copy>. It is also used by
117 L<DBIx::Class::Schema/deploy>.
121 Set this to a true value for a column that contains a key from a
122 foreign table. This is currently only used by
123 L<DBIx::Class::Schema/deploy>.
127 Set this to the default value which will be inserted into a column
128 by the database. Can contain either a value or a function. This is
129 currently only used by L<DBIx::Class::Schema/deploy>.
133 Set this on a primary key column to the name of the sequence used to
134 generate a new key value. If not specified, L<DBIx::Class::PK::Auto>
135 will attempt to retrieve the name of the sequence from the database
140 Set this to a true value for a column whose value is retrieved
141 automatically from an oracle sequence. If you do not use an Oracle
142 trigger to get the nextval, you have to set sequence as well.
146 This is used by L<DBIx::Class::Schema/deploy> and L<SQL::Translator>
147 to add extra non-generic data to the column. For example: C<< extra
148 => { unsigned => 1} >> is used by the MySQL producer to set an integer
149 column to unsigned. For more details, see
150 L<SQL::Translator::Producer::MySQL>.
158 =item Arguments: $colname, [ \%columninfo ]
160 =item Return value: 1/0 (true/false)
164 $source->add_column('col' => \%info?);
166 Add a single column and optional column info. Uses the same column
167 info keys as L</add_columns>.
172 my ($self, @cols) = @_;
173 $self->_ordered_columns(\@cols) unless $self->_ordered_columns;
176 my $columns = $self->_columns;
177 while (my $col = shift @cols) {
178 # If next entry is { ... } use that for the column info, if not
179 # use an empty hashref
180 my $column_info = ref $cols[0] ? shift(@cols) : {};
181 push(@added, $col) unless exists $columns->{$col};
182 $columns->{$col} = $column_info;
184 push @{ $self->_ordered_columns }, @added;
188 sub add_column { shift->add_columns(@_); } # DO NOT CHANGE THIS TO GLOB
194 =item Arguments: $colname
196 =item Return value: 1/0 (true/false)
200 if ($source->has_column($colname)) { ... }
202 Returns true if the source has a column of this name, false otherwise.
207 my ($self, $column) = @_;
208 return exists $self->_columns->{$column};
215 =item Arguments: $colname
217 =item Return value: Hashref of info
221 my $info = $source->column_info($col);
223 Returns the column metadata hashref for a column, as originally passed
224 to L</add_columns>. See the description of L</add_columns> for information
225 on the contents of the hashref.
230 my ($self, $column) = @_;
231 $self->throw_exception("No such column $column")
232 unless exists $self->_columns->{$column};
233 #warn $self->{_columns_info_loaded}, "\n";
234 if ( ! $self->_columns->{$column}{data_type}
235 and $self->column_info_from_storage
236 and ! $self->{_columns_info_loaded}
237 and $self->schema and $self->storage )
239 $self->{_columns_info_loaded}++;
242 # eval for the case of storage without table
243 eval { $info = $self->storage->columns_info_for( $self->from ) };
245 for my $realcol ( keys %{$info} ) {
246 $lc_info->{lc $realcol} = $info->{$realcol};
248 foreach my $col ( keys %{$self->_columns} ) {
249 $self->_columns->{$col} = {
250 %{ $self->_columns->{$col} },
251 %{ $info->{$col} || $lc_info->{lc $col} || {} }
256 return $self->_columns->{$column};
263 =item Arguments: None
265 =item Return value: Ordered list of column names
269 my @column_names = $source->columns;
271 Returns all column names in the order they were declared to L</add_columns>.
277 $self->throw_exception(
278 "columns() is a read-only accessor, did you mean add_columns()?"
280 return @{$self->{_ordered_columns}||[]};
283 =head2 remove_columns
287 =item Arguments: @colnames
289 =item Return value: undefined
293 $source->remove_columns(qw/col1 col2 col3/);
295 Removes the given list of columns by name, from the result source.
297 B<Warning>: Removing a column that is also used in the sources primary
298 key, or in one of the sources unique constraints, B<will> result in a
299 broken result source.
305 =item Arguments: $colname
307 =item Return value: undefined
311 $source->remove_column('col');
313 Remove a single column by name from the result source, similar to
316 B<Warning>: Removing a column that is also used in the sources primary
317 key, or in one of the sources unique constraints, B<will> result in a
318 broken result source.
323 my ($self, @to_remove) = @_;
325 my $columns = $self->_columns
330 delete $columns->{$_};
334 $self->_ordered_columns([ grep { not $to_remove{$_} } @{$self->_ordered_columns} ]);
337 sub remove_column { shift->remove_columns(@_); } # DO NOT CHANGE THIS TO GLOB
339 =head2 set_primary_key
343 =item Arguments: @cols
345 =item Return value: undefined
349 Defines one or more columns as primary key for this source. Should be
350 called after L</add_columns>.
352 Additionally, defines a L<unique constraint|add_unique_constraint>
355 The primary key columns are used by L<DBIx::Class::PK::Auto> to
356 retrieve automatically created values from the database.
360 sub set_primary_key {
361 my ($self, @cols) = @_;
362 # check if primary key columns are valid columns
363 foreach my $col (@cols) {
364 $self->throw_exception("No such column $col on table " . $self->name)
365 unless $self->has_column($col);
367 $self->_primaries(\@cols);
369 $self->add_unique_constraint(primary => \@cols);
372 =head2 primary_columns
376 =item Arguments: None
378 =item Return value: Ordered list of primary column names
382 Read-only accessor which returns the list of primary keys, supplied by
387 sub primary_columns {
388 return @{shift->_primaries||[]};
391 =head2 add_unique_constraint
395 =item Arguments: [ $name ], \@colnames
397 =item Return value: undefined
401 Declare a unique constraint on this source. Call once for each unique
404 # For UNIQUE (column1, column2)
405 __PACKAGE__->add_unique_constraint(
406 constraint_name => [ qw/column1 column2/ ],
409 Alternatively, you can specify only the columns:
411 __PACKAGE__->add_unique_constraint([ qw/column1 column2/ ]);
413 This will result in a unique constraint named C<table_column1_column2>, where
414 C<table> is replaced with the table name.
416 Unique constraints are used, for example, when you call
417 L<DBIx::Class::ResultSet/find>. Only columns in the constraint are searched.
419 Throws an error if any of the given column names do not yet exist on
424 sub add_unique_constraint {
429 $name ||= $self->name_unique_constraint($cols);
431 foreach my $col (@$cols) {
432 $self->throw_exception("No such column $col on table " . $self->name)
433 unless $self->has_column($col);
436 my %unique_constraints = $self->unique_constraints;
437 $unique_constraints{$name} = $cols;
438 $self->_unique_constraints(\%unique_constraints);
441 =head2 name_unique_constraint
445 =item Arguments: @colnames
447 =item Return value: Constraint name
451 $source->table('mytable');
452 $source->name_unique_constraint('col1', 'col2');
456 Return a name for a unique constraint containing the specified
457 columns. The name is created by joining the table name and each column
458 name, using an underscore character.
460 For example, a constraint on a table named C<cd> containing the columns
461 C<artist> and C<title> would result in a constraint name of C<cd_artist_title>.
463 This is used by L</add_unique_constraint> if you do not specify the
464 optional constraint name.
468 sub name_unique_constraint {
469 my ($self, $cols) = @_;
471 return join '_', $self->name, @$cols;
474 =head2 unique_constraints
478 =item Arguments: None
480 =item Return value: Hash of unique constraint data
484 $source->unique_constraints();
486 Read-only accessor which returns a hash of unique constraints on this source.
488 The hash is keyed by constraint name, and contains an arrayref of
489 column names as values.
493 sub unique_constraints {
494 return %{shift->_unique_constraints||{}};
497 =head2 unique_constraint_names
501 =item Arguments: None
503 =item Return value: Unique constraint names
507 $source->unique_constraint_names();
509 Returns the list of unique constraint names defined on this source.
513 sub unique_constraint_names {
516 my %unique_constraints = $self->unique_constraints;
518 return keys %unique_constraints;
521 =head2 unique_constraint_columns
525 =item Arguments: $constraintname
527 =item Return value: List of constraint columns
531 $source->unique_constraint_columns('myconstraint');
533 Returns the list of columns that make up the specified unique constraint.
537 sub unique_constraint_columns {
538 my ($self, $constraint_name) = @_;
540 my %unique_constraints = $self->unique_constraints;
542 $self->throw_exception(
543 "Unknown unique constraint $constraint_name on '" . $self->name . "'"
544 ) unless exists $unique_constraints{$constraint_name};
546 return @{ $unique_constraints{$constraint_name} };
549 =head2 sqlt_deploy_callback
553 =item Arguments: $callback
557 __PACKAGE__->sqlt_deploy_callback('mycallbackmethod');
559 An accessor to set a callback to be called during deployment of
560 the schema via L<DBIx::Class::Schema/create_ddl_dir> or
561 L<DBIx::Class::Schema/deploy>.
563 The callback can be set as either a code reference or the name of a
564 method in the current result class.
566 If not set, the L</default_sqlt_deploy_hook> is called.
568 Your callback will be passed the $source object representing the
569 ResultSource instance being deployed, and the
570 L<SQL::Translator::Schema::Table> object being created from it. The
571 callback can be used to manipulate the table object or add your own
572 customised indexes. If you need to manipulate a non-table object, use
573 the L<DBIx::Class::Schema/sqlt_deploy_hook>.
575 See L<DBIx::Class::Manual::Cookbook/Adding Indexes And Functions To
576 Your SQL> for examples.
578 This sqlt deployment callback can only be used to manipulate
579 SQL::Translator objects as they get turned into SQL. To execute
580 post-deploy statements which SQL::Translator does not currently
581 handle, override L<DBIx::Class::Schema/deploy> in your Schema class
582 and call L<dbh_do|DBIx::Class::Storage::DBI/dbh_do>.
584 =head2 default_sqlt_deploy_hook
588 =item Arguments: $source, $sqlt_table
590 =item Return value: undefined
594 This is the sensible default for L</sqlt_deploy_callback>.
596 If a method named C<sqlt_deploy_hook> exists in your Result class, it
597 will be called and passed the current C<$source> and the
598 C<$sqlt_table> being deployed.
602 sub default_sqlt_deploy_hook {
605 my $class = $self->result_class;
607 if ($class and $class->can('sqlt_deploy_hook')) {
608 $class->sqlt_deploy_hook(@_);
612 sub _invoke_sqlt_deploy_hook {
614 if ( my $hook = $self->sqlt_deploy_callback) {
623 =item Arguments: None
625 =item Return value: $resultset
629 Returns a resultset for the given source. This will initially be created
632 $self->resultset_class->new($self, $self->resultset_attributes)
634 but is cached from then on unless resultset_class changes.
636 =head2 resultset_class
640 =item Arguments: $classname
642 =item Return value: $classname
646 package My::ResultSetClass;
647 use base 'DBIx::Class::ResultSet';
650 $source->resultset_class('My::ResultSet::Class');
652 Set the class of the resultset. This is useful if you want to create your
653 own resultset methods. Create your own class derived from
654 L<DBIx::Class::ResultSet>, and set it here. If called with no arguments,
655 this method returns the name of the existing resultset class, if one
658 =head2 resultset_attributes
662 =item Arguments: \%attrs
664 =item Return value: \%attrs
668 $source->resultset_attributes({ order_by => [ 'id' ] });
670 Store a collection of resultset attributes, that will be set on every
671 L<DBIx::Class::ResultSet> produced from this result source. For a full
672 list see L<DBIx::Class::ResultSet/ATTRIBUTES>.
678 $self->throw_exception(
679 'resultset does not take any arguments. If you want another resultset, '.
680 'call it on the schema instead.'
683 return $self->resultset_class->new(
686 %{$self->{resultset_attributes}},
687 %{$self->schema->default_resultset_attributes}
696 =item Arguments: $source_name
698 =item Result value: $source_name
702 Set an alternate name for the result source when it is loaded into a schema.
703 This is useful if you want to refer to a result source by a name other than
706 package ArchivedBooks;
707 use base qw/DBIx::Class/;
708 __PACKAGE__->table('books_archive');
709 __PACKAGE__->source_name('Books');
711 # from your schema...
712 $schema->resultset('Books')->find(1);
718 =item Arguments: None
720 =item Return value: FROM clause
724 my $from_clause = $source->from();
726 Returns an expression of the source to be supplied to storage to specify
727 retrieval from this source. In the case of a database, the required FROM
734 =item Arguments: None
736 =item Return value: A schema object
740 my $schema = $source->schema();
742 Returns the L<DBIx::Class::Schema> object that this result source
749 =item Arguments: None
751 =item Return value: A Storage object
755 $source->storage->debug(1);
757 Returns the storage handle for the current schema.
759 See also: L<DBIx::Class::Storage>
763 sub storage { shift->schema->storage; }
765 =head2 add_relationship
769 =item Arguments: $relname, $related_source_name, \%cond, [ \%attrs ]
771 =item Return value: 1/true if it succeeded
775 $source->add_relationship('relname', 'related_source', $cond, $attrs);
777 L<DBIx::Class::Relationship> describes a series of methods which
778 create pre-defined useful types of relationships. Look there first
779 before using this method directly.
781 The relationship name can be arbitrary, but must be unique for each
782 relationship attached to this result source. 'related_source' should
783 be the name with which the related result source was registered with
784 the current schema. For example:
786 $schema->source('Book')->add_relationship('reviews', 'Review', {
787 'foreign.book_id' => 'self.id',
790 The condition C<$cond> needs to be an L<SQL::Abstract>-style
791 representation of the join between the tables. For example, if you're
792 creating a relation from Author to Book,
794 { 'foreign.author_id' => 'self.id' }
796 will result in the JOIN clause
798 author me JOIN book foreign ON foreign.author_id = me.id
800 You can specify as many foreign => self mappings as necessary.
802 Valid attributes are as follows:
808 Explicitly specifies the type of join to use in the relationship. Any
809 SQL join type is valid, e.g. C<LEFT> or C<RIGHT>. It will be placed in
810 the SQL command immediately before C<JOIN>.
814 An arrayref containing a list of accessors in the foreign class to proxy in
815 the main class. If, for example, you do the following:
817 CD->might_have(liner_notes => 'LinerNotes', undef, {
818 proxy => [ qw/notes/ ],
821 Then, assuming LinerNotes has an accessor named notes, you can do:
823 my $cd = CD->find(1);
824 # set notes -- LinerNotes object is created if it doesn't exist
825 $cd->notes('Notes go here');
829 Specifies the type of accessor that should be created for the
830 relationship. Valid values are C<single> (for when there is only a single
831 related object), C<multi> (when there can be many), and C<filter> (for
832 when there is a single related object, but you also want the relationship
833 accessor to double as a column accessor). For C<multi> accessors, an
834 add_to_* method is also created, which calls C<create_related> for the
839 Throws an exception if the condition is improperly supplied, or cannot
840 be resolved using L</resolve_join>.
844 sub add_relationship {
845 my ($self, $rel, $f_source_name, $cond, $attrs) = @_;
846 $self->throw_exception("Can't create relationship without join condition")
850 # Check foreign and self are right in cond
851 if ( (ref $cond ||'') eq 'HASH') {
853 $self->throw_exception("Keys of condition should be of form 'foreign.col', not '$_'")
854 if /\./ && !/^foreign\./;
858 my %rels = %{ $self->_relationships };
859 $rels{$rel} = { class => $f_source_name,
860 source => $f_source_name,
863 $self->_relationships(\%rels);
867 # XXX disabled. doesn't work properly currently. skip in tests.
869 my $f_source = $self->schema->source($f_source_name);
871 $self->ensure_class_loaded($f_source_name);
872 $f_source = $f_source_name->result_source;
873 #my $s_class = ref($self->schema);
874 #$f_source_name =~ m/^${s_class}::(.*)$/;
875 #$self->schema->register_class(($1 || $f_source_name), $f_source_name);
876 #$f_source = $self->schema->source($f_source_name);
878 return unless $f_source; # Can't test rel without f_source
880 eval { $self->resolve_join($rel, 'me') };
882 if ($@) { # If the resolve failed, back out and re-throw the error
883 delete $rels{$rel}; #
884 $self->_relationships(\%rels);
885 $self->throw_exception("Error creating relationship $rel: $@");
894 =item Arguments: None
896 =item Return value: List of relationship names
900 my @relnames = $source->relationships();
902 Returns all relationship names for this source.
907 return keys %{shift->_relationships};
910 =head2 relationship_info
914 =item Arguments: $relname
916 =item Return value: Hashref of relation data,
920 Returns a hash of relationship information for the specified relationship
921 name. The keys/values are as specified for L</add_relationship>.
925 sub relationship_info {
926 my ($self, $rel) = @_;
927 return $self->_relationships->{$rel};
930 =head2 has_relationship
934 =item Arguments: $rel
936 =item Return value: 1/0 (true/false)
940 Returns true if the source has a relationship of this name, false otherwise.
944 sub has_relationship {
945 my ($self, $rel) = @_;
946 return exists $self->_relationships->{$rel};
949 =head2 reverse_relationship_info
953 =item Arguments: $relname
955 =item Return value: Hashref of relationship data
959 Looks through all the relationships on the source this relationship
960 points to, looking for one whose condition is the reverse of the
961 condition on this relationship.
963 A common use of this is to find the name of the C<belongs_to> relation
964 opposing a C<has_many> relation. For definition of these look in
965 L<DBIx::Class::Relationship>.
967 The returned hashref is keyed by the name of the opposing
968 relationship, and contains it's data in the same manner as
969 L</relationship_info>.
973 sub reverse_relationship_info {
974 my ($self, $rel) = @_;
975 my $rel_info = $self->relationship_info($rel);
978 return $ret unless ((ref $rel_info->{cond}) eq 'HASH');
980 my @cond = keys(%{$rel_info->{cond}});
981 my @refkeys = map {/^\w+\.(\w+)$/} @cond;
982 my @keys = map {$rel_info->{cond}->{$_} =~ /^\w+\.(\w+)$/} @cond;
984 # Get the related result source for this relationship
985 my $othertable = $self->related_source($rel);
987 # Get all the relationships for that source that related to this source
988 # whose foreign column set are our self columns on $rel and whose self
989 # columns are our foreign columns on $rel.
990 my @otherrels = $othertable->relationships();
991 my $otherrelationship;
992 foreach my $otherrel (@otherrels) {
993 my $otherrel_info = $othertable->relationship_info($otherrel);
995 my $back = $othertable->related_source($otherrel);
996 next unless $back->source_name eq $self->source_name;
1000 if (ref $otherrel_info->{cond} eq 'HASH') {
1001 @othertestconds = ($otherrel_info->{cond});
1003 elsif (ref $otherrel_info->{cond} eq 'ARRAY') {
1004 @othertestconds = @{$otherrel_info->{cond}};
1010 foreach my $othercond (@othertestconds) {
1011 my @other_cond = keys(%$othercond);
1012 my @other_refkeys = map {/^\w+\.(\w+)$/} @other_cond;
1013 my @other_keys = map {$othercond->{$_} =~ /^\w+\.(\w+)$/} @other_cond;
1014 next if (!$self->compare_relationship_keys(\@refkeys, \@other_keys) ||
1015 !$self->compare_relationship_keys(\@other_refkeys, \@keys));
1016 $ret->{$otherrel} = $otherrel_info;
1022 =head2 compare_relationship_keys
1026 =item Arguments: \@keys1, \@keys2
1028 =item Return value: 1/0 (true/false)
1032 Returns true if both sets of keynames are the same, false otherwise.
1036 sub compare_relationship_keys {
1037 my ($self, $keys1, $keys2) = @_;
1039 # Make sure every keys1 is in keys2
1041 foreach my $key (@$keys1) {
1043 foreach my $prim (@$keys2) {
1044 if ($prim eq $key) {
1052 # Make sure every key2 is in key1
1054 foreach my $prim (@$keys2) {
1056 foreach my $key (@$keys1) {
1057 if ($prim eq $key) {
1073 =item Arguments: $relation
1075 =item Return value: Join condition arrayref
1079 Returns the join structure required for the related result source.
1084 my ($self, $join, $alias, $seen, $force_left) = @_;
1086 $force_left ||= { force => 0 };
1087 if (ref $join eq 'ARRAY') {
1088 return map { $self->resolve_join($_, $alias, $seen) } @$join;
1089 } elsif (ref $join eq 'HASH') {
1092 my $as = ($seen->{$_} ? $_.'_'.($seen->{$_}+1) : $_);
1093 local $force_left->{force};
1095 $self->resolve_join($_, $alias, $seen, $force_left),
1096 $self->related_source($_)->resolve_join(
1097 $join->{$_}, $as, $seen, $force_left
1101 } elsif (ref $join) {
1102 $self->throw_exception("No idea how to resolve join reftype ".ref $join);
1104 my $count = ++$seen->{$join};
1105 #use Data::Dumper; warn Dumper($seen);
1106 my $as = ($count > 1 ? "${join}_${count}" : $join);
1107 my $rel_info = $self->relationship_info($join);
1108 $self->throw_exception("No such relationship ${join}") unless $rel_info;
1110 if ($force_left->{force}) {
1113 $type = $rel_info->{attrs}{join_type} || '';
1114 $force_left->{force} = 1 if lc($type) eq 'left';
1116 return [ { $as => $self->related_source($join)->from,
1117 -join_type => $type },
1118 $self->resolve_condition($rel_info->{cond}, $as, $alias) ];
1122 =head2 pk_depends_on
1126 =item Arguments: $relname, $rel_data
1128 =item Return value: 1/0 (true/false)
1132 Determines whether a relation is dependent on an object from this source
1133 having already been inserted. Takes the name of the relationship and a
1134 hashref of columns of the related object.
1139 my ($self, $relname, $rel_data) = @_;
1140 my $cond = $self->relationship_info($relname)->{cond};
1142 return 0 unless ref($cond) eq 'HASH';
1144 # map { foreign.foo => 'self.bar' } to { bar => 'foo' }
1146 my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond };
1148 # assume anything that references our PK probably is dependent on us
1149 # rather than vice versa, unless the far side is (a) defined or (b)
1152 my $rel_source = $self->related_source($relname);
1154 foreach my $p ($self->primary_columns) {
1155 if (exists $keyhash->{$p}) {
1156 unless (defined($rel_data->{$keyhash->{$p}})
1157 || $rel_source->column_info($keyhash->{$p})
1158 ->{is_auto_increment}) {
1167 =head2 resolve_condition
1171 =item Arguments: $cond, $as, $alias|$object
1175 Resolves the passed condition to a concrete query fragment. If given an alias,
1176 returns a join condition; if given an object, inverts that object to produce
1177 a related conditional from that object.
1181 our $UNRESOLVABLE_CONDITION = \'1 = 0';
1183 sub resolve_condition {
1184 my ($self, $cond, $as, $for) = @_;
1186 if (ref $cond eq 'HASH') {
1188 foreach my $k (keys %{$cond}) {
1189 my $v = $cond->{$k};
1190 # XXX should probably check these are valid columns
1191 $k =~ s/^foreign\.// ||
1192 $self->throw_exception("Invalid rel cond key ${k}");
1193 $v =~ s/^self\.// ||
1194 $self->throw_exception("Invalid rel cond val ${v}");
1195 if (ref $for) { # Object
1196 #warn "$self $k $for $v";
1197 unless ($for->has_column_loaded($v)) {
1198 if ($for->in_storage) {
1199 $self->throw_exception("Column ${v} not loaded on ${for} trying to resolve relationship");
1201 return $UNRESOLVABLE_CONDITION;
1203 $ret{$k} = $for->get_column($v);
1204 #$ret{$k} = $for->get_column($v) if $for->has_column_loaded($v);
1206 } elsif (!defined $for) { # undef, i.e. "no object"
1208 } elsif (ref $as eq 'HASH') { # reverse hashref
1209 $ret{$v} = $as->{$k};
1210 } elsif (ref $as) { # reverse object
1211 $ret{$v} = $as->get_column($k);
1212 } elsif (!defined $as) { # undef, i.e. "no reverse object"
1215 $ret{"${as}.${k}"} = "${for}.${v}";
1219 } elsif (ref $cond eq 'ARRAY') {
1220 return [ map { $self->resolve_condition($_, $as, $for) } @$cond ];
1222 die("Can't handle this yet :(");
1226 =head2 resolve_prefetch
1230 =item Arguments: hashref/arrayref/scalar
1234 Accepts one or more relationships for the current source and returns an
1235 array of column names for each of those relationships. Column names are
1236 prefixed relative to the current source, in accordance with where they appear
1237 in the supplied relationships. Examples:
1239 my $source = $schema->resultset('Tag')->source;
1240 @columns = $source->resolve_prefetch( { cd => 'artist' } );
1248 # 'cd.artist.artistid',
1252 @columns = $source->resolve_prefetch( qw[/ cd /] );
1262 $source = $schema->resultset('CD')->source;
1263 @columns = $source->resolve_prefetch( qw[/ artist producer /] );
1267 # 'artist.artistid',
1269 # 'producer.producerid',
1275 sub resolve_prefetch {
1276 my ($self, $pre, $alias, $seen, $order, $collapse) = @_;
1278 #$alias ||= $self->name;
1279 #warn $alias, Dumper $pre;
1280 if( ref $pre eq 'ARRAY' ) {
1282 map { $self->resolve_prefetch( $_, $alias, $seen, $order, $collapse ) }
1285 elsif( ref $pre eq 'HASH' ) {
1288 $self->resolve_prefetch($_, $alias, $seen, $order, $collapse),
1289 $self->related_source($_)->resolve_prefetch(
1290 $pre->{$_}, "${alias}.$_", $seen, $order, $collapse)
1296 $self->throw_exception(
1297 "don't know how to resolve prefetch reftype ".ref($pre));
1300 my $count = ++$seen->{$pre};
1301 my $as = ($count > 1 ? "${pre}_${count}" : $pre);
1302 my $rel_info = $self->relationship_info( $pre );
1303 $self->throw_exception( $self->name . " has no such relationship '$pre'" )
1305 my $as_prefix = ($alias =~ /^.*?\.(.+)$/ ? $1.'.' : '');
1306 my $rel_source = $self->related_source($pre);
1308 if (exists $rel_info->{attrs}{accessor}
1309 && $rel_info->{attrs}{accessor} eq 'multi') {
1310 $self->throw_exception(
1311 "Can't prefetch has_many ${pre} (join cond too complex)")
1312 unless ref($rel_info->{cond}) eq 'HASH';
1313 my $dots = @{[$as_prefix =~ m/\./g]} + 1; # +1 to match the ".${as_prefix}"
1314 if (my ($fail) = grep { @{[$_ =~ m/\./g]} == $dots }
1315 keys %{$collapse}) {
1316 my ($last) = ($fail =~ /([^\.]+)$/);
1318 "Prefetching multiple has_many rels ${last} and ${pre} "
1319 .(length($as_prefix)
1320 ? "at the same level (${as_prefix}) "
1323 . 'will currently disrupt both the functionality of $rs->count(), '
1324 . 'and the amount of objects retrievable via $rs->next(). '
1325 . 'Use at your own risk.'
1328 #my @col = map { (/^self\.(.+)$/ ? ("${as_prefix}.$1") : ()); }
1329 # values %{$rel_info->{cond}};
1330 $collapse->{".${as_prefix}${pre}"} = [ $rel_source->primary_columns ];
1331 # action at a distance. prepending the '.' allows simpler code
1332 # in ResultSet->_collapse_result
1333 my @key = map { (/^foreign\.(.+)$/ ? ($1) : ()); }
1334 keys %{$rel_info->{cond}};
1335 my @ord = (ref($rel_info->{attrs}{order_by}) eq 'ARRAY'
1336 ? @{$rel_info->{attrs}{order_by}}
1337 : (defined $rel_info->{attrs}{order_by}
1338 ? ($rel_info->{attrs}{order_by})
1340 push(@$order, map { "${as}.$_" } (@key, @ord));
1343 return map { [ "${as}.$_", "${as_prefix}${pre}.$_", ] }
1344 $rel_source->columns;
1345 #warn $alias, Dumper (\@ret);
1350 =head2 related_source
1354 =item Arguments: $relname
1356 =item Return value: $source
1360 Returns the result source object for the given relationship.
1364 sub related_source {
1365 my ($self, $rel) = @_;
1366 if( !$self->has_relationship( $rel ) ) {
1367 $self->throw_exception("No such relationship '$rel'");
1369 return $self->schema->source($self->relationship_info($rel)->{source});
1372 =head2 related_class
1376 =item Arguments: $relname
1378 =item Return value: $classname
1382 Returns the class name for objects in the given relationship.
1387 my ($self, $rel) = @_;
1388 if( !$self->has_relationship( $rel ) ) {
1389 $self->throw_exception("No such relationship '$rel'");
1391 return $self->schema->class($self->relationship_info($rel)->{source});
1396 Obtain a new handle to this source. Returns an instance of a
1397 L<DBIx::Class::ResultSourceHandle>.
1402 return new DBIx::Class::ResultSourceHandle({
1403 schema => $_[0]->schema,
1404 source_moniker => $_[0]->source_name
1408 =head2 throw_exception
1410 See L<DBIx::Class::Schema/"throw_exception">.
1414 sub throw_exception {
1416 if (defined $self->schema) {
1417 $self->schema->throw_exception(@_);
1425 Stores a hashref of per-source metadata. No specific key names
1426 have yet been standardized, the examples below are purely hypothetical
1427 and don't actually accomplish anything on their own:
1429 __PACKAGE__->source_info({
1430 "_tablespace" => 'fast_disk_array_3',
1431 "_engine" => 'InnoDB',
1438 $class->new({attribute_name => value});
1440 Creates a new ResultSource object. Not normally called directly by end users.
1442 =head2 column_info_from_storage
1446 =item Arguments: 1/0 (default: 0)
1448 =item Return value: 1/0
1452 __PACKAGE__->column_info_from_storage(1);
1454 Enables the on-demand automatic loading of the above column
1455 metadata from storage as neccesary. This is *deprecated*, and
1456 should not be used. It will be removed before 1.0.
1461 Matt S. Trout <mst@shadowcatsystems.co.uk>
1465 You may distribute this code under the same terms as Perl itself.