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.
60 Repeated calls of this method will add more columns, not replace them.
62 The contents of the column_info are not set in stone, the following
63 keys are currently recognised/used by DBIx::Class.
69 Use this to set the name of the accessor for this column. If unset,
70 the name of the column will be used.
74 This contains the column type, it is automatically filled by the
75 L<SQL::Translator::Producer::DBIx::Class::File> producer, and the
76 L<DBIx::Class::Schema::Loader> module. If you do not enter the
77 data_type, DBIx::Class will attempt to retrieve it from the
78 database for you, using L<DBI>s column_info method. The values of this
79 key are typically upper-cased.
81 Currently there is no standard set of values for the data_type, use
82 whatever your database(s) support.
86 The length of your column, if it is a column type that can have a size
87 restriction. This is currently not used by DBIx::Class.
91 If the column is allowed to contain NULL values, set a true value
92 (typically 1), here. This is currently not used by DBIx::Class.
94 =item is_auto_increment
96 Set this to a true value if this is a column that is somehow
97 automatically filled. This is used to determine which columns to empty
98 when cloning objects using C<copy>.
102 Set this to a true value if this column represents a key from a
103 foreign table. This is currently not used by DBIx::Class.
107 Set this to the default value which will be inserted into this column
108 by the database. Can contain either values or functions. This is
109 currently not used by DBIx::Class.
113 Sets the name of the sequence to use to generate values. If not
114 specified, L<DBIx::Class::PK::Auto> will attempt to retrieve the
115 name of the sequence from the database automatically.
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 1 if the source has a column of this name, 0 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
210 =head3 Arguments: (@cols)
212 Defines one or more columns as primary key for this source. Should be
213 called after C<add_columns>.
215 Additionally, defines a unique constraint named C<primary>.
217 The primary key columns are used by L<DBIx::Class::PK::Auto> to
218 retrieve automatically created values from the database.
222 sub set_primary_key {
223 my ($self, @cols) = @_;
224 # check if primary key columns are valid columns
225 foreach my $col (@cols) {
226 $self->throw_exception("No such column $col on table " . $self->name)
227 unless $self->has_column($col);
229 $self->_primaries(\@cols);
231 $self->add_unique_constraint(primary => \@cols);
234 =head2 primary_columns
236 Read-only accessor which returns the list of primary keys.
240 sub primary_columns {
241 return @{shift->_primaries||[]};
244 =head2 add_unique_constraint
246 Declare a unique constraint on this source. Call once for each unique
247 constraint. Unique constraints are used when you call C<find> on a
248 L<DBIx::Class::ResultSet>, only columns in the constraint are searched,
250 # For e.g. UNIQUE (column1, column2)
251 __PACKAGE__->add_unique_constraint(constraint_name => [ qw/column1 column2/ ]);
255 sub add_unique_constraint {
256 my ($self, $name, $cols) = @_;
258 foreach my $col (@$cols) {
259 $self->throw_exception("No such column $col on table " . $self->name)
260 unless $self->has_column($col);
263 my %unique_constraints = $self->unique_constraints;
264 $unique_constraints{$name} = $cols;
265 $self->_unique_constraints(\%unique_constraints);
268 =head2 unique_constraints
270 Read-only accessor which returns the list of unique constraints on this source.
274 sub unique_constraints {
275 return %{shift->_unique_constraints||{}};
280 Returns an expression of the source to be supplied to storage to specify
281 retrieval from this source; in the case of a database the required FROM clause
288 Returns the storage handle for the current schema.
290 See also: L<DBIx::Class::Storage>
294 sub storage { shift->schema->storage; }
296 =head2 add_relationship
298 $source->add_relationship('relname', 'related_source', $cond, $attrs);
300 The relationship name can be arbitrary, but must be unique for each
301 relationship attached to this result source. 'related_source' should
302 be the name with which the related result source was registered with
303 the current schema. For example:
305 $schema->source('Book')->add_relationship('reviews', 'Review', {
306 'foreign.book_id' => 'self.id',
309 The condition C<$cond> needs to be an SQL::Abstract-style
310 representation of the join between the tables. For example, if you're
311 creating a rel from Author to Book,
313 { 'foreign.author_id' => 'self.id' }
315 will result in the JOIN clause
317 author me JOIN book foreign ON foreign.author_id = me.id
319 You can specify as many foreign => self mappings as necessary.
321 Valid attributes are as follows:
327 Explicitly specifies the type of join to use in the relationship. Any
328 SQL join type is valid, e.g. C<LEFT> or C<RIGHT>. It will be placed in
329 the SQL command immediately before C<JOIN>.
333 An arrayref containing a list of accessors in the foreign class to proxy in
334 the main class. If, for example, you do the following:
336 CD->might_have(liner_notes => 'LinerNotes', undef, {
337 proxy => [ qw/notes/ ],
340 Then, assuming LinerNotes has an accessor named notes, you can do:
342 my $cd = CD->find(1);
343 $cd->notes('Notes go here'); # set notes -- LinerNotes object is
344 # created if it doesn't exist
348 Specifies the type of accessor that should be created for the
349 relationship. Valid values are C<single> (for when there is only a single
350 related object), C<multi> (when there can be many), and C<filter> (for
351 when there is a single related object, but you also want the relationship
352 accessor to double as a column accessor). For C<multi> accessors, an
353 add_to_* method is also created, which calls C<create_related> for the
360 sub add_relationship {
361 my ($self, $rel, $f_source_name, $cond, $attrs) = @_;
362 $self->throw_exception("Can't create relationship without join condition") unless $cond;
365 my %rels = %{ $self->_relationships };
366 $rels{$rel} = { class => $f_source_name,
367 source => $f_source_name,
370 $self->_relationships(\%rels);
374 # XXX disabled. doesn't work properly currently. skip in tests.
376 my $f_source = $self->schema->source($f_source_name);
378 eval "require $f_source_name;";
380 die $@ unless $@ =~ /Can't locate/;
382 $f_source = $f_source_name->result_source;
383 #my $s_class = ref($self->schema);
384 #$f_source_name =~ m/^${s_class}::(.*)$/;
385 #$self->schema->register_class(($1 || $f_source_name), $f_source_name);
386 #$f_source = $self->schema->source($f_source_name);
388 return unless $f_source; # Can't test rel without f_source
390 eval { $self->resolve_join($rel, 'me') };
392 if ($@) { # If the resolve failed, back out and re-throw the error
393 delete $rels{$rel}; #
394 $self->_relationships(\%rels);
395 $self->throw_exception("Error creating relationship $rel: $@");
402 Returns all valid relationship names for this source
407 return keys %{shift->_relationships};
410 =head2 relationship_info
412 =head3 Arguments: ($relname)
414 Returns the relationship information for the specified relationship name
418 sub relationship_info {
419 my ($self, $rel) = @_;
420 return $self->_relationships->{$rel};
423 =head2 has_relationship
425 =head3 Arguments: ($rel)
427 Returns 1 if the source has a relationship of this name, 0 otherwise.
431 sub has_relationship {
432 my ($self, $rel) = @_;
433 return exists $self->_relationships->{$rel};
438 =head3 Arguments: ($relation)
440 Returns the join structure required for the related result source
445 my ($self, $join, $alias, $seen) = @_;
447 if (ref $join eq 'ARRAY') {
448 return map { $self->resolve_join($_, $alias, $seen) } @$join;
449 } elsif (ref $join eq 'HASH') {
452 my $as = ($seen->{$_} ? $_.'_'.($seen->{$_}+1) : $_);
453 ($self->resolve_join($_, $alias, $seen),
454 $self->related_source($_)->resolve_join($join->{$_}, $as, $seen));
456 } elsif (ref $join) {
457 $self->throw_exception("No idea how to resolve join reftype ".ref $join);
459 my $count = ++$seen->{$join};
460 #use Data::Dumper; warn Dumper($seen);
461 my $as = ($count > 1 ? "${join}_${count}" : $join);
462 my $rel_info = $self->relationship_info($join);
463 $self->throw_exception("No such relationship ${join}") unless $rel_info;
464 my $type = $rel_info->{attrs}{join_type} || '';
465 return [ { $as => $self->related_source($join)->from,
466 -join_type => $type },
467 $self->resolve_condition($rel_info->{cond}, $as, $alias) ];
471 =head2 resolve_condition
473 =head3 Arguments: ($cond, $as, $alias|$object)
475 Resolves the passed condition to a concrete query fragment. If given an alias,
476 returns a join condition; if given an object, inverts that object to produce
477 a related conditional from that object.
481 sub resolve_condition {
482 my ($self, $cond, $as, $for) = @_;
484 if (ref $cond eq 'HASH') {
486 while (my ($k, $v) = each %{$cond}) {
487 # XXX should probably check these are valid columns
488 $k =~ s/^foreign\.// || $self->throw_exception("Invalid rel cond key ${k}");
489 $v =~ s/^self\.// || $self->throw_exception("Invalid rel cond val ${v}");
490 if (ref $for) { # Object
491 #warn "$self $k $for $v";
492 $ret{$k} = $for->get_column($v);
494 } elsif (ref $as) { # reverse object
495 $ret{$v} = $as->get_column($k);
497 $ret{"${as}.${k}"} = "${for}.${v}";
501 } elsif (ref $cond eq 'ARRAY') {
502 return [ map { $self->resolve_condition($_, $as, $for) } @$cond ];
504 die("Can't handle this yet :(");
508 =head2 resolve_prefetch
510 =head3 Arguments: (hashref/arrayref/scalar)
512 Accepts one or more relationships for the current source and returns an
513 array of column names for each of those relationships. Column names are
514 prefixed relative to the current source, in accordance with where they appear
515 in the supplied relationships. Examples:
517 my $source = $schema->resultset('Tag')->source;
518 @columns = $source->resolve_prefetch( { cd => 'artist' } );
526 # 'cd.artist.artistid',
530 @columns = $source->resolve_prefetch( qw[/ cd /] );
540 $source = $schema->resultset('CD')->source;
541 @columns = $source->resolve_prefetch( qw[/ artist producer /] );
547 # 'producer.producerid',
553 sub resolve_prefetch {
554 my ($self, $pre, $alias, $seen, $order, $collapse) = @_;
556 #$alias ||= $self->name;
557 #warn $alias, Dumper $pre;
558 if( ref $pre eq 'ARRAY' ) {
560 map { $self->resolve_prefetch( $_, $alias, $seen, $order, $collapse ) }
563 elsif( ref $pre eq 'HASH' ) {
566 $self->resolve_prefetch($_, $alias, $seen, $order, $collapse),
567 $self->related_source($_)->resolve_prefetch(
568 $pre->{$_}, "${alias}.$_", $seen, $order, $collapse)
574 $self->throw_exception(
575 "don't know how to resolve prefetch reftype ".ref($pre));
578 my $count = ++$seen->{$pre};
579 my $as = ($count > 1 ? "${pre}_${count}" : $pre);
580 my $rel_info = $self->relationship_info( $pre );
581 $self->throw_exception( $self->name . " has no such relationship '$pre'" )
583 my $as_prefix = ($alias =~ /^.*?\.(.+)$/ ? $1.'.' : '');
584 my $rel_source = $self->related_source($pre);
586 if (exists $rel_info->{attrs}{accessor}
587 && $rel_info->{attrs}{accessor} eq 'multi') {
588 $self->throw_exception(
589 "Can't prefetch has_many ${pre} (join cond too complex)")
590 unless ref($rel_info->{cond}) eq 'HASH';
591 my @key = map { (/^foreign\.(.+)$/ ? ($1) : ()); }
592 keys %{$rel_info->{cond}};
593 $collapse->{"${as_prefix}${pre}"} = \@key;
594 my @ord = (ref($rel_info->{attrs}{order_by}) eq 'ARRAY'
595 ? @{$rel_info->{attrs}{order_by}}
596 : (defined $rel_info->{attrs}{order_by}
597 ? ($rel_info->{attrs}{order_by})
599 push(@$order, map { "${as}.$_" } (@key, @ord));
602 return map { [ "${as}.$_", "${as_prefix}${pre}.$_", ] }
603 $rel_source->columns;
604 #warn $alias, Dumper (\@ret);
609 =head2 related_source
611 =head3 Arguments: ($relname)
613 Returns the result source object for the given relationship
618 my ($self, $rel) = @_;
619 if( !$self->has_relationship( $rel ) ) {
620 $self->throw_exception("No such relationship '$rel'");
622 return $self->schema->source($self->relationship_info($rel)->{source});
627 =head3 Arguments: ($relname)
629 Returns the class object for the given relationship
634 my ($self, $rel) = @_;
635 if( !$self->has_relationship( $rel ) ) {
636 $self->throw_exception("No such relationship '$rel'");
638 return $self->schema->class($self->relationship_info($rel)->{source});
643 Returns a resultset for the given source. This will initially be created
646 $self->resultset_class->new($self, $self->resultset_attributes)
648 but is cached from then on unless resultset_class changes.
650 =head2 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.
656 =head2 resultset_attributes
658 Specify here any attributes you wish to pass to your specialised resultset.
664 $self->throw_exception('resultset does not take any arguments. If you want another resultset, call it on the schema instead.') if scalar @_;
665 return $self->{_resultset} if ref $self->{_resultset} eq $self->resultset_class;
666 return $self->{_resultset} = $self->resultset_class->new($self, $self->{resultset_attributes});
669 =head2 throw_exception
671 See throw_exception in L<DBIx::Class::Schema>.
675 sub throw_exception {
677 if (defined $self->schema) {
678 $self->schema->throw_exception(@_);
687 Matt S. Trout <mst@shadowcatsystems.co.uk>
691 You may distribute this code under the same terms as Perl itself.