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' =>
14 qw/_ordered_columns _columns _primaries _unique_constraints name resultset_attributes schema from _relationships/);
15 __PACKAGE__->mk_group_accessors('component_class' => qw/resultset_class result_class/);
19 DBIx::Class::ResultSource - Result source object
25 A ResultSource is a component of a schema from which results can be directly
26 retrieved, most usually a table (see L<DBIx::Class::ResultSource::Table>)
33 my ($class, $attrs) = @_;
34 $class = ref $class if ref $class;
35 my $new = bless({ %{$attrs || {}}, _resultset => undef }, $class);
36 $new->{resultset_class} ||= 'DBIx::Class::ResultSet';
37 $new->{resultset_attributes} = { %{$new->{resultset_attributes} || {}} };
38 $new->{_ordered_columns} = [ @{$new->{_ordered_columns}||[]}];
39 $new->{_columns} = { %{$new->{_columns}||{}} };
40 $new->{_relationships} = { %{$new->{_relationships}||{}} };
41 $new->{name} ||= "!!NAME NOT SET!!";
42 $new->{_columns_info_loaded} ||= 0;
50 $table->add_columns(qw/col1 col2 col3/);
52 $table->add_columns('col1' => \%col1_info, 'col2' => \%col2_info, ...);
54 Adds columns to the result source. If supplied key => hashref pairs uses
55 the hashref as the column_info for that column.
57 Repeated calls of this method will add more columns, not replace them.
59 The contents of the column_info are not set in stone, the following
60 keys are currently recognised/used by DBIx::Class.
66 Use this to set the name of the accessor for this column. If unset,
67 the name of the column will be used.
71 This contains the column type, it is automatically filled by the
72 L<SQL::Translator::Producer::DBIx::Class::File> producer, and the
73 L<DBIx::Class::Schema::Loader> module. If you do not enter the
74 data_type, DBIx::Class will attempt to retrieve it from the
75 database for you, using L<DBI>s column_info method. The values of this
76 key are typically upper-cased.
78 Currently there is no standard set of values for the data_type, use
79 whatever your database(s) support.
83 The length of your column, if it is a column type that can have a size
84 restriction. This is currently not used by DBIx::Class.
88 If the column is allowed to contain NULL values, set a true value
89 (typically 1), here. This is currently not used by DBIx::Class.
91 =item is_auto_increment
93 Set this to a true value if this is a column that is somehow
94 automatically filled. This is used to determine which columns to empty
95 when cloning objects using C<copy>.
99 Set this to a true value if this column represents a key from a
100 foreign table. This is currently not used by DBIx::Class.
104 Set this to the default value which will be inserted into this column
105 by the database. Can contain either values or functions. This is
106 currently not used by DBIx::Class.
110 If your column is using a sequence to create it's values, set the name
111 of the sequence here, to allow the values to be retrieved
112 automatically by the L<DBIx::Class::PK::Auto> module. PK::Auto will
113 attempt to retrieve the sequence name from the database, if this value
120 $table->add_column('col' => \%info?);
122 Convenience alias to add_columns
127 my ($self, @cols) = @_;
128 $self->_ordered_columns(\@cols) unless $self->_ordered_columns;
131 my $columns = $self->_columns;
132 while (my $col = shift @cols) {
133 # If next entry is { ... } use that for the column info, if not
134 # use an empty hashref
135 my $column_info = ref $cols[0] ? shift(@cols) : {};
136 push(@added, $col) unless exists $columns->{$col};
137 $columns->{$col} = $column_info;
139 push @{ $self->_ordered_columns }, @added;
143 *add_column = \&add_columns;
147 if ($obj->has_column($col)) { ... }
149 Returns 1 if the source has a column of this name, 0 otherwise.
154 my ($self, $column) = @_;
155 return exists $self->_columns->{$column};
160 my $info = $obj->column_info($col);
162 Returns the column metadata hashref for a column. See the description
163 of add_column for information on the contents of the hashref.
168 my ($self, $column) = @_;
169 $self->throw_exception("No such column $column")
170 unless exists $self->_columns->{$column};
171 #warn $self->{_columns_info_loaded}, "\n";
172 if ( ! $self->_columns->{$column}{data_type}
173 and ! $self->{_columns_info_loaded}
174 and $self->schema and $self->storage )
176 $self->{_columns_info_loaded}++;
178 # eval for the case of storage without table
179 eval { $info = $self->storage->columns_info_for($self->from) };
181 foreach my $col ( keys %{$self->_columns} ) {
182 foreach my $i ( keys %{$info->{$col}} ) {
183 $self->_columns->{$col}{$i} = $info->{$col}{$i};
188 return $self->_columns->{$column};
193 my @column_names = $obj->columns;
195 Returns all column names in the order they were declared to add_columns
201 $self->throw_exception("columns() is a read-only accessor, did you mean add_columns()?") if (@_ > 1);
202 return @{$self->{_ordered_columns}||[]};
205 =head2 set_primary_key
207 =head3 Arguments: (@cols)
209 Defines one or more columns as primary key for this source. Should be
210 called after C<add_columns>.
212 Additionally, defines a unique constraint named C<primary>.
214 The primary key columns are used by L<DBIx::Class::PK::Auto> to
215 retrieve automatically created values from the database.
219 sub set_primary_key {
220 my ($self, @cols) = @_;
221 # check if primary key columns are valid columns
222 foreach my $col (@cols) {
223 $self->throw_exception("No such column $col on table " . $self->name)
224 unless $self->has_column($col);
226 $self->_primaries(\@cols);
228 $self->add_unique_constraint(primary => \@cols);
231 =head2 primary_columns
233 Read-only accessor which returns the list of primary keys.
237 sub primary_columns {
238 return @{shift->_primaries||[]};
241 =head2 add_unique_constraint
243 Declare a unique constraint on this source. Call once for each unique
244 constraint. Unique constraints are used when you call C<find> on a
245 L<DBIx::Class::ResultSet>, only columns in the constraint are searched,
247 # For e.g. UNIQUE (column1, column2)
248 __PACKAGE__->add_unique_constraint(constraint_name => [ qw/column1 column2/ ]);
252 sub add_unique_constraint {
253 my ($self, $name, $cols) = @_;
255 foreach my $col (@$cols) {
256 $self->throw_exception("No such column $col on table " . $self->name)
257 unless $self->has_column($col);
260 my %unique_constraints = $self->unique_constraints;
261 $unique_constraints{$name} = $cols;
262 $self->_unique_constraints(\%unique_constraints);
265 =head2 unique_constraints
267 Read-only accessor which returns the list of unique constraints on this source.
271 sub unique_constraints {
272 return %{shift->_unique_constraints||{}};
277 Returns an expression of the source to be supplied to storage to specify
278 retrieval from this source; in the case of a database the required FROM clause
285 Returns the storage handle for the current schema.
287 See also: L<DBIx::Class::Storage>
291 sub storage { shift->schema->storage; }
293 =head2 add_relationship
295 $source->add_relationship('relname', 'related_source', $cond, $attrs);
297 The relationship name can be arbitrary, but must be unique for each
298 relationship attached to this result source. 'related_source' should
299 be the name with which the related result source was registered with
300 the current schema. For example:
302 $schema->source('Book')->add_relationship('reviews', 'Review', {
303 'foreign.book_id' => 'self.id',
306 The condition C<$cond> needs to be an SQL::Abstract-style
307 representation of the join between the tables. For example, if you're
308 creating a rel from Author to Book,
310 { 'foreign.author_id' => 'self.id' }
312 will result in the JOIN clause
314 author me JOIN book foreign ON foreign.author_id = me.id
316 You can specify as many foreign => self mappings as necessary.
318 Valid attributes are as follows:
324 Explicitly specifies the type of join to use in the relationship. Any
325 SQL join type is valid, e.g. C<LEFT> or C<RIGHT>. It will be placed in
326 the SQL command immediately before C<JOIN>.
330 An arrayref containing a list of accessors in the foreign class to proxy in
331 the main class. If, for example, you do the following:
333 CD->might_have(liner_notes => 'LinerNotes', undef, {
334 proxy => [ qw/notes/ ],
337 Then, assuming LinerNotes has an accessor named notes, you can do:
339 my $cd = CD->find(1);
340 $cd->notes('Notes go here'); # set notes -- LinerNotes object is
341 # created if it doesn't exist
345 Specifies the type of accessor that should be created for the
346 relationship. Valid values are C<single> (for when there is only a single
347 related object), C<multi> (when there can be many), and C<filter> (for
348 when there is a single related object, but you also want the relationship
349 accessor to double as a column accessor). For C<multi> accessors, an
350 add_to_* method is also created, which calls C<create_related> for the
357 sub add_relationship {
358 my ($self, $rel, $f_source_name, $cond, $attrs) = @_;
359 $self->throw_exception("Can't create relationship without join condition") unless $cond;
362 my %rels = %{ $self->_relationships };
363 $rels{$rel} = { class => $f_source_name,
364 source => $f_source_name,
367 $self->_relationships(\%rels);
371 # XXX disabled. doesn't work properly currently. skip in tests.
373 my $f_source = $self->schema->source($f_source_name);
375 eval "require $f_source_name;";
377 die $@ unless $@ =~ /Can't locate/;
379 $f_source = $f_source_name->result_source;
380 #my $s_class = ref($self->schema);
381 #$f_source_name =~ m/^${s_class}::(.*)$/;
382 #$self->schema->register_class(($1 || $f_source_name), $f_source_name);
383 #$f_source = $self->schema->source($f_source_name);
385 return unless $f_source; # Can't test rel without f_source
387 eval { $self->resolve_join($rel, 'me') };
389 if ($@) { # If the resolve failed, back out and re-throw the error
390 delete $rels{$rel}; #
391 $self->_relationships(\%rels);
392 $self->throw_exception("Error creating relationship $rel: $@");
399 Returns all valid relationship names for this source
404 return keys %{shift->_relationships};
407 =head2 relationship_info
409 =head3 Arguments: ($relname)
411 Returns the relationship information for the specified relationship name
415 sub relationship_info {
416 my ($self, $rel) = @_;
417 return $self->_relationships->{$rel};
420 =head2 has_relationship
422 =head3 Arguments: ($rel)
424 Returns 1 if the source has a relationship of this name, 0 otherwise.
428 sub has_relationship {
429 my ($self, $rel) = @_;
430 return exists $self->_relationships->{$rel};
435 =head3 Arguments: ($relation)
437 Returns the join structure required for the related result source
442 my ($self, $join, $alias, $seen) = @_;
444 if (ref $join eq 'ARRAY') {
445 return map { $self->resolve_join($_, $alias, $seen) } @$join;
446 } elsif (ref $join eq 'HASH') {
449 my $as = ($seen->{$_} ? $_.'_'.($seen->{$_}+1) : $_);
450 ($self->resolve_join($_, $alias, $seen),
451 $self->related_source($_)->resolve_join($join->{$_}, $as, $seen));
453 } elsif (ref $join) {
454 $self->throw_exception("No idea how to resolve join reftype ".ref $join);
456 my $count = ++$seen->{$join};
457 #use Data::Dumper; warn Dumper($seen);
458 my $as = ($count > 1 ? "${join}_${count}" : $join);
459 my $rel_info = $self->relationship_info($join);
460 $self->throw_exception("No such relationship ${join}") unless $rel_info;
461 my $type = $rel_info->{attrs}{join_type} || '';
462 return [ { $as => $self->related_source($join)->from,
463 -join_type => $type },
464 $self->resolve_condition($rel_info->{cond}, $as, $alias) ];
468 =head2 resolve_condition
470 =head3 Arguments: ($cond, $as, $alias|$object)
472 Resolves the passed condition to a concrete query fragment. If given an alias,
473 returns a join condition; if given an object, inverts that object to produce
474 a related conditional from that object.
478 sub resolve_condition {
479 my ($self, $cond, $as, $for) = @_;
481 if (ref $cond eq 'HASH') {
483 while (my ($k, $v) = each %{$cond}) {
484 # XXX should probably check these are valid columns
485 $k =~ s/^foreign\.// || $self->throw_exception("Invalid rel cond key ${k}");
486 $v =~ s/^self\.// || $self->throw_exception("Invalid rel cond val ${v}");
487 if (ref $for) { # Object
488 #warn "$self $k $for $v";
489 $ret{$k} = $for->get_column($v);
491 } elsif (ref $as) { # reverse object
492 $ret{$v} = $as->get_column($k);
494 $ret{"${as}.${k}"} = "${for}.${v}";
498 } elsif (ref $cond eq 'ARRAY') {
499 return [ map { $self->resolve_condition($_, $as, $for) } @$cond ];
501 die("Can't handle this yet :(");
505 =head2 resolve_prefetch
507 =head3 Arguments: (hashref/arrayref/scalar)
509 Accepts one or more relationships for the current source and returns an
510 array of column names for each of those relationships. Column names are
511 prefixed relative to the current source, in accordance with where they appear
512 in the supplied relationships. Examples:
514 my $source = $schema->resultset('Tag')->source;
515 @columns = $source->resolve_prefetch( { cd => 'artist' } );
523 # 'cd.artist.artistid',
527 @columns = $source->resolve_prefetch( qw[/ cd /] );
537 $source = $schema->resultset('CD')->source;
538 @columns = $source->resolve_prefetch( qw[/ artist producer /] );
544 # 'producer.producerid',
550 sub resolve_prefetch {
551 my ($self, $pre, $alias, $seen, $order, $collapse) = @_;
553 #$alias ||= $self->name;
554 #warn $alias, Dumper $pre;
555 if( ref $pre eq 'ARRAY' ) {
557 map { $self->resolve_prefetch( $_, $alias, $seen, $order, $collapse ) }
560 elsif( ref $pre eq 'HASH' ) {
563 $self->resolve_prefetch($_, $alias, $seen, $order, $collapse),
564 $self->related_source($_)->resolve_prefetch(
565 $pre->{$_}, "${alias}.$_", $seen, $order, $collapse)
571 $self->throw_exception(
572 "don't know how to resolve prefetch reftype ".ref($pre));
575 my $count = ++$seen->{$pre};
576 my $as = ($count > 1 ? "${pre}_${count}" : $pre);
577 my $rel_info = $self->relationship_info( $pre );
578 $self->throw_exception( $self->name . " has no such relationship '$pre'" )
580 my $as_prefix = ($alias =~ /^.*?\.(.+)$/ ? $1.'.' : '');
581 my $rel_source = $self->related_source($pre);
583 if (exists $rel_info->{attrs}{accessor}
584 && $rel_info->{attrs}{accessor} eq 'multi') {
585 $self->throw_exception(
586 "Can't prefetch has_many ${pre} (join cond too complex)")
587 unless ref($rel_info->{cond}) eq 'HASH';
588 my @key = map { (/^foreign\.(.+)$/ ? ($1) : ()); }
589 keys %{$rel_info->{cond}};
590 $collapse->{"${as_prefix}${pre}"} = \@key;
591 my @ord = (ref($rel_info->{attrs}{order_by}) eq 'ARRAY'
592 ? @{$rel_info->{attrs}{order_by}}
593 : (defined $rel_info->{attrs}{order_by}
594 ? ($rel_info->{attrs}{order_by})
596 push(@$order, map { "${as}.$_" } (@key, @ord));
599 return map { [ "${as}.$_", "${as_prefix}${pre}.$_", ] }
600 $rel_source->columns;
601 #warn $alias, Dumper (\@ret);
606 =head2 related_source
608 =head3 Arguments: ($relname)
610 Returns the result source object for the given relationship
615 my ($self, $rel) = @_;
616 if( !$self->has_relationship( $rel ) ) {
617 $self->throw_exception("No such relationship '$rel'");
619 return $self->schema->source($self->relationship_info($rel)->{source});
624 =head3 Arguments: ($relname)
626 Returns the class object for the given relationship
631 my ($self, $rel) = @_;
632 if( !$self->has_relationship( $rel ) ) {
633 $self->throw_exception("No such relationship '$rel'");
635 return $self->schema->class($self->relationship_info($rel)->{source});
640 Returns a resultset for the given source. This will initially be created
643 $self->resultset_class->new($self, $self->resultset_attributes)
645 but is cached from then on unless resultset_class changes.
647 =head2 resultset_class
649 Set the class of the resultset, this is useful if you want to create your
650 own resultset methods. Create your own class derived from
651 L<DBIx::Class::ResultSet>, and set it here.
653 =head2 resultset_attributes
655 Specify here any attributes you wish to pass to your specialised resultset.
661 $self->throw_exception('resultset does not take any arguments. If you want another resultset, call it on the schema instead.') if scalar @_;
662 return $self->{_resultset} if ref $self->{_resultset} eq $self->resultset_class;
663 return $self->{_resultset} = $self->resultset_class->new($self, $self->{resultset_attributes});
666 =head2 throw_exception
668 See throw_exception in L<DBIx::Class::Schema>.
672 sub throw_exception {
674 if (defined $self->schema) {
675 $self->schema->throw_exception(@_);
684 Matt S. Trout <mst@shadowcatsystems.co.uk>
688 You may distribute this code under the same terms as Perl itself.