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_class resultset_attributes result_class schema from _relationships/);
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 || {}} }, $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!!";
47 $table->add_columns(qw/col1 col2 col3/);
49 $table->add_columns('col1' => \%col1_info, 'col2' => \%col2_info, ...);
51 Adds columns to the result source. If supplied key => hashref pairs uses
52 the hashref as the column_info for that column.
56 $table->add_column('col' => \%info?);
58 Convenience alias to add_columns
63 my ($self, @cols) = @_;
64 $self->_ordered_columns( \@cols )
65 if !$self->_ordered_columns;
67 my $columns = $self->_columns;
68 while (my $col = shift @cols) {
70 my $column_info = ref $cols[0] ? shift(@cols) : {};
71 # If next entry is { ... } use that for the column info, if not
72 # use an empty hashref
74 push(@added, $col) unless exists $columns->{$col};
76 $columns->{$col} = $column_info;
78 push @{ $self->_ordered_columns }, @added;
82 *add_column = \&add_columns;
86 if ($obj->has_column($col)) { ... }
88 Returns 1 if the source has a column of this name, 0 otherwise.
93 my ($self, $column) = @_;
94 return exists $self->_columns->{$column};
99 my $info = $obj->column_info($col);
101 Returns the column metadata hashref for a column.
106 my ($self, $column) = @_;
107 $self->throw_exception("No such column $column")
108 unless exists $self->_columns->{$column};
109 if ( (! $self->_columns->{$column}->{data_type})
110 && $self->schema && $self->storage() ){
112 ############ eval for the case of storage without table
114 $info = $self->storage->columns_info_for ( $self->from() );
117 for my $col ( keys %{$self->_columns} ){
118 for my $i ( keys %{$info->{$col}} ){
119 $self->_columns()->{$col}->{$i} = $info->{$col}->{$i};
124 return $self->_columns->{$column};
129 my @column_names = $obj->columns;
131 Returns all column names in the order they were declared to add_columns
137 $self->throw_exception("columns() is a read-only accessor, did you mean add_columns()?") if (@_ > 1);
138 return @{$self->{_ordered_columns}||[]};
141 =head2 set_primary_key(@cols)
143 Defines one or more columns as primary key for this source. Should be
144 called after C<add_columns>.
146 Additionally, defines a unique constraint named C<primary>.
150 sub set_primary_key {
151 my ($self, @cols) = @_;
152 # check if primary key columns are valid columns
154 $self->throw_exception("No such column $_ on table ".$self->name)
155 unless $self->has_column($_);
157 $self->_primaries(\@cols);
159 $self->add_unique_constraint(primary => \@cols);
162 =head2 primary_columns
164 Read-only accessor which returns the list of primary keys.
168 sub primary_columns {
169 return @{shift->_primaries||[]};
172 =head2 add_unique_constraint
174 Declare a unique constraint on this source. Call once for each unique
177 # For e.g. UNIQUE (column1, column2)
178 __PACKAGE__->add_unique_constraint(constraint_name => [ qw/column1 column2/ ]);
182 sub add_unique_constraint {
183 my ($self, $name, $cols) = @_;
186 $self->throw_exception("No such column $_ on table ".$self->name)
187 unless $self->has_column($_);
190 my %unique_constraints = $self->unique_constraints;
191 $unique_constraints{$name} = $cols;
192 $self->_unique_constraints(\%unique_constraints);
195 =head2 unique_constraints
197 Read-only accessor which returns the list of unique constraints on this source.
201 sub unique_constraints {
202 return %{shift->_unique_constraints||{}};
207 Returns an expression of the source to be supplied to storage to specify
208 retrieval from this source; in the case of a database the required FROM clause
215 Returns the storage handle for the current schema
219 sub storage { shift->schema->storage; }
221 =head2 add_relationship
223 $source->add_relationship('relname', 'related_source', $cond, $attrs);
225 The relation name can be arbitrary, but must be unique for each relationship
226 attached to this result source. 'related_source' should be the name with
227 which the related result source was registered with the current schema
228 (for simple schemas this is usally either Some::Namespace::Foo or just Foo)
230 The condition needs to be an SQL::Abstract-style representation of the join
231 between the tables. For example, if you're creating a rel from Foo to Bar,
233 { 'foreign.foo_id' => 'self.id' }
235 will result in the JOIN clause
237 foo me JOIN bar bar ON bar.foo_id = me.id
239 You can specify as many foreign => self mappings as necessary.
241 Valid attributes are as follows:
247 Explicitly specifies the type of join to use in the relationship. Any SQL
248 join type is valid, e.g. C<LEFT> or C<RIGHT>. It will be placed in the SQL
249 command immediately before C<JOIN>.
253 An arrayref containing a list of accessors in the foreign class to proxy in
254 the main class. If, for example, you do the following:
256 __PACKAGE__->might_have(bar => 'Bar', undef, { proxy => [ qw/margle/ ] });
258 Then, assuming Bar has an accessor named margle, you can do:
260 my $obj = Foo->find(1);
261 $obj->margle(10); # set margle; Bar object is created if it doesn't exist
265 Specifies the type of accessor that should be created for the relationship.
266 Valid values are C<single> (for when there is only a single related object),
267 C<multi> (when there can be many), and C<filter> (for when there is a single
268 related object, but you also want the relationship accessor to double as
269 a column accessor). For C<multi> accessors, an add_to_* method is also
270 created, which calls C<create_related> for the relationship.
276 sub add_relationship {
277 my ($self, $rel, $f_source_name, $cond, $attrs) = @_;
278 $self->throw_exception("Can't create relationship without join condition") unless $cond;
281 my %rels = %{ $self->_relationships };
282 $rels{$rel} = { class => $f_source_name,
283 source => $f_source_name,
286 $self->_relationships(\%rels);
290 # XXX disabled. doesn't work properly currently. skip in tests.
292 my $f_source = $self->schema->source($f_source_name);
294 eval "require $f_source_name;";
296 die $@ unless $@ =~ /Can't locate/;
298 $f_source = $f_source_name->result_source;
299 #my $s_class = ref($self->schema);
300 #$f_source_name =~ m/^${s_class}::(.*)$/;
301 #$self->schema->register_class(($1 || $f_source_name), $f_source_name);
302 #$f_source = $self->schema->source($f_source_name);
304 return unless $f_source; # Can't test rel without f_source
306 eval { $self->resolve_join($rel, 'me') };
308 if ($@) { # If the resolve failed, back out and re-throw the error
309 delete $rels{$rel}; #
310 $self->_relationships(\%rels);
311 $self->throw_exception("Error creating relationship $rel: $@");
316 =head2 relationships()
318 Returns all valid relationship names for this source
323 return keys %{shift->_relationships};
326 =head2 relationship_info($relname)
328 Returns the relationship information for the specified relationship name
332 sub relationship_info {
333 my ($self, $rel) = @_;
334 return $self->_relationships->{$rel};
337 =head2 has_relationship($rel)
339 Returns 1 if the source has a relationship of this name, 0 otherwise.
343 sub has_relationship {
344 my ($self, $rel) = @_;
345 return exists $self->_relationships->{$rel};
348 =head2 resolve_join($relation)
350 Returns the join structure required for the related result source
355 my ($self, $join, $alias) = @_;
356 if (ref $join eq 'ARRAY') {
357 return map { $self->resolve_join($_, $alias) } @$join;
358 } elsif (ref $join eq 'HASH') {
359 return map { $self->resolve_join($_, $alias),
360 $self->related_source($_)->resolve_join($join->{$_}, $_) }
362 } elsif (ref $join) {
363 $self->throw_exception("No idea how to resolve join reftype ".ref $join);
365 my $rel_info = $self->relationship_info($join);
366 $self->throw_exception("No such relationship ${join}") unless $rel_info;
367 my $type = $rel_info->{attrs}{join_type} || '';
368 return [ { $join => $self->related_source($join)->from,
369 -join_type => $type },
370 $self->resolve_condition($rel_info->{cond}, $join, $alias) ];
374 =head2 resolve_condition($cond, $rel, $alias|$object)
376 Resolves the passed condition to a concrete query fragment. If given an alias,
377 returns a join condition; if given an object, inverts that object to produce
378 a related conditional from that object.
382 sub resolve_condition {
383 my ($self, $cond, $rel, $for) = @_;
385 if (ref $cond eq 'HASH') {
387 while (my ($k, $v) = each %{$cond}) {
388 # XXX should probably check these are valid columns
389 $k =~ s/^foreign\.// || $self->throw_exception("Invalid rel cond key ${k}");
390 $v =~ s/^self\.// || $self->throw_exception("Invalid rel cond val ${v}");
391 if (ref $for) { # Object
392 #warn "$self $k $for $v";
393 $ret{$k} = $for->get_column($v);
396 $ret{"${rel}.${k}"} = "${for}.${v}";
400 } elsif (ref $cond eq 'ARRAY') {
401 return [ map { $self->resolve_condition($_, $rel, $for) } @$cond ];
403 die("Can't handle this yet :(");
407 =head2 resolve_prefetch (hashref/arrayref/scalar)
409 Accepts one or more relationships for the current source and returns an
410 array of column names for each of those relationships. Column names are
411 prefixed relative to the current source, in accordance with where they appear
412 in the supplied relationships. Examples:
414 my $source = $schema->resultset('Tag')->source;
415 @columns = $source->resolve_prefetch( { cd => 'artist' } );
423 # 'cd.artist.artistid',
427 @columns = $source->resolve_prefetch( qw[/ cd /] );
437 $source = $schema->resultset('CD')->source;
438 @columns = $source->resolve_prefetch( qw[/ artist producer /] );
444 # 'producer.producerid',
450 sub resolve_prefetch {
451 my( $self, $pre, $alias ) = @_;
453 #$alias ||= $self->name;
454 #warn $alias, Dumper $pre;
455 if( ref $pre eq 'ARRAY' ) {
456 return map { $self->resolve_prefetch( $_, $alias ) } @$pre;
458 elsif( ref $pre eq 'HASH' ) {
461 $self->resolve_prefetch($_, $alias),
462 $self->related_source($_)->resolve_prefetch( $pre->{$_}, $_ )
469 $self->throw_exception( "don't know how to resolve prefetch reftype " . ref $pre);
472 my $rel_info = $self->relationship_info( $pre );
473 $self->throw_exception( $self->name . " has no such relationship '$pre'" ) unless $rel_info;
474 my $prefix = $alias && $alias ne 'me' ? "$alias.$pre" : $pre;
475 my @ret = map { "$prefix.$_" } $self->related_source($pre)->columns;
476 #warn $alias, Dumper (\@ret);
481 =head2 related_source($relname)
483 Returns the result source for the given relationship
488 my ($self, $rel) = @_;
489 if( !$self->has_relationship( $rel ) ) {
490 $self->throw_exception("No such relationship '$rel'");
492 return $self->schema->source($self->relationship_info($rel)->{source});
497 Returns a resultset for the given source created by calling
499 $self->resultset_class->new($self, $self->resultset_attributes)
501 =head2 resultset_class
505 =head2 resultset_attributes
513 return $self->resultset_class->new($self, $self->{resultset_attributes});
518 =head2 throw_exception
520 See schema's throw_exception
524 sub throw_exception {
526 if (defined $self->schema) {
527 $self->schema->throw_exception(@_);
536 Matt S. Trout <mst@shadowcatsystems.co.uk>
540 You may distribute this code under the same terms as Perl itself.