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 currently not used by DBIx::Class.
98 Set this to a true value if this column represents a key from a
99 foreign table. This is currently not used by DBIx::Class.
103 Set this to the default value which will be inserted into this column
104 by the database. Can contain either values or functions. This is
105 currently not used by DBIx::Class.
109 If your column is using a sequence to create it's values, set the name
110 of the sequence here, to allow the values to be retrieved
111 automatically by the L<DBIx::Class::PK::Auto> module. PK::Auto will
112 attempt to retrieve the sequence name from the database, if this value
119 $table->add_column('col' => \%info?);
121 Convenience alias to add_columns
126 my ($self, @cols) = @_;
127 $self->_ordered_columns(\@cols) unless $self->_ordered_columns;
130 my $columns = $self->_columns;
131 while (my $col = shift @cols) {
132 # If next entry is { ... } use that for the column info, if not
133 # use an empty hashref
134 my $column_info = ref $cols[0] ? shift(@cols) : {};
135 push(@added, $col) unless exists $columns->{$col};
136 $columns->{$col} = $column_info;
138 push @{ $self->_ordered_columns }, @added;
142 *add_column = \&add_columns;
146 if ($obj->has_column($col)) { ... }
148 Returns 1 if the source has a column of this name, 0 otherwise.
153 my ($self, $column) = @_;
154 return exists $self->_columns->{$column};
159 my $info = $obj->column_info($col);
161 Returns the column metadata hashref for a column. See the description
162 of add_column for information on the contents of the hashref.
167 my ($self, $column) = @_;
168 $self->throw_exception("No such column $column")
169 unless exists $self->_columns->{$column};
170 #warn $self->{_columns_info_loaded}, "\n";
171 if ( ! $self->_columns->{$column}{data_type}
172 and ! $self->{_columns_info_loaded}
173 and $self->schema and $self->storage )
175 $self->{_columns_info_loaded}++;
177 # eval for the case of storage without table
178 eval { $info = $self->storage->columns_info_for($self->from) };
180 foreach my $col ( keys %{$self->_columns} ) {
181 foreach my $i ( keys %{$info->{$col}} ) {
182 $self->_columns->{$col}{$i} = $info->{$col}{$i};
187 return $self->_columns->{$column};
192 my @column_names = $obj->columns;
194 Returns all column names in the order they were declared to add_columns
200 $self->throw_exception("columns() is a read-only accessor, did you mean add_columns()?") if (@_ > 1);
201 return @{$self->{_ordered_columns}||[]};
204 =head2 set_primary_key
206 =head3 Arguments: (@cols)
208 Defines one or more columns as primary key for this source. Should be
209 called after C<add_columns>.
211 Additionally, defines a unique constraint named C<primary>.
213 The primary key columns are used by L<DBIx::Class::PK::Auto> to
214 retrieve automatically created values from the database.
218 sub set_primary_key {
219 my ($self, @cols) = @_;
220 # check if primary key columns are valid columns
221 foreach my $col (@cols) {
222 $self->throw_exception("No such column $col on table " . $self->name)
223 unless $self->has_column($col);
225 $self->_primaries(\@cols);
227 $self->add_unique_constraint(primary => \@cols);
230 =head2 primary_columns
232 Read-only accessor which returns the list of primary keys.
236 sub primary_columns {
237 return @{shift->_primaries||[]};
240 =head2 add_unique_constraint
242 Declare a unique constraint on this source. Call once for each unique
243 constraint. Unique constraints are used when you call C<find> on a
244 L<DBIx::Class::ResultSet>, only columns in the constraint are searched,
246 # For e.g. UNIQUE (column1, column2)
247 __PACKAGE__->add_unique_constraint(constraint_name => [ qw/column1 column2/ ]);
251 sub add_unique_constraint {
252 my ($self, $name, $cols) = @_;
254 foreach my $col (@$cols) {
255 $self->throw_exception("No such column $col on table " . $self->name)
256 unless $self->has_column($col);
259 my %unique_constraints = $self->unique_constraints;
260 $unique_constraints{$name} = $cols;
261 $self->_unique_constraints(\%unique_constraints);
264 =head2 unique_constraints
266 Read-only accessor which returns the list of unique constraints on this source.
270 sub unique_constraints {
271 return %{shift->_unique_constraints||{}};
276 Returns an expression of the source to be supplied to storage to specify
277 retrieval from this source; in the case of a database the required FROM clause
284 Returns the storage handle for the current schema.
286 See also: L<DBIx::Class::Storage>
290 sub storage { shift->schema->storage; }
292 =head2 add_relationship
294 $source->add_relationship('relname', 'related_source', $cond, $attrs);
296 The relationship name can be arbitrary, but must be unique for each
297 relationship attached to this result source. 'related_source' should
298 be the name with which the related result source was registered with
299 the current schema. For example:
301 $schema->source('Book')->add_relationship('reviews', 'Review', {
302 'foreign.book_id' => 'self.id',
305 The condition C<$cond> needs to be an SQL::Abstract-style
306 representation of the join between the tables. For example, if you're
307 creating a rel from Author to Book,
309 { 'foreign.author_id' => 'self.id' }
311 will result in the JOIN clause
313 author me JOIN book foreign ON foreign.author_id = me.id
315 You can specify as many foreign => self mappings as necessary.
317 Valid attributes are as follows:
323 Explicitly specifies the type of join to use in the relationship. Any
324 SQL join type is valid, e.g. C<LEFT> or C<RIGHT>. It will be placed in
325 the SQL command immediately before C<JOIN>.
329 An arrayref containing a list of accessors in the foreign class to proxy in
330 the main class. If, for example, you do the following:
332 CD->might_have(liner_notes => 'LinerNotes', undef, {
333 proxy => [ qw/notes/ ],
336 Then, assuming LinerNotes has an accessor named notes, you can do:
338 my $cd = CD->find(1);
339 $cd->notes('Notes go here'); # set notes -- LinerNotes object is
340 # created if it doesn't exist
344 Specifies the type of accessor that should be created for the
345 relationship. Valid values are C<single> (for when there is only a single
346 related object), C<multi> (when there can be many), and C<filter> (for
347 when there is a single related object, but you also want the relationship
348 accessor to double as a column accessor). For C<multi> accessors, an
349 add_to_* method is also created, which calls C<create_related> for the
356 sub add_relationship {
357 my ($self, $rel, $f_source_name, $cond, $attrs) = @_;
358 $self->throw_exception("Can't create relationship without join condition") unless $cond;
361 my %rels = %{ $self->_relationships };
362 $rels{$rel} = { class => $f_source_name,
363 source => $f_source_name,
366 $self->_relationships(\%rels);
370 # XXX disabled. doesn't work properly currently. skip in tests.
372 my $f_source = $self->schema->source($f_source_name);
374 eval "require $f_source_name;";
376 die $@ unless $@ =~ /Can't locate/;
378 $f_source = $f_source_name->result_source;
379 #my $s_class = ref($self->schema);
380 #$f_source_name =~ m/^${s_class}::(.*)$/;
381 #$self->schema->register_class(($1 || $f_source_name), $f_source_name);
382 #$f_source = $self->schema->source($f_source_name);
384 return unless $f_source; # Can't test rel without f_source
386 eval { $self->resolve_join($rel, 'me') };
388 if ($@) { # If the resolve failed, back out and re-throw the error
389 delete $rels{$rel}; #
390 $self->_relationships(\%rels);
391 $self->throw_exception("Error creating relationship $rel: $@");
398 Returns all valid relationship names for this source
403 return keys %{shift->_relationships};
406 =head2 relationship_info
408 =head3 Arguments: ($relname)
410 Returns the relationship information for the specified relationship name
414 sub relationship_info {
415 my ($self, $rel) = @_;
416 return $self->_relationships->{$rel};
419 =head2 has_relationship
421 =head3 Arguments: ($rel)
423 Returns 1 if the source has a relationship of this name, 0 otherwise.
427 sub has_relationship {
428 my ($self, $rel) = @_;
429 return exists $self->_relationships->{$rel};
434 =head3 Arguments: ($relation)
436 Returns the join structure required for the related result source
441 my ($self, $join, $alias, $seen) = @_;
443 if (ref $join eq 'ARRAY') {
444 return map { $self->resolve_join($_, $alias, $seen) } @$join;
445 } elsif (ref $join eq 'HASH') {
448 my $as = ($seen->{$_} ? $_.'_'.($seen->{$_}+1) : $_);
449 ($self->resolve_join($_, $alias, $seen),
450 $self->related_source($_)->resolve_join($join->{$_}, $as, $seen));
452 } elsif (ref $join) {
453 $self->throw_exception("No idea how to resolve join reftype ".ref $join);
455 my $count = ++$seen->{$join};
456 #use Data::Dumper; warn Dumper($seen);
457 my $as = ($count > 1 ? "${join}_${count}" : $join);
458 my $rel_info = $self->relationship_info($join);
459 $self->throw_exception("No such relationship ${join}") unless $rel_info;
460 my $type = $rel_info->{attrs}{join_type} || '';
461 return [ { $as => $self->related_source($join)->from,
462 -join_type => $type },
463 $self->resolve_condition($rel_info->{cond}, $as, $alias) ];
467 =head2 resolve_condition
469 =head3 Arguments: ($cond, $as, $alias|$object)
471 Resolves the passed condition to a concrete query fragment. If given an alias,
472 returns a join condition; if given an object, inverts that object to produce
473 a related conditional from that object.
477 sub resolve_condition {
478 my ($self, $cond, $as, $for) = @_;
480 if (ref $cond eq 'HASH') {
482 while (my ($k, $v) = each %{$cond}) {
483 # XXX should probably check these are valid columns
484 $k =~ s/^foreign\.// || $self->throw_exception("Invalid rel cond key ${k}");
485 $v =~ s/^self\.// || $self->throw_exception("Invalid rel cond val ${v}");
486 if (ref $for) { # Object
487 #warn "$self $k $for $v";
488 $ret{$k} = $for->get_column($v);
490 } elsif (ref $as) { # reverse object
491 $ret{$v} = $as->get_column($k);
493 $ret{"${as}.${k}"} = "${for}.${v}";
497 } elsif (ref $cond eq 'ARRAY') {
498 return [ map { $self->resolve_condition($_, $as, $for) } @$cond ];
500 die("Can't handle this yet :(");
504 =head2 resolve_prefetch
506 =head3 Arguments: (hashref/arrayref/scalar)
508 Accepts one or more relationships for the current source and returns an
509 array of column names for each of those relationships. Column names are
510 prefixed relative to the current source, in accordance with where they appear
511 in the supplied relationships. Examples:
513 my $source = $schema->resultset('Tag')->source;
514 @columns = $source->resolve_prefetch( { cd => 'artist' } );
522 # 'cd.artist.artistid',
526 @columns = $source->resolve_prefetch( qw[/ cd /] );
536 $source = $schema->resultset('CD')->source;
537 @columns = $source->resolve_prefetch( qw[/ artist producer /] );
543 # 'producer.producerid',
549 sub resolve_prefetch {
550 my ($self, $pre, $alias, $seen, $order, $collapse) = @_;
552 #$alias ||= $self->name;
553 #warn $alias, Dumper $pre;
554 if( ref $pre eq 'ARRAY' ) {
556 map { $self->resolve_prefetch( $_, $alias, $seen, $order, $collapse ) }
559 elsif( ref $pre eq 'HASH' ) {
562 $self->resolve_prefetch($_, $alias, $seen, $order, $collapse),
563 $self->related_source($_)->resolve_prefetch(
564 $pre->{$_}, "${alias}.$_", $seen, $order, $collapse)
570 $self->throw_exception(
571 "don't know how to resolve prefetch reftype ".ref($pre));
574 my $count = ++$seen->{$pre};
575 my $as = ($count > 1 ? "${pre}_${count}" : $pre);
576 my $rel_info = $self->relationship_info( $pre );
577 $self->throw_exception( $self->name . " has no such relationship '$pre'" )
579 my $as_prefix = ($alias =~ /^.*?\.(.+)$/ ? $1.'.' : '');
580 my $rel_source = $self->related_source($pre);
582 if (exists $rel_info->{attrs}{accessor}
583 && $rel_info->{attrs}{accessor} eq 'multi') {
584 $self->throw_exception(
585 "Can't prefetch has_many ${pre} (join cond too complex)")
586 unless ref($rel_info->{cond}) eq 'HASH';
587 my @key = map { (/^foreign\.(.+)$/ ? ($1) : ()); }
588 keys %{$rel_info->{cond}};
589 $collapse->{"${as_prefix}${pre}"} = \@key;
590 my @ord = (ref($rel_info->{attrs}{order_by}) eq 'ARRAY'
591 ? @{$rel_info->{attrs}{order_by}}
592 : (defined $rel_info->{attrs}{order_by}
593 ? ($rel_info->{attrs}{order_by})
595 push(@$order, map { "${as}.$_" } (@key, @ord));
598 return map { [ "${as}.$_", "${as_prefix}${pre}.$_", ] }
599 $rel_source->columns;
600 #warn $alias, Dumper (\@ret);
605 =head2 related_source
607 =head3 Arguments: ($relname)
609 Returns the result source object for the given relationship
614 my ($self, $rel) = @_;
615 if( !$self->has_relationship( $rel ) ) {
616 $self->throw_exception("No such relationship '$rel'");
618 return $self->schema->source($self->relationship_info($rel)->{source});
623 =head3 Arguments: ($relname)
625 Returns the class object for the given relationship
630 my ($self, $rel) = @_;
631 if( !$self->has_relationship( $rel ) ) {
632 $self->throw_exception("No such relationship '$rel'");
634 return $self->schema->class($self->relationship_info($rel)->{source});
639 Returns a resultset for the given source, by calling:
641 $self->resultset_class->new($self, $self->resultset_attributes)
643 =head2 resultset_class
645 Set the class of the resultset, this is useful if you want to create your
646 own resultset methods. Create your own class derived from
647 L<DBIx::Class::ResultSet>, and set it here.
649 =head2 resultset_attributes
651 Specify here any attributes you wish to pass to your specialised resultset.
657 $self->throw_exception('resultset does not take any arguments. If you want another resultset, call it on the schema instead.') if scalar @_;
658 return $self->{_resultset} if ref $self->{_resultset} eq $self->resultset_class;
659 return $self->{_resultset} = $self->resultset_class->new($self, $self->{resultset_attributes});
662 =head2 throw_exception
664 See throw_exception in L<DBIx::Class::Schema>.
668 sub throw_exception {
670 if (defined $self->schema) {
671 $self->schema->throw_exception(@_);
680 Matt S. Trout <mst@shadowcatsystems.co.uk>
684 You may distribute this code under the same terms as Perl itself.