1 package DBIx::Class::ResultSource;
6 use DBIx::Class::ResultSet;
12 use base qw/DBIx::Class/;
13 __PACKAGE__->load_components(qw/AccessorGroup/);
15 __PACKAGE__->mk_group_accessors('simple' =>
16 qw/_ordered_columns _columns _primaries _unique_constraints name resultset_class result_class schema from _relationships/);
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->{_ordered_columns} = [ @{$new->{_ordered_columns}||[]}];
39 $new->{_columns} = { %{$new->{_columns}||{}} };
40 $new->{_relationships} = { %{$new->{_relationships}||{}} };
41 $new->{name} ||= "!!NAME NOT SET!!";
46 my ($self, @cols) = @_;
47 $self->_ordered_columns( \@cols )
48 if !$self->_ordered_columns;
50 my $columns = $self->_columns;
51 while (my $col = shift @cols) {
53 my $column_info = ref $cols[0] ? shift(@cols) : {};
54 # If next entry is { ... } use that for the column info, if not
55 # use an empty hashref
57 push(@added, $col) unless exists $columns->{$col};
59 $columns->{$col} = $column_info;
61 push @{ $self->_ordered_columns }, @added;
65 *add_column = \&add_columns;
69 $table->add_columns(qw/col1 col2 col3/);
71 $table->add_columns('col1' => \%col1_info, 'col2' => \%col2_info, ...);
73 Adds columns to the result source. If supplied key => hashref pairs uses
74 the hashref as the column_info for that column.
78 $table->add_column('col' => \%info?);
80 Convenience alias to add_columns
86 return $self->resultset_class->new($self);
91 if ($obj->has_column($col)) { ... }
93 Returns 1 if the source has a column of this name, 0 otherwise.
98 my ($self, $column) = @_;
99 return exists $self->_columns->{$column};
104 my $info = $obj->column_info($col);
106 Returns the column metadata hashref for a column.
111 my ($self, $column) = @_;
112 croak "No such column $column" unless exists $self->_columns->{$column};
113 if ( (! $self->_columns->{$column}->{data_type})
114 && $self->schema && $self->storage() ){
116 ############ eval for the case of storage without table
118 $info = $self->storage->columns_info_for ( $self->from() );
121 for my $col ( keys %{$self->_columns} ){
122 for my $i ( keys %{$info->{$col}} ){
123 $self->_columns()->{$col}->{$i} = $info->{$col}->{$i};
128 return $self->_columns->{$column};
133 my @column_names = $obj->columns;
135 Returns all column names in the order they were declared to add_columns
140 croak "columns() is a read-only accessor, did you mean add_columns()?" if (@_ > 1);
141 return @{shift->{_ordered_columns}||[]};
144 =head2 set_primary_key(@cols)
146 Defines one or more columns as primary key for this source. Should be
147 called after C<add_columns>.
149 Additionally, defines a unique constraint named C<primary>.
153 sub set_primary_key {
154 my ($self, @cols) = @_;
155 # check if primary key columns are valid columns
157 $self->throw("No such column $_ on table ".$self->name)
158 unless $self->has_column($_);
160 $self->_primaries(\@cols);
162 $self->add_unique_constraint(primary => \@cols);
165 =head2 primary_columns
167 Read-only accessor which returns the list of primary keys.
171 sub primary_columns {
172 return @{shift->_primaries||[]};
175 =head2 add_unique_constraint
177 Declare a unique constraint on this source. Call once for each unique
180 # For e.g. UNIQUE (column1, column2)
181 __PACKAGE__->add_unique_constraint(constraint_name => [ qw/column1 column2/ ]);
185 sub add_unique_constraint {
186 my ($self, $name, $cols) = @_;
189 $self->throw("No such column $_ on table ".$self->name)
190 unless $self->has_column($_);
193 my %unique_constraints = $self->unique_constraints;
194 $unique_constraints{$name} = $cols;
195 $self->_unique_constraints(\%unique_constraints);
198 =head2 unique_constraints
200 Read-only accessor which returns the list of unique constraints on this source.
204 sub unique_constraints {
205 return %{shift->_unique_constraints||{}};
210 Returns an expression of the source to be supplied to storage to specify
211 retrieval from this source; in the case of a database the required FROM clause
218 Returns the storage handle for the current schema
222 sub storage { shift->schema->storage; }
224 =head2 add_relationship
226 $source->add_relationship('relname', 'related_source', $cond, $attrs);
228 The relation name can be arbitrary, but must be unique for each relationship
229 attached to this result source. 'related_source' should be the name with
230 which the related result source was registered with the current schema
231 (for simple schemas this is usally either Some::Namespace::Foo or just Foo)
233 The condition needs to be an SQL::Abstract-style representation of the join
234 between the tables. For example, if you're creating a rel from Foo to Bar,
236 { 'foreign.foo_id' => 'self.id' }
238 will result in the JOIN clause
240 foo me JOIN bar bar ON bar.foo_id = me.id
242 You can specify as many foreign => self mappings as necessary.
244 Valid attributes are as follows:
250 Explicitly specifies the type of join to use in the relationship. Any SQL
251 join type is valid, e.g. C<LEFT> or C<RIGHT>. It will be placed in the SQL
252 command immediately before C<JOIN>.
256 An arrayref containing a list of accessors in the foreign class to proxy in
257 the main class. If, for example, you do the following:
259 __PACKAGE__->might_have(bar => 'Bar', undef, { proxy => qw[/ margle /] });
261 Then, assuming Bar has an accessor named margle, you can do:
263 my $obj = Foo->find(1);
264 $obj->margle(10); # set margle; Bar object is created if it doesn't exist
268 Specifies the type of accessor that should be created for the relationship.
269 Valid values are C<single> (for when there is only a single related object),
270 C<multi> (when there can be many), and C<filter> (for when there is a single
271 related object, but you also want the relationship accessor to double as
272 a column accessor). For C<multi> accessors, an add_to_* method is also
273 created, which calls C<create_related> for the relationship.
279 sub add_relationship {
280 my ($self, $rel, $f_source_name, $cond, $attrs) = @_;
281 croak "Can't create relationship without join condition" unless $cond;
284 my %rels = %{ $self->_relationships };
285 $rels{$rel} = { class => $f_source_name,
286 source => $f_source_name,
289 $self->_relationships(\%rels);
293 # XXX disabled. doesn't work properly currently. skip in tests.
295 my $f_source = $self->schema->source($f_source_name);
297 eval "require $f_source_name;";
299 die $@ unless $@ =~ /Can't locate/;
301 $f_source = $f_source_name->result_source;
302 #my $s_class = ref($self->schema);
303 #$f_source_name =~ m/^${s_class}::(.*)$/;
304 #$self->schema->register_class(($1 || $f_source_name), $f_source_name);
305 #$f_source = $self->schema->source($f_source_name);
307 return unless $f_source; # Can't test rel without f_source
309 eval { $self->resolve_join($rel, 'me') };
311 if ($@) { # If the resolve failed, back out and re-throw the error
312 delete $rels{$rel}; #
313 $self->_relationships(\%rels);
314 croak "Error creating relationship $rel: $@";
319 =head2 relationships()
321 Returns all valid relationship names for this source
326 return keys %{shift->_relationships};
329 =head2 relationship_info($relname)
331 Returns the relationship information for the specified relationship name
335 sub relationship_info {
336 my ($self, $rel) = @_;
337 return $self->_relationships->{$rel};
340 =head2 has_relationship($rel)
342 Returns 1 if the source has a relationship of this name, 0 otherwise.
346 sub has_relationship {
347 my ($self, $rel) = @_;
348 return exists $self->_relationships->{$rel};
351 =head2 resolve_join($relation)
353 Returns the join structure required for the related result source
358 my ($self, $join, $alias) = @_;
359 if (ref $join eq 'ARRAY') {
360 return map { $self->resolve_join($_, $alias) } @$join;
361 } elsif (ref $join eq 'HASH') {
362 return map { $self->resolve_join($_, $alias),
363 $self->related_source($_)->resolve_join($join->{$_}, $_) }
365 } elsif (ref $join) {
366 croak ("No idea how to resolve join reftype ".ref $join);
368 my $rel_info = $self->relationship_info($join);
369 croak("No such relationship ${join}") unless $rel_info;
370 my $type = $rel_info->{attrs}{join_type} || '';
371 return [ { $join => $self->related_source($join)->from,
372 -join_type => $type },
373 $self->resolve_condition($rel_info->{cond}, $join, $alias) ];
377 =head2 resolve_condition($cond, $rel, $alias|$object)
379 Resolves the passed condition to a concrete query fragment. If given an alias,
380 returns a join condition; if given an object, inverts that object to produce
381 a related conditional from that object.
385 sub resolve_condition {
386 my ($self, $cond, $rel, $for) = @_;
388 if (ref $cond eq 'HASH') {
390 while (my ($k, $v) = each %{$cond}) {
391 # XXX should probably check these are valid columns
392 $k =~ s/^foreign\.// || croak "Invalid rel cond key ${k}";
393 $v =~ s/^self\.// || croak "Invalid rel cond val ${v}";
394 if (ref $for) { # Object
395 #warn "$self $k $for $v";
396 $ret{$k} = $for->get_column($v);
399 $ret{"${rel}.${k}"} = "${for}.${v}";
403 } elsif (ref $cond eq 'ARRAY') {
404 return [ map { $self->resolve_condition($_, $rel, $for) } @$cond ];
406 die("Can't handle this yet :(");
410 =head2 resolve_prefetch (hashref/arrayref/scalar)
412 Accepts one or more relationships for the current source and returns an
413 array of column names for each of those relationships. Column names are
414 prefixed relative to the current source, in accordance with where they appear
415 in the supplied relationships. Examples:
417 my $source = $schema->$resultset('Tag')->source;
418 @columns = $source->resolve_prefetch( { cd => 'artist' } );
426 # 'cd.artist.artistid',
430 @columns = $source->resolve_prefetch( qw[/ cd /] );
440 $source = $schema->resultset('CD')->source;
441 @columns = $source->resolve_prefetch( qw[/ artist producer /] );
447 # 'producer.producerid',
453 sub resolve_prefetch {
454 my( $self, $pre, $alias ) = @_;
456 #$alias ||= $self->name;
457 #warn $alias, Dumper $pre;
458 if( ref $pre eq 'ARRAY' ) {
459 return map { $self->resolve_prefetch( $_, $alias ) } @$pre;
461 elsif( ref $pre eq 'HASH' ) {
464 $self->resolve_prefetch($_, $alias),
465 $self->related_source($_)->resolve_prefetch( $pre->{$_}, $_ )
472 croak( "don't know how to resolve prefetch reftype " . ref $pre);
475 my $rel_info = $self->relationship_info( $pre );
476 croak( $self->name . " has no such relationship '$pre'" ) unless $rel_info;
477 my $prefix = $alias && $alias ne 'me' ? "$alias.$pre" : $pre;
478 my @ret = map { "$prefix.$_" } $self->related_source($pre)->columns;
479 #warn $alias, Dumper (\@ret);
484 =head2 related_source($relname)
486 Returns the result source for the given relationship
491 my ($self, $rel) = @_;
492 if( !$self->has_relationship( $rel ) ) {
493 croak "No such relationship '$rel'";
495 return $self->schema->source($self->relationship_info($rel)->{source});
502 Matt S. Trout <mst@shadowcatsystems.co.uk>
506 You may distribute this code under the same terms as Perl itself.