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' => qw/_ordered_columns
14 _columns _primaries _unique_constraints name resultset_attributes
15 schema from _relationships column_info_from_storage source_name
18 __PACKAGE__->mk_group_accessors('component_class' => qw/resultset_class
23 DBIx::Class::ResultSource - Result source object
29 A ResultSource is a component of a schema from which results can be directly
30 retrieved, most usually a table (see L<DBIx::Class::ResultSource::Table>)
40 $class->new({attribute_name => value});
42 Creates a new ResultSource object. Not normally called directly by end users.
47 my ($class, $attrs) = @_;
48 $class = ref $class if ref $class;
50 my $new = { %{$attrs || {}}, _resultset => undef };
53 $new->{resultset_class} ||= 'DBIx::Class::ResultSet';
54 $new->{resultset_attributes} = { %{$new->{resultset_attributes} || {}} };
55 $new->{_ordered_columns} = [ @{$new->{_ordered_columns}||[]}];
56 $new->{_columns} = { %{$new->{_columns}||{}} };
57 $new->{_relationships} = { %{$new->{_relationships}||{}} };
58 $new->{name} ||= "!!NAME NOT SET!!";
59 $new->{_columns_info_loaded} ||= 0;
67 Stores a hashref of per-source metadata. No specific key names
68 have yet been standardized, the examples below are purely hypothetical
69 and don't actually accomplish anything on their own:
71 __PACKAGE__->source_info({
72 "_tablespace" => 'fast_disk_array_3',
73 "_engine" => 'InnoDB',
78 $table->add_columns(qw/col1 col2 col3/);
80 $table->add_columns('col1' => \%col1_info, 'col2' => \%col2_info, ...);
82 Adds columns to the result source. If supplied key => hashref pairs, uses
83 the hashref as the column_info for that column. Repeated calls of this
84 method will add more columns, not replace them.
86 The contents of the column_info are not set in stone. The following
87 keys are currently recognised/used by DBIx::Class:
93 Use this to set the name of the accessor for this column. If unset,
94 the name of the column will be used.
98 This contains the column type. It is automatically filled by the
99 L<SQL::Translator::Producer::DBIx::Class::File> producer, and the
100 L<DBIx::Class::Schema::Loader> module. If you do not enter a
101 data_type, DBIx::Class will attempt to retrieve it from the
102 database for you, using L<DBI>'s column_info method. The values of this
103 key are typically upper-cased.
105 Currently there is no standard set of values for the data_type. Use
106 whatever your database supports.
110 The length of your column, if it is a column type that can have a size
111 restriction. This is currently only used by L<DBIx::Class::Schema/deploy>.
115 Set this to a true value for a columns that is allowed to contain
116 NULL values. This is currently only used by L<DBIx::Class::Schema/deploy>.
118 =item is_auto_increment
120 Set this to a true value for a column whose value is somehow
121 automatically set. This is used to determine which columns to empty
122 when cloning objects using C<copy>. It is also used by
123 L<DBIx::Class::Schema/deploy>.
127 Set this to a true value for a column that contains a key from a
128 foreign table. This is currently only used by
129 L<DBIx::Class::Schema/deploy>.
133 Set this to the default value which will be inserted into a column
134 by the database. Can contain either a value or a function. This is
135 currently only used by L<DBIx::Class::Schema/deploy>.
139 Set this on a primary key column to the name of the sequence used to
140 generate a new key value. If not specified, L<DBIx::Class::PK::Auto>
141 will attempt to retrieve the name of the sequence from the database
146 This is used by L<DBIx::Class::Schema/deploy> and L<SQL::Translator>
147 to add extra non-generic data to the column. For example: C<< extras
148 => { unsigned => 1} >> is used by the MySQL producer to set an integer
149 column to unsigned. For more details, see
150 L<SQL::Translator::Producer::MySQL>.
156 $table->add_column('col' => \%info?);
158 Convenience alias to add_columns.
163 my ($self, @cols) = @_;
164 $self->_ordered_columns(\@cols) unless $self->_ordered_columns;
167 my $columns = $self->_columns;
168 while (my $col = shift @cols) {
169 # If next entry is { ... } use that for the column info, if not
170 # use an empty hashref
171 my $column_info = ref $cols[0] ? shift(@cols) : {};
172 push(@added, $col) unless exists $columns->{$col};
173 $columns->{$col} = $column_info;
175 push @{ $self->_ordered_columns }, @added;
179 *add_column = \&add_columns;
183 if ($obj->has_column($col)) { ... }
185 Returns true if the source has a column of this name, false otherwise.
190 my ($self, $column) = @_;
191 return exists $self->_columns->{$column};
196 my $info = $obj->column_info($col);
198 Returns the column metadata hashref for a column. See the description
199 of add_column for information on the contents of the hashref.
204 my ($self, $column) = @_;
205 $self->throw_exception("No such column $column")
206 unless exists $self->_columns->{$column};
207 #warn $self->{_columns_info_loaded}, "\n";
208 if ( ! $self->_columns->{$column}{data_type}
209 and $self->column_info_from_storage
210 and ! $self->{_columns_info_loaded}
211 and $self->schema and $self->storage )
213 $self->{_columns_info_loaded}++;
216 # eval for the case of storage without table
217 eval { $info = $self->storage->columns_info_for( $self->from ) };
219 for my $realcol ( keys %{$info} ) {
220 $lc_info->{lc $realcol} = $info->{$realcol};
222 foreach my $col ( keys %{$self->_columns} ) {
223 $self->_columns->{$col} = {
224 %{ $self->_columns->{$col} },
225 %{ $info->{$col} || $lc_info->{lc $col} || {} }
230 return $self->_columns->{$column};
233 =head2 column_info_from_storage
235 Enables the on-demand automatic loading of the above column
236 metadata from storage as neccesary. This is *deprecated*, and
237 should not be used. It will be removed before 1.0.
239 __PACKAGE__->column_info_from_storage(1);
243 my @column_names = $obj->columns;
245 Returns all column names in the order they were declared to add_columns.
251 $self->throw_exception(
252 "columns() is a read-only accessor, did you mean add_columns()?"
254 return @{$self->{_ordered_columns}||[]};
257 =head2 remove_columns
259 $table->remove_columns(qw/col1 col2 col3/);
261 Removes columns from the result source.
265 $table->remove_column('col');
267 Convenience alias to remove_columns.
272 my ($self, @cols) = @_;
274 return unless $self->_ordered_columns;
276 my $columns = $self->_columns;
279 foreach my $col (@{$self->_ordered_columns}) {
280 push @remaining, $col unless grep(/$col/, @cols);
284 delete $columns->{$_};
287 $self->_ordered_columns(\@remaining);
290 *remove_column = \&remove_columns;
292 =head2 set_primary_key
296 =item Arguments: @cols
300 Defines one or more columns as primary key for this source. Should be
301 called after C<add_columns>.
303 Additionally, defines a unique constraint named C<primary>.
305 The primary key columns are used by L<DBIx::Class::PK::Auto> to
306 retrieve automatically created values from the database.
310 sub set_primary_key {
311 my ($self, @cols) = @_;
312 # check if primary key columns are valid columns
313 foreach my $col (@cols) {
314 $self->throw_exception("No such column $col on table " . $self->name)
315 unless $self->has_column($col);
317 $self->_primaries(\@cols);
319 $self->add_unique_constraint(primary => \@cols);
322 =head2 primary_columns
324 Read-only accessor which returns the list of primary keys.
328 sub primary_columns {
329 return @{shift->_primaries||[]};
332 =head2 add_unique_constraint
334 Declare a unique constraint on this source. Call once for each unique
337 # For UNIQUE (column1, column2)
338 __PACKAGE__->add_unique_constraint(
339 constraint_name => [ qw/column1 column2/ ],
342 Alternatively, you can specify only the columns:
344 __PACKAGE__->add_unique_constraint([ qw/column1 column2/ ]);
346 This will result in a unique constraint named C<table_column1_column2>, where
347 C<table> is replaced with the table name.
349 Unique constraints are used, for example, when you call
350 L<DBIx::Class::ResultSet/find>. Only columns in the constraint are searched.
354 sub add_unique_constraint {
359 $name ||= $self->name_unique_constraint($cols);
361 foreach my $col (@$cols) {
362 $self->throw_exception("No such column $col on table " . $self->name)
363 unless $self->has_column($col);
366 my %unique_constraints = $self->unique_constraints;
367 $unique_constraints{$name} = $cols;
368 $self->_unique_constraints(\%unique_constraints);
371 =head2 name_unique_constraint
373 Return a name for a unique constraint containing the specified columns. These
374 names consist of the table name and each column name, separated by underscores.
376 For example, a constraint on a table named C<cd> containing the columns
377 C<artist> and C<title> would result in a constraint name of C<cd_artist_title>.
381 sub name_unique_constraint {
382 my ($self, $cols) = @_;
384 return join '_', $self->name, @$cols;
387 =head2 unique_constraints
389 Read-only accessor which returns the list of unique constraints on this source.
393 sub unique_constraints {
394 return %{shift->_unique_constraints||{}};
397 =head2 unique_constraint_names
399 Returns the list of unique constraint names defined on this source.
403 sub unique_constraint_names {
406 my %unique_constraints = $self->unique_constraints;
408 return keys %unique_constraints;
411 =head2 unique_constraint_columns
413 Returns the list of columns that make up the specified unique constraint.
417 sub unique_constraint_columns {
418 my ($self, $constraint_name) = @_;
420 my %unique_constraints = $self->unique_constraints;
422 $self->throw_exception(
423 "Unknown unique constraint $constraint_name on '" . $self->name . "'"
424 ) unless exists $unique_constraints{$constraint_name};
426 return @{ $unique_constraints{$constraint_name} };
431 Returns an expression of the source to be supplied to storage to specify
432 retrieval from this source. In the case of a database, the required FROM
437 Returns the L<DBIx::Class::Schema> object that this result source
442 Returns the storage handle for the current schema.
444 See also: L<DBIx::Class::Storage>
448 sub storage { shift->schema->storage; }
450 =head2 add_relationship
452 $source->add_relationship('relname', 'related_source', $cond, $attrs);
454 The relationship name can be arbitrary, but must be unique for each
455 relationship attached to this result source. 'related_source' should
456 be the name with which the related result source was registered with
457 the current schema. For example:
459 $schema->source('Book')->add_relationship('reviews', 'Review', {
460 'foreign.book_id' => 'self.id',
463 The condition C<$cond> needs to be an L<SQL::Abstract>-style
464 representation of the join between the tables. For example, if you're
465 creating a rel from Author to Book,
467 { 'foreign.author_id' => 'self.id' }
469 will result in the JOIN clause
471 author me JOIN book foreign ON foreign.author_id = me.id
473 You can specify as many foreign => self mappings as necessary.
475 Valid attributes are as follows:
481 Explicitly specifies the type of join to use in the relationship. Any
482 SQL join type is valid, e.g. C<LEFT> or C<RIGHT>. It will be placed in
483 the SQL command immediately before C<JOIN>.
487 An arrayref containing a list of accessors in the foreign class to proxy in
488 the main class. If, for example, you do the following:
490 CD->might_have(liner_notes => 'LinerNotes', undef, {
491 proxy => [ qw/notes/ ],
494 Then, assuming LinerNotes has an accessor named notes, you can do:
496 my $cd = CD->find(1);
497 # set notes -- LinerNotes object is created if it doesn't exist
498 $cd->notes('Notes go here');
502 Specifies the type of accessor that should be created for the
503 relationship. Valid values are C<single> (for when there is only a single
504 related object), C<multi> (when there can be many), and C<filter> (for
505 when there is a single related object, but you also want the relationship
506 accessor to double as a column accessor). For C<multi> accessors, an
507 add_to_* method is also created, which calls C<create_related> for the
514 sub add_relationship {
515 my ($self, $rel, $f_source_name, $cond, $attrs) = @_;
516 $self->throw_exception("Can't create relationship without join condition")
520 my %rels = %{ $self->_relationships };
521 $rels{$rel} = { class => $f_source_name,
522 source => $f_source_name,
525 $self->_relationships(\%rels);
529 # XXX disabled. doesn't work properly currently. skip in tests.
531 my $f_source = $self->schema->source($f_source_name);
533 $self->ensure_class_loaded($f_source_name);
534 $f_source = $f_source_name->result_source;
535 #my $s_class = ref($self->schema);
536 #$f_source_name =~ m/^${s_class}::(.*)$/;
537 #$self->schema->register_class(($1 || $f_source_name), $f_source_name);
538 #$f_source = $self->schema->source($f_source_name);
540 return unless $f_source; # Can't test rel without f_source
542 eval { $self->resolve_join($rel, 'me') };
544 if ($@) { # If the resolve failed, back out and re-throw the error
545 delete $rels{$rel}; #
546 $self->_relationships(\%rels);
547 $self->throw_exception("Error creating relationship $rel: $@");
554 Returns all relationship names for this source.
559 return keys %{shift->_relationships};
562 =head2 relationship_info
566 =item Arguments: $relname
570 Returns a hash of relationship information for the specified relationship
575 sub relationship_info {
576 my ($self, $rel) = @_;
577 return $self->_relationships->{$rel};
580 =head2 has_relationship
584 =item Arguments: $rel
588 Returns true if the source has a relationship of this name, false otherwise.
592 sub has_relationship {
593 my ($self, $rel) = @_;
594 return exists $self->_relationships->{$rel};
597 =head2 reverse_relationship_info
601 =item Arguments: $relname
605 Returns an array of hash references of relationship information for
606 the other side of the specified relationship name.
610 sub reverse_relationship_info {
611 my ($self, $rel) = @_;
612 my $rel_info = $self->relationship_info($rel);
615 return $ret unless ((ref $rel_info->{cond}) eq 'HASH');
617 my @cond = keys(%{$rel_info->{cond}});
618 my @refkeys = map {/^\w+\.(\w+)$/} @cond;
619 my @keys = map {$rel_info->{cond}->{$_} =~ /^\w+\.(\w+)$/} @cond;
621 # Get the related result source for this relationship
622 my $othertable = $self->related_source($rel);
624 # Get all the relationships for that source that related to this source
625 # whose foreign column set are our self columns on $rel and whose self
626 # columns are our foreign columns on $rel.
627 my @otherrels = $othertable->relationships();
628 my $otherrelationship;
629 foreach my $otherrel (@otherrels) {
630 my $otherrel_info = $othertable->relationship_info($otherrel);
632 my $back = $othertable->related_source($otherrel);
633 next unless $back->name eq $self->name;
637 if (ref $otherrel_info->{cond} eq 'HASH') {
638 @othertestconds = ($otherrel_info->{cond});
640 elsif (ref $otherrel_info->{cond} eq 'ARRAY') {
641 @othertestconds = @{$otherrel_info->{cond}};
647 foreach my $othercond (@othertestconds) {
648 my @other_cond = keys(%$othercond);
649 my @other_refkeys = map {/^\w+\.(\w+)$/} @other_cond;
650 my @other_keys = map {$othercond->{$_} =~ /^\w+\.(\w+)$/} @other_cond;
651 next if (!$self->compare_relationship_keys(\@refkeys, \@other_keys) ||
652 !$self->compare_relationship_keys(\@other_refkeys, \@keys));
653 $ret->{$otherrel} = $otherrel_info;
659 =head2 compare_relationship_keys
663 =item Arguments: $keys1, $keys2
667 Returns true if both sets of keynames are the same, false otherwise.
671 sub compare_relationship_keys {
672 my ($self, $keys1, $keys2) = @_;
674 # Make sure every keys1 is in keys2
676 foreach my $key (@$keys1) {
678 foreach my $prim (@$keys2) {
687 # Make sure every key2 is in key1
689 foreach my $prim (@$keys2) {
691 foreach my $key (@$keys1) {
708 =item Arguments: $relation
712 Returns the join structure required for the related result source.
717 my ($self, $join, $alias, $seen) = @_;
719 if (ref $join eq 'ARRAY') {
720 return map { $self->resolve_join($_, $alias, $seen) } @$join;
721 } elsif (ref $join eq 'HASH') {
724 my $as = ($seen->{$_} ? $_.'_'.($seen->{$_}+1) : $_);
725 ($self->resolve_join($_, $alias, $seen),
726 $self->related_source($_)->resolve_join($join->{$_}, $as, $seen));
728 } elsif (ref $join) {
729 $self->throw_exception("No idea how to resolve join reftype ".ref $join);
731 my $count = ++$seen->{$join};
732 #use Data::Dumper; warn Dumper($seen);
733 my $as = ($count > 1 ? "${join}_${count}" : $join);
734 my $rel_info = $self->relationship_info($join);
735 $self->throw_exception("No such relationship ${join}") unless $rel_info;
736 my $type = $rel_info->{attrs}{join_type} || '';
737 return [ { $as => $self->related_source($join)->from,
738 -join_type => $type },
739 $self->resolve_condition($rel_info->{cond}, $as, $alias) ];
743 =head2 resolve_condition
747 =item Arguments: $cond, $as, $alias|$object
751 Resolves the passed condition to a concrete query fragment. If given an alias,
752 returns a join condition; if given an object, inverts that object to produce
753 a related conditional from that object.
757 sub resolve_condition {
758 my ($self, $cond, $as, $for) = @_;
760 if (ref $cond eq 'HASH') {
762 foreach my $k (keys %{$cond}) {
764 # XXX should probably check these are valid columns
765 $k =~ s/^foreign\.// ||
766 $self->throw_exception("Invalid rel cond key ${k}");
768 $self->throw_exception("Invalid rel cond val ${v}");
769 if (ref $for) { # Object
770 #warn "$self $k $for $v";
771 $ret{$k} = $for->get_column($v);
773 } elsif (!defined $for) { # undef, i.e. "no object"
775 } elsif (ref $as) { # reverse object
776 $ret{$v} = $as->get_column($k);
777 } elsif (!defined $as) { # undef, i.e. "no reverse object"
780 $ret{"${as}.${k}"} = "${for}.${v}";
784 } elsif (ref $cond eq 'ARRAY') {
785 return [ map { $self->resolve_condition($_, $as, $for) } @$cond ];
787 die("Can't handle this yet :(");
791 =head2 resolve_prefetch
795 =item Arguments: hashref/arrayref/scalar
799 Accepts one or more relationships for the current source and returns an
800 array of column names for each of those relationships. Column names are
801 prefixed relative to the current source, in accordance with where they appear
802 in the supplied relationships. Examples:
804 my $source = $schema->resultset('Tag')->source;
805 @columns = $source->resolve_prefetch( { cd => 'artist' } );
813 # 'cd.artist.artistid',
817 @columns = $source->resolve_prefetch( qw[/ cd /] );
827 $source = $schema->resultset('CD')->source;
828 @columns = $source->resolve_prefetch( qw[/ artist producer /] );
834 # 'producer.producerid',
840 sub resolve_prefetch {
841 my ($self, $pre, $alias, $seen, $order, $collapse) = @_;
843 #$alias ||= $self->name;
844 #warn $alias, Dumper $pre;
845 if( ref $pre eq 'ARRAY' ) {
847 map { $self->resolve_prefetch( $_, $alias, $seen, $order, $collapse ) }
850 elsif( ref $pre eq 'HASH' ) {
853 $self->resolve_prefetch($_, $alias, $seen, $order, $collapse),
854 $self->related_source($_)->resolve_prefetch(
855 $pre->{$_}, "${alias}.$_", $seen, $order, $collapse)
861 $self->throw_exception(
862 "don't know how to resolve prefetch reftype ".ref($pre));
865 my $count = ++$seen->{$pre};
866 my $as = ($count > 1 ? "${pre}_${count}" : $pre);
867 my $rel_info = $self->relationship_info( $pre );
868 $self->throw_exception( $self->name . " has no such relationship '$pre'" )
870 my $as_prefix = ($alias =~ /^.*?\.(.+)$/ ? $1.'.' : '');
871 my $rel_source = $self->related_source($pre);
873 if (exists $rel_info->{attrs}{accessor}
874 && $rel_info->{attrs}{accessor} eq 'multi') {
875 $self->throw_exception(
876 "Can't prefetch has_many ${pre} (join cond too complex)")
877 unless ref($rel_info->{cond}) eq 'HASH';
878 my @key = map { (/^foreign\.(.+)$/ ? ($1) : ()); }
879 keys %{$rel_info->{cond}};
880 $collapse->{"${as_prefix}${pre}"} = \@key;
881 my @ord = (ref($rel_info->{attrs}{order_by}) eq 'ARRAY'
882 ? @{$rel_info->{attrs}{order_by}}
883 : (defined $rel_info->{attrs}{order_by}
884 ? ($rel_info->{attrs}{order_by})
886 push(@$order, map { "${as}.$_" } (@key, @ord));
889 return map { [ "${as}.$_", "${as_prefix}${pre}.$_", ] }
890 $rel_source->columns;
891 #warn $alias, Dumper (\@ret);
896 =head2 related_source
900 =item Arguments: $relname
904 Returns the result source object for the given relationship.
909 my ($self, $rel) = @_;
910 if( !$self->has_relationship( $rel ) ) {
911 $self->throw_exception("No such relationship '$rel'");
913 return $self->schema->source($self->relationship_info($rel)->{source});
920 =item Arguments: $relname
924 Returns the class name for objects in the given relationship.
929 my ($self, $rel) = @_;
930 if( !$self->has_relationship( $rel ) ) {
931 $self->throw_exception("No such relationship '$rel'");
933 return $self->schema->class($self->relationship_info($rel)->{source});
938 Returns a resultset for the given source. This will initially be created
941 $self->resultset_class->new($self, $self->resultset_attributes)
943 but is cached from then on unless resultset_class changes.
945 =head2 resultset_class
947 ` package My::ResultSetClass;
948 use base 'DBIx::Class::ResultSet';
951 $source->resultset_class('My::ResultSet::Class');
953 Set the class of the resultset, this is useful if you want to create your
954 own resultset methods. Create your own class derived from
955 L<DBIx::Class::ResultSet>, and set it here.
957 =head2 resultset_attributes
959 $source->resultset_attributes({ order_by => [ 'id' ] });
961 Specify here any attributes you wish to pass to your specialised resultset.
967 $self->throw_exception(
968 'resultset does not take any arguments. If you want another resultset, '.
969 'call it on the schema instead.'
972 # disabled until we can figure out a way to do it without consistency issues
974 #return $self->{_resultset}
975 # if ref $self->{_resultset} eq $self->resultset_class;
976 #return $self->{_resultset} =
978 return $self->resultset_class->new(
979 $self, $self->{resultset_attributes}
987 =item Arguments: $source_name
991 Set the name of the result source when it is loaded into a schema.
992 This is usefull if you want to refer to a result source by a name other than
995 package ArchivedBooks;
996 use base qw/DBIx::Class/;
997 __PACKAGE__->table('books_archive');
998 __PACKAGE__->source_name('Books');
1000 # from your schema...
1001 $schema->resultset('Books')->find(1);
1003 =head2 throw_exception
1005 See L<DBIx::Class::Schema/"throw_exception">.
1009 sub throw_exception {
1011 if (defined $self->schema) {
1012 $self->schema->throw_exception(@_);
1020 Matt S. Trout <mst@shadowcatsystems.co.uk>
1024 You may distribute this code under the same terms as Perl itself.