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 Sets the name of the sequence to use to generate values. If not
111 specified, L<DBIx::Class::PK::Auto> will attempt to retrieve the
112 name of the sequence from the database automatically.
118 $table->add_column('col' => \%info?);
120 Convenience alias to add_columns
125 my ($self, @cols) = @_;
126 $self->_ordered_columns(\@cols) unless $self->_ordered_columns;
129 my $columns = $self->_columns;
130 while (my $col = shift @cols) {
131 # If next entry is { ... } use that for the column info, if not
132 # use an empty hashref
133 my $column_info = ref $cols[0] ? shift(@cols) : {};
134 push(@added, $col) unless exists $columns->{$col};
135 $columns->{$col} = $column_info;
137 push @{ $self->_ordered_columns }, @added;
141 *add_column = \&add_columns;
145 if ($obj->has_column($col)) { ... }
147 Returns 1 if the source has a column of this name, 0 otherwise.
152 my ($self, $column) = @_;
153 return exists $self->_columns->{$column};
158 my $info = $obj->column_info($col);
160 Returns the column metadata hashref for a column. See the description
161 of add_column for information on the contents of the hashref.
166 my ($self, $column) = @_;
167 $self->throw_exception("No such column $column")
168 unless exists $self->_columns->{$column};
169 #warn $self->{_columns_info_loaded}, "\n";
170 if ( ! $self->_columns->{$column}{data_type}
171 and ! $self->{_columns_info_loaded}
172 and $self->schema and $self->storage )
174 $self->{_columns_info_loaded}++;
176 # eval for the case of storage without table
177 eval { $info = $self->storage->columns_info_for($self->from) };
179 foreach my $col ( keys %{$self->_columns} ) {
180 foreach my $i ( keys %{$info->{$col}} ) {
181 $self->_columns->{$col}{$i} = $info->{$col}{$i};
186 return $self->_columns->{$column};
191 my @column_names = $obj->columns;
193 Returns all column names in the order they were declared to add_columns
199 $self->throw_exception("columns() is a read-only accessor, did you mean add_columns()?") if (@_ > 1);
200 return @{$self->{_ordered_columns}||[]};
203 =head2 set_primary_key
205 =head3 Arguments: (@cols)
207 Defines one or more columns as primary key for this source. Should be
208 called after C<add_columns>.
210 Additionally, defines a unique constraint named C<primary>.
212 The primary key columns are used by L<DBIx::Class::PK::Auto> to
213 retrieve automatically created values from the database.
217 sub set_primary_key {
218 my ($self, @cols) = @_;
219 # check if primary key columns are valid columns
220 foreach my $col (@cols) {
221 $self->throw_exception("No such column $col on table " . $self->name)
222 unless $self->has_column($col);
224 $self->_primaries(\@cols);
226 $self->add_unique_constraint(primary => \@cols);
229 =head2 primary_columns
231 Read-only accessor which returns the list of primary keys.
235 sub primary_columns {
236 return @{shift->_primaries||[]};
239 =head2 add_unique_constraint
241 Declare a unique constraint on this source. Call once for each unique
242 constraint. Unique constraints are used when you call C<find> on a
243 L<DBIx::Class::ResultSet>, only columns in the constraint are searched,
245 # For e.g. UNIQUE (column1, column2)
246 __PACKAGE__->add_unique_constraint(constraint_name => [ qw/column1 column2/ ]);
250 sub add_unique_constraint {
251 my ($self, $name, $cols) = @_;
253 foreach my $col (@$cols) {
254 $self->throw_exception("No such column $col on table " . $self->name)
255 unless $self->has_column($col);
258 my %unique_constraints = $self->unique_constraints;
259 $unique_constraints{$name} = $cols;
260 $self->_unique_constraints(\%unique_constraints);
263 =head2 unique_constraints
265 Read-only accessor which returns the list of unique constraints on this source.
269 sub unique_constraints {
270 return %{shift->_unique_constraints||{}};
275 Returns an expression of the source to be supplied to storage to specify
276 retrieval from this source; in the case of a database the required FROM clause
283 Returns the storage handle for the current schema.
285 See also: L<DBIx::Class::Storage>
289 sub storage { shift->schema->storage; }
291 =head2 add_relationship
293 $source->add_relationship('relname', 'related_source', $cond, $attrs);
295 The relationship name can be arbitrary, but must be unique for each
296 relationship attached to this result source. 'related_source' should
297 be the name with which the related result source was registered with
298 the current schema. For example:
300 $schema->source('Book')->add_relationship('reviews', 'Review', {
301 'foreign.book_id' => 'self.id',
304 The condition C<$cond> needs to be an SQL::Abstract-style
305 representation of the join between the tables. For example, if you're
306 creating a rel from Author to Book,
308 { 'foreign.author_id' => 'self.id' }
310 will result in the JOIN clause
312 author me JOIN book foreign ON foreign.author_id = me.id
314 You can specify as many foreign => self mappings as necessary.
316 Valid attributes are as follows:
322 Explicitly specifies the type of join to use in the relationship. Any
323 SQL join type is valid, e.g. C<LEFT> or C<RIGHT>. It will be placed in
324 the SQL command immediately before C<JOIN>.
328 An arrayref containing a list of accessors in the foreign class to proxy in
329 the main class. If, for example, you do the following:
331 CD->might_have(liner_notes => 'LinerNotes', undef, {
332 proxy => [ qw/notes/ ],
335 Then, assuming LinerNotes has an accessor named notes, you can do:
337 my $cd = CD->find(1);
338 $cd->notes('Notes go here'); # set notes -- LinerNotes object is
339 # created if it doesn't exist
343 Specifies the type of accessor that should be created for the
344 relationship. Valid values are C<single> (for when there is only a single
345 related object), C<multi> (when there can be many), and C<filter> (for
346 when there is a single related object, but you also want the relationship
347 accessor to double as a column accessor). For C<multi> accessors, an
348 add_to_* method is also created, which calls C<create_related> for the
355 sub add_relationship {
356 my ($self, $rel, $f_source_name, $cond, $attrs) = @_;
357 $self->throw_exception("Can't create relationship without join condition") unless $cond;
360 my %rels = %{ $self->_relationships };
361 $rels{$rel} = { class => $f_source_name,
362 source => $f_source_name,
365 $self->_relationships(\%rels);
369 # XXX disabled. doesn't work properly currently. skip in tests.
371 my $f_source = $self->schema->source($f_source_name);
373 eval "require $f_source_name;";
375 die $@ unless $@ =~ /Can't locate/;
377 $f_source = $f_source_name->result_source;
378 #my $s_class = ref($self->schema);
379 #$f_source_name =~ m/^${s_class}::(.*)$/;
380 #$self->schema->register_class(($1 || $f_source_name), $f_source_name);
381 #$f_source = $self->schema->source($f_source_name);
383 return unless $f_source; # Can't test rel without f_source
385 eval { $self->resolve_join($rel, 'me') };
387 if ($@) { # If the resolve failed, back out and re-throw the error
388 delete $rels{$rel}; #
389 $self->_relationships(\%rels);
390 $self->throw_exception("Error creating relationship $rel: $@");
397 Returns all valid relationship names for this source
402 return keys %{shift->_relationships};
405 =head2 relationship_info
407 =head3 Arguments: ($relname)
409 Returns the relationship information for the specified relationship name
413 sub relationship_info {
414 my ($self, $rel) = @_;
415 return $self->_relationships->{$rel};
418 =head2 has_relationship
420 =head3 Arguments: ($rel)
422 Returns 1 if the source has a relationship of this name, 0 otherwise.
426 sub has_relationship {
427 my ($self, $rel) = @_;
428 return exists $self->_relationships->{$rel};
433 =head3 Arguments: ($relation)
435 Returns the join structure required for the related result source
440 my ($self, $join, $alias, $seen) = @_;
442 if (ref $join eq 'ARRAY') {
443 return map { $self->resolve_join($_, $alias, $seen) } @$join;
444 } elsif (ref $join eq 'HASH') {
447 my $as = ($seen->{$_} ? $_.'_'.($seen->{$_}+1) : $_);
448 ($self->resolve_join($_, $alias, $seen),
449 $self->related_source($_)->resolve_join($join->{$_}, $as, $seen));
451 } elsif (ref $join) {
452 $self->throw_exception("No idea how to resolve join reftype ".ref $join);
454 my $count = ++$seen->{$join};
455 #use Data::Dumper; warn Dumper($seen);
456 my $as = ($count > 1 ? "${join}_${count}" : $join);
457 my $rel_info = $self->relationship_info($join);
458 $self->throw_exception("No such relationship ${join}") unless $rel_info;
459 my $type = $rel_info->{attrs}{join_type} || '';
460 return [ { $as => $self->related_source($join)->from,
461 -join_type => $type },
462 $self->resolve_condition($rel_info->{cond}, $as, $alias) ];
466 =head2 resolve_condition
468 =head3 Arguments: ($cond, $as, $alias|$object)
470 Resolves the passed condition to a concrete query fragment. If given an alias,
471 returns a join condition; if given an object, inverts that object to produce
472 a related conditional from that object.
476 sub resolve_condition {
477 my ($self, $cond, $as, $for) = @_;
479 if (ref $cond eq 'HASH') {
481 while (my ($k, $v) = each %{$cond}) {
482 # XXX should probably check these are valid columns
483 $k =~ s/^foreign\.// || $self->throw_exception("Invalid rel cond key ${k}");
484 $v =~ s/^self\.// || $self->throw_exception("Invalid rel cond val ${v}");
485 if (ref $for) { # Object
486 #warn "$self $k $for $v";
487 $ret{$k} = $for->get_column($v);
489 } elsif (ref $as) { # reverse object
490 $ret{$v} = $as->get_column($k);
492 $ret{"${as}.${k}"} = "${for}.${v}";
496 } elsif (ref $cond eq 'ARRAY') {
497 return [ map { $self->resolve_condition($_, $as, $for) } @$cond ];
499 die("Can't handle this yet :(");
503 =head2 resolve_prefetch
505 =head3 Arguments: (hashref/arrayref/scalar)
507 Accepts one or more relationships for the current source and returns an
508 array of column names for each of those relationships. Column names are
509 prefixed relative to the current source, in accordance with where they appear
510 in the supplied relationships. Examples:
512 my $source = $schema->resultset('Tag')->source;
513 @columns = $source->resolve_prefetch( { cd => 'artist' } );
521 # 'cd.artist.artistid',
525 @columns = $source->resolve_prefetch( qw[/ cd /] );
535 $source = $schema->resultset('CD')->source;
536 @columns = $source->resolve_prefetch( qw[/ artist producer /] );
542 # 'producer.producerid',
548 sub resolve_prefetch {
549 my ($self, $pre, $alias, $seen, $order, $collapse) = @_;
551 #$alias ||= $self->name;
552 #warn $alias, Dumper $pre;
553 if( ref $pre eq 'ARRAY' ) {
555 map { $self->resolve_prefetch( $_, $alias, $seen, $order, $collapse ) }
558 elsif( ref $pre eq 'HASH' ) {
561 $self->resolve_prefetch($_, $alias, $seen, $order, $collapse),
562 $self->related_source($_)->resolve_prefetch(
563 $pre->{$_}, "${alias}.$_", $seen, $order, $collapse)
569 $self->throw_exception(
570 "don't know how to resolve prefetch reftype ".ref($pre));
573 my $count = ++$seen->{$pre};
574 my $as = ($count > 1 ? "${pre}_${count}" : $pre);
575 my $rel_info = $self->relationship_info( $pre );
576 $self->throw_exception( $self->name . " has no such relationship '$pre'" )
578 my $as_prefix = ($alias =~ /^.*?\.(.+)$/ ? $1.'.' : '');
579 my $rel_source = $self->related_source($pre);
581 if (exists $rel_info->{attrs}{accessor}
582 && $rel_info->{attrs}{accessor} eq 'multi') {
583 $self->throw_exception(
584 "Can't prefetch has_many ${pre} (join cond too complex)")
585 unless ref($rel_info->{cond}) eq 'HASH';
586 my @key = map { (/^foreign\.(.+)$/ ? ($1) : ()); }
587 keys %{$rel_info->{cond}};
588 $collapse->{"${as_prefix}${pre}"} = \@key;
589 my @ord = (ref($rel_info->{attrs}{order_by}) eq 'ARRAY'
590 ? @{$rel_info->{attrs}{order_by}}
591 : (defined $rel_info->{attrs}{order_by}
592 ? ($rel_info->{attrs}{order_by})
594 push(@$order, map { "${as}.$_" } (@key, @ord));
597 return map { [ "${as}.$_", "${as_prefix}${pre}.$_", ] }
598 $rel_source->columns;
599 #warn $alias, Dumper (\@ret);
604 =head2 related_source
606 =head3 Arguments: ($relname)
608 Returns the result source object for the given relationship
613 my ($self, $rel) = @_;
614 if( !$self->has_relationship( $rel ) ) {
615 $self->throw_exception("No such relationship '$rel'");
617 return $self->schema->source($self->relationship_info($rel)->{source});
622 =head3 Arguments: ($relname)
624 Returns the class object for the given relationship
629 my ($self, $rel) = @_;
630 if( !$self->has_relationship( $rel ) ) {
631 $self->throw_exception("No such relationship '$rel'");
633 return $self->schema->class($self->relationship_info($rel)->{source});
638 Returns a resultset for the given source. This will initially be created
641 $self->resultset_class->new($self, $self->resultset_attributes)
643 but is cached from then on unless resultset_class changes.
645 =head2 resultset_class
647 Set the class of the resultset, this is useful if you want to create your
648 own resultset methods. Create your own class derived from
649 L<DBIx::Class::ResultSet>, and set it here.
651 =head2 resultset_attributes
653 Specify here any attributes you wish to pass to your specialised resultset.
659 $self->throw_exception('resultset does not take any arguments. If you want another resultset, call it on the schema instead.') if scalar @_;
660 return $self->{_resultset} if ref $self->{_resultset} eq $self->resultset_class;
661 return $self->{_resultset} = $self->resultset_class->new($self, $self->{resultset_attributes});
664 =head2 throw_exception
666 See throw_exception in L<DBIx::Class::Schema>.
670 sub throw_exception {
672 if (defined $self->schema) {
673 $self->schema->throw_exception(@_);
682 Matt S. Trout <mst@shadowcatsystems.co.uk>
686 You may distribute this code under the same terms as Perl itself.