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
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 set_primary_key
212 =item Arguments: @cols
216 Defines one or more columns as primary key for this source. Should be
217 called after C<add_columns>.
219 Additionally, defines a unique constraint named C<primary>.
221 The primary key columns are used by L<DBIx::Class::PK::Auto> to
222 retrieve automatically created values from the database.
226 sub set_primary_key {
227 my ($self, @cols) = @_;
228 # check if primary key columns are valid columns
229 foreach my $col (@cols) {
230 $self->throw_exception("No such column $col on table " . $self->name)
231 unless $self->has_column($col);
233 $self->_primaries(\@cols);
235 $self->add_unique_constraint(primary => \@cols);
238 =head2 primary_columns
240 Read-only accessor which returns the list of primary keys.
244 sub primary_columns {
245 return @{shift->_primaries||[]};
248 =head2 add_unique_constraint
250 Declare a unique constraint on this source. Call once for each unique
251 constraint. Unique constraints are used when you call C<find> on a
252 L<DBIx::Class::ResultSet>. Only columns in the constraint are searched,
255 # For UNIQUE (column1, column2)
256 __PACKAGE__->add_unique_constraint(
257 constraint_name => [ qw/column1 column2/ ],
262 sub add_unique_constraint {
263 my ($self, $name, $cols) = @_;
265 foreach my $col (@$cols) {
266 $self->throw_exception("No such column $col on table " . $self->name)
267 unless $self->has_column($col);
270 my %unique_constraints = $self->unique_constraints;
271 $unique_constraints{$name} = $cols;
272 $self->_unique_constraints(\%unique_constraints);
275 =head2 unique_constraints
277 Read-only accessor which returns the list of unique constraints on this source.
281 sub unique_constraints {
282 return %{shift->_unique_constraints||{}};
287 Returns an expression of the source to be supplied to storage to specify
288 retrieval from this source. In the case of a database, the required FROM
293 Returns the L<DBIx::Class::Schema> object that this result source
298 Returns the storage handle for the current schema.
300 See also: L<DBIx::Class::Storage>
304 sub storage { shift->schema->storage; }
306 =head2 add_relationship
308 $source->add_relationship('relname', 'related_source', $cond, $attrs);
310 The relationship name can be arbitrary, but must be unique for each
311 relationship attached to this result source. 'related_source' should
312 be the name with which the related result source was registered with
313 the current schema. For example:
315 $schema->source('Book')->add_relationship('reviews', 'Review', {
316 'foreign.book_id' => 'self.id',
319 The condition C<$cond> needs to be an L<SQL::Abstract>-style
320 representation of the join between the tables. For example, if you're
321 creating a rel from Author to Book,
323 { 'foreign.author_id' => 'self.id' }
325 will result in the JOIN clause
327 author me JOIN book foreign ON foreign.author_id = me.id
329 You can specify as many foreign => self mappings as necessary.
331 Valid attributes are as follows:
337 Explicitly specifies the type of join to use in the relationship. Any
338 SQL join type is valid, e.g. C<LEFT> or C<RIGHT>. It will be placed in
339 the SQL command immediately before C<JOIN>.
343 An arrayref containing a list of accessors in the foreign class to proxy in
344 the main class. If, for example, you do the following:
346 CD->might_have(liner_notes => 'LinerNotes', undef, {
347 proxy => [ qw/notes/ ],
350 Then, assuming LinerNotes has an accessor named notes, you can do:
352 my $cd = CD->find(1);
353 # set notes -- LinerNotes object is created if it doesn't exist
354 $cd->notes('Notes go here');
358 Specifies the type of accessor that should be created for the
359 relationship. Valid values are C<single> (for when there is only a single
360 related object), C<multi> (when there can be many), and C<filter> (for
361 when there is a single related object, but you also want the relationship
362 accessor to double as a column accessor). For C<multi> accessors, an
363 add_to_* method is also created, which calls C<create_related> for the
370 sub add_relationship {
371 my ($self, $rel, $f_source_name, $cond, $attrs) = @_;
372 $self->throw_exception("Can't create relationship without join condition")
376 my %rels = %{ $self->_relationships };
377 $rels{$rel} = { class => $f_source_name,
378 source => $f_source_name,
381 $self->_relationships(\%rels);
385 # XXX disabled. doesn't work properly currently. skip in tests.
387 my $f_source = $self->schema->source($f_source_name);
389 eval "require $f_source_name;";
391 die $@ unless $@ =~ /Can't locate/;
393 $f_source = $f_source_name->result_source;
394 #my $s_class = ref($self->schema);
395 #$f_source_name =~ m/^${s_class}::(.*)$/;
396 #$self->schema->register_class(($1 || $f_source_name), $f_source_name);
397 #$f_source = $self->schema->source($f_source_name);
399 return unless $f_source; # Can't test rel without f_source
401 eval { $self->resolve_join($rel, 'me') };
403 if ($@) { # If the resolve failed, back out and re-throw the error
404 delete $rels{$rel}; #
405 $self->_relationships(\%rels);
406 $self->throw_exception("Error creating relationship $rel: $@");
413 Returns all relationship names for this source.
418 return keys %{shift->_relationships};
421 =head2 relationship_info
425 =item Arguments: $relname
429 Returns a hash of relationship information for the specified relationship
434 sub relationship_info {
435 my ($self, $rel) = @_;
436 return $self->_relationships->{$rel};
439 =head2 has_relationship
443 =item Arguments: $rel
447 Returns true if the source has a relationship of this name, false otherwise.
451 sub has_relationship {
452 my ($self, $rel) = @_;
453 return exists $self->_relationships->{$rel};
460 =item Arguments: $relation
464 Returns the join structure required for the related result source.
469 my ($self, $join, $alias, $seen) = @_;
471 if (ref $join eq 'ARRAY') {
472 return map { $self->resolve_join($_, $alias, $seen) } @$join;
473 } elsif (ref $join eq 'HASH') {
476 my $as = ($seen->{$_} ? $_.'_'.($seen->{$_}+1) : $_);
477 ($self->resolve_join($_, $alias, $seen),
478 $self->related_source($_)->resolve_join($join->{$_}, $as, $seen));
480 } elsif (ref $join) {
481 $self->throw_exception("No idea how to resolve join reftype ".ref $join);
483 my $count = ++$seen->{$join};
484 #use Data::Dumper; warn Dumper($seen);
485 my $as = ($count > 1 ? "${join}_${count}" : $join);
486 my $rel_info = $self->relationship_info($join);
487 $self->throw_exception("No such relationship ${join}") unless $rel_info;
488 my $type = $rel_info->{attrs}{join_type} || '';
489 return [ { $as => $self->related_source($join)->from,
490 -join_type => $type },
491 $self->resolve_condition($rel_info->{cond}, $as, $alias) ];
495 =head2 resolve_condition
499 =item Arguments: $cond, $as, $alias|$object
503 Resolves the passed condition to a concrete query fragment. If given an alias,
504 returns a join condition; if given an object, inverts that object to produce
505 a related conditional from that object.
509 sub resolve_condition {
510 my ($self, $cond, $as, $for) = @_;
512 if (ref $cond eq 'HASH') {
514 foreach my $k (keys %{$cond}) {
516 # XXX should probably check these are valid columns
517 $k =~ s/^foreign\.// ||
518 $self->throw_exception("Invalid rel cond key ${k}");
520 $self->throw_exception("Invalid rel cond val ${v}");
521 if (ref $for) { # Object
522 #warn "$self $k $for $v";
523 $ret{$k} = $for->get_column($v);
525 } elsif (!defined $for) { # undef, i.e. "no object"
527 } elsif (ref $as) { # reverse object
528 $ret{$v} = $as->get_column($k);
529 } elsif (!defined $as) { # undef, i.e. "no reverse object"
532 $ret{"${as}.${k}"} = "${for}.${v}";
536 } elsif (ref $cond eq 'ARRAY') {
537 return [ map { $self->resolve_condition($_, $as, $for) } @$cond ];
539 die("Can't handle this yet :(");
543 =head2 resolve_prefetch
547 =item Arguments: hashref/arrayref/scalar
551 Accepts one or more relationships for the current source and returns an
552 array of column names for each of those relationships. Column names are
553 prefixed relative to the current source, in accordance with where they appear
554 in the supplied relationships. Examples:
556 my $source = $schema->resultset('Tag')->source;
557 @columns = $source->resolve_prefetch( { cd => 'artist' } );
565 # 'cd.artist.artistid',
569 @columns = $source->resolve_prefetch( qw[/ cd /] );
579 $source = $schema->resultset('CD')->source;
580 @columns = $source->resolve_prefetch( qw[/ artist producer /] );
586 # 'producer.producerid',
592 sub resolve_prefetch {
593 my ($self, $pre, $alias, $seen, $order, $collapse) = @_;
595 #$alias ||= $self->name;
596 #warn $alias, Dumper $pre;
597 if( ref $pre eq 'ARRAY' ) {
599 map { $self->resolve_prefetch( $_, $alias, $seen, $order, $collapse ) }
602 elsif( ref $pre eq 'HASH' ) {
605 $self->resolve_prefetch($_, $alias, $seen, $order, $collapse),
606 $self->related_source($_)->resolve_prefetch(
607 $pre->{$_}, "${alias}.$_", $seen, $order, $collapse)
613 $self->throw_exception(
614 "don't know how to resolve prefetch reftype ".ref($pre));
617 my $count = ++$seen->{$pre};
618 my $as = ($count > 1 ? "${pre}_${count}" : $pre);
619 my $rel_info = $self->relationship_info( $pre );
620 $self->throw_exception( $self->name . " has no such relationship '$pre'" )
622 my $as_prefix = ($alias =~ /^.*?\.(.+)$/ ? $1.'.' : '');
623 my $rel_source = $self->related_source($pre);
625 if (exists $rel_info->{attrs}{accessor}
626 && $rel_info->{attrs}{accessor} eq 'multi') {
627 $self->throw_exception(
628 "Can't prefetch has_many ${pre} (join cond too complex)")
629 unless ref($rel_info->{cond}) eq 'HASH';
630 my @key = map { (/^foreign\.(.+)$/ ? ($1) : ()); }
631 keys %{$rel_info->{cond}};
632 $collapse->{"${as_prefix}${pre}"} = \@key;
633 my @ord = (ref($rel_info->{attrs}{order_by}) eq 'ARRAY'
634 ? @{$rel_info->{attrs}{order_by}}
635 : (defined $rel_info->{attrs}{order_by}
636 ? ($rel_info->{attrs}{order_by})
638 push(@$order, map { "${as}.$_" } (@key, @ord));
641 return map { [ "${as}.$_", "${as_prefix}${pre}.$_", ] }
642 $rel_source->columns;
643 #warn $alias, Dumper (\@ret);
648 =head2 related_source
652 =item Arguments: $relname
656 Returns the result source object for the given relationship.
661 my ($self, $rel) = @_;
662 if( !$self->has_relationship( $rel ) ) {
663 $self->throw_exception("No such relationship '$rel'");
665 return $self->schema->source($self->relationship_info($rel)->{source});
672 =item Arguments: $relname
676 Returns the class name for objects in the given relationship.
681 my ($self, $rel) = @_;
682 if( !$self->has_relationship( $rel ) ) {
683 $self->throw_exception("No such relationship '$rel'");
685 return $self->schema->class($self->relationship_info($rel)->{source});
690 Returns a resultset for the given source. This will initially be created
693 $self->resultset_class->new($self, $self->resultset_attributes)
695 but is cached from then on unless resultset_class changes.
697 =head2 resultset_class
699 Set the class of the resultset, this is useful if you want to create your
700 own resultset methods. Create your own class derived from
701 L<DBIx::Class::ResultSet>, and set it here.
703 =head2 resultset_attributes
705 Specify here any attributes you wish to pass to your specialised resultset.
711 $self->throw_exception(
712 'resultset does not take any arguments. If you want another resultset, '.
713 'call it on the schema instead.'
716 # disabled until we can figure out a way to do it without consistency issues
718 #return $self->{_resultset}
719 # if ref $self->{_resultset} eq $self->resultset_class;
720 #return $self->{_resultset} =
722 return $self->resultset_class->new(
723 $self, $self->{resultset_attributes}
727 =head2 throw_exception
729 See L<DBIx::Class::Schema/"throw_exception">.
733 sub throw_exception {
735 if (defined $self->schema) {
736 $self->schema->throw_exception(@_);
744 Matt S. Trout <mst@shadowcatsystems.co.uk>
748 You may distribute this code under the same terms as Perl itself.