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",
539 =head2 add_unique_constraint
543 =item Arguments: $name?, \@colnames
545 =item Return value: undefined
549 Declare a unique constraint on this source. Call once for each unique
552 # For UNIQUE (column1, column2)
553 __PACKAGE__->add_unique_constraint(
554 constraint_name => [ qw/column1 column2/ ],
557 Alternatively, you can specify only the columns:
559 __PACKAGE__->add_unique_constraint([ qw/column1 column2/ ]);
561 This will result in a unique constraint named
562 C<table_column1_column2>, where C<table> is replaced with the table
565 Unique constraints are used, for example, when you pass the constraint
566 name as the C<key> attribute to L<DBIx::Class::ResultSet/find>. Then
567 only columns in the constraint are searched.
569 Throws an error if any of the given column names do not yet exist on
574 sub add_unique_constraint {
578 $self->throw_exception(
579 'add_unique_constraint() does not accept multiple constraints, use '
580 . 'add_unique_constraints() instead'
585 if (ref $cols ne 'ARRAY') {
586 $self->throw_exception (
587 'Expecting an arrayref of constraint columns, got ' . ($cols||'NOTHING')
593 $name ||= $self->name_unique_constraint($cols);
595 foreach my $col (@$cols) {
596 $self->throw_exception("No such column $col on table " . $self->name)
597 unless $self->has_column($col);
600 my %unique_constraints = $self->unique_constraints;
601 $unique_constraints{$name} = $cols;
602 $self->_unique_constraints(\%unique_constraints);
605 =head2 add_unique_constraints
609 =item Arguments: @constraints
611 =item Return value: undefined
615 Declare multiple unique constraints on this source.
617 __PACKAGE__->add_unique_constraints(
618 constraint_name1 => [ qw/column1 column2/ ],
619 constraint_name2 => [ qw/column2 column3/ ],
622 Alternatively, you can specify only the columns:
624 __PACKAGE__->add_unique_constraints(
625 [ qw/column1 column2/ ],
626 [ qw/column3 column4/ ]
629 This will result in unique constraints named C<table_column1_column2> and
630 C<table_column3_column4>, where C<table> is replaced with the table name.
632 Throws an error if any of the given column names do not yet exist on
635 See also L</add_unique_constraint>.
639 sub add_unique_constraints {
641 my @constraints = @_;
643 if ( !(@constraints % 2) && first { ref $_ ne 'ARRAY' } @constraints ) {
644 # with constraint name
645 while (my ($name, $constraint) = splice @constraints, 0, 2) {
646 $self->add_unique_constraint($name => $constraint);
651 foreach my $constraint (@constraints) {
652 $self->add_unique_constraint($constraint);
657 =head2 name_unique_constraint
661 =item Arguments: \@colnames
663 =item Return value: Constraint name
667 $source->table('mytable');
668 $source->name_unique_constraint(['col1', 'col2']);
672 Return a name for a unique constraint containing the specified
673 columns. The name is created by joining the table name and each column
674 name, using an underscore character.
676 For example, a constraint on a table named C<cd> containing the columns
677 C<artist> and C<title> would result in a constraint name of C<cd_artist_title>.
679 This is used by L</add_unique_constraint> if you do not specify the
680 optional constraint name.
684 sub name_unique_constraint {
685 my ($self, $cols) = @_;
687 my $name = $self->name;
688 $name = $$name if (ref $name eq 'SCALAR');
690 return join '_', $name, @$cols;
693 =head2 unique_constraints
697 =item Arguments: None
699 =item Return value: Hash of unique constraint data
703 $source->unique_constraints();
705 Read-only accessor which returns a hash of unique constraints on this
708 The hash is keyed by constraint name, and contains an arrayref of
709 column names as values.
713 sub unique_constraints {
714 return %{shift->_unique_constraints||{}};
717 =head2 unique_constraint_names
721 =item Arguments: None
723 =item Return value: Unique constraint names
727 $source->unique_constraint_names();
729 Returns the list of unique constraint names defined on this source.
733 sub unique_constraint_names {
736 my %unique_constraints = $self->unique_constraints;
738 return keys %unique_constraints;
741 =head2 unique_constraint_columns
745 =item Arguments: $constraintname
747 =item Return value: List of constraint columns
751 $source->unique_constraint_columns('myconstraint');
753 Returns the list of columns that make up the specified unique constraint.
757 sub unique_constraint_columns {
758 my ($self, $constraint_name) = @_;
760 my %unique_constraints = $self->unique_constraints;
762 $self->throw_exception(
763 "Unknown unique constraint $constraint_name on '" . $self->name . "'"
764 ) unless exists $unique_constraints{$constraint_name};
766 return @{ $unique_constraints{$constraint_name} };
769 =head2 sqlt_deploy_callback
773 =item Arguments: $callback
777 __PACKAGE__->sqlt_deploy_callback('mycallbackmethod');
779 An accessor to set a callback to be called during deployment of
780 the schema via L<DBIx::Class::Schema/create_ddl_dir> or
781 L<DBIx::Class::Schema/deploy>.
783 The callback can be set as either a code reference or the name of a
784 method in the current result class.
786 If not set, the L</default_sqlt_deploy_hook> is called.
788 Your callback will be passed the $source object representing the
789 ResultSource instance being deployed, and the
790 L<SQL::Translator::Schema::Table> object being created from it. The
791 callback can be used to manipulate the table object or add your own
792 customised indexes. If you need to manipulate a non-table object, use
793 the L<DBIx::Class::Schema/sqlt_deploy_hook>.
795 See L<DBIx::Class::Manual::Cookbook/Adding Indexes And Functions To
796 Your SQL> for examples.
798 This sqlt deployment callback can only be used to manipulate
799 SQL::Translator objects as they get turned into SQL. To execute
800 post-deploy statements which SQL::Translator does not currently
801 handle, override L<DBIx::Class::Schema/deploy> in your Schema class
802 and call L<dbh_do|DBIx::Class::Storage::DBI/dbh_do>.
804 =head2 default_sqlt_deploy_hook
808 =item Arguments: $source, $sqlt_table
810 =item Return value: undefined
814 This is the sensible default for L</sqlt_deploy_callback>.
816 If a method named C<sqlt_deploy_hook> exists in your Result class, it
817 will be called and passed the current C<$source> and the
818 C<$sqlt_table> being deployed.
822 sub default_sqlt_deploy_hook {
825 my $class = $self->result_class;
827 if ($class and $class->can('sqlt_deploy_hook')) {
828 $class->sqlt_deploy_hook(@_);
832 sub _invoke_sqlt_deploy_hook {
834 if ( my $hook = $self->sqlt_deploy_callback) {
843 =item Arguments: None
845 =item Return value: $resultset
849 Returns a resultset for the given source. This will initially be created
852 $self->resultset_class->new($self, $self->resultset_attributes)
854 but is cached from then on unless resultset_class changes.
856 =head2 resultset_class
860 =item Arguments: $classname
862 =item Return value: $classname
866 package My::Schema::ResultSet::Artist;
867 use base 'DBIx::Class::ResultSet';
870 # In the result class
871 __PACKAGE__->resultset_class('My::Schema::ResultSet::Artist');
874 $source->resultset_class('My::Schema::ResultSet::Artist');
876 Set the class of the resultset. This is useful if you want to create your
877 own resultset methods. Create your own class derived from
878 L<DBIx::Class::ResultSet>, and set it here. If called with no arguments,
879 this method returns the name of the existing resultset class, if one
882 =head2 resultset_attributes
886 =item Arguments: \%attrs
888 =item Return value: \%attrs
892 # In the result class
893 __PACKAGE__->resultset_attributes({ order_by => [ 'id' ] });
896 $source->resultset_attributes({ order_by => [ 'id' ] });
898 Store a collection of resultset attributes, that will be set on every
899 L<DBIx::Class::ResultSet> produced from this result source. For a full
900 list see L<DBIx::Class::ResultSet/ATTRIBUTES>.
906 $self->throw_exception(
907 'resultset does not take any arguments. If you want another resultset, '.
908 'call it on the schema instead.'
911 return $self->resultset_class->new(
914 %{$self->{resultset_attributes}},
915 %{$self->schema->default_resultset_attributes}
924 =item Arguments: $source_name
926 =item Result value: $source_name
930 Set an alternate name for the result source when it is loaded into a schema.
931 This is useful if you want to refer to a result source by a name other than
934 package ArchivedBooks;
935 use base qw/DBIx::Class/;
936 __PACKAGE__->table('books_archive');
937 __PACKAGE__->source_name('Books');
939 # from your schema...
940 $schema->resultset('Books')->find(1);
946 =item Arguments: None
948 =item Return value: FROM clause
952 my $from_clause = $source->from();
954 Returns an expression of the source to be supplied to storage to specify
955 retrieval from this source. In the case of a database, the required FROM
962 =item Arguments: None
964 =item Return value: A schema object
968 my $schema = $source->schema();
970 Returns the L<DBIx::Class::Schema> object that this result source
977 =item Arguments: None
979 =item Return value: A Storage object
983 $source->storage->debug(1);
985 Returns the storage handle for the current schema.
987 See also: L<DBIx::Class::Storage>
991 sub storage { shift->schema->storage; }
993 =head2 add_relationship
997 =item Arguments: $relname, $related_source_name, \%cond, [ \%attrs ]
999 =item Return value: 1/true if it succeeded
1003 $source->add_relationship('relname', 'related_source', $cond, $attrs);
1005 L<DBIx::Class::Relationship> describes a series of methods which
1006 create pre-defined useful types of relationships. Look there first
1007 before using this method directly.
1009 The relationship name can be arbitrary, but must be unique for each
1010 relationship attached to this result source. 'related_source' should
1011 be the name with which the related result source was registered with
1012 the current schema. For example:
1014 $schema->source('Book')->add_relationship('reviews', 'Review', {
1015 'foreign.book_id' => 'self.id',
1018 The condition C<$cond> needs to be an L<SQL::Abstract>-style
1019 representation of the join between the tables. For example, if you're
1020 creating a relation from Author to Book,
1022 { 'foreign.author_id' => 'self.id' }
1024 will result in the JOIN clause
1026 author me JOIN book foreign ON foreign.author_id = me.id
1028 You can specify as many foreign => self mappings as necessary.
1030 Valid attributes are as follows:
1036 Explicitly specifies the type of join to use in the relationship. Any
1037 SQL join type is valid, e.g. C<LEFT> or C<RIGHT>. It will be placed in
1038 the SQL command immediately before C<JOIN>.
1042 An arrayref containing a list of accessors in the foreign class to proxy in
1043 the main class. If, for example, you do the following:
1045 CD->might_have(liner_notes => 'LinerNotes', undef, {
1046 proxy => [ qw/notes/ ],
1049 Then, assuming LinerNotes has an accessor named notes, you can do:
1051 my $cd = CD->find(1);
1052 # set notes -- LinerNotes object is created if it doesn't exist
1053 $cd->notes('Notes go here');
1057 Specifies the type of accessor that should be created for the
1058 relationship. Valid values are C<single> (for when there is only a single
1059 related object), C<multi> (when there can be many), and C<filter> (for
1060 when there is a single related object, but you also want the relationship
1061 accessor to double as a column accessor). For C<multi> accessors, an
1062 add_to_* method is also created, which calls C<create_related> for the
1067 Throws an exception if the condition is improperly supplied, or cannot
1072 sub add_relationship {
1073 my ($self, $rel, $f_source_name, $cond, $attrs) = @_;
1074 $self->throw_exception("Can't create relationship without join condition")
1078 # Check foreign and self are right in cond
1079 if ( (ref $cond ||'') eq 'HASH') {
1081 $self->throw_exception("Keys of condition should be of form 'foreign.col', not '$_'")
1082 if /\./ && !/^foreign\./;
1086 my %rels = %{ $self->_relationships };
1087 $rels{$rel} = { class => $f_source_name,
1088 source => $f_source_name,
1091 $self->_relationships(\%rels);
1095 # XXX disabled. doesn't work properly currently. skip in tests.
1097 my $f_source = $self->schema->source($f_source_name);
1098 unless ($f_source) {
1099 $self->ensure_class_loaded($f_source_name);
1100 $f_source = $f_source_name->result_source;
1101 #my $s_class = ref($self->schema);
1102 #$f_source_name =~ m/^${s_class}::(.*)$/;
1103 #$self->schema->register_class(($1 || $f_source_name), $f_source_name);
1104 #$f_source = $self->schema->source($f_source_name);
1106 return unless $f_source; # Can't test rel without f_source
1108 try { $self->_resolve_join($rel, 'me', {}, []) }
1110 # If the resolve failed, back out and re-throw the error
1112 $self->_relationships(\%rels);
1113 $self->throw_exception("Error creating relationship $rel: $_");
1119 =head2 relationships
1123 =item Arguments: None
1125 =item Return value: List of relationship names
1129 my @relnames = $source->relationships();
1131 Returns all relationship names for this source.
1136 return keys %{shift->_relationships};
1139 =head2 relationship_info
1143 =item Arguments: $relname
1145 =item Return value: Hashref of relation data,
1149 Returns a hash of relationship information for the specified relationship
1150 name. The keys/values are as specified for L</add_relationship>.
1154 sub relationship_info {
1155 my ($self, $rel) = @_;
1156 return $self->_relationships->{$rel};
1159 =head2 has_relationship
1163 =item Arguments: $rel
1165 =item Return value: 1/0 (true/false)
1169 Returns true if the source has a relationship of this name, false otherwise.
1173 sub has_relationship {
1174 my ($self, $rel) = @_;
1175 return exists $self->_relationships->{$rel};
1178 =head2 reverse_relationship_info
1182 =item Arguments: $relname
1184 =item Return value: Hashref of relationship data
1188 Looks through all the relationships on the source this relationship
1189 points to, looking for one whose condition is the reverse of the
1190 condition on this relationship.
1192 A common use of this is to find the name of the C<belongs_to> relation
1193 opposing a C<has_many> relation. For definition of these look in
1194 L<DBIx::Class::Relationship>.
1196 The returned hashref is keyed by the name of the opposing
1197 relationship, and contains its data in the same manner as
1198 L</relationship_info>.
1202 sub reverse_relationship_info {
1203 my ($self, $rel) = @_;
1204 my $rel_info = $self->relationship_info($rel);
1207 return $ret unless ((ref $rel_info->{cond}) eq 'HASH');
1209 my @cond = keys(%{$rel_info->{cond}});
1210 my @refkeys = map {/^\w+\.(\w+)$/} @cond;
1211 my @keys = map {$rel_info->{cond}->{$_} =~ /^\w+\.(\w+)$/} @cond;
1213 # Get the related result source for this relationship
1214 my $othertable = $self->related_source($rel);
1216 # Get all the relationships for that source that related to this source
1217 # whose foreign column set are our self columns on $rel and whose self
1218 # columns are our foreign columns on $rel.
1219 my @otherrels = $othertable->relationships();
1220 my $otherrelationship;
1221 foreach my $otherrel (@otherrels) {
1222 my $otherrel_info = $othertable->relationship_info($otherrel);
1224 my $back = $othertable->related_source($otherrel);
1225 next unless $back->source_name eq $self->source_name;
1229 if (ref $otherrel_info->{cond} eq 'HASH') {
1230 @othertestconds = ($otherrel_info->{cond});
1232 elsif (ref $otherrel_info->{cond} eq 'ARRAY') {
1233 @othertestconds = @{$otherrel_info->{cond}};
1239 foreach my $othercond (@othertestconds) {
1240 my @other_cond = keys(%$othercond);
1241 my @other_refkeys = map {/^\w+\.(\w+)$/} @other_cond;
1242 my @other_keys = map {$othercond->{$_} =~ /^\w+\.(\w+)$/} @other_cond;
1243 next if (!$self->_compare_relationship_keys(\@refkeys, \@other_keys) ||
1244 !$self->_compare_relationship_keys(\@other_refkeys, \@keys));
1245 $ret->{$otherrel} = $otherrel_info;
1251 sub compare_relationship_keys {
1252 carp 'compare_relationship_keys is a private method, stop calling it';
1254 $self->_compare_relationship_keys (@_);
1257 # Returns true if both sets of keynames are the same, false otherwise.
1258 sub _compare_relationship_keys {
1259 my ($self, $keys1, $keys2) = @_;
1261 # Make sure every keys1 is in keys2
1263 foreach my $key (@$keys1) {
1265 foreach my $prim (@$keys2) {
1266 if ($prim eq $key) {
1274 # Make sure every key2 is in key1
1276 foreach my $prim (@$keys2) {
1278 foreach my $key (@$keys1) {
1279 if ($prim eq $key) {
1291 # Returns the {from} structure used to express JOIN conditions
1293 my ($self, $join, $alias, $seen, $jpath, $parent_force_left) = @_;
1295 # we need a supplied one, because we do in-place modifications, no returns
1296 $self->throw_exception ('You must supply a seen hashref as the 3rd argument to _resolve_join')
1297 unless ref $seen eq 'HASH';
1299 $self->throw_exception ('You must supply a joinpath arrayref as the 4th argument to _resolve_join')
1300 unless ref $jpath eq 'ARRAY';
1302 $jpath = [@$jpath]; # copy
1304 if (not defined $join) {
1307 elsif (ref $join eq 'ARRAY') {
1310 $self->_resolve_join($_, $alias, $seen, $jpath, $parent_force_left);
1313 elsif (ref $join eq 'HASH') {
1316 for my $rel (keys %$join) {
1318 my $rel_info = $self->relationship_info($rel)
1319 or $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
1321 my $force_left = $parent_force_left;
1322 $force_left ||= lc($rel_info->{attrs}{join_type}||'') eq 'left';
1324 # the actual seen value will be incremented by the recursion
1325 my $as = $self->storage->relname_to_table_alias(
1326 $rel, ($seen->{$rel} && $seen->{$rel} + 1)
1330 $self->_resolve_join($rel, $alias, $seen, [@$jpath], $force_left),
1331 $self->related_source($rel)->_resolve_join(
1332 $join->{$rel}, $as, $seen, [@$jpath, { $rel => $as }], $force_left
1340 $self->throw_exception("No idea how to resolve join reftype ".ref $join);
1343 my $count = ++$seen->{$join};
1344 my $as = $self->storage->relname_to_table_alias(
1345 $join, ($count > 1 && $count)
1348 my $rel_info = $self->relationship_info($join)
1349 or $self->throw_exception("No such relationship $join on " . $self->source_name);
1351 my $rel_src = $self->related_source($join);
1352 return [ { $as => $rel_src->from,
1353 -source_handle => $rel_src->handle,
1354 -join_type => $parent_force_left
1356 : $rel_info->{attrs}{join_type}
1358 -join_path => [@$jpath, { $join => $as } ],
1360 $rel_info->{attrs}{accessor}
1362 first { $rel_info->{attrs}{accessor} eq $_ } (qw/single filter/)
1365 -relation_chain_depth => $seen->{-relation_chain_depth} || 0,
1367 $self->_resolve_condition($rel_info->{cond}, $as, $alias) ];
1372 carp 'pk_depends_on is a private method, stop calling it';
1374 $self->_pk_depends_on (@_);
1377 # Determines whether a relation is dependent on an object from this source
1378 # having already been inserted. Takes the name of the relationship and a
1379 # hashref of columns of the related object.
1380 sub _pk_depends_on {
1381 my ($self, $relname, $rel_data) = @_;
1383 my $relinfo = $self->relationship_info($relname);
1385 # don't assume things if the relationship direction is specified
1386 return $relinfo->{attrs}{is_foreign_key_constraint}
1387 if exists ($relinfo->{attrs}{is_foreign_key_constraint});
1389 my $cond = $relinfo->{cond};
1390 return 0 unless ref($cond) eq 'HASH';
1392 # map { foreign.foo => 'self.bar' } to { bar => 'foo' }
1393 my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond };
1395 # assume anything that references our PK probably is dependent on us
1396 # rather than vice versa, unless the far side is (a) defined or (b)
1398 my $rel_source = $self->related_source($relname);
1400 foreach my $p ($self->primary_columns) {
1401 if (exists $keyhash->{$p}) {
1402 unless (defined($rel_data->{$keyhash->{$p}})
1403 || $rel_source->column_info($keyhash->{$p})
1404 ->{is_auto_increment}) {
1413 sub resolve_condition {
1414 carp 'resolve_condition is a private method, stop calling it';
1416 $self->_resolve_condition (@_);
1419 # Resolves the passed condition to a concrete query fragment. If given an alias,
1420 # returns a join condition; if given an object, inverts that object to produce
1421 # a related conditional from that object.
1422 our $UNRESOLVABLE_CONDITION = \'1 = 0';
1424 sub _resolve_condition {
1425 my ($self, $cond, $as, $for) = @_;
1426 if (ref $cond eq 'HASH') {
1428 foreach my $k (keys %{$cond}) {
1429 my $v = $cond->{$k};
1430 # XXX should probably check these are valid columns
1431 $k =~ s/^foreign\.// ||
1432 $self->throw_exception("Invalid rel cond key ${k}");
1433 $v =~ s/^self\.// ||
1434 $self->throw_exception("Invalid rel cond val ${v}");
1435 if (ref $for) { # Object
1436 #warn "$self $k $for $v";
1437 unless ($for->has_column_loaded($v)) {
1438 if ($for->in_storage) {
1439 $self->throw_exception(sprintf
1440 "Unable to resolve relationship '%s' from object %s: column '%s' not "
1441 . 'loaded from storage (or not passed to new() prior to insert()). You '
1442 . 'probably need to call ->discard_changes to get the server-side defaults '
1443 . 'from the database.',
1449 return $UNRESOLVABLE_CONDITION;
1451 $ret{$k} = $for->get_column($v);
1452 #$ret{$k} = $for->get_column($v) if $for->has_column_loaded($v);
1454 } elsif (!defined $for) { # undef, i.e. "no object"
1456 } elsif (ref $as eq 'HASH') { # reverse hashref
1457 $ret{$v} = $as->{$k};
1458 } elsif (ref $as) { # reverse object
1459 $ret{$v} = $as->get_column($k);
1460 } elsif (!defined $as) { # undef, i.e. "no reverse object"
1463 $ret{"${as}.${k}"} = "${for}.${v}";
1467 } elsif (ref $cond eq 'ARRAY') {
1468 return [ map { $self->_resolve_condition($_, $as, $for) } @$cond ];
1470 die("Can't handle condition $cond yet :(");
1475 # Accepts one or more relationships for the current source and returns an
1476 # array of column names for each of those relationships. Column names are
1477 # prefixed relative to the current source, in accordance with where they appear
1478 # in the supplied relationships.
1480 sub _resolve_prefetch {
1481 my ($self, $pre, $alias, $alias_map, $order, $collapse, $pref_path) = @_;
1484 if (not defined $pre) {
1487 elsif( ref $pre eq 'ARRAY' ) {
1489 map { $self->_resolve_prefetch( $_, $alias, $alias_map, $order, $collapse, [ @$pref_path ] ) }
1492 elsif( ref $pre eq 'HASH' ) {
1495 $self->_resolve_prefetch($_, $alias, $alias_map, $order, $collapse, [ @$pref_path ] ),
1496 $self->related_source($_)->_resolve_prefetch(
1497 $pre->{$_}, "${alias}.$_", $alias_map, $order, $collapse, [ @$pref_path, $_] )
1502 $self->throw_exception(
1503 "don't know how to resolve prefetch reftype ".ref($pre));
1507 $p = $p->{$_} for (@$pref_path, $pre);
1509 $self->throw_exception (
1510 "Unable to resolve prefetch '$pre' - join alias map does not contain an entry for path: "
1511 . join (' -> ', @$pref_path, $pre)
1512 ) if (ref $p->{-join_aliases} ne 'ARRAY' or not @{$p->{-join_aliases}} );
1514 my $as = shift @{$p->{-join_aliases}};
1516 my $rel_info = $self->relationship_info( $pre );
1517 $self->throw_exception( $self->source_name . " has no such relationship '$pre'" )
1519 my $as_prefix = ($alias =~ /^.*?\.(.+)$/ ? $1.'.' : '');
1520 my $rel_source = $self->related_source($pre);
1522 if ($rel_info->{attrs}{accessor} && $rel_info->{attrs}{accessor} eq 'multi') {
1523 $self->throw_exception(
1524 "Can't prefetch has_many ${pre} (join cond too complex)")
1525 unless ref($rel_info->{cond}) eq 'HASH';
1526 my $dots = @{[$as_prefix =~ m/\./g]} + 1; # +1 to match the ".${as_prefix}"
1527 if (my ($fail) = grep { @{[$_ =~ m/\./g]} == $dots }
1528 keys %{$collapse}) {
1529 my ($last) = ($fail =~ /([^\.]+)$/);
1531 "Prefetching multiple has_many rels ${last} and ${pre} "
1532 .(length($as_prefix)
1533 ? "at the same level (${as_prefix}) "
1536 . 'will explode the number of row objects retrievable via ->next or ->all. '
1537 . 'Use at your own risk.'
1540 #my @col = map { (/^self\.(.+)$/ ? ("${as_prefix}.$1") : ()); }
1541 # values %{$rel_info->{cond}};
1542 $collapse->{".${as_prefix}${pre}"} = [ $rel_source->_pri_cols ];
1543 # action at a distance. prepending the '.' allows simpler code
1544 # in ResultSet->_collapse_result
1545 my @key = map { (/^foreign\.(.+)$/ ? ($1) : ()); }
1546 keys %{$rel_info->{cond}};
1547 my @ord = (ref($rel_info->{attrs}{order_by}) eq 'ARRAY'
1548 ? @{$rel_info->{attrs}{order_by}}
1550 : (defined $rel_info->{attrs}{order_by}
1551 ? ($rel_info->{attrs}{order_by})
1553 push(@$order, map { "${as}.$_" } (@key, @ord));
1556 return map { [ "${as}.$_", "${as_prefix}${pre}.$_", ] }
1557 $rel_source->columns;
1561 =head2 related_source
1565 =item Arguments: $relname
1567 =item Return value: $source
1571 Returns the result source object for the given relationship.
1575 sub related_source {
1576 my ($self, $rel) = @_;
1577 if( !$self->has_relationship( $rel ) ) {
1578 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
1580 return $self->schema->source($self->relationship_info($rel)->{source});
1583 =head2 related_class
1587 =item Arguments: $relname
1589 =item Return value: $classname
1593 Returns the class name for objects in the given relationship.
1598 my ($self, $rel) = @_;
1599 if( !$self->has_relationship( $rel ) ) {
1600 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
1602 return $self->schema->class($self->relationship_info($rel)->{source});
1607 Obtain a new handle to this source. Returns an instance of a
1608 L<DBIx::Class::ResultSourceHandle>.
1613 return DBIx::Class::ResultSourceHandle->new({
1614 schema => $_[0]->schema,
1615 source_moniker => $_[0]->source_name
1619 =head2 throw_exception
1621 See L<DBIx::Class::Schema/"throw_exception">.
1625 sub throw_exception {
1628 if (defined $self->schema) {
1629 $self->schema->throw_exception(@_);
1632 DBIx::Class::Exception->throw(@_);
1638 Stores a hashref of per-source metadata. No specific key names
1639 have yet been standardized, the examples below are purely hypothetical
1640 and don't actually accomplish anything on their own:
1642 __PACKAGE__->source_info({
1643 "_tablespace" => 'fast_disk_array_3',
1644 "_engine" => 'InnoDB',
1651 $class->new({attribute_name => value});
1653 Creates a new ResultSource object. Not normally called directly by end users.
1655 =head2 column_info_from_storage
1659 =item Arguments: 1/0 (default: 0)
1661 =item Return value: 1/0
1665 __PACKAGE__->column_info_from_storage(1);
1667 Enables the on-demand automatic loading of the above column
1668 metadata from storage as necessary. This is *deprecated*, and
1669 should not be used. It will be removed before 1.0.
1674 Matt S. Trout <mst@shadowcatsystems.co.uk>
1678 You may distribute this code under the same terms as Perl itself.