1 package DBIx::Class::ResultSource;
6 use DBIx::Class::ResultSet;
7 use Carp::Clan qw/^DBIx::Class/;
10 use Scalar::Util qw/weaken/;
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_attributes schema from _relationships/);
17 __PACKAGE__->mk_group_accessors('component_class' => qw/resultset_class result_class/);
21 DBIx::Class::ResultSource - Result source object
27 A ResultSource is a component of a schema from which results can be directly
28 retrieved, most usually a table (see L<DBIx::Class::ResultSource::Table>)
35 my ($class, $attrs) = @_;
36 $class = ref $class if ref $class;
37 my $new = bless({ %{$attrs || {}}, _resultset => undef }, $class);
38 $new->{resultset_class} ||= 'DBIx::Class::ResultSet';
39 $new->{resultset_attributes} = { %{$new->{resultset_attributes} || {}} };
40 $new->{_ordered_columns} = [ @{$new->{_ordered_columns}||[]}];
41 $new->{_columns} = { %{$new->{_columns}||{}} };
42 $new->{_relationships} = { %{$new->{_relationships}||{}} };
43 $new->{name} ||= "!!NAME NOT SET!!";
44 $new->{_columns_info_loaded} ||= 0;
52 $table->add_columns(qw/col1 col2 col3/);
54 $table->add_columns('col1' => \%col1_info, 'col2' => \%col2_info, ...);
56 Adds columns to the result source. If supplied key => hashref pairs uses
57 the hashref as the column_info for that column.
59 Repeated calls of this method will add more columns, not replace them.
61 The contents of the column_info are not set in stone, the following
62 keys are currently recognised/used by DBIx::Class.
68 Use this to set the name of the accessor for this column. If unset,
69 the name of the column will be used.
73 This contains the column type, it is automatically filled by the
74 L<SQL::Translator::Producer::DBIx::Class::File> producer, and the
75 L<DBIx::Class::Schema::Loader> module. If you do not enter the
76 data_type, DBIx::Class will attempt to retrieve it from the
77 database for you, using L<DBI>s column_info method. The values of this
78 key are typically upper-cased.
80 Currently there is no standard set of values for the data_type, use
81 whatever your database(s) support.
85 The length of your column, if it is a column type that can have a size
86 restriction. This is currently not used by DBIx::Class.
90 If the column is allowed to contain NULL values, set a true value
91 (typically 1), here. This is currently not used by DBIx::Class.
93 =item is_auto_increment
95 Set this to a true value if this is a column that is somehow
96 automatically filled. This is currently not used by DBIx::Class.
100 Set this to a true value if this column represents a key from a
101 foreign table. This is currently not used by DBIx::Class.
105 Set this to the default value which will be inserted into this column
106 by the database. Can contain either values or functions. This is
107 currently not used by DBIx::Class.
111 If your column is using a sequence to create it's values, set the name
112 of the sequence here, to allow the values to be retrieved
113 automatically by the L<DBIx::Class::PK::Auto> module. PK::Auto will
114 attempt to retrieve the sequence name from the database, if this value
121 $table->add_column('col' => \%info?);
123 Convenience alias to add_columns
128 my ($self, @cols) = @_;
129 $self->_ordered_columns( \@cols )
130 if !$self->_ordered_columns;
132 my $columns = $self->_columns;
133 while (my $col = shift @cols) {
135 my $column_info = ref $cols[0] ? shift(@cols) : {};
136 # If next entry is { ... } use that for the column info, if not
137 # use an empty hashref
139 push(@added, $col) unless exists $columns->{$col};
141 $columns->{$col} = $column_info;
143 push @{ $self->_ordered_columns }, @added;
147 *add_column = \&add_columns;
151 if ($obj->has_column($col)) { ... }
153 Returns 1 if the source has a column of this name, 0 otherwise.
158 my ($self, $column) = @_;
159 return exists $self->_columns->{$column};
164 my $info = $obj->column_info($col);
166 Returns the column metadata hashref for a column. See the description
167 of add_column for information on the contents of the hashref.
172 my ($self, $column) = @_;
173 $self->throw_exception("No such column $column")
174 unless exists $self->_columns->{$column};
175 #warn $self->{_columns_info_loaded}, "\n";
176 if ( ! $self->_columns->{$column}->{data_type}
177 && ! $self->{_columns_info_loaded}
178 && $self->schema && $self->storage() ){
179 $self->{_columns_info_loaded}++;
181 ############ eval for the case of storage without table
183 $info = $self->storage->columns_info_for ( $self->from() );
186 for my $col ( keys %{$self->_columns} ){
187 for my $i ( keys %{$info->{$col}} ){
188 $self->_columns()->{$col}->{$i} = $info->{$col}->{$i};
193 return $self->_columns->{$column};
198 my @column_names = $obj->columns;
200 Returns all column names in the order they were declared to add_columns
206 $self->throw_exception("columns() is a read-only accessor, did you mean add_columns()?") if (@_ > 1);
207 return @{$self->{_ordered_columns}||[]};
210 =head2 set_primary_key
212 =head3 Arguments: (@cols)
214 Defines one or more columns as primary key for this source. Should be
215 called after C<add_columns>.
217 Additionally, defines a unique constraint named C<primary>.
219 The primary key columns are used by L<DBIx::Class::PK::Auto> to
220 retrieve automatically created values from the database.
224 sub set_primary_key {
225 my ($self, @cols) = @_;
226 # check if primary key columns are valid columns
228 $self->throw_exception("No such column $_ on table ".$self->name)
229 unless $self->has_column($_);
231 $self->_primaries(\@cols);
233 $self->add_unique_constraint(primary => \@cols);
236 =head2 primary_columns
238 Read-only accessor which returns the list of primary keys.
242 sub primary_columns {
243 return @{shift->_primaries||[]};
246 =head2 add_unique_constraint
248 Declare a unique constraint on this source. Call once for each unique
249 constraint. Unique constraints are used when you call C<find> on a
250 L<DBIx::Class::ResultSet>, only columns in the constraint are searched,
252 # For e.g. UNIQUE (column1, column2)
253 __PACKAGE__->add_unique_constraint(constraint_name => [ qw/column1 column2/ ]);
257 sub add_unique_constraint {
258 my ($self, $name, $cols) = @_;
261 $self->throw_exception("No such column $_ on table ".$self->name)
262 unless $self->has_column($_);
265 my %unique_constraints = $self->unique_constraints;
266 $unique_constraints{$name} = $cols;
267 $self->_unique_constraints(\%unique_constraints);
270 =head2 unique_constraints
272 Read-only accessor which returns the list of unique constraints on this source.
276 sub unique_constraints {
277 return %{shift->_unique_constraints||{}};
282 Returns an expression of the source to be supplied to storage to specify
283 retrieval from this source; in the case of a database the required FROM clause
290 Returns the storage handle for the current schema.
292 See also: L<DBIx::Class::Storage>
296 sub storage { shift->schema->storage; }
298 =head2 add_relationship
300 $source->add_relationship('relname', 'related_source', $cond, $attrs);
302 The relation name can be arbitrary, but must be unique for each relationship
303 attached to this result source. 'related_source' should be the name with
304 which the related result source was registered with the current schema
305 (for simple schemas this is usally either Some::Namespace::Foo or just Foo)
307 The condition needs to be an SQL::Abstract-style representation of the join
308 between the tables. For example, if you're creating a rel from Author to Book,
310 { 'foreign.author_id' => 'self.id' }
312 will result in the JOIN clause
314 author me JOIN book foreign ON foreign.author_id = me.id
316 You can specify as many foreign => self mappings as necessary.
318 Valid attributes are as follows:
324 Explicitly specifies the type of join to use in the relationship. Any
325 SQL join type is valid, e.g. C<LEFT> or C<RIGHT>. It will be placed in
326 the SQL command immediately before C<JOIN>.
330 An arrayref containing a list of accessors in the foreign class to
331 proxy in the main class. If, for example, you do the following:
333 __PACKAGE__->might_have(bar => 'Bar', undef, { proxy => [ qw/margle/] });
335 Then, assuming Bar has an accessor named margle, you can do:
337 my $obj = Foo->find(1);
338 $obj->margle(10); # set margle; Bar object is created if it doesn't exist
342 Specifies the type of accessor that should be created for the
343 relationship. Valid values are C<single> (for when there is only a single
344 related object), C<multi> (when there can be many), and C<filter> (for
345 when there is a single related object, but you also want the relationship
346 accessor to double as a column accessor). For C<multi> accessors, an
347 add_to_* method is also created, which calls C<create_related> for the
354 sub add_relationship {
355 my ($self, $rel, $f_source_name, $cond, $attrs) = @_;
356 $self->throw_exception("Can't create relationship without join condition") unless $cond;
359 my %rels = %{ $self->_relationships };
360 $rels{$rel} = { class => $f_source_name,
361 source => $f_source_name,
364 $self->_relationships(\%rels);
368 # XXX disabled. doesn't work properly currently. skip in tests.
370 my $f_source = $self->schema->source($f_source_name);
372 eval "require $f_source_name;";
374 die $@ unless $@ =~ /Can't locate/;
376 $f_source = $f_source_name->result_source;
377 #my $s_class = ref($self->schema);
378 #$f_source_name =~ m/^${s_class}::(.*)$/;
379 #$self->schema->register_class(($1 || $f_source_name), $f_source_name);
380 #$f_source = $self->schema->source($f_source_name);
382 return unless $f_source; # Can't test rel without f_source
384 eval { $self->resolve_join($rel, 'me') };
386 if ($@) { # If the resolve failed, back out and re-throw the error
387 delete $rels{$rel}; #
388 $self->_relationships(\%rels);
389 $self->throw_exception("Error creating relationship $rel: $@");
396 Returns all valid relationship names for this source
401 return keys %{shift->_relationships};
404 =head2 relationship_info
406 =head3 Arguments: ($relname)
408 Returns the relationship information for the specified relationship name
412 sub relationship_info {
413 my ($self, $rel) = @_;
414 return $self->_relationships->{$rel};
417 =head2 has_relationship
419 =head3 Arguments: ($rel)
421 Returns 1 if the source has a relationship of this name, 0 otherwise.
425 sub has_relationship {
426 my ($self, $rel) = @_;
427 return exists $self->_relationships->{$rel};
432 =head3 Arguments: ($relation)
434 Returns the join structure required for the related result source
439 my ($self, $join, $alias, $seen) = @_;
441 if (ref $join eq 'ARRAY') {
442 return map { $self->resolve_join($_, $alias, $seen) } @$join;
443 } elsif (ref $join eq 'HASH') {
446 my $as = ($seen->{$_} ? $_.'_'.($seen->{$_}+1) : $_);
447 ($self->resolve_join($_, $alias, $seen),
448 $self->related_source($_)->resolve_join($join->{$_}, $as, $seen));
450 } elsif (ref $join) {
451 $self->throw_exception("No idea how to resolve join reftype ".ref $join);
453 my $count = ++$seen->{$join};
454 #use Data::Dumper; warn Dumper($seen);
455 my $as = ($count > 1 ? "${join}_${count}" : $join);
456 my $rel_info = $self->relationship_info($join);
457 $self->throw_exception("No such relationship ${join}") unless $rel_info;
458 my $type = $rel_info->{attrs}{join_type} || '';
459 return [ { $as => $self->related_source($join)->from,
460 -join_type => $type },
461 $self->resolve_condition($rel_info->{cond}, $as, $alias) ];
465 =head2 resolve_condition
467 =head3 Arguments: ($cond, $as, $alias|$object)
469 Resolves the passed condition to a concrete query fragment. If given an alias,
470 returns a join condition; if given an object, inverts that object to produce
471 a related conditional from that object.
475 sub resolve_condition {
476 my ($self, $cond, $as, $for) = @_;
478 if (ref $cond eq 'HASH') {
480 while (my ($k, $v) = each %{$cond}) {
481 # XXX should probably check these are valid columns
482 $k =~ s/^foreign\.// || $self->throw_exception("Invalid rel cond key ${k}");
483 $v =~ s/^self\.// || $self->throw_exception("Invalid rel cond val ${v}");
484 if (ref $for) { # Object
485 #warn "$self $k $for $v";
486 $ret{$k} = $for->get_column($v);
488 } elsif (ref $as) { # reverse object
489 $ret{$v} = $as->get_column($k);
491 $ret{"${as}.${k}"} = "${for}.${v}";
495 } elsif (ref $cond eq 'ARRAY') {
496 return [ map { $self->resolve_condition($_, $as, $for) } @$cond ];
498 die("Can't handle this yet :(");
502 =head2 resolve_prefetch
504 =head3 Arguments: (hashref/arrayref/scalar)
506 Accepts one or more relationships for the current source and returns an
507 array of column names for each of those relationships. Column names are
508 prefixed relative to the current source, in accordance with where they appear
509 in the supplied relationships. Examples:
511 my $source = $schema->resultset('Tag')->source;
512 @columns = $source->resolve_prefetch( { cd => 'artist' } );
520 # 'cd.artist.artistid',
524 @columns = $source->resolve_prefetch( qw[/ cd /] );
534 $source = $schema->resultset('CD')->source;
535 @columns = $source->resolve_prefetch( qw[/ artist producer /] );
541 # 'producer.producerid',
547 sub resolve_prefetch {
548 my ($self, $pre, $alias, $seen) = @_;
551 #$alias ||= $self->name;
552 #warn $alias, Dumper $pre;
553 if( ref $pre eq 'ARRAY' ) {
554 return map { $self->resolve_prefetch( $_, $alias, $seen ) } @$pre;
556 elsif( ref $pre eq 'HASH' ) {
559 $self->resolve_prefetch($_, $alias, $seen),
560 $self->related_source($_)->resolve_prefetch(
561 $pre->{$_}, "${alias}.$_", $seen)
567 $self->throw_exception( "don't know how to resolve prefetch reftype " . ref $pre);
570 my $count = ++$seen->{$pre};
571 my $as = ($count > 1 ? "${pre}_${count}" : $pre);
572 my $rel_info = $self->relationship_info( $pre );
573 $self->throw_exception( $self->name . " has no such relationship '$pre'" ) unless $rel_info;
574 my $as_prefix = ($alias =~ /^.*?\.(.*)$/ ? $1.'.' : '');
575 return map { [ "${as}.$_", "${as_prefix}${pre}.$_", ] }
576 $self->related_source($pre)->columns;
577 #warn $alias, Dumper (\@ret);
582 =head2 related_source
584 =head3 Arguments: ($relname)
586 Returns the result source object for the given relationship
591 my ($self, $rel) = @_;
592 if( !$self->has_relationship( $rel ) ) {
593 $self->throw_exception("No such relationship '$rel'");
595 return $self->schema->source($self->relationship_info($rel)->{source});
600 Returns a resultset for the given source, by calling:
602 $self->resultset_class->new($self, $self->resultset_attributes)
604 =head2 resultset_class
606 Set the class of the resultset, this is useful if you want to create your
607 own resultset methods. Create your own class derived from
608 L<DBIx::Class::ResultSet>, and set it here.
610 =head2 resultset_attributes
612 Specify here any attributes you wish to pass to your specialised resultset.
618 return $self->{_resultset} if ref $self->{_resultset} eq $self->resultset_class;
619 return $self->{_resultset} = do {
620 my $rs = $self->resultset_class->new($self, $self->{resultset_attributes});
621 weaken $rs->result_source;
626 =head2 throw_exception
628 See throw_exception in L<DBIx::Class::Schema>.
632 sub throw_exception {
634 if (defined $self->schema) {
635 $self->schema->throw_exception(@_);
644 Matt S. Trout <mst@shadowcatsystems.co.uk>
648 You may distribute this code under the same terms as Perl itself.