1 package DBIx::Class::ResultSource;
6 use base qw/DBIx::Class::ResultSource::RowParser DBIx::Class/;
8 use DBIx::Class::ResultSet;
9 use DBIx::Class::ResultSourceHandle;
11 use DBIx::Class::Exception;
12 use DBIx::Class::Carp;
13 use DBIx::Class::GlobalDestruction;
15 use List::Util 'first';
16 use Scalar::Util qw/blessed weaken isweak/;
20 __PACKAGE__->mk_group_accessors(simple => qw/
21 source_name name source_info
22 _ordered_columns _columns _primaries _unique_constraints
23 _relationships resultset_attributes
24 column_info_from_storage
27 __PACKAGE__->mk_group_accessors(component_class => qw/
32 __PACKAGE__->mk_classdata( sqlt_deploy_callback => 'default_sqlt_deploy_hook' );
36 DBIx::Class::ResultSource - Result source object
40 # Create a table based result source, in a result class.
42 package MyApp::Schema::Result::Artist;
43 use base qw/DBIx::Class::Core/;
45 __PACKAGE__->table('artist');
46 __PACKAGE__->add_columns(qw/ artistid name /);
47 __PACKAGE__->set_primary_key('artistid');
48 __PACKAGE__->has_many(cds => 'MyApp::Schema::Result::CD');
52 # Create a query (view) based result source, in a result class
53 package MyApp::Schema::Result::Year2000CDs;
54 use base qw/DBIx::Class::Core/;
56 __PACKAGE__->load_components('InflateColumn::DateTime');
57 __PACKAGE__->table_class('DBIx::Class::ResultSource::View');
59 __PACKAGE__->table('year2000cds');
60 __PACKAGE__->result_source_instance->is_virtual(1);
61 __PACKAGE__->result_source_instance->view_definition(
62 "SELECT cdid, artist, title FROM cd WHERE year ='2000'"
68 A ResultSource is an object that represents a source of data for querying.
70 This class is a base class for various specialised types of result
71 sources, for example L<DBIx::Class::ResultSource::Table>. Table is the
72 default result source type, so one is created for you when defining a
73 result class as described in the synopsis above.
75 More specifically, the L<DBIx::Class::Core> base class pulls in the
76 L<DBIx::Class::ResultSourceProxy::Table> component, which defines
77 the L<table|DBIx::Class::ResultSourceProxy::Table/table> method.
78 When called, C<table> creates and stores an instance of
79 L<DBIx::Class::ResultSoure::Table>. Luckily, to use tables as result
80 sources, you don't need to remember any of this.
82 Result sources representing select queries, or views, can also be
83 created, see L<DBIx::Class::ResultSource::View> for full details.
85 =head2 Finding result source objects
87 As mentioned above, a result source instance is created and stored for
88 you when you define a L<Result Class|DBIx::Class::Manual::Glossary/Result Class>.
90 You can retrieve the result source at runtime in the following ways:
94 =item From a Schema object:
96 $schema->source($source_name);
98 =item From a Row object:
102 =item From a ResultSet object:
115 my ($class, $attrs) = @_;
116 $class = ref $class if ref $class;
118 my $new = bless { %{$attrs || {}} }, $class;
119 $new->{resultset_class} ||= 'DBIx::Class::ResultSet';
120 $new->{resultset_attributes} = { %{$new->{resultset_attributes} || {}} };
121 $new->{_ordered_columns} = [ @{$new->{_ordered_columns}||[]}];
122 $new->{_columns} = { %{$new->{_columns}||{}} };
123 $new->{_relationships} = { %{$new->{_relationships}||{}} };
124 $new->{name} ||= "!!NAME NOT SET!!";
125 $new->{_columns_info_loaded} ||= 0;
135 =item Arguments: @columns
137 =item Return value: The ResultSource object
141 $source->add_columns(qw/col1 col2 col3/);
143 $source->add_columns('col1' => \%col1_info, 'col2' => \%col2_info, ...);
145 Adds columns to the result source. If supplied colname => hashref
146 pairs, uses the hashref as the L</column_info> for that column. Repeated
147 calls of this method will add more columns, not replace them.
149 The column names given will be created as accessor methods on your
150 L<DBIx::Class::Row> objects. You can change the name of the accessor
151 by supplying an L</accessor> in the column_info hash.
153 If a column name beginning with a plus sign ('+col1') is provided, the
154 attributes provided will be merged with any existing attributes for the
155 column, with the new attributes taking precedence in the case that an
156 attribute already exists. Using this without a hashref
157 (C<< $source->add_columns(qw/+col1 +col2/) >>) is legal, but useless --
158 it does the same thing it would do without the plus.
160 The contents of the column_info are not set in stone. The following
161 keys are currently recognised/used by DBIx::Class:
167 { accessor => '_name' }
169 # example use, replace standard accessor with one of your own:
171 my ($self, $value) = @_;
173 die "Name cannot contain digits!" if($value =~ /\d/);
174 $self->_name($value);
176 return $self->_name();
179 Use this to set the name of the accessor method for this column. If unset,
180 the name of the column will be used.
184 { data_type => 'integer' }
186 This contains the column type. It is automatically filled if you use the
187 L<SQL::Translator::Producer::DBIx::Class::File> producer, or the
188 L<DBIx::Class::Schema::Loader> module.
190 Currently there is no standard set of values for the data_type. Use
191 whatever your database supports.
197 The length of your column, if it is a column type that can have a size
198 restriction. This is currently only used to create tables from your
199 schema, see L<DBIx::Class::Schema/deploy>.
205 Set this to a true value for a columns that is allowed to contain NULL
206 values, default is false. This is currently only used to create tables
207 from your schema, see L<DBIx::Class::Schema/deploy>.
209 =item is_auto_increment
211 { is_auto_increment => 1 }
213 Set this to a true value for a column whose value is somehow
214 automatically set, defaults to false. This is used to determine which
215 columns to empty when cloning objects using
216 L<DBIx::Class::Row/copy>. It is also used by
217 L<DBIx::Class::Schema/deploy>.
223 Set this to a true or false value (not C<undef>) to explicitly specify
224 if this column contains numeric data. This controls how set_column
225 decides whether to consider a column dirty after an update: if
226 C<is_numeric> is true a numeric comparison C<< != >> will take place
227 instead of the usual C<eq>
229 If not specified the storage class will attempt to figure this out on
230 first access to the column, based on the column C<data_type>. The
231 result will be cached in this attribute.
235 { is_foreign_key => 1 }
237 Set this to a true value for a column that contains a key from a
238 foreign table, defaults to false. This is currently only used to
239 create tables from your schema, see L<DBIx::Class::Schema/deploy>.
243 { default_value => \'now()' }
245 Set this to the default value which will be inserted into a column by
246 the database. Can contain either a value or a function (use a
247 reference to a scalar e.g. C<\'now()'> if you want a function). This
248 is currently only used to create tables from your schema, see
249 L<DBIx::Class::Schema/deploy>.
251 See the note on L<DBIx::Class::Row/new> for more information about possible
252 issues related to db-side default values.
256 { sequence => 'my_table_seq' }
258 Set this on a primary key column to the name of the sequence used to
259 generate a new key value. If not specified, L<DBIx::Class::PK::Auto>
260 will attempt to retrieve the name of the sequence from the database
263 =item retrieve_on_insert
265 { retrieve_on_insert => 1 }
267 For every column where this is set to true, DBIC will retrieve the RDBMS-side
268 value upon a new row insertion (normally only the autoincrement PK is
269 retrieved on insert). C<INSERT ... RETURNING> is used automatically if
270 supported by the underlying storage, otherwise an extra SELECT statement is
271 executed to retrieve the missing data.
275 { auto_nextval => 1 }
277 Set this to a true value for a column whose value is retrieved automatically
278 from a sequence or function (if supported by your Storage driver.) For a
279 sequence, if you do not use a trigger to get the nextval, you have to set the
280 L</sequence> value as well.
282 Also set this for MSSQL columns with the 'uniqueidentifier'
283 L<data_type|DBIx::Class::ResultSource/data_type> whose values you want to
284 automatically generate using C<NEWID()>, unless they are a primary key in which
285 case this will be done anyway.
289 This is used by L<DBIx::Class::Schema/deploy> and L<SQL::Translator>
290 to add extra non-generic data to the column. For example: C<< extra
291 => { unsigned => 1} >> is used by the MySQL producer to set an integer
292 column to unsigned. For more details, see
293 L<SQL::Translator::Producer::MySQL>.
301 =item Arguments: $colname, \%columninfo?
303 =item Return value: 1/0 (true/false)
307 $source->add_column('col' => \%info);
309 Add a single column and optional column info. Uses the same column
310 info keys as L</add_columns>.
315 my ($self, @cols) = @_;
316 $self->_ordered_columns(\@cols) unless $self->_ordered_columns;
319 my $columns = $self->_columns;
320 while (my $col = shift @cols) {
321 my $column_info = {};
322 if ($col =~ s/^\+//) {
323 $column_info = $self->column_info($col);
326 # If next entry is { ... } use that for the column info, if not
327 # use an empty hashref
329 my $new_info = shift(@cols);
330 %$column_info = (%$column_info, %$new_info);
332 push(@added, $col) unless exists $columns->{$col};
333 $columns->{$col} = $column_info;
335 push @{ $self->_ordered_columns }, @added;
339 sub add_column { shift->add_columns(@_); } # DO NOT CHANGE THIS TO GLOB
345 =item Arguments: $colname
347 =item Return value: 1/0 (true/false)
351 if ($source->has_column($colname)) { ... }
353 Returns true if the source has a column of this name, false otherwise.
358 my ($self, $column) = @_;
359 return exists $self->_columns->{$column};
366 =item Arguments: $colname
368 =item Return value: Hashref of info
372 my $info = $source->column_info($col);
374 Returns the column metadata hashref for a column, as originally passed
375 to L</add_columns>. See L</add_columns> above for information on the
376 contents of the hashref.
381 my ($self, $column) = @_;
382 $self->throw_exception("No such column $column")
383 unless exists $self->_columns->{$column};
385 if ( ! $self->_columns->{$column}{data_type}
386 and ! $self->{_columns_info_loaded}
387 and $self->column_info_from_storage
388 and my $stor = try { $self->storage } )
390 $self->{_columns_info_loaded}++;
392 # try for the case of storage without table
394 my $info = $stor->columns_info_for( $self->from );
396 { (lc $_) => $info->{$_} }
400 foreach my $col ( keys %{$self->_columns} ) {
401 $self->_columns->{$col} = {
402 %{ $self->_columns->{$col} },
403 %{ $info->{$col} || $lc_info->{lc $col} || {} }
409 return $self->_columns->{$column};
416 =item Arguments: None
418 =item Return value: Ordered list of column names
422 my @column_names = $source->columns;
424 Returns all column names in the order they were declared to L</add_columns>.
430 $self->throw_exception(
431 "columns() is a read-only accessor, did you mean add_columns()?"
433 return @{$self->{_ordered_columns}||[]};
440 =item Arguments: \@colnames ?
442 =item Return value: Hashref of column name/info pairs
446 my $columns_info = $source->columns_info;
448 Like L</column_info> but returns information for the requested columns. If
449 the optional column-list arrayref is omitted it returns info on all columns
450 currently defined on the ResultSource via L</add_columns>.
455 my ($self, $columns) = @_;
457 my $colinfo = $self->_columns;
460 first { ! $_->{data_type} } values %$colinfo
462 ! $self->{_columns_info_loaded}
464 $self->column_info_from_storage
466 my $stor = try { $self->storage }
468 $self->{_columns_info_loaded}++;
470 # try for the case of storage without table
472 my $info = $stor->columns_info_for( $self->from );
474 { (lc $_) => $info->{$_} }
478 foreach my $col ( keys %$colinfo ) {
480 %{ $colinfo->{$col} },
481 %{ $info->{$col} || $lc_info->{lc $col} || {} }
491 if (my $inf = $colinfo->{$_}) {
495 $self->throw_exception( sprintf (
496 "No such column '%s' on source %s",
510 =head2 remove_columns
514 =item Arguments: @colnames
516 =item Return value: undefined
520 $source->remove_columns(qw/col1 col2 col3/);
522 Removes the given list of columns by name, from the result source.
524 B<Warning>: Removing a column that is also used in the sources primary
525 key, or in one of the sources unique constraints, B<will> result in a
526 broken result source.
532 =item Arguments: $colname
534 =item Return value: undefined
538 $source->remove_column('col');
540 Remove a single column by name from the result source, similar to
543 B<Warning>: Removing a column that is also used in the sources primary
544 key, or in one of the sources unique constraints, B<will> result in a
545 broken result source.
550 my ($self, @to_remove) = @_;
552 my $columns = $self->_columns
557 delete $columns->{$_};
561 $self->_ordered_columns([ grep { not $to_remove{$_} } @{$self->_ordered_columns} ]);
564 sub remove_column { shift->remove_columns(@_); } # DO NOT CHANGE THIS TO GLOB
566 =head2 set_primary_key
570 =item Arguments: @cols
572 =item Return value: undefined
576 Defines one or more columns as primary key for this source. Must be
577 called after L</add_columns>.
579 Additionally, defines a L<unique constraint|add_unique_constraint>
582 Note: you normally do want to define a primary key on your sources
583 B<even if the underlying database table does not have a primary key>.
585 L<DBIx::Class::Manual::Intro/The Significance and Importance of Primary Keys>
590 sub set_primary_key {
591 my ($self, @cols) = @_;
592 # check if primary key columns are valid columns
593 foreach my $col (@cols) {
594 $self->throw_exception("No such column $col on table " . $self->name)
595 unless $self->has_column($col);
597 $self->_primaries(\@cols);
599 $self->add_unique_constraint(primary => \@cols);
602 =head2 primary_columns
606 =item Arguments: None
608 =item Return value: Ordered list of primary column names
612 Read-only accessor which returns the list of primary keys, supplied by
617 sub primary_columns {
618 return @{shift->_primaries||[]};
621 # a helper method that will automatically die with a descriptive message if
622 # no pk is defined on the source in question. For internal use to save
623 # on if @pks... boilerplate
626 my @pcols = $self->primary_columns
627 or $self->throw_exception (sprintf(
628 "Operation requires a primary key to be declared on '%s' via set_primary_key",
629 # source_name is set only after schema-registration
630 $self->source_name || $self->result_class || $self->name || 'Unknown source...?',
637 Manually define the correct sequence for your table, to avoid the overhead
638 associated with looking up the sequence automatically. The supplied sequence
639 will be applied to the L</column_info> of each L<primary_key|/set_primary_key>
643 =item Arguments: $sequence_name
645 =item Return value: undefined
652 my ($self,$seq) = @_;
654 my @pks = $self->primary_columns
657 $_->{sequence} = $seq
658 for values %{ $self->columns_info (\@pks) };
662 =head2 add_unique_constraint
666 =item Arguments: $name?, \@colnames
668 =item Return value: undefined
672 Declare a unique constraint on this source. Call once for each unique
675 # For UNIQUE (column1, column2)
676 __PACKAGE__->add_unique_constraint(
677 constraint_name => [ qw/column1 column2/ ],
680 Alternatively, you can specify only the columns:
682 __PACKAGE__->add_unique_constraint([ qw/column1 column2/ ]);
684 This will result in a unique constraint named
685 C<table_column1_column2>, where C<table> is replaced with the table
688 Unique constraints are used, for example, when you pass the constraint
689 name as the C<key> attribute to L<DBIx::Class::ResultSet/find>. Then
690 only columns in the constraint are searched.
692 Throws an error if any of the given column names do not yet exist on
697 sub add_unique_constraint {
701 $self->throw_exception(
702 'add_unique_constraint() does not accept multiple constraints, use '
703 . 'add_unique_constraints() instead'
708 if (ref $cols ne 'ARRAY') {
709 $self->throw_exception (
710 'Expecting an arrayref of constraint columns, got ' . ($cols||'NOTHING')
716 $name ||= $self->name_unique_constraint($cols);
718 foreach my $col (@$cols) {
719 $self->throw_exception("No such column $col on table " . $self->name)
720 unless $self->has_column($col);
723 my %unique_constraints = $self->unique_constraints;
724 $unique_constraints{$name} = $cols;
725 $self->_unique_constraints(\%unique_constraints);
728 =head2 add_unique_constraints
732 =item Arguments: @constraints
734 =item Return value: undefined
738 Declare multiple unique constraints on this source.
740 __PACKAGE__->add_unique_constraints(
741 constraint_name1 => [ qw/column1 column2/ ],
742 constraint_name2 => [ qw/column2 column3/ ],
745 Alternatively, you can specify only the columns:
747 __PACKAGE__->add_unique_constraints(
748 [ qw/column1 column2/ ],
749 [ qw/column3 column4/ ]
752 This will result in unique constraints named C<table_column1_column2> and
753 C<table_column3_column4>, where C<table> is replaced with the table name.
755 Throws an error if any of the given column names do not yet exist on
758 See also L</add_unique_constraint>.
762 sub add_unique_constraints {
764 my @constraints = @_;
766 if ( !(@constraints % 2) && first { ref $_ ne 'ARRAY' } @constraints ) {
767 # with constraint name
768 while (my ($name, $constraint) = splice @constraints, 0, 2) {
769 $self->add_unique_constraint($name => $constraint);
774 foreach my $constraint (@constraints) {
775 $self->add_unique_constraint($constraint);
780 =head2 name_unique_constraint
784 =item Arguments: \@colnames
786 =item Return value: Constraint name
790 $source->table('mytable');
791 $source->name_unique_constraint(['col1', 'col2']);
795 Return a name for a unique constraint containing the specified
796 columns. The name is created by joining the table name and each column
797 name, using an underscore character.
799 For example, a constraint on a table named C<cd> containing the columns
800 C<artist> and C<title> would result in a constraint name of C<cd_artist_title>.
802 This is used by L</add_unique_constraint> if you do not specify the
803 optional constraint name.
807 sub name_unique_constraint {
808 my ($self, $cols) = @_;
810 my $name = $self->name;
811 $name = $$name if (ref $name eq 'SCALAR');
813 return join '_', $name, @$cols;
816 =head2 unique_constraints
820 =item Arguments: None
822 =item Return value: Hash of unique constraint data
826 $source->unique_constraints();
828 Read-only accessor which returns a hash of unique constraints on this
831 The hash is keyed by constraint name, and contains an arrayref of
832 column names as values.
836 sub unique_constraints {
837 return %{shift->_unique_constraints||{}};
840 =head2 unique_constraint_names
844 =item Arguments: None
846 =item Return value: Unique constraint names
850 $source->unique_constraint_names();
852 Returns the list of unique constraint names defined on this source.
856 sub unique_constraint_names {
859 my %unique_constraints = $self->unique_constraints;
861 return keys %unique_constraints;
864 =head2 unique_constraint_columns
868 =item Arguments: $constraintname
870 =item Return value: List of constraint columns
874 $source->unique_constraint_columns('myconstraint');
876 Returns the list of columns that make up the specified unique constraint.
880 sub unique_constraint_columns {
881 my ($self, $constraint_name) = @_;
883 my %unique_constraints = $self->unique_constraints;
885 $self->throw_exception(
886 "Unknown unique constraint $constraint_name on '" . $self->name . "'"
887 ) unless exists $unique_constraints{$constraint_name};
889 return @{ $unique_constraints{$constraint_name} };
892 =head2 sqlt_deploy_callback
896 =item Arguments: $callback_name | \&callback_code
898 =item Return value: $callback_name | \&callback_code
902 __PACKAGE__->sqlt_deploy_callback('mycallbackmethod');
906 __PACKAGE__->sqlt_deploy_callback(sub {
907 my ($source_instance, $sqlt_table) = @_;
911 An accessor to set a callback to be called during deployment of
912 the schema via L<DBIx::Class::Schema/create_ddl_dir> or
913 L<DBIx::Class::Schema/deploy>.
915 The callback can be set as either a code reference or the name of a
916 method in the current result class.
918 Defaults to L</default_sqlt_deploy_hook>.
920 Your callback will be passed the $source object representing the
921 ResultSource instance being deployed, and the
922 L<SQL::Translator::Schema::Table> object being created from it. The
923 callback can be used to manipulate the table object or add your own
924 customised indexes. If you need to manipulate a non-table object, use
925 the L<DBIx::Class::Schema/sqlt_deploy_hook>.
927 See L<DBIx::Class::Manual::Cookbook/Adding Indexes And Functions To
928 Your SQL> for examples.
930 This sqlt deployment callback can only be used to manipulate
931 SQL::Translator objects as they get turned into SQL. To execute
932 post-deploy statements which SQL::Translator does not currently
933 handle, override L<DBIx::Class::Schema/deploy> in your Schema class
934 and call L<dbh_do|DBIx::Class::Storage::DBI/dbh_do>.
936 =head2 default_sqlt_deploy_hook
938 This is the default deploy hook implementation which checks if your
939 current Result class has a C<sqlt_deploy_hook> method, and if present
940 invokes it B<on the Result class directly>. This is to preserve the
941 semantics of C<sqlt_deploy_hook> which was originally designed to expect
942 the Result class name and the
943 L<$sqlt_table instance|SQL::Translator::Schema::Table> of the table being
948 sub default_sqlt_deploy_hook {
951 my $class = $self->result_class;
953 if ($class and $class->can('sqlt_deploy_hook')) {
954 $class->sqlt_deploy_hook(@_);
958 sub _invoke_sqlt_deploy_hook {
960 if ( my $hook = $self->sqlt_deploy_callback) {
969 =item Arguments: None
971 =item Return value: $resultset
975 Returns a resultset for the given source. This will initially be created
978 $self->resultset_class->new($self, $self->resultset_attributes)
980 but is cached from then on unless resultset_class changes.
982 =head2 resultset_class
986 =item Arguments: $classname
988 =item Return value: $classname
992 package My::Schema::ResultSet::Artist;
993 use base 'DBIx::Class::ResultSet';
996 # In the result class
997 __PACKAGE__->resultset_class('My::Schema::ResultSet::Artist');
1000 $source->resultset_class('My::Schema::ResultSet::Artist');
1002 Set the class of the resultset. This is useful if you want to create your
1003 own resultset methods. Create your own class derived from
1004 L<DBIx::Class::ResultSet>, and set it here. If called with no arguments,
1005 this method returns the name of the existing resultset class, if one
1008 =head2 resultset_attributes
1012 =item Arguments: \%attrs
1014 =item Return value: \%attrs
1018 # In the result class
1019 __PACKAGE__->resultset_attributes({ order_by => [ 'id' ] });
1022 $source->resultset_attributes({ order_by => [ 'id' ] });
1024 Store a collection of resultset attributes, that will be set on every
1025 L<DBIx::Class::ResultSet> produced from this result source. For a full
1026 list see L<DBIx::Class::ResultSet/ATTRIBUTES>.
1032 $self->throw_exception(
1033 'resultset does not take any arguments. If you want another resultset, '.
1034 'call it on the schema instead.'
1037 $self->resultset_class->new(
1040 try { %{$self->schema->default_resultset_attributes} },
1041 %{$self->{resultset_attributes}},
1050 =item Arguments: None
1052 =item Result value: $name
1056 Returns the name of the result source, which will typically be the table
1057 name. This may be a scalar reference if the result source has a non-standard
1064 =item Arguments: $source_name
1066 =item Result value: $source_name
1070 Set an alternate name for the result source when it is loaded into a schema.
1071 This is useful if you want to refer to a result source by a name other than
1074 package ArchivedBooks;
1075 use base qw/DBIx::Class/;
1076 __PACKAGE__->table('books_archive');
1077 __PACKAGE__->source_name('Books');
1079 # from your schema...
1080 $schema->resultset('Books')->find(1);
1086 =item Arguments: None
1088 =item Return value: FROM clause
1092 my $from_clause = $source->from();
1094 Returns an expression of the source to be supplied to storage to specify
1095 retrieval from this source. In the case of a database, the required FROM
1100 sub from { die 'Virtual method!' }
1106 =item Arguments: $schema
1108 =item Return value: A schema object
1112 my $schema = $source->schema();
1114 Sets and/or returns the L<DBIx::Class::Schema> object to which this
1115 result source instance has been attached to.
1121 $_[0]->{schema} = $_[1];
1124 $_[0]->{schema} || do {
1125 my $name = $_[0]->{source_name} || '_unnamed_';
1126 my $err = 'Unable to perform storage-dependent operations with a detached result source '
1127 . "(source '$name' is not associated with a schema).";
1129 $err .= ' You need to use $schema->thaw() or manually set'
1130 . ' $DBIx::Class::ResultSourceHandle::thaw_schema while thawing.'
1131 if $_[0]->{_detached_thaw};
1133 DBIx::Class::Exception->throw($err);
1142 =item Arguments: None
1144 =item Return value: A Storage object
1148 $source->storage->debug(1);
1150 Returns the storage handle for the current schema.
1152 See also: L<DBIx::Class::Storage>
1156 sub storage { shift->schema->storage; }
1158 =head2 add_relationship
1162 =item Arguments: $relname, $related_source_name, \%cond, [ \%attrs ]
1164 =item Return value: 1/true if it succeeded
1168 $source->add_relationship('relname', 'related_source', $cond, $attrs);
1170 L<DBIx::Class::Relationship> describes a series of methods which
1171 create pre-defined useful types of relationships. Look there first
1172 before using this method directly.
1174 The relationship name can be arbitrary, but must be unique for each
1175 relationship attached to this result source. 'related_source' should
1176 be the name with which the related result source was registered with
1177 the current schema. For example:
1179 $schema->source('Book')->add_relationship('reviews', 'Review', {
1180 'foreign.book_id' => 'self.id',
1183 The condition C<$cond> needs to be an L<SQL::Abstract>-style
1184 representation of the join between the tables. For example, if you're
1185 creating a relation from Author to Book,
1187 { 'foreign.author_id' => 'self.id' }
1189 will result in the JOIN clause
1191 author me JOIN book foreign ON foreign.author_id = me.id
1193 You can specify as many foreign => self mappings as necessary.
1195 Valid attributes are as follows:
1201 Explicitly specifies the type of join to use in the relationship. Any
1202 SQL join type is valid, e.g. C<LEFT> or C<RIGHT>. It will be placed in
1203 the SQL command immediately before C<JOIN>.
1207 An arrayref containing a list of accessors in the foreign class to proxy in
1208 the main class. If, for example, you do the following:
1210 CD->might_have(liner_notes => 'LinerNotes', undef, {
1211 proxy => [ qw/notes/ ],
1214 Then, assuming LinerNotes has an accessor named notes, you can do:
1216 my $cd = CD->find(1);
1217 # set notes -- LinerNotes object is created if it doesn't exist
1218 $cd->notes('Notes go here');
1222 Specifies the type of accessor that should be created for the
1223 relationship. Valid values are C<single> (for when there is only a single
1224 related object), C<multi> (when there can be many), and C<filter> (for
1225 when there is a single related object, but you also want the relationship
1226 accessor to double as a column accessor). For C<multi> accessors, an
1227 add_to_* method is also created, which calls C<create_related> for the
1232 Throws an exception if the condition is improperly supplied, or cannot
1237 sub add_relationship {
1238 my ($self, $rel, $f_source_name, $cond, $attrs) = @_;
1239 $self->throw_exception("Can't create relationship without join condition")
1243 # Check foreign and self are right in cond
1244 if ( (ref $cond ||'') eq 'HASH') {
1246 $self->throw_exception("Keys of condition should be of form 'foreign.col', not '$_'")
1247 if /\./ && !/^foreign\./;
1251 my %rels = %{ $self->_relationships };
1252 $rels{$rel} = { class => $f_source_name,
1253 source => $f_source_name,
1256 $self->_relationships(\%rels);
1260 # XXX disabled. doesn't work properly currently. skip in tests.
1262 my $f_source = $self->schema->source($f_source_name);
1263 unless ($f_source) {
1264 $self->ensure_class_loaded($f_source_name);
1265 $f_source = $f_source_name->result_source;
1266 #my $s_class = ref($self->schema);
1267 #$f_source_name =~ m/^${s_class}::(.*)$/;
1268 #$self->schema->register_class(($1 || $f_source_name), $f_source_name);
1269 #$f_source = $self->schema->source($f_source_name);
1271 return unless $f_source; # Can't test rel without f_source
1273 try { $self->_resolve_join($rel, 'me', {}, []) }
1275 # If the resolve failed, back out and re-throw the error
1277 $self->_relationships(\%rels);
1278 $self->throw_exception("Error creating relationship $rel: $_");
1284 =head2 relationships
1288 =item Arguments: None
1290 =item Return value: List of relationship names
1294 my @relnames = $source->relationships();
1296 Returns all relationship names for this source.
1301 return keys %{shift->_relationships};
1304 =head2 relationship_info
1308 =item Arguments: $relname
1310 =item Return value: Hashref of relation data,
1314 Returns a hash of relationship information for the specified relationship
1315 name. The keys/values are as specified for L</add_relationship>.
1319 sub relationship_info {
1320 my ($self, $rel) = @_;
1321 return $self->_relationships->{$rel};
1324 =head2 has_relationship
1328 =item Arguments: $rel
1330 =item Return value: 1/0 (true/false)
1334 Returns true if the source has a relationship of this name, false otherwise.
1338 sub has_relationship {
1339 my ($self, $rel) = @_;
1340 return exists $self->_relationships->{$rel};
1343 =head2 reverse_relationship_info
1347 =item Arguments: $relname
1349 =item Return value: Hashref of relationship data
1353 Looks through all the relationships on the source this relationship
1354 points to, looking for one whose condition is the reverse of the
1355 condition on this relationship.
1357 A common use of this is to find the name of the C<belongs_to> relation
1358 opposing a C<has_many> relation. For definition of these look in
1359 L<DBIx::Class::Relationship>.
1361 The returned hashref is keyed by the name of the opposing
1362 relationship, and contains its data in the same manner as
1363 L</relationship_info>.
1367 sub reverse_relationship_info {
1368 my ($self, $rel) = @_;
1370 my $rel_info = $self->relationship_info($rel)
1371 or $self->throw_exception("No such relationship '$rel'");
1375 return $ret unless ((ref $rel_info->{cond}) eq 'HASH');
1377 my $stripped_cond = $self->__strip_relcond ($rel_info->{cond});
1379 my $rsrc_schema_moniker = $self->source_name
1380 if try { $self->schema };
1382 # this may be a partial schema or something else equally esoteric
1383 my $other_rsrc = try { $self->related_source($rel) }
1386 # Get all the relationships for that source that related to this source
1387 # whose foreign column set are our self columns on $rel and whose self
1388 # columns are our foreign columns on $rel
1389 foreach my $other_rel ($other_rsrc->relationships) {
1391 # only consider stuff that points back to us
1392 # "us" here is tricky - if we are in a schema registration, we want
1393 # to use the source_names, otherwise we will use the actual classes
1395 # the schema may be partial
1396 my $roundtrip_rsrc = try { $other_rsrc->related_source($other_rel) }
1399 if ($rsrc_schema_moniker and try { $roundtrip_rsrc->schema } ) {
1400 next unless $rsrc_schema_moniker eq $roundtrip_rsrc->source_name;
1403 next unless $self->result_class eq $roundtrip_rsrc->result_class;
1406 my $other_rel_info = $other_rsrc->relationship_info($other_rel);
1408 # this can happen when we have a self-referential class
1409 next if $other_rel_info eq $rel_info;
1411 next unless ref $other_rel_info->{cond} eq 'HASH';
1412 my $other_stripped_cond = $self->__strip_relcond($other_rel_info->{cond});
1414 $ret->{$other_rel} = $other_rel_info if (
1415 $self->_compare_relationship_keys (
1416 [ keys %$stripped_cond ], [ values %$other_stripped_cond ]
1419 $self->_compare_relationship_keys (
1420 [ values %$stripped_cond ], [ keys %$other_stripped_cond ]
1428 # all this does is removes the foreign/self prefix from a condition
1429 sub __strip_relcond {
1432 { map { /^ (?:foreign|self) \. (\w+) $/x } ($_, $_[1]{$_}) }
1437 sub compare_relationship_keys {
1438 carp 'compare_relationship_keys is a private method, stop calling it';
1440 $self->_compare_relationship_keys (@_);
1443 # Returns true if both sets of keynames are the same, false otherwise.
1444 sub _compare_relationship_keys {
1445 # my ($self, $keys1, $keys2) = @_;
1447 join ("\x00", sort @{$_[1]})
1449 join ("\x00", sort @{$_[2]})
1453 # optionally takes either an arrayref of column names, or a hashref of already
1454 # retrieved colinfos
1455 # returns an arrayref of column names of the shortest unique constraint
1456 # (matching some of the input if any), giving preference to the PK
1457 sub _identifying_column_set {
1458 my ($self, $cols) = @_;
1460 my %unique = $self->unique_constraints;
1461 my $colinfos = ref $cols eq 'HASH' ? $cols : $self->columns_info($cols||());
1463 # always prefer the PK first, and then shortest constraints first
1465 for my $set (delete $unique{primary}, sort { @$a <=> @$b } (values %unique) ) {
1466 next unless $set && @$set;
1469 next USET unless ($colinfos->{$_} && !$colinfos->{$_}{is_nullable} );
1472 # copy so we can mangle it at will
1479 # Returns the {from} structure used to express JOIN conditions
1481 my ($self, $join, $alias, $seen, $jpath, $parent_force_left) = @_;
1483 # we need a supplied one, because we do in-place modifications, no returns
1484 $self->throw_exception ('You must supply a seen hashref as the 3rd argument to _resolve_join')
1485 unless ref $seen eq 'HASH';
1487 $self->throw_exception ('You must supply a joinpath arrayref as the 4th argument to _resolve_join')
1488 unless ref $jpath eq 'ARRAY';
1490 $jpath = [@$jpath]; # copy
1492 if (not defined $join or not length $join) {
1495 elsif (ref $join eq 'ARRAY') {
1498 $self->_resolve_join($_, $alias, $seen, $jpath, $parent_force_left);
1501 elsif (ref $join eq 'HASH') {
1504 for my $rel (keys %$join) {
1506 my $rel_info = $self->relationship_info($rel)
1507 or $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
1509 my $force_left = $parent_force_left;
1510 $force_left ||= lc($rel_info->{attrs}{join_type}||'') eq 'left';
1512 # the actual seen value will be incremented by the recursion
1513 my $as = $self->storage->relname_to_table_alias(
1514 $rel, ($seen->{$rel} && $seen->{$rel} + 1)
1518 $self->_resolve_join($rel, $alias, $seen, [@$jpath], $force_left),
1519 $self->related_source($rel)->_resolve_join(
1520 $join->{$rel}, $as, $seen, [@$jpath, { $rel => $as }], $force_left
1528 $self->throw_exception("No idea how to resolve join reftype ".ref $join);
1531 my $count = ++$seen->{$join};
1532 my $as = $self->storage->relname_to_table_alias(
1533 $join, ($count > 1 && $count)
1536 my $rel_info = $self->relationship_info($join)
1537 or $self->throw_exception("No such relationship $join on " . $self->source_name);
1539 my $rel_src = $self->related_source($join);
1540 return [ { $as => $rel_src->from,
1542 -join_type => $parent_force_left
1544 : $rel_info->{attrs}{join_type}
1546 -join_path => [@$jpath, { $join => $as } ],
1548 (! $rel_info->{attrs}{accessor})
1550 first { $rel_info->{attrs}{accessor} eq $_ } (qw/single filter/)
1553 -relation_chain_depth => $seen->{-relation_chain_depth} || 0,
1555 scalar $self->_resolve_condition($rel_info->{cond}, $as, $alias, $join)
1561 carp 'pk_depends_on is a private method, stop calling it';
1563 $self->_pk_depends_on (@_);
1566 # Determines whether a relation is dependent on an object from this source
1567 # having already been inserted. Takes the name of the relationship and a
1568 # hashref of columns of the related object.
1569 sub _pk_depends_on {
1570 my ($self, $relname, $rel_data) = @_;
1572 my $relinfo = $self->relationship_info($relname);
1574 # don't assume things if the relationship direction is specified
1575 return $relinfo->{attrs}{is_foreign_key_constraint}
1576 if exists ($relinfo->{attrs}{is_foreign_key_constraint});
1578 my $cond = $relinfo->{cond};
1579 return 0 unless ref($cond) eq 'HASH';
1581 # map { foreign.foo => 'self.bar' } to { bar => 'foo' }
1582 my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond };
1584 # assume anything that references our PK probably is dependent on us
1585 # rather than vice versa, unless the far side is (a) defined or (b)
1587 my $rel_source = $self->related_source($relname);
1589 foreach my $p ($self->primary_columns) {
1590 if (exists $keyhash->{$p}) {
1591 unless (defined($rel_data->{$keyhash->{$p}})
1592 || $rel_source->column_info($keyhash->{$p})
1593 ->{is_auto_increment}) {
1602 sub resolve_condition {
1603 carp 'resolve_condition is a private method, stop calling it';
1605 $self->_resolve_condition (@_);
1608 our $UNRESOLVABLE_CONDITION = \ '1 = 0';
1610 # Resolves the passed condition to a concrete query fragment and a flag
1611 # indicating whether this is a cross-table condition. Also an optional
1612 # list of non-triviail values (notmally conditions) returned as a part
1613 # of a joinfree condition hash
1614 sub _resolve_condition {
1615 my ($self, $cond, $as, $for, $relname) = @_;
1617 my $obj_rel = !!blessed $for;
1619 if (ref $cond eq 'CODE') {
1620 my $relalias = $obj_rel ? 'me' : $as;
1622 my ($crosstable_cond, $joinfree_cond) = $cond->({
1623 self_alias => $obj_rel ? $as : $for,
1624 foreign_alias => $relalias,
1625 self_resultsource => $self,
1626 foreign_relname => $relname || ($obj_rel ? $as : $for),
1627 self_rowobj => $obj_rel ? $for : undef
1631 if ($joinfree_cond) {
1633 # FIXME sanity check until things stabilize, remove at some point
1634 $self->throw_exception (
1635 "A join-free condition returned for relationship '$relname' without a row-object to chain from"
1638 # FIXME another sanity check
1640 ref $joinfree_cond ne 'HASH'
1642 first { $_ !~ /^\Q$relalias.\E.+/ } keys %$joinfree_cond
1644 $self->throw_exception (
1645 "The join-free condition returned for relationship '$relname' must be a hash "
1646 .'reference with all keys being valid columns on the related result source'
1651 for (values %$joinfree_cond) {
1661 # see which parts of the joinfree cond are conditionals
1662 my $relcol_list = { map { $_ => 1 } $self->related_source($relname)->columns };
1664 for my $c (keys %$joinfree_cond) {
1665 my ($colname) = $c =~ /^ (?: \Q$relalias.\E )? (.+)/x;
1667 unless ($relcol_list->{$colname}) {
1668 push @$cond_cols, $colname;
1673 ref $joinfree_cond->{$c}
1675 ref $joinfree_cond->{$c} ne 'SCALAR'
1677 ref $joinfree_cond->{$c} ne 'REF'
1679 push @$cond_cols, $colname;
1684 return wantarray ? ($joinfree_cond, 0, $cond_cols) : $joinfree_cond;
1687 return wantarray ? ($crosstable_cond, 1) : $crosstable_cond;
1690 elsif (ref $cond eq 'HASH') {
1692 foreach my $k (keys %{$cond}) {
1693 my $v = $cond->{$k};
1694 # XXX should probably check these are valid columns
1695 $k =~ s/^foreign\.// ||
1696 $self->throw_exception("Invalid rel cond key ${k}");
1697 $v =~ s/^self\.// ||
1698 $self->throw_exception("Invalid rel cond val ${v}");
1699 if (ref $for) { # Object
1700 #warn "$self $k $for $v";
1701 unless ($for->has_column_loaded($v)) {
1702 if ($for->in_storage) {
1703 $self->throw_exception(sprintf
1704 "Unable to resolve relationship '%s' from object %s: column '%s' not "
1705 . 'loaded from storage (or not passed to new() prior to insert()). You '
1706 . 'probably need to call ->discard_changes to get the server-side defaults '
1707 . 'from the database.',
1713 return $UNRESOLVABLE_CONDITION;
1715 $ret{$k} = $for->get_column($v);
1716 #$ret{$k} = $for->get_column($v) if $for->has_column_loaded($v);
1718 } elsif (!defined $for) { # undef, i.e. "no object"
1720 } elsif (ref $as eq 'HASH') { # reverse hashref
1721 $ret{$v} = $as->{$k};
1722 } elsif (ref $as) { # reverse object
1723 $ret{$v} = $as->get_column($k);
1724 } elsif (!defined $as) { # undef, i.e. "no reverse object"
1727 $ret{"${as}.${k}"} = { -ident => "${for}.${v}" };
1732 ? ( \%ret, ($obj_rel || !defined $as || ref $as) ? 0 : 1 )
1736 elsif (ref $cond eq 'ARRAY') {
1737 my (@ret, $crosstable);
1739 my ($cond, $crosstab) = $self->_resolve_condition($_, $as, $for, $relname);
1741 $crosstable ||= $crosstab;
1743 return wantarray ? (\@ret, $crosstable) : \@ret;
1746 $self->throw_exception ("Can't handle condition $cond for relationship '$relname' yet :(");
1750 =head2 related_source
1754 =item Arguments: $relname
1756 =item Return value: $source
1760 Returns the result source object for the given relationship.
1764 sub related_source {
1765 my ($self, $rel) = @_;
1766 if( !$self->has_relationship( $rel ) ) {
1767 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
1770 # if we are not registered with a schema - just use the prototype
1771 # however if we do have a schema - ask for the source by name (and
1772 # throw in the process if all fails)
1773 if (my $schema = try { $self->schema }) {
1774 $schema->source($self->relationship_info($rel)->{source});
1777 my $class = $self->relationship_info($rel)->{class};
1778 $self->ensure_class_loaded($class);
1779 $class->result_source_instance;
1783 =head2 related_class
1787 =item Arguments: $relname
1789 =item Return value: $classname
1793 Returns the class name for objects in the given relationship.
1798 my ($self, $rel) = @_;
1799 if( !$self->has_relationship( $rel ) ) {
1800 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
1802 return $self->schema->class($self->relationship_info($rel)->{source});
1809 =item Arguments: None
1811 =item Return value: $source_handle
1815 Obtain a new L<result source handle instance|DBIx::Class::ResultSourceHandle>
1816 for this source. Used as a serializable pointer to this resultsource, as it is not
1817 easy (nor advisable) to serialize CODErefs which may very well be present in e.g.
1818 relationship definitions.
1823 return DBIx::Class::ResultSourceHandle->new({
1824 source_moniker => $_[0]->source_name,
1826 # so that a detached thaw can be re-frozen
1827 $_[0]->{_detached_thaw}
1828 ? ( _detached_source => $_[0] )
1829 : ( schema => $_[0]->schema )
1834 my $global_phase_destroy;
1836 return if $global_phase_destroy ||= in_global_destruction;
1842 # Under no circumstances shall $_[0] be stored anywhere else (like copied to
1843 # a lexical variable, or shifted, or anything else). Doing so will mess up
1844 # the refcount of this particular result source, and will allow the $schema
1845 # we are trying to save to reattach back to the source we are destroying.
1846 # The relevant code checking refcounts is in ::Schema::DESTROY()
1848 # if we are not a schema instance holder - we don't matter
1850 ! ref $_[0]->{schema}
1852 isweak $_[0]->{schema}
1855 # weaken our schema hold forcing the schema to find somewhere else to live
1856 # during global destruction (if we have not yet bailed out) this will throw
1857 # which will serve as a signal to not try doing anything else
1858 # however beware - on older perls the exception seems randomly untrappable
1859 # due to some weird race condition during thread joining :(((
1862 weaken $_[0]->{schema};
1864 # if schema is still there reintroduce ourselves with strong refs back to us
1865 if ($_[0]->{schema}) {
1866 my $srcregs = $_[0]->{schema}->source_registrations;
1867 for (keys %$srcregs) {
1868 next unless $srcregs->{$_};
1869 $srcregs->{$_} = $_[0] if $srcregs->{$_} == $_[0];
1875 $global_phase_destroy = 1;
1881 sub STORABLE_freeze { Storable::nfreeze($_[0]->handle) }
1884 my ($self, $cloning, $ice) = @_;
1885 %$self = %{ (Storable::thaw($ice))->resolve };
1888 =head2 throw_exception
1890 See L<DBIx::Class::Schema/"throw_exception">.
1894 sub throw_exception {
1898 ? $self->{schema}->throw_exception(@_)
1899 : DBIx::Class::Exception->throw(@_)
1905 Stores a hashref of per-source metadata. No specific key names
1906 have yet been standardized, the examples below are purely hypothetical
1907 and don't actually accomplish anything on their own:
1909 __PACKAGE__->source_info({
1910 "_tablespace" => 'fast_disk_array_3',
1911 "_engine" => 'InnoDB',
1918 $class->new({attribute_name => value});
1920 Creates a new ResultSource object. Not normally called directly by end users.
1922 =head2 column_info_from_storage
1926 =item Arguments: 1/0 (default: 0)
1928 =item Return value: 1/0
1932 __PACKAGE__->column_info_from_storage(1);
1934 Enables the on-demand automatic loading of the above column
1935 metadata from storage as necessary. This is *deprecated*, and
1936 should not be used. It will be removed before 1.0.
1941 Matt S. Trout <mst@shadowcatsystems.co.uk>
1945 You may distribute this code under the same terms as Perl itself.