1 package DBIx::Class::ResultSource;
6 use DBIx::Class::ResultSet;
7 use DBIx::Class::ResultSourceHandle;
9 use DBIx::Class::Exception;
10 use Carp::Clan qw/^DBIx::Class/;
12 use List::Util 'first';
15 use base qw/DBIx::Class/;
17 __PACKAGE__->mk_group_accessors('simple' => qw/_ordered_columns
18 _columns _primaries _unique_constraints name resultset_attributes
19 schema from _relationships column_info_from_storage source_info
20 source_name sqlt_deploy_callback/);
22 __PACKAGE__->mk_group_accessors('component_class' => qw/resultset_class
27 DBIx::Class::ResultSource - Result source object
31 # Create a table based result source, in a result class.
33 package MyDB::Schema::Result::Artist;
34 use base qw/DBIx::Class::Core/;
36 __PACKAGE__->table('artist');
37 __PACKAGE__->add_columns(qw/ artistid name /);
38 __PACKAGE__->set_primary_key('artistid');
39 __PACKAGE__->has_many(cds => 'MyDB::Schema::Result::CD');
43 # Create a query (view) based result source, in a result class
44 package MyDB::Schema::Result::Year2000CDs;
45 use base qw/DBIx::Class::Core/;
47 __PACKAGE__->load_components('InflateColumn::DateTime');
48 __PACKAGE__->table_class('DBIx::Class::ResultSource::View');
50 __PACKAGE__->table('year2000cds');
51 __PACKAGE__->result_source_instance->is_virtual(1);
52 __PACKAGE__->result_source_instance->view_definition(
53 "SELECT cdid, artist, title FROM cd WHERE year ='2000'"
59 A ResultSource is an object that represents a source of data for querying.
61 This class is a base class for various specialised types of result
62 sources, for example L<DBIx::Class::ResultSource::Table>. Table is the
63 default result source type, so one is created for you when defining a
64 result class as described in the synopsis above.
66 More specifically, the L<DBIx::Class::Core> base class pulls in the
67 L<DBIx::Class::ResultSourceProxy::Table> component, which defines
68 the L<table|DBIx::Class::ResultSourceProxy::Table/table> method.
69 When called, C<table> creates and stores an instance of
70 L<DBIx::Class::ResultSoure::Table>. Luckily, to use tables as result
71 sources, you don't need to remember any of this.
73 Result sources representing select queries, or views, can also be
74 created, see L<DBIx::Class::ResultSource::View> for full details.
76 =head2 Finding result source objects
78 As mentioned above, a result source instance is created and stored for
79 you when you define a L<Result Class|DBIx::Class::Manual::Glossary/Result Class>.
81 You can retrieve the result source at runtime in the following ways:
85 =item From a Schema object:
87 $schema->source($source_name);
89 =item From a Row object:
93 =item From a ResultSet object:
106 my ($class, $attrs) = @_;
107 $class = ref $class if ref $class;
109 my $new = bless { %{$attrs || {}} }, $class;
110 $new->{resultset_class} ||= 'DBIx::Class::ResultSet';
111 $new->{resultset_attributes} = { %{$new->{resultset_attributes} || {}} };
112 $new->{_ordered_columns} = [ @{$new->{_ordered_columns}||[]}];
113 $new->{_columns} = { %{$new->{_columns}||{}} };
114 $new->{_relationships} = { %{$new->{_relationships}||{}} };
115 $new->{name} ||= "!!NAME NOT SET!!";
116 $new->{_columns_info_loaded} ||= 0;
117 $new->{sqlt_deploy_callback} ||= "default_sqlt_deploy_hook";
127 =item Arguments: @columns
129 =item Return value: The ResultSource object
133 $source->add_columns(qw/col1 col2 col3/);
135 $source->add_columns('col1' => \%col1_info, 'col2' => \%col2_info, ...);
137 Adds columns to the result source. If supplied colname => hashref
138 pairs, uses the hashref as the L</column_info> for that column. Repeated
139 calls of this method will add more columns, not replace them.
141 The column names given will be created as accessor methods on your
142 L<DBIx::Class::Row> objects. You can change the name of the accessor
143 by supplying an L</accessor> in the column_info hash.
145 If a column name beginning with a plus sign ('+col1') is provided, the
146 attributes provided will be merged with any existing attributes for the
147 column, with the new attributes taking precedence in the case that an
148 attribute already exists. Using this without a hashref
149 (C<< $source->add_columns(qw/+col1 +col2/) >>) is legal, but useless --
150 it does the same thing it would do without the plus.
152 The contents of the column_info are not set in stone. The following
153 keys are currently recognised/used by DBIx::Class:
159 { accessor => '_name' }
161 # example use, replace standard accessor with one of your own:
163 my ($self, $value) = @_;
165 die "Name cannot contain digits!" if($value =~ /\d/);
166 $self->_name($value);
168 return $self->_name();
171 Use this to set the name of the accessor method for this column. If unset,
172 the name of the column will be used.
176 { data_type => 'integer' }
178 This contains the column type. It is automatically filled if you use the
179 L<SQL::Translator::Producer::DBIx::Class::File> producer, or the
180 L<DBIx::Class::Schema::Loader> module.
182 Currently there is no standard set of values for the data_type. Use
183 whatever your database supports.
189 The length of your column, if it is a column type that can have a size
190 restriction. This is currently only used to create tables from your
191 schema, see L<DBIx::Class::Schema/deploy>.
197 Set this to a true value for a columns that is allowed to contain NULL
198 values, default is false. This is currently only used to create tables
199 from your schema, see L<DBIx::Class::Schema/deploy>.
201 =item is_auto_increment
203 { is_auto_increment => 1 }
205 Set this to a true value for a column whose value is somehow
206 automatically set, defaults to false. This is used to determine which
207 columns to empty when cloning objects using
208 L<DBIx::Class::Row/copy>. It is also used by
209 L<DBIx::Class::Schema/deploy>.
215 Set this to a true or false value (not C<undef>) to explicitly specify
216 if this column contains numeric data. This controls how set_column
217 decides whether to consider a column dirty after an update: if
218 C<is_numeric> is true a numeric comparison C<< != >> will take place
219 instead of the usual C<eq>
221 If not specified the storage class will attempt to figure this out on
222 first access to the column, based on the column C<data_type>. The
223 result will be cached in this attribute.
227 { is_foreign_key => 1 }
229 Set this to a true value for a column that contains a key from a
230 foreign table, defaults to false. This is currently only used to
231 create tables from your schema, see L<DBIx::Class::Schema/deploy>.
235 { default_value => \'now()' }
237 Set this to the default value which will be inserted into a column by
238 the database. Can contain either a value or a function (use a
239 reference to a scalar e.g. C<\'now()'> if you want a function). This
240 is currently only used to create tables from your schema, see
241 L<DBIx::Class::Schema/deploy>.
243 See the note on L<DBIx::Class::Row/new> for more information about possible
244 issues related to db-side default values.
248 { sequence => 'my_table_seq' }
250 Set this on a primary key column to the name of the sequence used to
251 generate a new key value. If not specified, L<DBIx::Class::PK::Auto>
252 will attempt to retrieve the name of the sequence from the database
257 Set this to a true value for a column whose value is retrieved automatically
258 from a sequence or function (if supported by your Storage driver.) For a
259 sequence, if you do not use a trigger to get the nextval, you have to set the
260 L</sequence> value as well.
262 Also set this for MSSQL columns with the 'uniqueidentifier'
263 L<data_type|DBIx::Class::ResultSource/data_type> whose values you want to
264 automatically generate using C<NEWID()>, unless they are a primary key in which
265 case this will be done anyway.
269 This is used by L<DBIx::Class::Schema/deploy> and L<SQL::Translator>
270 to add extra non-generic data to the column. For example: C<< extra
271 => { unsigned => 1} >> is used by the MySQL producer to set an integer
272 column to unsigned. For more details, see
273 L<SQL::Translator::Producer::MySQL>.
281 =item Arguments: $colname, \%columninfo?
283 =item Return value: 1/0 (true/false)
287 $source->add_column('col' => \%info);
289 Add a single column and optional column info. Uses the same column
290 info keys as L</add_columns>.
295 my ($self, @cols) = @_;
296 $self->_ordered_columns(\@cols) unless $self->_ordered_columns;
299 my $columns = $self->_columns;
300 while (my $col = shift @cols) {
301 my $column_info = {};
302 if ($col =~ s/^\+//) {
303 $column_info = $self->column_info($col);
306 # If next entry is { ... } use that for the column info, if not
307 # use an empty hashref
309 my $new_info = shift(@cols);
310 %$column_info = (%$column_info, %$new_info);
312 push(@added, $col) unless exists $columns->{$col};
313 $columns->{$col} = $column_info;
315 push @{ $self->_ordered_columns }, @added;
319 sub add_column { shift->add_columns(@_); } # DO NOT CHANGE THIS TO GLOB
325 =item Arguments: $colname
327 =item Return value: 1/0 (true/false)
331 if ($source->has_column($colname)) { ... }
333 Returns true if the source has a column of this name, false otherwise.
338 my ($self, $column) = @_;
339 return exists $self->_columns->{$column};
346 =item Arguments: $colname
348 =item Return value: Hashref of info
352 my $info = $source->column_info($col);
354 Returns the column metadata hashref for a column, as originally passed
355 to L</add_columns>. See L</add_columns> above for information on the
356 contents of the hashref.
361 my ($self, $column) = @_;
362 $self->throw_exception("No such column $column")
363 unless exists $self->_columns->{$column};
364 #warn $self->{_columns_info_loaded}, "\n";
365 if ( ! $self->_columns->{$column}{data_type}
366 and $self->column_info_from_storage
367 and ! $self->{_columns_info_loaded}
368 and $self->schema and $self->storage )
370 $self->{_columns_info_loaded}++;
374 # try for the case of storage without table
376 $info = $self->storage->columns_info_for( $self->from );
377 for my $realcol ( keys %{$info} ) {
378 $lc_info->{lc $realcol} = $info->{$realcol};
380 foreach my $col ( keys %{$self->_columns} ) {
381 $self->_columns->{$col} = {
382 %{ $self->_columns->{$col} },
383 %{ $info->{$col} || $lc_info->{lc $col} || {} }
388 return $self->_columns->{$column};
395 =item Arguments: None
397 =item Return value: Ordered list of column names
401 my @column_names = $source->columns;
403 Returns all column names in the order they were declared to L</add_columns>.
409 $self->throw_exception(
410 "columns() is a read-only accessor, did you mean add_columns()?"
412 return @{$self->{_ordered_columns}||[]};
415 =head2 remove_columns
419 =item Arguments: @colnames
421 =item Return value: undefined
425 $source->remove_columns(qw/col1 col2 col3/);
427 Removes the given list of columns by name, from the result source.
429 B<Warning>: Removing a column that is also used in the sources primary
430 key, or in one of the sources unique constraints, B<will> result in a
431 broken result source.
437 =item Arguments: $colname
439 =item Return value: undefined
443 $source->remove_column('col');
445 Remove a single column by name from the result source, similar to
448 B<Warning>: Removing a column that is also used in the sources primary
449 key, or in one of the sources unique constraints, B<will> result in a
450 broken result source.
455 my ($self, @to_remove) = @_;
457 my $columns = $self->_columns
462 delete $columns->{$_};
466 $self->_ordered_columns([ grep { not $to_remove{$_} } @{$self->_ordered_columns} ]);
469 sub remove_column { shift->remove_columns(@_); } # DO NOT CHANGE THIS TO GLOB
471 =head2 set_primary_key
475 =item Arguments: @cols
477 =item Return value: undefined
481 Defines one or more columns as primary key for this source. Must be
482 called after L</add_columns>.
484 Additionally, defines a L<unique constraint|add_unique_constraint>
487 Note: you normally do want to define a primary key on your sources
488 B<even if the underlying database table does not have a primary key>.
490 L<DBIx::Class::Manual::Intro/The Significance and Importance of Primary Keys>
495 sub set_primary_key {
496 my ($self, @cols) = @_;
497 # check if primary key columns are valid columns
498 foreach my $col (@cols) {
499 $self->throw_exception("No such column $col on table " . $self->name)
500 unless $self->has_column($col);
502 $self->_primaries(\@cols);
504 $self->add_unique_constraint(primary => \@cols);
507 =head2 primary_columns
511 =item Arguments: None
513 =item Return value: Ordered list of primary column names
517 Read-only accessor which returns the list of primary keys, supplied by
522 sub primary_columns {
523 return @{shift->_primaries||[]};
526 # a helper method that will automatically die with a descriptive message if
527 # no pk is defined on the source in question. For internal use to save
528 # on if @pks... boilerplate
531 my @pcols = $self->primary_columns
532 or $self->throw_exception (sprintf(
533 "Operation requires a primary key to be declared on '%s' via set_primary_key",
534 # source_name is set only after schema-registration
535 $self->source_name || $self->result_class || $self->name || 'Unknown source...?',
540 =head2 add_unique_constraint
544 =item Arguments: $name?, \@colnames
546 =item Return value: undefined
550 Declare a unique constraint on this source. Call once for each unique
553 # For UNIQUE (column1, column2)
554 __PACKAGE__->add_unique_constraint(
555 constraint_name => [ qw/column1 column2/ ],
558 Alternatively, you can specify only the columns:
560 __PACKAGE__->add_unique_constraint([ qw/column1 column2/ ]);
562 This will result in a unique constraint named
563 C<table_column1_column2>, where C<table> is replaced with the table
566 Unique constraints are used, for example, when you pass the constraint
567 name as the C<key> attribute to L<DBIx::Class::ResultSet/find>. Then
568 only columns in the constraint are searched.
570 Throws an error if any of the given column names do not yet exist on
575 sub add_unique_constraint {
579 $self->throw_exception(
580 'add_unique_constraint() does not accept multiple constraints, use '
581 . 'add_unique_constraints() instead'
586 if (ref $cols ne 'ARRAY') {
587 $self->throw_exception (
588 'Expecting an arrayref of constraint columns, got ' . ($cols||'NOTHING')
594 $name ||= $self->name_unique_constraint($cols);
596 foreach my $col (@$cols) {
597 $self->throw_exception("No such column $col on table " . $self->name)
598 unless $self->has_column($col);
601 my %unique_constraints = $self->unique_constraints;
602 $unique_constraints{$name} = $cols;
603 $self->_unique_constraints(\%unique_constraints);
606 =head2 add_unique_constraints
610 =item Arguments: @constraints
612 =item Return value: undefined
616 Declare multiple unique constraints on this source.
618 __PACKAGE__->add_unique_constraints(
619 constraint_name1 => [ qw/column1 column2/ ],
620 constraint_name2 => [ qw/column2 column3/ ],
623 Alternatively, you can specify only the columns:
625 __PACKAGE__->add_unique_constraints(
626 [ qw/column1 column2/ ],
627 [ qw/column3 column4/ ]
630 This will result in unique constraints named C<table_column1_column2> and
631 C<table_column3_column4>, where C<table> is replaced with the table name.
633 Throws an error if any of the given column names do not yet exist on
636 See also L</add_unique_constraint>.
640 sub add_unique_constraints {
642 my @constraints = @_;
644 if ( !(@constraints % 2) && first { ref $_ ne 'ARRAY' } @constraints ) {
645 # with constraint name
646 while (my ($name, $constraint) = splice @constraints, 0, 2) {
647 $self->add_unique_constraint($name => $constraint);
652 foreach my $constraint (@constraints) {
653 $self->add_unique_constraint($constraint);
658 =head2 name_unique_constraint
662 =item Arguments: \@colnames
664 =item Return value: Constraint name
668 $source->table('mytable');
669 $source->name_unique_constraint(['col1', 'col2']);
673 Return a name for a unique constraint containing the specified
674 columns. The name is created by joining the table name and each column
675 name, using an underscore character.
677 For example, a constraint on a table named C<cd> containing the columns
678 C<artist> and C<title> would result in a constraint name of C<cd_artist_title>.
680 This is used by L</add_unique_constraint> if you do not specify the
681 optional constraint name.
685 sub name_unique_constraint {
686 my ($self, $cols) = @_;
688 my $name = $self->name;
689 $name = $$name if (ref $name eq 'SCALAR');
691 return join '_', $name, @$cols;
694 =head2 unique_constraints
698 =item Arguments: None
700 =item Return value: Hash of unique constraint data
704 $source->unique_constraints();
706 Read-only accessor which returns a hash of unique constraints on this
709 The hash is keyed by constraint name, and contains an arrayref of
710 column names as values.
714 sub unique_constraints {
715 return %{shift->_unique_constraints||{}};
718 =head2 unique_constraint_names
722 =item Arguments: None
724 =item Return value: Unique constraint names
728 $source->unique_constraint_names();
730 Returns the list of unique constraint names defined on this source.
734 sub unique_constraint_names {
737 my %unique_constraints = $self->unique_constraints;
739 return keys %unique_constraints;
742 =head2 unique_constraint_columns
746 =item Arguments: $constraintname
748 =item Return value: List of constraint columns
752 $source->unique_constraint_columns('myconstraint');
754 Returns the list of columns that make up the specified unique constraint.
758 sub unique_constraint_columns {
759 my ($self, $constraint_name) = @_;
761 my %unique_constraints = $self->unique_constraints;
763 $self->throw_exception(
764 "Unknown unique constraint $constraint_name on '" . $self->name . "'"
765 ) unless exists $unique_constraints{$constraint_name};
767 return @{ $unique_constraints{$constraint_name} };
770 =head2 sqlt_deploy_callback
774 =item Arguments: $callback
778 __PACKAGE__->sqlt_deploy_callback('mycallbackmethod');
780 An accessor to set a callback to be called during deployment of
781 the schema via L<DBIx::Class::Schema/create_ddl_dir> or
782 L<DBIx::Class::Schema/deploy>.
784 The callback can be set as either a code reference or the name of a
785 method in the current result class.
787 If not set, the L</default_sqlt_deploy_hook> is called.
789 Your callback will be passed the $source object representing the
790 ResultSource instance being deployed, and the
791 L<SQL::Translator::Schema::Table> object being created from it. The
792 callback can be used to manipulate the table object or add your own
793 customised indexes. If you need to manipulate a non-table object, use
794 the L<DBIx::Class::Schema/sqlt_deploy_hook>.
796 See L<DBIx::Class::Manual::Cookbook/Adding Indexes And Functions To
797 Your SQL> for examples.
799 This sqlt deployment callback can only be used to manipulate
800 SQL::Translator objects as they get turned into SQL. To execute
801 post-deploy statements which SQL::Translator does not currently
802 handle, override L<DBIx::Class::Schema/deploy> in your Schema class
803 and call L<dbh_do|DBIx::Class::Storage::DBI/dbh_do>.
805 =head2 default_sqlt_deploy_hook
809 =item Arguments: $source, $sqlt_table
811 =item Return value: undefined
815 This is the sensible default for L</sqlt_deploy_callback>.
817 If a method named C<sqlt_deploy_hook> exists in your Result class, it
818 will be called and passed the current C<$source> and the
819 C<$sqlt_table> being deployed.
823 sub default_sqlt_deploy_hook {
826 my $class = $self->result_class;
828 if ($class and $class->can('sqlt_deploy_hook')) {
829 $class->sqlt_deploy_hook(@_);
833 sub _invoke_sqlt_deploy_hook {
835 if ( my $hook = $self->sqlt_deploy_callback) {
844 =item Arguments: None
846 =item Return value: $resultset
850 Returns a resultset for the given source. This will initially be created
853 $self->resultset_class->new($self, $self->resultset_attributes)
855 but is cached from then on unless resultset_class changes.
857 =head2 resultset_class
861 =item Arguments: $classname
863 =item Return value: $classname
867 package My::Schema::ResultSet::Artist;
868 use base 'DBIx::Class::ResultSet';
871 # In the result class
872 __PACKAGE__->resultset_class('My::Schema::ResultSet::Artist');
875 $source->resultset_class('My::Schema::ResultSet::Artist');
877 Set the class of the resultset. This is useful if you want to create your
878 own resultset methods. Create your own class derived from
879 L<DBIx::Class::ResultSet>, and set it here. If called with no arguments,
880 this method returns the name of the existing resultset class, if one
883 =head2 resultset_attributes
887 =item Arguments: \%attrs
889 =item Return value: \%attrs
893 # In the result class
894 __PACKAGE__->resultset_attributes({ order_by => [ 'id' ] });
897 $source->resultset_attributes({ order_by => [ 'id' ] });
899 Store a collection of resultset attributes, that will be set on every
900 L<DBIx::Class::ResultSet> produced from this result source. For a full
901 list see L<DBIx::Class::ResultSet/ATTRIBUTES>.
907 $self->throw_exception(
908 'resultset does not take any arguments. If you want another resultset, '.
909 'call it on the schema instead.'
912 return $self->resultset_class->new(
915 %{$self->{resultset_attributes}},
916 %{$self->schema->default_resultset_attributes}
925 =item Arguments: $source_name
927 =item Result value: $source_name
931 Set an alternate name for the result source when it is loaded into a schema.
932 This is useful if you want to refer to a result source by a name other than
935 package ArchivedBooks;
936 use base qw/DBIx::Class/;
937 __PACKAGE__->table('books_archive');
938 __PACKAGE__->source_name('Books');
940 # from your schema...
941 $schema->resultset('Books')->find(1);
947 =item Arguments: None
949 =item Return value: FROM clause
953 my $from_clause = $source->from();
955 Returns an expression of the source to be supplied to storage to specify
956 retrieval from this source. In the case of a database, the required FROM
963 =item Arguments: None
965 =item Return value: A schema object
969 my $schema = $source->schema();
971 Returns the L<DBIx::Class::Schema> object that this result source
978 =item Arguments: None
980 =item Return value: A Storage object
984 $source->storage->debug(1);
986 Returns the storage handle for the current schema.
988 See also: L<DBIx::Class::Storage>
992 sub storage { shift->schema->storage; }
994 =head2 add_relationship
998 =item Arguments: $relname, $related_source_name, \%cond, [ \%attrs ]
1000 =item Return value: 1/true if it succeeded
1004 $source->add_relationship('relname', 'related_source', $cond, $attrs);
1006 L<DBIx::Class::Relationship> describes a series of methods which
1007 create pre-defined useful types of relationships. Look there first
1008 before using this method directly.
1010 The relationship name can be arbitrary, but must be unique for each
1011 relationship attached to this result source. 'related_source' should
1012 be the name with which the related result source was registered with
1013 the current schema. For example:
1015 $schema->source('Book')->add_relationship('reviews', 'Review', {
1016 'foreign.book_id' => 'self.id',
1019 The condition C<$cond> needs to be an L<SQL::Abstract>-style
1020 representation of the join between the tables. For example, if you're
1021 creating a relation from Author to Book,
1023 { 'foreign.author_id' => 'self.id' }
1025 will result in the JOIN clause
1027 author me JOIN book foreign ON foreign.author_id = me.id
1029 You can specify as many foreign => self mappings as necessary.
1031 Valid attributes are as follows:
1037 Explicitly specifies the type of join to use in the relationship. Any
1038 SQL join type is valid, e.g. C<LEFT> or C<RIGHT>. It will be placed in
1039 the SQL command immediately before C<JOIN>.
1043 An arrayref containing a list of accessors in the foreign class to proxy in
1044 the main class. If, for example, you do the following:
1046 CD->might_have(liner_notes => 'LinerNotes', undef, {
1047 proxy => [ qw/notes/ ],
1050 Then, assuming LinerNotes has an accessor named notes, you can do:
1052 my $cd = CD->find(1);
1053 # set notes -- LinerNotes object is created if it doesn't exist
1054 $cd->notes('Notes go here');
1058 Specifies the type of accessor that should be created for the
1059 relationship. Valid values are C<single> (for when there is only a single
1060 related object), C<multi> (when there can be many), and C<filter> (for
1061 when there is a single related object, but you also want the relationship
1062 accessor to double as a column accessor). For C<multi> accessors, an
1063 add_to_* method is also created, which calls C<create_related> for the
1068 Throws an exception if the condition is improperly supplied, or cannot
1073 sub add_relationship {
1074 my ($self, $rel, $f_source_name, $cond, $attrs) = @_;
1075 $self->throw_exception("Can't create relationship without join condition")
1079 # Check foreign and self are right in cond
1080 if ( (ref $cond ||'') eq 'HASH') {
1082 $self->throw_exception("Keys of condition should be of form 'foreign.col', not '$_'")
1083 if /\./ && !/^foreign\./;
1087 my %rels = %{ $self->_relationships };
1088 $rels{$rel} = { class => $f_source_name,
1089 source => $f_source_name,
1092 $self->_relationships(\%rels);
1096 # XXX disabled. doesn't work properly currently. skip in tests.
1098 my $f_source = $self->schema->source($f_source_name);
1099 unless ($f_source) {
1100 $self->ensure_class_loaded($f_source_name);
1101 $f_source = $f_source_name->result_source;
1102 #my $s_class = ref($self->schema);
1103 #$f_source_name =~ m/^${s_class}::(.*)$/;
1104 #$self->schema->register_class(($1 || $f_source_name), $f_source_name);
1105 #$f_source = $self->schema->source($f_source_name);
1107 return unless $f_source; # Can't test rel without f_source
1109 try { $self->_resolve_join($rel, 'me', {}, []) }
1111 # If the resolve failed, back out and re-throw the error
1113 $self->_relationships(\%rels);
1114 $self->throw_exception("Error creating relationship $rel: $_");
1120 =head2 relationships
1124 =item Arguments: None
1126 =item Return value: List of relationship names
1130 my @relnames = $source->relationships();
1132 Returns all relationship names for this source.
1137 return keys %{shift->_relationships};
1140 =head2 relationship_info
1144 =item Arguments: $relname
1146 =item Return value: Hashref of relation data,
1150 Returns a hash of relationship information for the specified relationship
1151 name. The keys/values are as specified for L</add_relationship>.
1155 sub relationship_info {
1156 my ($self, $rel) = @_;
1157 return $self->_relationships->{$rel};
1160 =head2 has_relationship
1164 =item Arguments: $rel
1166 =item Return value: 1/0 (true/false)
1170 Returns true if the source has a relationship of this name, false otherwise.
1174 sub has_relationship {
1175 my ($self, $rel) = @_;
1176 return exists $self->_relationships->{$rel};
1179 =head2 reverse_relationship_info
1183 =item Arguments: $relname
1185 =item Return value: Hashref of relationship data
1189 Looks through all the relationships on the source this relationship
1190 points to, looking for one whose condition is the reverse of the
1191 condition on this relationship.
1193 A common use of this is to find the name of the C<belongs_to> relation
1194 opposing a C<has_many> relation. For definition of these look in
1195 L<DBIx::Class::Relationship>.
1197 The returned hashref is keyed by the name of the opposing
1198 relationship, and contains its data in the same manner as
1199 L</relationship_info>.
1203 sub reverse_relationship_info {
1204 my ($self, $rel) = @_;
1205 my $rel_info = $self->relationship_info($rel);
1208 return $ret unless ((ref $rel_info->{cond}) eq 'HASH');
1210 my @cond = keys(%{$rel_info->{cond}});
1211 my @refkeys = map {/^\w+\.(\w+)$/} @cond;
1212 my @keys = map {$rel_info->{cond}->{$_} =~ /^\w+\.(\w+)$/} @cond;
1214 # Get the related result source for this relationship
1215 my $othertable = $self->related_source($rel);
1217 # Get all the relationships for that source that related to this source
1218 # whose foreign column set are our self columns on $rel and whose self
1219 # columns are our foreign columns on $rel.
1220 my @otherrels = $othertable->relationships();
1221 my $otherrelationship;
1222 foreach my $otherrel (@otherrels) {
1223 my $otherrel_info = $othertable->relationship_info($otherrel);
1225 my $back = $othertable->related_source($otherrel);
1226 next unless $back->source_name eq $self->source_name;
1230 if (ref $otherrel_info->{cond} eq 'HASH') {
1231 @othertestconds = ($otherrel_info->{cond});
1233 elsif (ref $otherrel_info->{cond} eq 'ARRAY') {
1234 @othertestconds = @{$otherrel_info->{cond}};
1240 foreach my $othercond (@othertestconds) {
1241 my @other_cond = keys(%$othercond);
1242 my @other_refkeys = map {/^\w+\.(\w+)$/} @other_cond;
1243 my @other_keys = map {$othercond->{$_} =~ /^\w+\.(\w+)$/} @other_cond;
1244 next if (!$self->_compare_relationship_keys(\@refkeys, \@other_keys) ||
1245 !$self->_compare_relationship_keys(\@other_refkeys, \@keys));
1246 $ret->{$otherrel} = $otherrel_info;
1252 sub compare_relationship_keys {
1253 carp 'compare_relationship_keys is a private method, stop calling it';
1255 $self->_compare_relationship_keys (@_);
1258 # Returns true if both sets of keynames are the same, false otherwise.
1259 sub _compare_relationship_keys {
1260 my ($self, $keys1, $keys2) = @_;
1262 # Make sure every keys1 is in keys2
1264 foreach my $key (@$keys1) {
1266 foreach my $prim (@$keys2) {
1267 if ($prim eq $key) {
1275 # Make sure every key2 is in key1
1277 foreach my $prim (@$keys2) {
1279 foreach my $key (@$keys1) {
1280 if ($prim eq $key) {
1292 # Returns the {from} structure used to express JOIN conditions
1294 my ($self, $join, $alias, $seen, $jpath, $parent_force_left) = @_;
1296 # we need a supplied one, because we do in-place modifications, no returns
1297 $self->throw_exception ('You must supply a seen hashref as the 3rd argument to _resolve_join')
1298 unless ref $seen eq 'HASH';
1300 $self->throw_exception ('You must supply a joinpath arrayref as the 4th argument to _resolve_join')
1301 unless ref $jpath eq 'ARRAY';
1303 $jpath = [@$jpath]; # copy
1305 if (not defined $join) {
1308 elsif (ref $join eq 'ARRAY') {
1311 $self->_resolve_join($_, $alias, $seen, $jpath, $parent_force_left);
1314 elsif (ref $join eq 'HASH') {
1317 for my $rel (keys %$join) {
1319 my $rel_info = $self->relationship_info($rel)
1320 or $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
1322 my $force_left = $parent_force_left;
1323 $force_left ||= lc($rel_info->{attrs}{join_type}||'') eq 'left';
1325 # the actual seen value will be incremented by the recursion
1326 my $as = $self->storage->relname_to_table_alias(
1327 $rel, ($seen->{$rel} && $seen->{$rel} + 1)
1331 $self->_resolve_join($rel, $alias, $seen, [@$jpath], $force_left),
1332 $self->related_source($rel)->_resolve_join(
1333 $join->{$rel}, $as, $seen, [@$jpath, { $rel => $as }], $force_left
1341 $self->throw_exception("No idea how to resolve join reftype ".ref $join);
1344 my $count = ++$seen->{$join};
1345 my $as = $self->storage->relname_to_table_alias(
1346 $join, ($count > 1 && $count)
1349 my $rel_info = $self->relationship_info($join)
1350 or $self->throw_exception("No such relationship $join on " . $self->source_name);
1352 my $rel_src = $self->related_source($join);
1353 return [ { $as => $rel_src->from,
1354 -source_handle => $rel_src->handle,
1355 -join_type => $parent_force_left
1357 : $rel_info->{attrs}{join_type}
1359 -join_path => [@$jpath, { $join => $as } ],
1361 $rel_info->{attrs}{accessor}
1363 first { $rel_info->{attrs}{accessor} eq $_ } (qw/single filter/)
1366 -relation_chain_depth => $seen->{-relation_chain_depth} || 0,
1368 $self->_resolve_condition($rel_info->{cond}, $as, $alias) ];
1373 carp 'pk_depends_on is a private method, stop calling it';
1375 $self->_pk_depends_on (@_);
1378 # Determines whether a relation is dependent on an object from this source
1379 # having already been inserted. Takes the name of the relationship and a
1380 # hashref of columns of the related object.
1381 sub _pk_depends_on {
1382 my ($self, $relname, $rel_data) = @_;
1384 my $relinfo = $self->relationship_info($relname);
1386 # don't assume things if the relationship direction is specified
1387 return $relinfo->{attrs}{is_foreign_key_constraint}
1388 if exists ($relinfo->{attrs}{is_foreign_key_constraint});
1390 my $cond = $relinfo->{cond};
1391 return 0 unless ref($cond) eq 'HASH';
1393 # map { foreign.foo => 'self.bar' } to { bar => 'foo' }
1394 my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond };
1396 # assume anything that references our PK probably is dependent on us
1397 # rather than vice versa, unless the far side is (a) defined or (b)
1399 my $rel_source = $self->related_source($relname);
1401 foreach my $p ($self->primary_columns) {
1402 if (exists $keyhash->{$p}) {
1403 unless (defined($rel_data->{$keyhash->{$p}})
1404 || $rel_source->column_info($keyhash->{$p})
1405 ->{is_auto_increment}) {
1414 sub resolve_condition {
1415 carp 'resolve_condition is a private method, stop calling it';
1417 $self->_resolve_condition (@_);
1420 # Resolves the passed condition to a concrete query fragment. If given an alias,
1421 # returns a join condition; if given an object, inverts that object to produce
1422 # a related conditional from that object.
1423 our $UNRESOLVABLE_CONDITION = \'1 = 0';
1425 sub _resolve_condition {
1426 my ($self, $cond, $as, $for) = @_;
1427 if (ref $cond eq 'HASH') {
1429 foreach my $k (keys %{$cond}) {
1430 my $v = $cond->{$k};
1431 # XXX should probably check these are valid columns
1432 $k =~ s/^foreign\.// ||
1433 $self->throw_exception("Invalid rel cond key ${k}");
1434 $v =~ s/^self\.// ||
1435 $self->throw_exception("Invalid rel cond val ${v}");
1436 if (ref $for) { # Object
1437 #warn "$self $k $for $v";
1438 unless ($for->has_column_loaded($v)) {
1439 if ($for->in_storage) {
1440 $self->throw_exception(sprintf
1441 "Unable to resolve relationship '%s' from object %s: column '%s' not "
1442 . 'loaded from storage (or not passed to new() prior to insert()). You '
1443 . 'probably need to call ->discard_changes to get the server-side defaults '
1444 . 'from the database.',
1450 return $UNRESOLVABLE_CONDITION;
1452 $ret{$k} = $for->get_column($v);
1453 #$ret{$k} = $for->get_column($v) if $for->has_column_loaded($v);
1455 } elsif (!defined $for) { # undef, i.e. "no object"
1457 } elsif (ref $as eq 'HASH') { # reverse hashref
1458 $ret{$v} = $as->{$k};
1459 } elsif (ref $as) { # reverse object
1460 $ret{$v} = $as->get_column($k);
1461 } elsif (!defined $as) { # undef, i.e. "no reverse object"
1464 $ret{"${as}.${k}"} = "${for}.${v}";
1468 } elsif (ref $cond eq 'ARRAY') {
1469 return [ map { $self->_resolve_condition($_, $as, $for) } @$cond ];
1471 die("Can't handle condition $cond yet :(");
1476 # Accepts one or more relationships for the current source and returns an
1477 # array of column names for each of those relationships. Column names are
1478 # prefixed relative to the current source, in accordance with where they appear
1479 # in the supplied relationships.
1481 sub _resolve_prefetch {
1482 my ($self, $pre, $alias, $alias_map, $order, $collapse, $pref_path) = @_;
1485 if (not defined $pre) {
1488 elsif( ref $pre eq 'ARRAY' ) {
1490 map { $self->_resolve_prefetch( $_, $alias, $alias_map, $order, $collapse, [ @$pref_path ] ) }
1493 elsif( ref $pre eq 'HASH' ) {
1496 $self->_resolve_prefetch($_, $alias, $alias_map, $order, $collapse, [ @$pref_path ] ),
1497 $self->related_source($_)->_resolve_prefetch(
1498 $pre->{$_}, "${alias}.$_", $alias_map, $order, $collapse, [ @$pref_path, $_] )
1503 $self->throw_exception(
1504 "don't know how to resolve prefetch reftype ".ref($pre));
1508 $p = $p->{$_} for (@$pref_path, $pre);
1510 $self->throw_exception (
1511 "Unable to resolve prefetch '$pre' - join alias map does not contain an entry for path: "
1512 . join (' -> ', @$pref_path, $pre)
1513 ) if (ref $p->{-join_aliases} ne 'ARRAY' or not @{$p->{-join_aliases}} );
1515 my $as = shift @{$p->{-join_aliases}};
1517 my $rel_info = $self->relationship_info( $pre );
1518 $self->throw_exception( $self->source_name . " has no such relationship '$pre'" )
1520 my $as_prefix = ($alias =~ /^.*?\.(.+)$/ ? $1.'.' : '');
1521 my $rel_source = $self->related_source($pre);
1523 if ($rel_info->{attrs}{accessor} && $rel_info->{attrs}{accessor} eq 'multi') {
1524 $self->throw_exception(
1525 "Can't prefetch has_many ${pre} (join cond too complex)")
1526 unless ref($rel_info->{cond}) eq 'HASH';
1527 my $dots = @{[$as_prefix =~ m/\./g]} + 1; # +1 to match the ".${as_prefix}"
1528 if (my ($fail) = grep { @{[$_ =~ m/\./g]} == $dots }
1529 keys %{$collapse}) {
1530 my ($last) = ($fail =~ /([^\.]+)$/);
1532 "Prefetching multiple has_many rels ${last} and ${pre} "
1533 .(length($as_prefix)
1534 ? "at the same level (${as_prefix}) "
1537 . 'will explode the number of row objects retrievable via ->next or ->all. '
1538 . 'Use at your own risk.'
1541 #my @col = map { (/^self\.(.+)$/ ? ("${as_prefix}.$1") : ()); }
1542 # values %{$rel_info->{cond}};
1543 $collapse->{".${as_prefix}${pre}"} = [ $rel_source->_pri_cols ];
1544 # action at a distance. prepending the '.' allows simpler code
1545 # in ResultSet->_collapse_result
1546 my @key = map { (/^foreign\.(.+)$/ ? ($1) : ()); }
1547 keys %{$rel_info->{cond}};
1548 push @$order, map { "${as}.$_" } @key;
1550 if (my $rel_order = $rel_info->{attrs}{order_by}) {
1551 # this is kludgy and incomplete, I am well aware
1552 # but the parent method is going away entirely anyway
1554 my $sql_maker = $self->storage->sql_maker;
1555 my ($orig_ql, $orig_qr) = $sql_maker->_quote_chars;
1556 my $sep = $sql_maker->name_sep;
1558 # install our own quoter, so we can catch unqualified stuff
1559 local $sql_maker->{quote_char} = ["\x00", "\xFF"];
1561 my $quoted_prefix = "\x00${as}\xFF";
1563 for my $chunk ( $sql_maker->_order_by_chunks ($rel_order) ) {
1565 ($chunk, @bind) = @$chunk if ref $chunk;
1567 $chunk = "${quoted_prefix}${sep}${chunk}"
1568 unless $chunk =~ /\Q$sep/;
1570 $chunk =~ s/\x00/$orig_ql/g;
1571 $chunk =~ s/\xFF/$orig_qr/g;
1572 push @$order, \[$chunk, @bind];
1577 return map { [ "${as}.$_", "${as_prefix}${pre}.$_", ] }
1578 $rel_source->columns;
1582 =head2 related_source
1586 =item Arguments: $relname
1588 =item Return value: $source
1592 Returns the result source object for the given relationship.
1596 sub related_source {
1597 my ($self, $rel) = @_;
1598 if( !$self->has_relationship( $rel ) ) {
1599 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
1601 return $self->schema->source($self->relationship_info($rel)->{source});
1604 =head2 related_class
1608 =item Arguments: $relname
1610 =item Return value: $classname
1614 Returns the class name for objects in the given relationship.
1619 my ($self, $rel) = @_;
1620 if( !$self->has_relationship( $rel ) ) {
1621 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
1623 return $self->schema->class($self->relationship_info($rel)->{source});
1628 Obtain a new handle to this source. Returns an instance of a
1629 L<DBIx::Class::ResultSourceHandle>.
1634 return DBIx::Class::ResultSourceHandle->new({
1635 schema => $_[0]->schema,
1636 source_moniker => $_[0]->source_name
1640 =head2 throw_exception
1642 See L<DBIx::Class::Schema/"throw_exception">.
1646 sub throw_exception {
1649 if (defined $self->schema) {
1650 $self->schema->throw_exception(@_);
1653 DBIx::Class::Exception->throw(@_);
1659 Stores a hashref of per-source metadata. No specific key names
1660 have yet been standardized, the examples below are purely hypothetical
1661 and don't actually accomplish anything on their own:
1663 __PACKAGE__->source_info({
1664 "_tablespace" => 'fast_disk_array_3',
1665 "_engine" => 'InnoDB',
1672 $class->new({attribute_name => value});
1674 Creates a new ResultSource object. Not normally called directly by end users.
1676 =head2 column_info_from_storage
1680 =item Arguments: 1/0 (default: 0)
1682 =item Return value: 1/0
1686 __PACKAGE__->column_info_from_storage(1);
1688 Enables the on-demand automatic loading of the above column
1689 metadata from storage as necessary. This is *deprecated*, and
1690 should not be used. It will be removed before 1.0.
1695 Matt S. Trout <mst@shadowcatsystems.co.uk>
1699 You may distribute this code under the same terms as Perl itself.