1 package DBIx::Class::ResultSource;
6 use DBIx::Class::ResultSet;
7 use Carp::Clan qw/^DBIx::Class/;
11 use base qw/DBIx::Class/;
12 __PACKAGE__->load_components(qw/AccessorGroup/);
14 __PACKAGE__->mk_group_accessors('simple' =>
15 qw/_ordered_columns _columns _primaries _unique_constraints name resultset_attributes schema from _relationships/);
16 __PACKAGE__->mk_group_accessors('component_class' => qw/resultset_class result_class/);
20 DBIx::Class::ResultSource - Result source object
26 A ResultSource is a component of a schema from which results can be directly
27 retrieved, most usually a table (see L<DBIx::Class::ResultSource::Table>)
34 my ($class, $attrs) = @_;
35 $class = ref $class if ref $class;
36 my $new = bless({ %{$attrs || {}} }, $class);
37 $new->{resultset_class} ||= 'DBIx::Class::ResultSet';
38 $new->{resultset_attributes} = { %{$new->{resultset_attributes} || {}} };
39 $new->{_ordered_columns} = [ @{$new->{_ordered_columns}||[]}];
40 $new->{_columns} = { %{$new->{_columns}||{}} };
41 $new->{_relationships} = { %{$new->{_relationships}||{}} };
42 $new->{name} ||= "!!NAME NOT SET!!";
43 $new->{_columns_info_loaded} ||= 0;
51 $table->add_columns(qw/col1 col2 col3/);
53 $table->add_columns('col1' => \%col1_info, 'col2' => \%col2_info, ...);
55 Adds columns to the result source. If supplied key => hashref pairs uses
56 the hashref as the column_info for that column.
58 Repeated calls of this method will add more columns, not replace them.
60 The contents of the column_info are not set in stone, the following
61 keys are currently recognised/used by DBIx::Class.
67 Use this to set the name of the accessor for this column. If unset,
68 the name of the column will be used.
72 This contains the column type, it is automatically filled by the
73 L<SQL::Translator::Producer::DBIx::Class::File> producer, and the
74 L<DBIx::Class::Schema::Loader> module. If you do not enter the
75 data_type, DBIx::Class will attempt to retrieve it from the
76 database for you, using L<DBI>s column_info method. The values of this
77 key are typically upper-cased.
79 Currently there is no standard set of values for the data_type, use
80 whatever your database(s) support.
84 The length of your column, if it is a column type that can have a size
85 restriction. This is currently not used by DBIx::Class.
89 If the column is allowed to contain NULL values, set a true value
90 (typically 1), here. This is currently not used by DBIx::Class.
92 =item is_auto_increment
94 Set this to a true value if this is a column that is somehow
95 automatically filled. This is currently not used by DBIx::Class.
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 )
129 if !$self->_ordered_columns;
131 my $columns = $self->_columns;
132 while (my $col = shift @cols) {
134 my $column_info = ref $cols[0] ? shift(@cols) : {};
135 # If next entry is { ... } use that for the column info, if not
136 # use an empty hashref
138 push(@added, $col) unless exists $columns->{$col};
140 $columns->{$col} = $column_info;
142 push @{ $self->_ordered_columns }, @added;
146 *add_column = \&add_columns;
150 if ($obj->has_column($col)) { ... }
152 Returns 1 if the source has a column of this name, 0 otherwise.
157 my ($self, $column) = @_;
158 return exists $self->_columns->{$column};
163 my $info = $obj->column_info($col);
165 Returns the column metadata hashref for a column. See the description
166 of add_column for information on the contents of the hashref.
171 my ($self, $column) = @_;
172 $self->throw_exception("No such column $column")
173 unless exists $self->_columns->{$column};
174 #warn $self->{_columns_info_loaded}, "\n";
175 if ( ! $self->_columns->{$column}->{data_type}
176 && ! $self->{_columns_info_loaded}
177 && $self->schema && $self->storage() ){
178 $self->{_columns_info_loaded}++;
180 ############ eval for the case of storage without table
182 $info = $self->storage->columns_info_for ( $self->from() );
185 for my $col ( keys %{$self->_columns} ){
186 for my $i ( keys %{$info->{$col}} ){
187 $self->_columns()->{$col}->{$i} = $info->{$col}->{$i};
192 return $self->_columns->{$column};
197 my @column_names = $obj->columns;
199 Returns all column names in the order they were declared to add_columns
205 $self->throw_exception("columns() is a read-only accessor, did you mean add_columns()?") if (@_ > 1);
206 return @{$self->{_ordered_columns}||[]};
209 =head2 set_primary_key
211 =head3 Arguments: (@cols)
213 Defines one or more columns as primary key for this source. Should be
214 called after C<add_columns>.
216 Additionally, defines a unique constraint named C<primary>.
218 The primary key columns are used by L<DBIx::Class::PK::Auto> to
219 retrieve automatically created values from the database.
223 sub set_primary_key {
224 my ($self, @cols) = @_;
225 # check if primary key columns are valid columns
227 $self->throw_exception("No such column $_ on table ".$self->name)
228 unless $self->has_column($_);
230 $self->_primaries(\@cols);
232 $self->add_unique_constraint(primary => \@cols);
235 =head2 primary_columns
237 Read-only accessor which returns the list of primary keys.
241 sub primary_columns {
242 return @{shift->_primaries||[]};
245 =head2 add_unique_constraint
247 Declare a unique constraint on this source. Call once for each unique
248 constraint. Unique constraints are used when you call C<find> on a
249 L<DBIx::Class::ResultSet>, only columns in the constraint are searched,
251 # For e.g. UNIQUE (column1, column2)
252 __PACKAGE__->add_unique_constraint(constraint_name => [ qw/column1 column2/ ]);
256 sub add_unique_constraint {
257 my ($self, $name, $cols) = @_;
260 $self->throw_exception("No such column $_ on table ".$self->name)
261 unless $self->has_column($_);
264 my %unique_constraints = $self->unique_constraints;
265 $unique_constraints{$name} = $cols;
266 $self->_unique_constraints(\%unique_constraints);
269 =head2 unique_constraints
271 Read-only accessor which returns the list of unique constraints on this source.
275 sub unique_constraints {
276 return %{shift->_unique_constraints||{}};
281 Returns an expression of the source to be supplied to storage to specify
282 retrieval from this source; in the case of a database the required FROM clause
289 Returns the storage handle for the current schema.
291 See also: L<DBIx::Class::Storage>
295 sub storage { shift->schema->storage; }
297 =head2 add_relationship
299 $source->add_relationship('relname', 'related_source', $cond, $attrs);
301 The relation name can be arbitrary, but must be unique for each relationship
302 attached to this result source. 'related_source' should be the name with
303 which the related result source was registered with the current schema
304 (for simple schemas this is usally either Some::Namespace::Foo or just Foo)
306 The condition needs to be an SQL::Abstract-style representation of the join
307 between the tables. For example, if you're 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
330 proxy in the main class. If, for example, you do the following:
332 __PACKAGE__->might_have(bar => 'Bar', undef, { proxy => [ qw/margle/] });
334 Then, assuming Bar has an accessor named margle, you can do:
336 my $obj = Foo->find(1);
337 $obj->margle(10); # set margle; Bar object is created if it doesn't exist
341 Specifies the type of accessor that should be created for the
342 relationship. Valid values are C<single> (for when there is only a single
343 related object), C<multi> (when there can be many), and C<filter> (for
344 when there is a single related object, but you also want the relationship
345 accessor to double as a column accessor). For C<multi> accessors, an
346 add_to_* method is also created, which calls C<create_related> for the
353 sub add_relationship {
354 my ($self, $rel, $f_source_name, $cond, $attrs) = @_;
355 $self->throw_exception("Can't create relationship without join condition") unless $cond;
358 my %rels = %{ $self->_relationships };
359 $rels{$rel} = { class => $f_source_name,
360 source => $f_source_name,
363 $self->_relationships(\%rels);
367 # XXX disabled. doesn't work properly currently. skip in tests.
369 my $f_source = $self->schema->source($f_source_name);
371 eval "require $f_source_name;";
373 die $@ unless $@ =~ /Can't locate/;
375 $f_source = $f_source_name->result_source;
376 #my $s_class = ref($self->schema);
377 #$f_source_name =~ m/^${s_class}::(.*)$/;
378 #$self->schema->register_class(($1 || $f_source_name), $f_source_name);
379 #$f_source = $self->schema->source($f_source_name);
381 return unless $f_source; # Can't test rel without f_source
383 eval { $self->resolve_join($rel, 'me') };
385 if ($@) { # If the resolve failed, back out and re-throw the error
386 delete $rels{$rel}; #
387 $self->_relationships(\%rels);
388 $self->throw_exception("Error creating relationship $rel: $@");
395 Returns all valid relationship names for this source
400 return keys %{shift->_relationships};
403 =head2 relationship_info
405 =head3 Arguments: ($relname)
407 Returns the relationship information for the specified relationship name
411 sub relationship_info {
412 my ($self, $rel) = @_;
413 return $self->_relationships->{$rel};
416 =head2 has_relationship
418 =head3 Arguments: ($rel)
420 Returns 1 if the source has a relationship of this name, 0 otherwise.
424 sub has_relationship {
425 my ($self, $rel) = @_;
426 return exists $self->_relationships->{$rel};
431 =head3 Arguments: ($relation)
433 Returns the join structure required for the related result source
438 my ($self, $join, $alias, $seen) = @_;
440 if (ref $join eq 'ARRAY') {
441 return map { $self->resolve_join($_, $alias, $seen) } @$join;
442 } elsif (ref $join eq 'HASH') {
445 my $as = ($seen->{$_} ? $_.'_'.($seen->{$_}+1) : $_);
446 ($self->resolve_join($_, $alias, $seen),
447 $self->related_source($_)->resolve_join($join->{$_}, $as, $seen));
449 } elsif (ref $join) {
450 $self->throw_exception("No idea how to resolve join reftype ".ref $join);
452 my $count = ++$seen->{$join};
453 #use Data::Dumper; warn Dumper($seen);
454 my $as = ($count > 1 ? "${join}_${count}" : $join);
455 my $rel_info = $self->relationship_info($join);
456 $self->throw_exception("No such relationship ${join}") unless $rel_info;
457 my $type = $rel_info->{attrs}{join_type} || '';
458 return [ { $as => $self->related_source($join)->from,
459 -join_type => $type },
460 $self->resolve_condition($rel_info->{cond}, $as, $alias) ];
464 =head2 resolve_condition
466 =head3 Arguments: ($cond, $as, $alias|$object)
468 Resolves the passed condition to a concrete query fragment. If given an alias,
469 returns a join condition; if given an object, inverts that object to produce
470 a related conditional from that object.
474 sub resolve_condition {
475 my ($self, $cond, $as, $for) = @_;
477 if (ref $cond eq 'HASH') {
479 while (my ($k, $v) = each %{$cond}) {
480 # XXX should probably check these are valid columns
481 $k =~ s/^foreign\.// || $self->throw_exception("Invalid rel cond key ${k}");
482 $v =~ s/^self\.// || $self->throw_exception("Invalid rel cond val ${v}");
483 if (ref $for) { # Object
484 #warn "$self $k $for $v";
485 $ret{$k} = $for->get_column($v);
488 $ret{"${as}.${k}"} = "${for}.${v}";
492 } elsif (ref $cond eq 'ARRAY') {
493 return [ map { $self->resolve_condition($_, $as, $for) } @$cond ];
495 die("Can't handle this yet :(");
499 =head2 resolve_prefetch
501 =head3 Arguments: (hashref/arrayref/scalar)
503 Accepts one or more relationships for the current source and returns an
504 array of column names for each of those relationships. Column names are
505 prefixed relative to the current source, in accordance with where they appear
506 in the supplied relationships. Examples:
508 my $source = $schema->resultset('Tag')->source;
509 @columns = $source->resolve_prefetch( { cd => 'artist' } );
517 # 'cd.artist.artistid',
521 @columns = $source->resolve_prefetch( qw[/ cd /] );
531 $source = $schema->resultset('CD')->source;
532 @columns = $source->resolve_prefetch( qw[/ artist producer /] );
538 # 'producer.producerid',
544 sub resolve_prefetch {
545 my ($self, $pre, $alias, $seen) = @_;
548 #$alias ||= $self->name;
549 #warn $alias, Dumper $pre;
550 if( ref $pre eq 'ARRAY' ) {
551 return map { $self->resolve_prefetch( $_, $alias, $seen ) } @$pre;
553 elsif( ref $pre eq 'HASH' ) {
556 $self->resolve_prefetch($_, $alias, $seen),
557 $self->related_source($_)->resolve_prefetch(
558 $pre->{$_}, "${alias}.$_", $seen)
564 $self->throw_exception( "don't know how to resolve prefetch reftype " . ref $pre);
567 my $count = ++$seen->{$pre};
568 my $as = ($count > 1 ? "${pre}_${count}" : $pre);
569 my $rel_info = $self->relationship_info( $pre );
570 $self->throw_exception( $self->name . " has no such relationship '$pre'" ) unless $rel_info;
571 my $as_prefix = ($alias =~ /^.*?\.(.*)$/ ? $1.'.' : '');
572 return map { [ "${as}.$_", "${as_prefix}${pre}.$_", ] }
573 $self->related_source($pre)->columns;
574 #warn $alias, Dumper (\@ret);
579 =head2 related_source
581 =head3 Arguments: ($relname)
583 Returns the result source object for the given relationship
588 my ($self, $rel) = @_;
589 if( !$self->has_relationship( $rel ) ) {
590 $self->throw_exception("No such relationship '$rel'");
592 return $self->schema->source($self->relationship_info($rel)->{source});
597 Returns a resultset for the given source, by calling:
599 $self->resultset_class->new($self, $self->resultset_attributes)
601 =head2 resultset_class
603 Set the class of the resultset, this is useful if you want to create your
604 own resultset methods. Create your own class derived from
605 L<DBIx::Class::ResultSet>, and set it here.
607 =head2 resultset_attributes
609 Specify here any attributes you wish to pass to your specialised resultset.
615 return $self->resultset_class->new($self, $self->{resultset_attributes});
618 =head2 throw_exception
620 See throw_exception in L<DBIx::Class::Schema>.
624 sub throw_exception {
626 if (defined $self->schema) {
627 $self->schema->throw_exception(@_);
636 Matt S. Trout <mst@shadowcatsystems.co.uk>
640 You may distribute this code under the same terms as Perl itself.