1 package DBIx::Class::ResultSource;
6 use DBIx::Class::ResultSet;
7 use DBIx::Class::ResultSourceHandle;
9 use DBIx::Class::Exception;
10 use DBIx::Class::Carp;
12 use List::Util 'first';
13 use Scalar::Util qw/blessed weaken isweak/;
16 use base qw/DBIx::Class/;
18 __PACKAGE__->mk_group_accessors('simple' => qw/_ordered_columns
19 _columns _primaries _unique_constraints name resultset_attributes
20 from _relationships column_info_from_storage source_info
21 source_name sqlt_deploy_callback/);
23 __PACKAGE__->mk_group_accessors('component_class' => qw/resultset_class
28 DBIx::Class::ResultSource - Result source object
32 # Create a table based result source, in a result class.
34 package MyApp::Schema::Result::Artist;
35 use base qw/DBIx::Class::Core/;
37 __PACKAGE__->table('artist');
38 __PACKAGE__->add_columns(qw/ artistid name /);
39 __PACKAGE__->set_primary_key('artistid');
40 __PACKAGE__->has_many(cds => 'MyApp::Schema::Result::CD');
44 # Create a query (view) based result source, in a result class
45 package MyApp::Schema::Result::Year2000CDs;
46 use base qw/DBIx::Class::Core/;
48 __PACKAGE__->load_components('InflateColumn::DateTime');
49 __PACKAGE__->table_class('DBIx::Class::ResultSource::View');
51 __PACKAGE__->table('year2000cds');
52 __PACKAGE__->result_source_instance->is_virtual(1);
53 __PACKAGE__->result_source_instance->view_definition(
54 "SELECT cdid, artist, title FROM cd WHERE year ='2000'"
60 A ResultSource is an object that represents a source of data for querying.
62 This class is a base class for various specialised types of result
63 sources, for example L<DBIx::Class::ResultSource::Table>. Table is the
64 default result source type, so one is created for you when defining a
65 result class as described in the synopsis above.
67 More specifically, the L<DBIx::Class::Core> base class pulls in the
68 L<DBIx::Class::ResultSourceProxy::Table> component, which defines
69 the L<table|DBIx::Class::ResultSourceProxy::Table/table> method.
70 When called, C<table> creates and stores an instance of
71 L<DBIx::Class::ResultSoure::Table>. Luckily, to use tables as result
72 sources, you don't need to remember any of this.
74 Result sources representing select queries, or views, can also be
75 created, see L<DBIx::Class::ResultSource::View> for full details.
77 =head2 Finding result source objects
79 As mentioned above, a result source instance is created and stored for
80 you when you define a L<Result Class|DBIx::Class::Manual::Glossary/Result Class>.
82 You can retrieve the result source at runtime in the following ways:
86 =item From a Schema object:
88 $schema->source($source_name);
90 =item From a Row object:
94 =item From a ResultSet object:
107 my ($class, $attrs) = @_;
108 $class = ref $class if ref $class;
110 my $new = bless { %{$attrs || {}} }, $class;
111 $new->{resultset_class} ||= 'DBIx::Class::ResultSet';
112 $new->{resultset_attributes} = { %{$new->{resultset_attributes} || {}} };
113 $new->{_ordered_columns} = [ @{$new->{_ordered_columns}||[]}];
114 $new->{_columns} = { %{$new->{_columns}||{}} };
115 $new->{_relationships} = { %{$new->{_relationships}||{}} };
116 $new->{name} ||= "!!NAME NOT SET!!";
117 $new->{_columns_info_loaded} ||= 0;
118 $new->{sqlt_deploy_callback} ||= "default_sqlt_deploy_hook";
128 =item Arguments: @columns
130 =item Return value: The ResultSource object
134 $source->add_columns(qw/col1 col2 col3/);
136 $source->add_columns('col1' => \%col1_info, 'col2' => \%col2_info, ...);
138 Adds columns to the result source. If supplied colname => hashref
139 pairs, uses the hashref as the L</column_info> for that column. Repeated
140 calls of this method will add more columns, not replace them.
142 The column names given will be created as accessor methods on your
143 L<DBIx::Class::Row> objects. You can change the name of the accessor
144 by supplying an L</accessor> in the column_info hash.
146 If a column name beginning with a plus sign ('+col1') is provided, the
147 attributes provided will be merged with any existing attributes for the
148 column, with the new attributes taking precedence in the case that an
149 attribute already exists. Using this without a hashref
150 (C<< $source->add_columns(qw/+col1 +col2/) >>) is legal, but useless --
151 it does the same thing it would do without the plus.
153 The contents of the column_info are not set in stone. The following
154 keys are currently recognised/used by DBIx::Class:
160 { accessor => '_name' }
162 # example use, replace standard accessor with one of your own:
164 my ($self, $value) = @_;
166 die "Name cannot contain digits!" if($value =~ /\d/);
167 $self->_name($value);
169 return $self->_name();
172 Use this to set the name of the accessor method for this column. If unset,
173 the name of the column will be used.
177 { data_type => 'integer' }
179 This contains the column type. It is automatically filled if you use the
180 L<SQL::Translator::Producer::DBIx::Class::File> producer, or the
181 L<DBIx::Class::Schema::Loader> module.
183 Currently there is no standard set of values for the data_type. Use
184 whatever your database supports.
190 The length of your column, if it is a column type that can have a size
191 restriction. This is currently only used to create tables from your
192 schema, see L<DBIx::Class::Schema/deploy>.
198 Set this to a true value for a columns that is allowed to contain NULL
199 values, default is false. This is currently only used to create tables
200 from your schema, see L<DBIx::Class::Schema/deploy>.
202 =item is_auto_increment
204 { is_auto_increment => 1 }
206 Set this to a true value for a column whose value is somehow
207 automatically set, defaults to false. This is used to determine which
208 columns to empty when cloning objects using
209 L<DBIx::Class::Row/copy>. It is also used by
210 L<DBIx::Class::Schema/deploy>.
216 Set this to a true or false value (not C<undef>) to explicitly specify
217 if this column contains numeric data. This controls how set_column
218 decides whether to consider a column dirty after an update: if
219 C<is_numeric> is true a numeric comparison C<< != >> will take place
220 instead of the usual C<eq>
222 If not specified the storage class will attempt to figure this out on
223 first access to the column, based on the column C<data_type>. The
224 result will be cached in this attribute.
228 { is_foreign_key => 1 }
230 Set this to a true value for a column that contains a key from a
231 foreign table, defaults to false. This is currently only used to
232 create tables from your schema, see L<DBIx::Class::Schema/deploy>.
236 { default_value => \'now()' }
238 Set this to the default value which will be inserted into a column by
239 the database. Can contain either a value or a function (use a
240 reference to a scalar e.g. C<\'now()'> if you want a function). This
241 is currently only used to create tables from your schema, see
242 L<DBIx::Class::Schema/deploy>.
244 See the note on L<DBIx::Class::Row/new> for more information about possible
245 issues related to db-side default values.
249 { sequence => 'my_table_seq' }
251 Set this on a primary key column to the name of the sequence used to
252 generate a new key value. If not specified, L<DBIx::Class::PK::Auto>
253 will attempt to retrieve the name of the sequence from the database
256 =item retrieve_on_insert
258 { retrieve_on_insert => 1 }
260 For every column where this is set to true, DBIC will retrieve the RDBMS-side
261 value upon a new row insertion (normally only the autoincrement PK is
262 retrieved on insert). C<INSERT ... RETURNING> is used automatically if
263 supported by the underlying storage, otherwise an extra SELECT statement is
264 executed to retrieve the missing data.
268 { auto_nextval => 1 }
270 Set this to a true value for a column whose value is retrieved automatically
271 from a sequence or function (if supported by your Storage driver.) For a
272 sequence, if you do not use a trigger to get the nextval, you have to set the
273 L</sequence> value as well.
275 Also set this for MSSQL columns with the 'uniqueidentifier'
276 L<data_type|DBIx::Class::ResultSource/data_type> whose values you want to
277 automatically generate using C<NEWID()>, unless they are a primary key in which
278 case this will be done anyway.
282 This is used by L<DBIx::Class::Schema/deploy> and L<SQL::Translator>
283 to add extra non-generic data to the column. For example: C<< extra
284 => { unsigned => 1} >> is used by the MySQL producer to set an integer
285 column to unsigned. For more details, see
286 L<SQL::Translator::Producer::MySQL>.
294 =item Arguments: $colname, \%columninfo?
296 =item Return value: 1/0 (true/false)
300 $source->add_column('col' => \%info);
302 Add a single column and optional column info. Uses the same column
303 info keys as L</add_columns>.
308 my ($self, @cols) = @_;
309 $self->_ordered_columns(\@cols) unless $self->_ordered_columns;
312 my $columns = $self->_columns;
313 while (my $col = shift @cols) {
314 my $column_info = {};
315 if ($col =~ s/^\+//) {
316 $column_info = $self->column_info($col);
319 # If next entry is { ... } use that for the column info, if not
320 # use an empty hashref
322 my $new_info = shift(@cols);
323 %$column_info = (%$column_info, %$new_info);
325 push(@added, $col) unless exists $columns->{$col};
326 $columns->{$col} = $column_info;
328 push @{ $self->_ordered_columns }, @added;
332 sub add_column { shift->add_columns(@_); } # DO NOT CHANGE THIS TO GLOB
338 =item Arguments: $colname
340 =item Return value: 1/0 (true/false)
344 if ($source->has_column($colname)) { ... }
346 Returns true if the source has a column of this name, false otherwise.
351 my ($self, $column) = @_;
352 return exists $self->_columns->{$column};
359 =item Arguments: $colname
361 =item Return value: Hashref of info
365 my $info = $source->column_info($col);
367 Returns the column metadata hashref for a column, as originally passed
368 to L</add_columns>. See L</add_columns> above for information on the
369 contents of the hashref.
374 my ($self, $column) = @_;
375 $self->throw_exception("No such column $column")
376 unless exists $self->_columns->{$column};
378 if ( ! $self->_columns->{$column}{data_type}
379 and ! $self->{_columns_info_loaded}
380 and $self->column_info_from_storage
381 and my $stor = try { $self->storage } )
383 $self->{_columns_info_loaded}++;
385 # try for the case of storage without table
387 my $info = $stor->columns_info_for( $self->from );
389 { (lc $_) => $info->{$_} }
393 foreach my $col ( keys %{$self->_columns} ) {
394 $self->_columns->{$col} = {
395 %{ $self->_columns->{$col} },
396 %{ $info->{$col} || $lc_info->{lc $col} || {} }
402 return $self->_columns->{$column};
409 =item Arguments: None
411 =item Return value: Ordered list of column names
415 my @column_names = $source->columns;
417 Returns all column names in the order they were declared to L</add_columns>.
423 $self->throw_exception(
424 "columns() is a read-only accessor, did you mean add_columns()?"
426 return @{$self->{_ordered_columns}||[]};
433 =item Arguments: \@colnames ?
435 =item Return value: Hashref of column name/info pairs
439 my $columns_info = $source->columns_info;
441 Like L</column_info> but returns information for the requested columns. If
442 the optional column-list arrayref is omitted it returns info on all columns
443 currently defined on the ResultSource via L</add_columns>.
448 my ($self, $columns) = @_;
450 my $colinfo = $self->_columns;
453 first { ! $_->{data_type} } values %$colinfo
455 ! $self->{_columns_info_loaded}
457 $self->column_info_from_storage
459 my $stor = try { $self->storage }
461 $self->{_columns_info_loaded}++;
463 # try for the case of storage without table
465 my $info = $stor->columns_info_for( $self->from );
467 { (lc $_) => $info->{$_} }
471 foreach my $col ( keys %$colinfo ) {
473 %{ $colinfo->{$col} },
474 %{ $info->{$col} || $lc_info->{lc $col} || {} }
484 if (my $inf = $colinfo->{$_}) {
488 $self->throw_exception( sprintf (
489 "No such column '%s' on source %s",
503 =head2 remove_columns
507 =item Arguments: @colnames
509 =item Return value: undefined
513 $source->remove_columns(qw/col1 col2 col3/);
515 Removes the given list of columns by name, from the result source.
517 B<Warning>: Removing a column that is also used in the sources primary
518 key, or in one of the sources unique constraints, B<will> result in a
519 broken result source.
525 =item Arguments: $colname
527 =item Return value: undefined
531 $source->remove_column('col');
533 Remove a single column by name from the result source, similar to
536 B<Warning>: Removing a column that is also used in the sources primary
537 key, or in one of the sources unique constraints, B<will> result in a
538 broken result source.
543 my ($self, @to_remove) = @_;
545 my $columns = $self->_columns
550 delete $columns->{$_};
554 $self->_ordered_columns([ grep { not $to_remove{$_} } @{$self->_ordered_columns} ]);
557 sub remove_column { shift->remove_columns(@_); } # DO NOT CHANGE THIS TO GLOB
559 =head2 set_primary_key
563 =item Arguments: @cols
565 =item Return value: undefined
569 Defines one or more columns as primary key for this source. Must be
570 called after L</add_columns>.
572 Additionally, defines a L<unique constraint|add_unique_constraint>
575 Note: you normally do want to define a primary key on your sources
576 B<even if the underlying database table does not have a primary key>.
578 L<DBIx::Class::Manual::Intro/The Significance and Importance of Primary Keys>
583 sub set_primary_key {
584 my ($self, @cols) = @_;
585 # check if primary key columns are valid columns
586 foreach my $col (@cols) {
587 $self->throw_exception("No such column $col on table " . $self->name)
588 unless $self->has_column($col);
590 $self->_primaries(\@cols);
592 $self->add_unique_constraint(primary => \@cols);
595 =head2 primary_columns
599 =item Arguments: None
601 =item Return value: Ordered list of primary column names
605 Read-only accessor which returns the list of primary keys, supplied by
610 sub primary_columns {
611 return @{shift->_primaries||[]};
614 # a helper method that will automatically die with a descriptive message if
615 # no pk is defined on the source in question. For internal use to save
616 # on if @pks... boilerplate
619 my @pcols = $self->primary_columns
620 or $self->throw_exception (sprintf(
621 "Operation requires a primary key to be declared on '%s' via set_primary_key",
622 # source_name is set only after schema-registration
623 $self->source_name || $self->result_class || $self->name || 'Unknown source...?',
630 Manually define the correct sequence for your table, to avoid the overhead
631 associated with looking up the sequence automatically. The supplied sequence
632 will be applied to the L</column_info> of each L<primary_key|/set_primary_key>
636 =item Arguments: $sequence_name
638 =item Return value: undefined
645 my ($self,$seq) = @_;
647 my @pks = $self->primary_columns
650 $_->{sequence} = $seq
651 for values %{ $self->columns_info (\@pks) };
655 =head2 add_unique_constraint
659 =item Arguments: $name?, \@colnames
661 =item Return value: undefined
665 Declare a unique constraint on this source. Call once for each unique
668 # For UNIQUE (column1, column2)
669 __PACKAGE__->add_unique_constraint(
670 constraint_name => [ qw/column1 column2/ ],
673 Alternatively, you can specify only the columns:
675 __PACKAGE__->add_unique_constraint([ qw/column1 column2/ ]);
677 This will result in a unique constraint named
678 C<table_column1_column2>, where C<table> is replaced with the table
681 Unique constraints are used, for example, when you pass the constraint
682 name as the C<key> attribute to L<DBIx::Class::ResultSet/find>. Then
683 only columns in the constraint are searched.
685 Throws an error if any of the given column names do not yet exist on
690 sub add_unique_constraint {
694 $self->throw_exception(
695 'add_unique_constraint() does not accept multiple constraints, use '
696 . 'add_unique_constraints() instead'
701 if (ref $cols ne 'ARRAY') {
702 $self->throw_exception (
703 'Expecting an arrayref of constraint columns, got ' . ($cols||'NOTHING')
709 $name ||= $self->name_unique_constraint($cols);
711 foreach my $col (@$cols) {
712 $self->throw_exception("No such column $col on table " . $self->name)
713 unless $self->has_column($col);
716 my %unique_constraints = $self->unique_constraints;
717 $unique_constraints{$name} = $cols;
718 $self->_unique_constraints(\%unique_constraints);
721 =head2 add_unique_constraints
725 =item Arguments: @constraints
727 =item Return value: undefined
731 Declare multiple unique constraints on this source.
733 __PACKAGE__->add_unique_constraints(
734 constraint_name1 => [ qw/column1 column2/ ],
735 constraint_name2 => [ qw/column2 column3/ ],
738 Alternatively, you can specify only the columns:
740 __PACKAGE__->add_unique_constraints(
741 [ qw/column1 column2/ ],
742 [ qw/column3 column4/ ]
745 This will result in unique constraints named C<table_column1_column2> and
746 C<table_column3_column4>, where C<table> is replaced with the table name.
748 Throws an error if any of the given column names do not yet exist on
751 See also L</add_unique_constraint>.
755 sub add_unique_constraints {
757 my @constraints = @_;
759 if ( !(@constraints % 2) && first { ref $_ ne 'ARRAY' } @constraints ) {
760 # with constraint name
761 while (my ($name, $constraint) = splice @constraints, 0, 2) {
762 $self->add_unique_constraint($name => $constraint);
767 foreach my $constraint (@constraints) {
768 $self->add_unique_constraint($constraint);
773 =head2 name_unique_constraint
777 =item Arguments: \@colnames
779 =item Return value: Constraint name
783 $source->table('mytable');
784 $source->name_unique_constraint(['col1', 'col2']);
788 Return a name for a unique constraint containing the specified
789 columns. The name is created by joining the table name and each column
790 name, using an underscore character.
792 For example, a constraint on a table named C<cd> containing the columns
793 C<artist> and C<title> would result in a constraint name of C<cd_artist_title>.
795 This is used by L</add_unique_constraint> if you do not specify the
796 optional constraint name.
800 sub name_unique_constraint {
801 my ($self, $cols) = @_;
803 my $name = $self->name;
804 $name = $$name if (ref $name eq 'SCALAR');
806 return join '_', $name, @$cols;
809 =head2 unique_constraints
813 =item Arguments: None
815 =item Return value: Hash of unique constraint data
819 $source->unique_constraints();
821 Read-only accessor which returns a hash of unique constraints on this
824 The hash is keyed by constraint name, and contains an arrayref of
825 column names as values.
829 sub unique_constraints {
830 return %{shift->_unique_constraints||{}};
833 =head2 unique_constraint_names
837 =item Arguments: None
839 =item Return value: Unique constraint names
843 $source->unique_constraint_names();
845 Returns the list of unique constraint names defined on this source.
849 sub unique_constraint_names {
852 my %unique_constraints = $self->unique_constraints;
854 return keys %unique_constraints;
857 =head2 unique_constraint_columns
861 =item Arguments: $constraintname
863 =item Return value: List of constraint columns
867 $source->unique_constraint_columns('myconstraint');
869 Returns the list of columns that make up the specified unique constraint.
873 sub unique_constraint_columns {
874 my ($self, $constraint_name) = @_;
876 my %unique_constraints = $self->unique_constraints;
878 $self->throw_exception(
879 "Unknown unique constraint $constraint_name on '" . $self->name . "'"
880 ) unless exists $unique_constraints{$constraint_name};
882 return @{ $unique_constraints{$constraint_name} };
885 =head2 sqlt_deploy_callback
889 =item Arguments: $callback_name | \&callback_code
891 =item Return value: $callback_name | \&callback_code
895 __PACKAGE__->sqlt_deploy_callback('mycallbackmethod');
899 __PACKAGE__->sqlt_deploy_callback(sub {
900 my ($source_instance, $sqlt_table) = @_;
904 An accessor to set a callback to be called during deployment of
905 the schema via L<DBIx::Class::Schema/create_ddl_dir> or
906 L<DBIx::Class::Schema/deploy>.
908 The callback can be set as either a code reference or the name of a
909 method in the current result class.
911 Defaults to L</default_sqlt_deploy_hook>.
913 Your callback will be passed the $source object representing the
914 ResultSource instance being deployed, and the
915 L<SQL::Translator::Schema::Table> object being created from it. The
916 callback can be used to manipulate the table object or add your own
917 customised indexes. If you need to manipulate a non-table object, use
918 the L<DBIx::Class::Schema/sqlt_deploy_hook>.
920 See L<DBIx::Class::Manual::Cookbook/Adding Indexes And Functions To
921 Your SQL> for examples.
923 This sqlt deployment callback can only be used to manipulate
924 SQL::Translator objects as they get turned into SQL. To execute
925 post-deploy statements which SQL::Translator does not currently
926 handle, override L<DBIx::Class::Schema/deploy> in your Schema class
927 and call L<dbh_do|DBIx::Class::Storage::DBI/dbh_do>.
929 =head2 default_sqlt_deploy_hook
931 This is the default deploy hook implementation which checks if your
932 current Result class has a C<sqlt_deploy_hook> method, and if present
933 invokes it B<on the Result class directly>. This is to preserve the
934 semantics of C<sqlt_deploy_hook> which was originally designed to expect
935 the Result class name and the
936 L<$sqlt_table instance|SQL::Translator::Schema::Table> of the table being
941 sub default_sqlt_deploy_hook {
944 my $class = $self->result_class;
946 if ($class and $class->can('sqlt_deploy_hook')) {
947 $class->sqlt_deploy_hook(@_);
951 sub _invoke_sqlt_deploy_hook {
953 if ( my $hook = $self->sqlt_deploy_callback) {
962 =item Arguments: None
964 =item Return value: $resultset
968 Returns a resultset for the given source. This will initially be created
971 $self->resultset_class->new($self, $self->resultset_attributes)
973 but is cached from then on unless resultset_class changes.
975 =head2 resultset_class
979 =item Arguments: $classname
981 =item Return value: $classname
985 package My::Schema::ResultSet::Artist;
986 use base 'DBIx::Class::ResultSet';
989 # In the result class
990 __PACKAGE__->resultset_class('My::Schema::ResultSet::Artist');
993 $source->resultset_class('My::Schema::ResultSet::Artist');
995 Set the class of the resultset. This is useful if you want to create your
996 own resultset methods. Create your own class derived from
997 L<DBIx::Class::ResultSet>, and set it here. If called with no arguments,
998 this method returns the name of the existing resultset class, if one
1001 =head2 resultset_attributes
1005 =item Arguments: \%attrs
1007 =item Return value: \%attrs
1011 # In the result class
1012 __PACKAGE__->resultset_attributes({ order_by => [ 'id' ] });
1015 $source->resultset_attributes({ order_by => [ 'id' ] });
1017 Store a collection of resultset attributes, that will be set on every
1018 L<DBIx::Class::ResultSet> produced from this result source. For a full
1019 list see L<DBIx::Class::ResultSet/ATTRIBUTES>.
1025 $self->throw_exception(
1026 'resultset does not take any arguments. If you want another resultset, '.
1027 'call it on the schema instead.'
1030 $self->resultset_class->new(
1033 try { %{$self->schema->default_resultset_attributes} },
1034 %{$self->{resultset_attributes}},
1043 =item Arguments: $source_name
1045 =item Result value: $source_name
1049 Set an alternate name for the result source when it is loaded into a schema.
1050 This is useful if you want to refer to a result source by a name other than
1053 package ArchivedBooks;
1054 use base qw/DBIx::Class/;
1055 __PACKAGE__->table('books_archive');
1056 __PACKAGE__->source_name('Books');
1058 # from your schema...
1059 $schema->resultset('Books')->find(1);
1065 =item Arguments: None
1067 =item Return value: FROM clause
1071 my $from_clause = $source->from();
1073 Returns an expression of the source to be supplied to storage to specify
1074 retrieval from this source. In the case of a database, the required FROM
1081 =item Arguments: $schema
1083 =item Return value: A schema object
1087 my $schema = $source->schema();
1089 Sets and/or returns the L<DBIx::Class::Schema> object to which this
1090 result source instance has been attached to.
1096 $_[0]->{schema} = $_[1];
1099 $_[0]->{schema} || do {
1100 my $name = $_[0]->{source_name} || '_unnamed_';
1101 my $err = 'Unable to perform storage-dependent operations with a detached result source '
1102 . "(source '$name' is not associated with a schema).";
1104 $err .= ' You need to use $schema->thaw() or manually set'
1105 . ' $DBIx::Class::ResultSourceHandle::thaw_schema while thawing.'
1106 if $_[0]->{_detached_thaw};
1108 DBIx::Class::Exception->throw($err);
1117 =item Arguments: None
1119 =item Return value: A Storage object
1123 $source->storage->debug(1);
1125 Returns the storage handle for the current schema.
1127 See also: L<DBIx::Class::Storage>
1131 sub storage { shift->schema->storage; }
1133 =head2 add_relationship
1137 =item Arguments: $relname, $related_source_name, \%cond, [ \%attrs ]
1139 =item Return value: 1/true if it succeeded
1143 $source->add_relationship('relname', 'related_source', $cond, $attrs);
1145 L<DBIx::Class::Relationship> describes a series of methods which
1146 create pre-defined useful types of relationships. Look there first
1147 before using this method directly.
1149 The relationship name can be arbitrary, but must be unique for each
1150 relationship attached to this result source. 'related_source' should
1151 be the name with which the related result source was registered with
1152 the current schema. For example:
1154 $schema->source('Book')->add_relationship('reviews', 'Review', {
1155 'foreign.book_id' => 'self.id',
1158 The condition C<$cond> needs to be an L<SQL::Abstract>-style
1159 representation of the join between the tables. For example, if you're
1160 creating a relation from Author to Book,
1162 { 'foreign.author_id' => 'self.id' }
1164 will result in the JOIN clause
1166 author me JOIN book foreign ON foreign.author_id = me.id
1168 You can specify as many foreign => self mappings as necessary.
1170 Valid attributes are as follows:
1176 Explicitly specifies the type of join to use in the relationship. Any
1177 SQL join type is valid, e.g. C<LEFT> or C<RIGHT>. It will be placed in
1178 the SQL command immediately before C<JOIN>.
1182 An arrayref containing a list of accessors in the foreign class to proxy in
1183 the main class. If, for example, you do the following:
1185 CD->might_have(liner_notes => 'LinerNotes', undef, {
1186 proxy => [ qw/notes/ ],
1189 Then, assuming LinerNotes has an accessor named notes, you can do:
1191 my $cd = CD->find(1);
1192 # set notes -- LinerNotes object is created if it doesn't exist
1193 $cd->notes('Notes go here');
1197 Specifies the type of accessor that should be created for the
1198 relationship. Valid values are C<single> (for when there is only a single
1199 related object), C<multi> (when there can be many), and C<filter> (for
1200 when there is a single related object, but you also want the relationship
1201 accessor to double as a column accessor). For C<multi> accessors, an
1202 add_to_* method is also created, which calls C<create_related> for the
1207 Throws an exception if the condition is improperly supplied, or cannot
1212 sub add_relationship {
1213 my ($self, $rel, $f_source_name, $cond, $attrs) = @_;
1214 $self->throw_exception("Can't create relationship without join condition")
1218 # Check foreign and self are right in cond
1219 if ( (ref $cond ||'') eq 'HASH') {
1221 $self->throw_exception("Keys of condition should be of form 'foreign.col', not '$_'")
1222 if /\./ && !/^foreign\./;
1226 my %rels = %{ $self->_relationships };
1227 $rels{$rel} = { class => $f_source_name,
1228 source => $f_source_name,
1231 $self->_relationships(\%rels);
1235 # XXX disabled. doesn't work properly currently. skip in tests.
1237 my $f_source = $self->schema->source($f_source_name);
1238 unless ($f_source) {
1239 $self->ensure_class_loaded($f_source_name);
1240 $f_source = $f_source_name->result_source;
1241 #my $s_class = ref($self->schema);
1242 #$f_source_name =~ m/^${s_class}::(.*)$/;
1243 #$self->schema->register_class(($1 || $f_source_name), $f_source_name);
1244 #$f_source = $self->schema->source($f_source_name);
1246 return unless $f_source; # Can't test rel without f_source
1248 try { $self->_resolve_join($rel, 'me', {}, []) }
1250 # If the resolve failed, back out and re-throw the error
1252 $self->_relationships(\%rels);
1253 $self->throw_exception("Error creating relationship $rel: $_");
1259 =head2 relationships
1263 =item Arguments: None
1265 =item Return value: List of relationship names
1269 my @relnames = $source->relationships();
1271 Returns all relationship names for this source.
1276 return keys %{shift->_relationships};
1279 =head2 relationship_info
1283 =item Arguments: $relname
1285 =item Return value: Hashref of relation data,
1289 Returns a hash of relationship information for the specified relationship
1290 name. The keys/values are as specified for L</add_relationship>.
1294 sub relationship_info {
1295 my ($self, $rel) = @_;
1296 return $self->_relationships->{$rel};
1299 =head2 has_relationship
1303 =item Arguments: $rel
1305 =item Return value: 1/0 (true/false)
1309 Returns true if the source has a relationship of this name, false otherwise.
1313 sub has_relationship {
1314 my ($self, $rel) = @_;
1315 return exists $self->_relationships->{$rel};
1318 =head2 reverse_relationship_info
1322 =item Arguments: $relname
1324 =item Return value: Hashref of relationship data
1328 Looks through all the relationships on the source this relationship
1329 points to, looking for one whose condition is the reverse of the
1330 condition on this relationship.
1332 A common use of this is to find the name of the C<belongs_to> relation
1333 opposing a C<has_many> relation. For definition of these look in
1334 L<DBIx::Class::Relationship>.
1336 The returned hashref is keyed by the name of the opposing
1337 relationship, and contains its data in the same manner as
1338 L</relationship_info>.
1342 sub reverse_relationship_info {
1343 my ($self, $rel) = @_;
1345 my $rel_info = $self->relationship_info($rel)
1346 or $self->throw_exception("No such relationship '$rel'");
1350 return $ret unless ((ref $rel_info->{cond}) eq 'HASH');
1352 my $stripped_cond = $self->__strip_relcond ($rel_info->{cond});
1354 my $rsrc_schema_moniker = $self->source_name
1355 if try { $self->schema };
1357 # this may be a partial schema or something else equally esoteric
1358 my $other_rsrc = try { $self->related_source($rel) }
1361 # Get all the relationships for that source that related to this source
1362 # whose foreign column set are our self columns on $rel and whose self
1363 # columns are our foreign columns on $rel
1364 foreach my $other_rel ($other_rsrc->relationships) {
1366 # only consider stuff that points back to us
1367 # "us" here is tricky - if we are in a schema registration, we want
1368 # to use the source_names, otherwise we will use the actual classes
1370 # the schema may be partial
1371 my $roundtrip_rsrc = try { $other_rsrc->related_source($other_rel) }
1374 if ($rsrc_schema_moniker and try { $roundtrip_rsrc->schema } ) {
1375 next unless $rsrc_schema_moniker eq $roundtrip_rsrc->source_name;
1378 next unless $self->result_class eq $roundtrip_rsrc->result_class;
1381 my $other_rel_info = $other_rsrc->relationship_info($other_rel);
1383 # this can happen when we have a self-referential class
1384 next if $other_rel_info eq $rel_info;
1386 next unless ref $other_rel_info->{cond} eq 'HASH';
1387 my $other_stripped_cond = $self->__strip_relcond($other_rel_info->{cond});
1389 $ret->{$other_rel} = $other_rel_info if (
1390 $self->_compare_relationship_keys (
1391 [ keys %$stripped_cond ], [ values %$other_stripped_cond ]
1394 $self->_compare_relationship_keys (
1395 [ values %$stripped_cond ], [ keys %$other_stripped_cond ]
1403 # all this does is removes the foreign/self prefix from a condition
1404 sub __strip_relcond {
1407 { map { /^ (?:foreign|self) \. (\w+) $/x } ($_, $_[1]{$_}) }
1412 sub compare_relationship_keys {
1413 carp 'compare_relationship_keys is a private method, stop calling it';
1415 $self->_compare_relationship_keys (@_);
1418 # Returns true if both sets of keynames are the same, false otherwise.
1419 sub _compare_relationship_keys {
1420 # my ($self, $keys1, $keys2) = @_;
1422 join ("\x00", sort @{$_[1]})
1424 join ("\x00", sort @{$_[2]})
1428 # Returns the {from} structure used to express JOIN conditions
1430 my ($self, $join, $alias, $seen, $jpath, $parent_force_left) = @_;
1432 # we need a supplied one, because we do in-place modifications, no returns
1433 $self->throw_exception ('You must supply a seen hashref as the 3rd argument to _resolve_join')
1434 unless ref $seen eq 'HASH';
1436 $self->throw_exception ('You must supply a joinpath arrayref as the 4th argument to _resolve_join')
1437 unless ref $jpath eq 'ARRAY';
1439 $jpath = [@$jpath]; # copy
1441 if (not defined $join) {
1444 elsif (ref $join eq 'ARRAY') {
1447 $self->_resolve_join($_, $alias, $seen, $jpath, $parent_force_left);
1450 elsif (ref $join eq 'HASH') {
1453 for my $rel (keys %$join) {
1455 my $rel_info = $self->relationship_info($rel)
1456 or $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
1458 my $force_left = $parent_force_left;
1459 $force_left ||= lc($rel_info->{attrs}{join_type}||'') eq 'left';
1461 # the actual seen value will be incremented by the recursion
1462 my $as = $self->storage->relname_to_table_alias(
1463 $rel, ($seen->{$rel} && $seen->{$rel} + 1)
1467 $self->_resolve_join($rel, $alias, $seen, [@$jpath], $force_left),
1468 $self->related_source($rel)->_resolve_join(
1469 $join->{$rel}, $as, $seen, [@$jpath, { $rel => $as }], $force_left
1477 $self->throw_exception("No idea how to resolve join reftype ".ref $join);
1480 my $count = ++$seen->{$join};
1481 my $as = $self->storage->relname_to_table_alias(
1482 $join, ($count > 1 && $count)
1485 my $rel_info = $self->relationship_info($join)
1486 or $self->throw_exception("No such relationship $join on " . $self->source_name);
1488 my $rel_src = $self->related_source($join);
1489 return [ { $as => $rel_src->from,
1491 -join_type => $parent_force_left
1493 : $rel_info->{attrs}{join_type}
1495 -join_path => [@$jpath, { $join => $as } ],
1497 $rel_info->{attrs}{accessor}
1499 first { $rel_info->{attrs}{accessor} eq $_ } (qw/single filter/)
1502 -relation_chain_depth => $seen->{-relation_chain_depth} || 0,
1504 $self->_resolve_condition($rel_info->{cond}, $as, $alias, $join)
1510 carp 'pk_depends_on is a private method, stop calling it';
1512 $self->_pk_depends_on (@_);
1515 # Determines whether a relation is dependent on an object from this source
1516 # having already been inserted. Takes the name of the relationship and a
1517 # hashref of columns of the related object.
1518 sub _pk_depends_on {
1519 my ($self, $relname, $rel_data) = @_;
1521 my $relinfo = $self->relationship_info($relname);
1523 # don't assume things if the relationship direction is specified
1524 return $relinfo->{attrs}{is_foreign_key_constraint}
1525 if exists ($relinfo->{attrs}{is_foreign_key_constraint});
1527 my $cond = $relinfo->{cond};
1528 return 0 unless ref($cond) eq 'HASH';
1530 # map { foreign.foo => 'self.bar' } to { bar => 'foo' }
1531 my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond };
1533 # assume anything that references our PK probably is dependent on us
1534 # rather than vice versa, unless the far side is (a) defined or (b)
1536 my $rel_source = $self->related_source($relname);
1538 foreach my $p ($self->primary_columns) {
1539 if (exists $keyhash->{$p}) {
1540 unless (defined($rel_data->{$keyhash->{$p}})
1541 || $rel_source->column_info($keyhash->{$p})
1542 ->{is_auto_increment}) {
1551 sub resolve_condition {
1552 carp 'resolve_condition is a private method, stop calling it';
1554 $self->_resolve_condition (@_);
1557 our $UNRESOLVABLE_CONDITION = \ '1 = 0';
1559 # Resolves the passed condition to a concrete query fragment and a flag
1560 # indicating whether this is a cross-table condition. Also an optional
1561 # list of non-triviail values (notmally conditions) returned as a part
1562 # of a joinfree condition hash
1563 sub _resolve_condition {
1564 my ($self, $cond, $as, $for, $relname) = @_;
1566 my $obj_rel = !!blessed $for;
1568 if (ref $cond eq 'CODE') {
1569 my $relalias = $obj_rel ? 'me' : $as;
1571 my ($crosstable_cond, $joinfree_cond) = $cond->({
1572 self_alias => $obj_rel ? $as : $for,
1573 foreign_alias => $relalias,
1574 self_resultsource => $self,
1575 foreign_relname => $relname || ($obj_rel ? $as : $for),
1576 self_rowobj => $obj_rel ? $for : undef
1580 if ($joinfree_cond) {
1582 # FIXME sanity check until things stabilize, remove at some point
1583 $self->throw_exception (
1584 "A join-free condition returned for relationship '$relname' without a row-object to chain from"
1587 # FIXME another sanity check
1589 ref $joinfree_cond ne 'HASH'
1591 first { $_ !~ /^\Q$relalias.\E.+/ } keys %$joinfree_cond
1593 $self->throw_exception (
1594 "The join-free condition returned for relationship '$relname' must be a hash "
1595 .'reference with all keys being valid columns on the related result source'
1600 for (values %$joinfree_cond) {
1610 # see which parts of the joinfree cond are conditionals
1611 my $relcol_list = { map { $_ => 1 } $self->related_source($relname)->columns };
1613 for my $c (keys %$joinfree_cond) {
1614 my ($colname) = $c =~ /^ (?: \Q$relalias.\E )? (.+)/x;
1616 unless ($relcol_list->{$colname}) {
1617 push @$cond_cols, $colname;
1622 ref $joinfree_cond->{$c}
1624 ref $joinfree_cond->{$c} ne 'SCALAR'
1626 ref $joinfree_cond->{$c} ne 'REF'
1628 push @$cond_cols, $colname;
1633 return wantarray ? ($joinfree_cond, 0, $cond_cols) : $joinfree_cond;
1636 return wantarray ? ($crosstable_cond, 1) : $crosstable_cond;
1639 elsif (ref $cond eq 'HASH') {
1641 foreach my $k (keys %{$cond}) {
1642 my $v = $cond->{$k};
1643 # XXX should probably check these are valid columns
1644 $k =~ s/^foreign\.// ||
1645 $self->throw_exception("Invalid rel cond key ${k}");
1646 $v =~ s/^self\.// ||
1647 $self->throw_exception("Invalid rel cond val ${v}");
1648 if (ref $for) { # Object
1649 #warn "$self $k $for $v";
1650 unless ($for->has_column_loaded($v)) {
1651 if ($for->in_storage) {
1652 $self->throw_exception(sprintf
1653 "Unable to resolve relationship '%s' from object %s: column '%s' not "
1654 . 'loaded from storage (or not passed to new() prior to insert()). You '
1655 . 'probably need to call ->discard_changes to get the server-side defaults '
1656 . 'from the database.',
1662 return $UNRESOLVABLE_CONDITION;
1664 $ret{$k} = $for->get_column($v);
1665 #$ret{$k} = $for->get_column($v) if $for->has_column_loaded($v);
1667 } elsif (!defined $for) { # undef, i.e. "no object"
1669 } elsif (ref $as eq 'HASH') { # reverse hashref
1670 $ret{$v} = $as->{$k};
1671 } elsif (ref $as) { # reverse object
1672 $ret{$v} = $as->get_column($k);
1673 } elsif (!defined $as) { # undef, i.e. "no reverse object"
1676 $ret{"${as}.${k}"} = { -ident => "${for}.${v}" };
1681 ? ( \%ret, ($obj_rel || !defined $as || ref $as) ? 0 : 1 )
1685 elsif (ref $cond eq 'ARRAY') {
1686 my (@ret, $crosstable);
1688 my ($cond, $crosstab) = $self->_resolve_condition($_, $as, $for, $relname);
1690 $crosstable ||= $crosstab;
1692 return wantarray ? (\@ret, $crosstable) : \@ret;
1695 $self->throw_exception ("Can't handle condition $cond for relationship '$relname' yet :(");
1699 # Accepts one or more relationships for the current source and returns an
1700 # array of column names for each of those relationships. Column names are
1701 # prefixed relative to the current source, in accordance with where they appear
1702 # in the supplied relationships.
1704 sub _resolve_prefetch {
1705 my ($self, $pre, $alias, $alias_map, $order, $collapse, $pref_path) = @_;
1708 if (not defined $pre) {
1711 elsif( ref $pre eq 'ARRAY' ) {
1713 map { $self->_resolve_prefetch( $_, $alias, $alias_map, $order, $collapse, [ @$pref_path ] ) }
1716 elsif( ref $pre eq 'HASH' ) {
1719 $self->_resolve_prefetch($_, $alias, $alias_map, $order, $collapse, [ @$pref_path ] ),
1720 $self->related_source($_)->_resolve_prefetch(
1721 $pre->{$_}, "${alias}.$_", $alias_map, $order, $collapse, [ @$pref_path, $_] )
1726 $self->throw_exception(
1727 "don't know how to resolve prefetch reftype ".ref($pre));
1731 $p = $p->{$_} for (@$pref_path, $pre);
1733 $self->throw_exception (
1734 "Unable to resolve prefetch '$pre' - join alias map does not contain an entry for path: "
1735 . join (' -> ', @$pref_path, $pre)
1736 ) if (ref $p->{-join_aliases} ne 'ARRAY' or not @{$p->{-join_aliases}} );
1738 my $as = shift @{$p->{-join_aliases}};
1740 my $rel_info = $self->relationship_info( $pre );
1741 $self->throw_exception( $self->source_name . " has no such relationship '$pre'" )
1743 my $as_prefix = ($alias =~ /^.*?\.(.+)$/ ? $1.'.' : '');
1744 my $rel_source = $self->related_source($pre);
1746 if ($rel_info->{attrs}{accessor} && $rel_info->{attrs}{accessor} eq 'multi') {
1747 $self->throw_exception(
1748 "Can't prefetch has_many ${pre} (join cond too complex)")
1749 unless ref($rel_info->{cond}) eq 'HASH';
1750 my $dots = @{[$as_prefix =~ m/\./g]} + 1; # +1 to match the ".${as_prefix}"
1752 if (my ($fail) = grep { @{[$_ =~ m/\./g]} == $dots }
1753 keys %{$collapse}) {
1754 my ($last) = ($fail =~ /([^\.]+)$/);
1756 "Prefetching multiple has_many rels ${last} and ${pre} "
1757 .(length($as_prefix)
1758 ? "at the same level (${as_prefix}) "
1761 . 'will explode the number of row objects retrievable via ->next or ->all. '
1762 . 'Use at your own risk.'
1766 #my @col = map { (/^self\.(.+)$/ ? ("${as_prefix}.$1") : ()); }
1767 # values %{$rel_info->{cond}};
1768 $collapse->{".${as_prefix}${pre}"} = [ $rel_source->_pri_cols ];
1769 # action at a distance. prepending the '.' allows simpler code
1770 # in ResultSet->_collapse_result
1771 my @key = map { (/^foreign\.(.+)$/ ? ($1) : ()); }
1772 keys %{$rel_info->{cond}};
1773 push @$order, map { "${as}.$_" } @key;
1775 if (my $rel_order = $rel_info->{attrs}{order_by}) {
1776 # this is kludgy and incomplete, I am well aware
1777 # but the parent method is going away entirely anyway
1779 my $sql_maker = $self->storage->sql_maker;
1780 my ($orig_ql, $orig_qr) = $sql_maker->_quote_chars;
1781 my $sep = $sql_maker->name_sep;
1783 # install our own quoter, so we can catch unqualified stuff
1784 local $sql_maker->{quote_char} = ["\x00", "\xFF"];
1786 my $quoted_prefix = "\x00${as}\xFF";
1788 for my $chunk ( $sql_maker->_order_by_chunks ($rel_order) ) {
1790 ($chunk, @bind) = @$chunk if ref $chunk;
1792 $chunk = "${quoted_prefix}${sep}${chunk}"
1793 unless $chunk =~ /\Q$sep/;
1795 $chunk =~ s/\x00/$orig_ql/g;
1796 $chunk =~ s/\xFF/$orig_qr/g;
1797 push @$order, \[$chunk, @bind];
1802 return map { [ "${as}.$_", "${as_prefix}${pre}.$_", ] }
1803 $rel_source->columns;
1807 =head2 related_source
1811 =item Arguments: $relname
1813 =item Return value: $source
1817 Returns the result source object for the given relationship.
1821 sub related_source {
1822 my ($self, $rel) = @_;
1823 if( !$self->has_relationship( $rel ) ) {
1824 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
1827 # if we are not registered with a schema - just use the prototype
1828 # however if we do have a schema - ask for the source by name (and
1829 # throw in the process if all fails)
1830 if (my $schema = try { $self->schema }) {
1831 $schema->source($self->relationship_info($rel)->{source});
1834 my $class = $self->relationship_info($rel)->{class};
1835 $self->ensure_class_loaded($class);
1836 $class->result_source_instance;
1840 =head2 related_class
1844 =item Arguments: $relname
1846 =item Return value: $classname
1850 Returns the class name for objects in the given relationship.
1855 my ($self, $rel) = @_;
1856 if( !$self->has_relationship( $rel ) ) {
1857 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
1859 return $self->schema->class($self->relationship_info($rel)->{source});
1866 =item Arguments: None
1868 =item Return value: $source_handle
1872 Obtain a new L<result source handle instance|DBIx::Class::ResultSourceHandle>
1873 for this source. Used as a serializable pointer to this resultsource, as it is not
1874 easy (nor advisable) to serialize CODErefs which may very well be present in e.g.
1875 relationship definitions.
1880 return DBIx::Class::ResultSourceHandle->new({
1881 source_moniker => $_[0]->source_name,
1883 # so that a detached thaw can be re-frozen
1884 $_[0]->{_detached_thaw}
1885 ? ( _detached_source => $_[0] )
1886 : ( schema => $_[0]->schema )
1892 my $global_phase_destroy;
1894 # SpeedyCGI runs END blocks every cycle but keeps object instances
1895 # hence we have to disable the globaldestroy hatch, and rely on the
1896 # eval trap below (which appears to work, but is risky done so late)
1897 END { $global_phase_destroy = 1 unless $CGI::SpeedyCGI::i_am_speedy }
1900 return if $global_phase_destroy;
1906 # Under no circumstances shall $_[0] be stored anywhere else (like copied to
1907 # a lexical variable, or shifted, or anything else). Doing so will mess up
1908 # the refcount of this particular result source, and will allow the $schema
1909 # we are trying to save to reattach back to the source we are destroying.
1910 # The relevant code checking refcounts is in ::Schema::DESTROY()
1912 # if we are not a schema instance holder - we don't matter
1914 ! ref $_[0]->{schema}
1916 isweak $_[0]->{schema}
1919 # weaken our schema hold forcing the schema to find somewhere else to live
1920 # during global destruction (if we have not yet bailed out) this will throw
1921 # which will serve as a signal to not try doing anything else
1924 weaken $_[0]->{schema};
1927 $global_phase_destroy = 1;
1932 # if schema is still there reintroduce ourselves with strong refs back to us
1933 if ($_[0]->{schema}) {
1934 my $srcregs = $_[0]->{schema}->source_registrations;
1935 for (keys %$srcregs) {
1936 next unless $srcregs->{$_};
1937 $srcregs->{$_} = $_[0] if $srcregs->{$_} == $_[0];
1943 sub STORABLE_freeze { Storable::nfreeze($_[0]->handle) }
1946 my ($self, $cloning, $ice) = @_;
1947 %$self = %{ (Storable::thaw($ice))->resolve };
1950 =head2 throw_exception
1952 See L<DBIx::Class::Schema/"throw_exception">.
1956 sub throw_exception {
1960 ? $self->{schema}->throw_exception(@_)
1961 : DBIx::Class::Exception->throw(@_)
1967 Stores a hashref of per-source metadata. No specific key names
1968 have yet been standardized, the examples below are purely hypothetical
1969 and don't actually accomplish anything on their own:
1971 __PACKAGE__->source_info({
1972 "_tablespace" => 'fast_disk_array_3',
1973 "_engine" => 'InnoDB',
1980 $class->new({attribute_name => value});
1982 Creates a new ResultSource object. Not normally called directly by end users.
1984 =head2 column_info_from_storage
1988 =item Arguments: 1/0 (default: 0)
1990 =item Return value: 1/0
1994 __PACKAGE__->column_info_from_storage(1);
1996 Enables the on-demand automatic loading of the above column
1997 metadata from storage as necessary. This is *deprecated*, and
1998 should not be used. It will be removed before 1.0.
2003 Matt S. Trout <mst@shadowcatsystems.co.uk>
2007 You may distribute this code under the same terms as Perl itself.