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 relation name can be arbitrary, but must be unique for each relationship
297 attached to this result source. 'related_source' should be the name with
298 which the related result source was registered with the current schema
299 (for simple schemas this is usally either Some::Namespace::Foo or just Foo)
301 The condition needs to be an SQL::Abstract-style representation of the join
302 between the tables. For example, if you're creating a rel from Author to Book,
304 { 'foreign.author_id' => 'self.id' }
306 will result in the JOIN clause
308 author me JOIN book foreign ON foreign.author_id = me.id
310 You can specify as many foreign => self mappings as necessary.
312 Valid attributes are as follows:
318 Explicitly specifies the type of join to use in the relationship. Any
319 SQL join type is valid, e.g. C<LEFT> or C<RIGHT>. It will be placed in
320 the SQL command immediately before C<JOIN>.
324 An arrayref containing a list of accessors in the foreign class to
325 proxy in the main class. If, for example, you do the following:
327 __PACKAGE__->might_have(bar => 'Bar', undef, { proxy => [ qw/margle/] });
329 Then, assuming Bar has an accessor named margle, you can do:
331 my $obj = Foo->find(1);
332 $obj->margle(10); # set margle; Bar object is created if it doesn't exist
336 Specifies the type of accessor that should be created for the
337 relationship. Valid values are C<single> (for when there is only a single
338 related object), C<multi> (when there can be many), and C<filter> (for
339 when there is a single related object, but you also want the relationship
340 accessor to double as a column accessor). For C<multi> accessors, an
341 add_to_* method is also created, which calls C<create_related> for the
348 sub add_relationship {
349 my ($self, $rel, $f_source_name, $cond, $attrs) = @_;
350 $self->throw_exception("Can't create relationship without join condition") unless $cond;
353 my %rels = %{ $self->_relationships };
354 $rels{$rel} = { class => $f_source_name,
355 source => $f_source_name,
358 $self->_relationships(\%rels);
362 # XXX disabled. doesn't work properly currently. skip in tests.
364 my $f_source = $self->schema->source($f_source_name);
366 eval "require $f_source_name;";
368 die $@ unless $@ =~ /Can't locate/;
370 $f_source = $f_source_name->result_source;
371 #my $s_class = ref($self->schema);
372 #$f_source_name =~ m/^${s_class}::(.*)$/;
373 #$self->schema->register_class(($1 || $f_source_name), $f_source_name);
374 #$f_source = $self->schema->source($f_source_name);
376 return unless $f_source; # Can't test rel without f_source
378 eval { $self->resolve_join($rel, 'me') };
380 if ($@) { # If the resolve failed, back out and re-throw the error
381 delete $rels{$rel}; #
382 $self->_relationships(\%rels);
383 $self->throw_exception("Error creating relationship $rel: $@");
390 Returns all valid relationship names for this source
395 return keys %{shift->_relationships};
398 =head2 relationship_info
400 =head3 Arguments: ($relname)
402 Returns the relationship information for the specified relationship name
406 sub relationship_info {
407 my ($self, $rel) = @_;
408 return $self->_relationships->{$rel};
411 =head2 has_relationship
413 =head3 Arguments: ($rel)
415 Returns 1 if the source has a relationship of this name, 0 otherwise.
419 sub has_relationship {
420 my ($self, $rel) = @_;
421 return exists $self->_relationships->{$rel};
426 =head3 Arguments: ($relation)
428 Returns the join structure required for the related result source
433 my ($self, $join, $alias, $seen) = @_;
435 if (ref $join eq 'ARRAY') {
436 return map { $self->resolve_join($_, $alias, $seen) } @$join;
437 } elsif (ref $join eq 'HASH') {
440 my $as = ($seen->{$_} ? $_.'_'.($seen->{$_}+1) : $_);
441 ($self->resolve_join($_, $alias, $seen),
442 $self->related_source($_)->resolve_join($join->{$_}, $as, $seen));
444 } elsif (ref $join) {
445 $self->throw_exception("No idea how to resolve join reftype ".ref $join);
447 my $count = ++$seen->{$join};
448 #use Data::Dumper; warn Dumper($seen);
449 my $as = ($count > 1 ? "${join}_${count}" : $join);
450 my $rel_info = $self->relationship_info($join);
451 $self->throw_exception("No such relationship ${join}") unless $rel_info;
452 my $type = $rel_info->{attrs}{join_type} || '';
453 return [ { $as => $self->related_source($join)->from,
454 -join_type => $type },
455 $self->resolve_condition($rel_info->{cond}, $as, $alias) ];
459 =head2 resolve_condition
461 =head3 Arguments: ($cond, $as, $alias|$object)
463 Resolves the passed condition to a concrete query fragment. If given an alias,
464 returns a join condition; if given an object, inverts that object to produce
465 a related conditional from that object.
469 sub resolve_condition {
470 my ($self, $cond, $as, $for) = @_;
472 if (ref $cond eq 'HASH') {
474 while (my ($k, $v) = each %{$cond}) {
475 # XXX should probably check these are valid columns
476 $k =~ s/^foreign\.// || $self->throw_exception("Invalid rel cond key ${k}");
477 $v =~ s/^self\.// || $self->throw_exception("Invalid rel cond val ${v}");
478 if (ref $for) { # Object
479 #warn "$self $k $for $v";
480 $ret{$k} = $for->get_column($v);
482 } elsif (ref $as) { # reverse object
483 $ret{$v} = $as->get_column($k);
485 $ret{"${as}.${k}"} = "${for}.${v}";
489 } elsif (ref $cond eq 'ARRAY') {
490 return [ map { $self->resolve_condition($_, $as, $for) } @$cond ];
492 die("Can't handle this yet :(");
496 =head2 resolve_prefetch
498 =head3 Arguments: (hashref/arrayref/scalar)
500 Accepts one or more relationships for the current source and returns an
501 array of column names for each of those relationships. Column names are
502 prefixed relative to the current source, in accordance with where they appear
503 in the supplied relationships. Examples:
505 my $source = $schema->resultset('Tag')->source;
506 @columns = $source->resolve_prefetch( { cd => 'artist' } );
514 # 'cd.artist.artistid',
518 @columns = $source->resolve_prefetch( qw[/ cd /] );
528 $source = $schema->resultset('CD')->source;
529 @columns = $source->resolve_prefetch( qw[/ artist producer /] );
535 # 'producer.producerid',
541 sub resolve_prefetch {
542 my ($self, $pre, $alias, $seen, $order, $collapse) = @_;
544 #$alias ||= $self->name;
545 #warn $alias, Dumper $pre;
546 if( ref $pre eq 'ARRAY' ) {
548 map { $self->resolve_prefetch( $_, $alias, $seen, $order, $collapse ) }
551 elsif( ref $pre eq 'HASH' ) {
554 $self->resolve_prefetch($_, $alias, $seen, $order, $collapse),
555 $self->related_source($_)->resolve_prefetch(
556 $pre->{$_}, "${alias}.$_", $seen, $order, $collapse)
562 $self->throw_exception(
563 "don't know how to resolve prefetch reftype ".ref($pre));
566 my $count = ++$seen->{$pre};
567 my $as = ($count > 1 ? "${pre}_${count}" : $pre);
568 my $rel_info = $self->relationship_info( $pre );
569 $self->throw_exception( $self->name . " has no such relationship '$pre'" )
571 my $as_prefix = ($alias =~ /^.*?\.(.+)$/ ? $1.'.' : '');
572 my $rel_source = $self->related_source($pre);
574 if (exists $rel_info->{attrs}{accessor}
575 && $rel_info->{attrs}{accessor} eq 'multi') {
576 $self->throw_exception(
577 "Can't prefetch has_many ${pre} (join cond too complex)")
578 unless ref($rel_info->{cond}) eq 'HASH';
579 my @key = map { (/^foreign\.(.+)$/ ? ($1) : ()); }
580 keys %{$rel_info->{cond}};
581 $collapse->{"${as_prefix}${pre}"} = \@key;
582 my @ord = (ref($rel_info->{attrs}{order_by}) eq 'ARRAY'
583 ? @{$rel_info->{attrs}{order_by}}
584 : (defined $rel_info->{attrs}{order_by}
585 ? ($rel_info->{attrs}{order_by})
587 push(@$order, map { "${as}.$_" } (@key, @ord));
590 return map { [ "${as}.$_", "${as_prefix}${pre}.$_", ] }
591 $rel_source->columns;
592 #warn $alias, Dumper (\@ret);
597 =head2 related_source
599 =head3 Arguments: ($relname)
601 Returns the result source object for the given relationship
606 my ($self, $rel) = @_;
607 if( !$self->has_relationship( $rel ) ) {
608 $self->throw_exception("No such relationship '$rel'");
610 return $self->schema->source($self->relationship_info($rel)->{source});
615 Returns a resultset for the given source, by calling:
617 $self->resultset_class->new($self, $self->resultset_attributes)
619 =head2 resultset_class
621 Set the class of the resultset, this is useful if you want to create your
622 own resultset methods. Create your own class derived from
623 L<DBIx::Class::ResultSet>, and set it here.
625 =head2 resultset_attributes
627 Specify here any attributes you wish to pass to your specialised resultset.
633 $self->throw_exception('resultset does not take any arguments. If you want another resultset, call it on the schema instead.') if scalar @_;
634 return $self->{_resultset} if ref $self->{_resultset} eq $self->resultset_class;
635 return $self->{_resultset} = $self->resultset_class->new($self, $self->{resultset_attributes});
638 =head2 throw_exception
640 See throw_exception in L<DBIx::Class::Schema>.
644 sub throw_exception {
646 if (defined $self->schema) {
647 $self->schema->throw_exception(@_);
656 Matt S. Trout <mst@shadowcatsystems.co.uk>
660 You may distribute this code under the same terms as Perl itself.