1 package DBIx::Class::ResultSource;
6 use DBIx::Class::ResultSet;
7 use Carp::Clan qw/^DBIx::Class/;
10 use base qw/DBIx::Class/;
11 __PACKAGE__->load_components(qw/AccessorGroup/);
13 __PACKAGE__->mk_group_accessors('simple' => qw/_ordered_columns
14 _columns _primaries _unique_constraints name resultset_attributes
15 schema from _relationships/);
17 __PACKAGE__->mk_group_accessors('component_class' => qw/resultset_class
18 result_class source_name/);
22 DBIx::Class::ResultSource - Result source object
28 A ResultSource is a component of a schema from which results can be directly
29 retrieved, most usually a table (see L<DBIx::Class::ResultSource::Table>)
36 my ($class, $attrs) = @_;
37 $class = ref $class if ref $class;
38 my $new = bless({ %{$attrs || {}}, _resultset => undef }, $class);
39 $new->{resultset_class} ||= 'DBIx::Class::ResultSet';
40 $new->{resultset_attributes} = { %{$new->{resultset_attributes} || {}} };
41 $new->{_ordered_columns} = [ @{$new->{_ordered_columns}||[]}];
42 $new->{_columns} = { %{$new->{_columns}||{}} };
43 $new->{_relationships} = { %{$new->{_relationships}||{}} };
44 $new->{name} ||= "!!NAME NOT SET!!";
45 $new->{_columns_info_loaded} ||= 0;
53 $table->add_columns(qw/col1 col2 col3/);
55 $table->add_columns('col1' => \%col1_info, 'col2' => \%col2_info, ...);
57 Adds columns to the result source. If supplied key => hashref pairs, uses
58 the hashref as the column_info for that column. Repeated calls of this
59 method will add more columns, not replace them.
61 The contents of the column_info are not set in stone. The following
62 keys are currently recognised/used by DBIx::Class:
68 Use this to set the name of the accessor for this column. If unset,
69 the name of the column will be used.
73 This contains the column type. It is automatically filled by the
74 L<SQL::Translator::Producer::DBIx::Class::File> producer, and the
75 L<DBIx::Class::Schema::Loader> module. If you do not enter a
76 data_type, DBIx::Class will attempt to retrieve it from the
77 database for you, using L<DBI>'s column_info method. The values of this
78 key are typically upper-cased.
80 Currently there is no standard set of values for the data_type. Use
81 whatever your database supports.
85 The length of your column, if it is a column type that can have a size
86 restriction. This is currently not used by DBIx::Class.
90 Set this to a true value for a columns that is allowed to contain
91 NULL values. This is currently not used by DBIx::Class.
93 =item is_auto_increment
95 Set this to a true value for a column whose value is somehow
96 automatically set. This is used to determine which columns to empty
97 when cloning objects using C<copy>.
101 Set this to a true value for a column that contains a key from a
102 foreign table. This is currently not used by DBIx::Class.
106 Set this to the default value which will be inserted into a column
107 by the database. Can contain either a value or a function. This is
108 currently not used by DBIx::Class.
112 Set this on a primary key column to the name of the sequence used to
113 generate a new key value. If not specified, L<DBIx::Class::PK::Auto>
114 will attempt to retrieve the name of the sequence from the database
121 $table->add_column('col' => \%info?);
123 Convenience alias to add_columns.
128 my ($self, @cols) = @_;
129 $self->_ordered_columns(\@cols) unless $self->_ordered_columns;
132 my $columns = $self->_columns;
133 while (my $col = shift @cols) {
134 # If next entry is { ... } use that for the column info, if not
135 # use an empty hashref
136 my $column_info = ref $cols[0] ? shift(@cols) : {};
137 push(@added, $col) unless exists $columns->{$col};
138 $columns->{$col} = $column_info;
140 push @{ $self->_ordered_columns }, @added;
144 *add_column = \&add_columns;
148 if ($obj->has_column($col)) { ... }
150 Returns true if the source has a column of this name, false otherwise.
155 my ($self, $column) = @_;
156 return exists $self->_columns->{$column};
161 my $info = $obj->column_info($col);
163 Returns the column metadata hashref for a column. See the description
164 of add_column for information on the contents of the hashref.
169 my ($self, $column) = @_;
170 $self->throw_exception("No such column $column")
171 unless exists $self->_columns->{$column};
172 #warn $self->{_columns_info_loaded}, "\n";
173 if ( ! $self->_columns->{$column}{data_type}
174 and ! $self->{_columns_info_loaded}
175 and $self->schema and $self->storage )
177 $self->{_columns_info_loaded}++;
179 # eval for the case of storage without table
180 eval { $info = $self->storage->columns_info_for($self->from) };
182 foreach my $col ( keys %{$self->_columns} ) {
183 foreach my $i ( keys %{$info->{$col}} ) {
184 $self->_columns->{$col}{$i} = $info->{$col}{$i};
189 return $self->_columns->{$column};
194 my @column_names = $obj->columns;
196 Returns all column names in the order they were declared to add_columns.
202 $self->throw_exception(
203 "columns() is a read-only accessor, did you mean add_columns()?"
205 return @{$self->{_ordered_columns}||[]};
208 =head2 remove_columns
210 $table->remove_columns(qw/col1 col2 col3/);
212 Removes columns from the result source.
216 $table->remove_column('col');
218 Convenience alias to remove_columns.
223 my ($self, @cols) = @_;
225 return unless $self->_ordered_columns;
227 my $columns = $self->_columns;
230 foreach my $col (@{$self->_ordered_columns}) {
231 push @remaining, $col unless grep(/$col/, @cols);
235 undef $columns->{$_};
238 $self->_ordered_columns(\@remaining);
241 *remove_column = \&remove_columns;
243 =head2 set_primary_key
247 =item Arguments: @cols
251 Defines one or more columns as primary key for this source. Should be
252 called after C<add_columns>.
254 Additionally, defines a unique constraint named C<primary>.
256 The primary key columns are used by L<DBIx::Class::PK::Auto> to
257 retrieve automatically created values from the database.
261 sub set_primary_key {
262 my ($self, @cols) = @_;
263 # check if primary key columns are valid columns
264 foreach my $col (@cols) {
265 $self->throw_exception("No such column $col on table " . $self->name)
266 unless $self->has_column($col);
268 $self->_primaries(\@cols);
270 $self->add_unique_constraint(primary => \@cols);
273 =head2 primary_columns
275 Read-only accessor which returns the list of primary keys.
279 sub primary_columns {
280 return @{shift->_primaries||[]};
283 =head2 add_unique_constraint
285 Declare a unique constraint on this source. Call once for each unique
288 # For UNIQUE (column1, column2)
289 __PACKAGE__->add_unique_constraint(
290 constraint_name => [ qw/column1 column2/ ],
293 Unique constraints are used, for example, when you call
294 L<DBIx::Class::ResultSet/find>. Only columns in the constraint are searched.
298 sub add_unique_constraint {
299 my ($self, $name, $cols) = @_;
301 foreach my $col (@$cols) {
302 $self->throw_exception("No such column $col on table " . $self->name)
303 unless $self->has_column($col);
306 my %unique_constraints = $self->unique_constraints;
307 $unique_constraints{$name} = $cols;
308 $self->_unique_constraints(\%unique_constraints);
311 =head2 unique_constraints
313 Read-only accessor which returns the list of unique constraints on this source.
317 sub unique_constraints {
318 return %{shift->_unique_constraints||{}};
323 Returns an expression of the source to be supplied to storage to specify
324 retrieval from this source. In the case of a database, the required FROM
331 Returns the storage handle for the current schema.
333 See also: L<DBIx::Class::Storage>
337 sub storage { shift->schema->storage; }
339 =head2 add_relationship
341 $source->add_relationship('relname', 'related_source', $cond, $attrs);
343 The relationship name can be arbitrary, but must be unique for each
344 relationship attached to this result source. 'related_source' should
345 be the name with which the related result source was registered with
346 the current schema. For example:
348 $schema->source('Book')->add_relationship('reviews', 'Review', {
349 'foreign.book_id' => 'self.id',
352 The condition C<$cond> needs to be an L<SQL::Abstract>-style
353 representation of the join between the tables. For example, if you're
354 creating a rel from Author to Book,
356 { 'foreign.author_id' => 'self.id' }
358 will result in the JOIN clause
360 author me JOIN book foreign ON foreign.author_id = me.id
362 You can specify as many foreign => self mappings as necessary.
364 Valid attributes are as follows:
370 Explicitly specifies the type of join to use in the relationship. Any
371 SQL join type is valid, e.g. C<LEFT> or C<RIGHT>. It will be placed in
372 the SQL command immediately before C<JOIN>.
376 An arrayref containing a list of accessors in the foreign class to proxy in
377 the main class. If, for example, you do the following:
379 CD->might_have(liner_notes => 'LinerNotes', undef, {
380 proxy => [ qw/notes/ ],
383 Then, assuming LinerNotes has an accessor named notes, you can do:
385 my $cd = CD->find(1);
386 # set notes -- LinerNotes object is created if it doesn't exist
387 $cd->notes('Notes go here');
391 Specifies the type of accessor that should be created for the
392 relationship. Valid values are C<single> (for when there is only a single
393 related object), C<multi> (when there can be many), and C<filter> (for
394 when there is a single related object, but you also want the relationship
395 accessor to double as a column accessor). For C<multi> accessors, an
396 add_to_* method is also created, which calls C<create_related> for the
403 sub add_relationship {
404 my ($self, $rel, $f_source_name, $cond, $attrs) = @_;
405 $self->throw_exception("Can't create relationship without join condition")
409 my %rels = %{ $self->_relationships };
410 $rels{$rel} = { class => $f_source_name,
411 source => $f_source_name,
414 $self->_relationships(\%rels);
418 # XXX disabled. doesn't work properly currently. skip in tests.
420 my $f_source = $self->schema->source($f_source_name);
422 eval "require $f_source_name;";
424 die $@ unless $@ =~ /Can't locate/;
426 $f_source = $f_source_name->result_source;
427 #my $s_class = ref($self->schema);
428 #$f_source_name =~ m/^${s_class}::(.*)$/;
429 #$self->schema->register_class(($1 || $f_source_name), $f_source_name);
430 #$f_source = $self->schema->source($f_source_name);
432 return unless $f_source; # Can't test rel without f_source
434 eval { $self->resolve_join($rel, 'me') };
436 if ($@) { # If the resolve failed, back out and re-throw the error
437 delete $rels{$rel}; #
438 $self->_relationships(\%rels);
439 $self->throw_exception("Error creating relationship $rel: $@");
446 Returns all relationship names for this source.
451 return keys %{shift->_relationships};
454 =head2 relationship_info
458 =item Arguments: $relname
462 Returns a hash of relationship information for the specified relationship
467 sub relationship_info {
468 my ($self, $rel) = @_;
469 return $self->_relationships->{$rel};
472 =head2 has_relationship
476 =item Arguments: $rel
480 Returns true if the source has a relationship of this name, false otherwise.
484 sub has_relationship {
485 my ($self, $rel) = @_;
486 return exists $self->_relationships->{$rel};
489 =head2 reverse_relationship_info
493 =item Arguments: $relname
497 Returns an array of hash references of relationship information for
498 the other side of the specified relationship name.
502 sub reverse_relationship_info {
503 my ($self, $rel) = @_;
504 my $rel_info = $self->relationship_info($rel);
507 return $ret unless ((ref $rel_info->{cond}) eq 'HASH');
509 my @cond = keys(%{$rel_info->{cond}});
510 my @refkeys = map {/^\w+\.(\w+)$/} @cond;
511 my @keys = map {$rel_info->{cond}->{$_} =~ /^\w+\.(\w+)$/} @cond;
513 # Get the related result source for this relationship
514 my $othertable = $self->related_source($rel);
516 # Get all the relationships for that source that related to this source
517 # whose foreign column set are our self columns on $rel and whose self
518 # columns are our foreign columns on $rel.
519 my @otherrels = $othertable->relationships();
520 my $otherrelationship;
521 foreach my $otherrel (@otherrels) {
522 my $otherrel_info = $othertable->relationship_info($otherrel);
524 my $back = $othertable->related_source($otherrel);
525 next unless $back->name eq $self->name;
529 if (ref $otherrel_info->{cond} eq 'HASH') {
530 @othertestconds = ($otherrel_info->{cond});
532 elsif (ref $otherrel_info->{cond} eq 'ARRAY') {
533 @othertestconds = @{$otherrel_info->{cond}};
539 foreach my $othercond (@othertestconds) {
540 my @other_cond = keys(%$othercond);
541 my @other_refkeys = map {/^\w+\.(\w+)$/} @other_cond;
542 my @other_keys = map {$othercond->{$_} =~ /^\w+\.(\w+)$/} @other_cond;
543 next if (!$self->compare_relationship_keys(\@refkeys, \@other_keys) ||
544 !$self->compare_relationship_keys(\@other_refkeys, \@keys));
545 $ret->{$otherrel} = $otherrel_info;
551 =head2 compare_relationship_keys
555 =item Arguments: $keys1, $keys2
559 Returns true if both sets of keynames are the same, false otherwise.
563 sub compare_relationship_keys {
564 my ($self, $keys1, $keys2) = @_;
566 # Make sure every keys1 is in keys2
568 foreach my $key (@$keys1) {
570 foreach my $prim (@$keys2) {
579 # Make sure every key2 is in key1
581 foreach my $prim (@$keys2) {
583 foreach my $key (@$keys1) {
600 =item Arguments: $relation
604 Returns the join structure required for the related result source.
609 my ($self, $join, $alias, $seen) = @_;
611 if (ref $join eq 'ARRAY') {
612 return map { $self->resolve_join($_, $alias, $seen) } @$join;
613 } elsif (ref $join eq 'HASH') {
616 my $as = ($seen->{$_} ? $_.'_'.($seen->{$_}+1) : $_);
617 ($self->resolve_join($_, $alias, $seen),
618 $self->related_source($_)->resolve_join($join->{$_}, $as, $seen));
620 } elsif (ref $join) {
621 $self->throw_exception("No idea how to resolve join reftype ".ref $join);
623 my $count = ++$seen->{$join};
624 #use Data::Dumper; warn Dumper($seen);
625 my $as = ($count > 1 ? "${join}_${count}" : $join);
626 my $rel_info = $self->relationship_info($join);
627 $self->throw_exception("No such relationship ${join}") unless $rel_info;
628 my $type = $rel_info->{attrs}{join_type} || '';
629 return [ { $as => $self->related_source($join)->from,
630 -join_type => $type },
631 $self->resolve_condition($rel_info->{cond}, $as, $alias) ];
635 =head2 resolve_condition
639 =item Arguments: $cond, $as, $alias|$object
643 Resolves the passed condition to a concrete query fragment. If given an alias,
644 returns a join condition; if given an object, inverts that object to produce
645 a related conditional from that object.
649 sub resolve_condition {
650 my ($self, $cond, $as, $for) = @_;
652 if (ref $cond eq 'HASH') {
654 while (my ($k, $v) = each %{$cond}) {
655 # XXX should probably check these are valid columns
656 $k =~ s/^foreign\.// ||
657 $self->throw_exception("Invalid rel cond key ${k}");
659 $self->throw_exception("Invalid rel cond val ${v}");
660 if (ref $for) { # Object
661 #warn "$self $k $for $v";
662 $ret{$k} = $for->get_column($v);
664 } elsif (ref $as) { # reverse object
665 $ret{$v} = $as->get_column($k);
667 $ret{"${as}.${k}"} = "${for}.${v}";
671 } elsif (ref $cond eq 'ARRAY') {
672 return [ map { $self->resolve_condition($_, $as, $for) } @$cond ];
674 die("Can't handle this yet :(");
678 =head2 resolve_prefetch
682 =item Arguments: hashref/arrayref/scalar
686 Accepts one or more relationships for the current source and returns an
687 array of column names for each of those relationships. Column names are
688 prefixed relative to the current source, in accordance with where they appear
689 in the supplied relationships. Examples:
691 my $source = $schema->resultset('Tag')->source;
692 @columns = $source->resolve_prefetch( { cd => 'artist' } );
700 # 'cd.artist.artistid',
704 @columns = $source->resolve_prefetch( qw[/ cd /] );
714 $source = $schema->resultset('CD')->source;
715 @columns = $source->resolve_prefetch( qw[/ artist producer /] );
721 # 'producer.producerid',
727 sub resolve_prefetch {
728 my ($self, $pre, $alias, $seen, $order, $collapse) = @_;
730 #$alias ||= $self->name;
731 #warn $alias, Dumper $pre;
732 if( ref $pre eq 'ARRAY' ) {
734 map { $self->resolve_prefetch( $_, $alias, $seen, $order, $collapse ) }
737 elsif( ref $pre eq 'HASH' ) {
740 $self->resolve_prefetch($_, $alias, $seen, $order, $collapse),
741 $self->related_source($_)->resolve_prefetch(
742 $pre->{$_}, "${alias}.$_", $seen, $order, $collapse)
748 $self->throw_exception(
749 "don't know how to resolve prefetch reftype ".ref($pre));
752 my $count = ++$seen->{$pre};
753 my $as = ($count > 1 ? "${pre}_${count}" : $pre);
754 my $rel_info = $self->relationship_info( $pre );
755 $self->throw_exception( $self->name . " has no such relationship '$pre'" )
757 my $as_prefix = ($alias =~ /^.*?\.(.+)$/ ? $1.'.' : '');
758 my $rel_source = $self->related_source($pre);
760 if (exists $rel_info->{attrs}{accessor}
761 && $rel_info->{attrs}{accessor} eq 'multi') {
762 $self->throw_exception(
763 "Can't prefetch has_many ${pre} (join cond too complex)")
764 unless ref($rel_info->{cond}) eq 'HASH';
765 my @key = map { (/^foreign\.(.+)$/ ? ($1) : ()); }
766 keys %{$rel_info->{cond}};
767 $collapse->{"${as_prefix}${pre}"} = \@key;
768 my @ord = (ref($rel_info->{attrs}{order_by}) eq 'ARRAY'
769 ? @{$rel_info->{attrs}{order_by}}
770 : (defined $rel_info->{attrs}{order_by}
771 ? ($rel_info->{attrs}{order_by})
773 push(@$order, map { "${as}.$_" } (@key, @ord));
776 return map { [ "${as}.$_", "${as_prefix}${pre}.$_", ] }
777 $rel_source->columns;
778 #warn $alias, Dumper (\@ret);
783 =head2 related_source
787 =item Arguments: $relname
791 Returns the result source object for the given relationship.
796 my ($self, $rel) = @_;
797 if( !$self->has_relationship( $rel ) ) {
798 $self->throw_exception("No such relationship '$rel'");
800 return $self->schema->source($self->relationship_info($rel)->{source});
807 =item Arguments: $relname
811 Returns the class name for objects in the given relationship.
816 my ($self, $rel) = @_;
817 if( !$self->has_relationship( $rel ) ) {
818 $self->throw_exception("No such relationship '$rel'");
820 return $self->schema->class($self->relationship_info($rel)->{source});
825 Returns a resultset for the given source. This will initially be created
828 $self->resultset_class->new($self, $self->resultset_attributes)
830 but is cached from then on unless resultset_class changes.
832 =head2 resultset_class
834 Set the class of the resultset, this is useful if you want to create your
835 own resultset methods. Create your own class derived from
836 L<DBIx::Class::ResultSet>, and set it here.
838 =head2 resultset_attributes
840 Specify here any attributes you wish to pass to your specialised resultset.
846 $self->throw_exception(
847 'resultset does not take any arguments. If you want another resultset, '.
848 'call it on the schema instead.'
850 return $self->{_resultset}
851 if ref $self->{_resultset} eq $self->resultset_class;
852 return $self->{_resultset} = $self->resultset_class->new(
853 $self, $self->{resultset_attributes}
861 =item Arguments: $source_name
865 Set the name of the result source when it is loaded into a schema.
866 This is usefull if you want to refer to a result source by a name other than
869 package ArchivedBooks;
870 use base qw/DBIx::Class/;
871 __PACKAGE__->table('books_archive');
872 __PACKAGE__->source_name('Books');
874 # from your schema...
875 $schema->resultset('Books')->find(1);
877 =head2 throw_exception
879 See L<DBIx::Class::Schema/"throw_exception">.
883 sub throw_exception {
885 if (defined $self->schema) {
886 $self->schema->throw_exception(@_);
894 Matt S. Trout <mst@shadowcatsystems.co.uk>
898 You may distribute this code under the same terms as Perl itself.