1 package DBIx::Class::ResultSource;
6 use DBIx::Class::ResultSet;
7 use DBIx::Class::ResultSourceHandle;
9 use DBIx::Class::Exception;
10 use Carp::Clan qw/^DBIx::Class/;
12 use List::Util 'first';
13 use Scalar::Util qw/weaken isweak/;
14 use Storable qw/nfreeze thaw/;
17 use base qw/DBIx::Class/;
19 __PACKAGE__->mk_group_accessors('simple' => qw/_ordered_columns
20 _columns _primaries _unique_constraints name resultset_attributes
21 from _relationships column_info_from_storage source_info
22 source_name sqlt_deploy_callback/);
24 __PACKAGE__->mk_group_accessors('component_class' => qw/resultset_class
29 DBIx::Class::ResultSource - Result source object
33 # Create a table based result source, in a result class.
35 package MyDB::Schema::Result::Artist;
36 use base qw/DBIx::Class::Core/;
38 __PACKAGE__->table('artist');
39 __PACKAGE__->add_columns(qw/ artistid name /);
40 __PACKAGE__->set_primary_key('artistid');
41 __PACKAGE__->has_many(cds => 'MyDB::Schema::Result::CD');
45 # Create a query (view) based result source, in a result class
46 package MyDB::Schema::Result::Year2000CDs;
47 use base qw/DBIx::Class::Core/;
49 __PACKAGE__->load_components('InflateColumn::DateTime');
50 __PACKAGE__->table_class('DBIx::Class::ResultSource::View');
52 __PACKAGE__->table('year2000cds');
53 __PACKAGE__->result_source_instance->is_virtual(1);
54 __PACKAGE__->result_source_instance->view_definition(
55 "SELECT cdid, artist, title FROM cd WHERE year ='2000'"
61 A ResultSource is an object that represents a source of data for querying.
63 This class is a base class for various specialised types of result
64 sources, for example L<DBIx::Class::ResultSource::Table>. Table is the
65 default result source type, so one is created for you when defining a
66 result class as described in the synopsis above.
68 More specifically, the L<DBIx::Class::Core> base class pulls in the
69 L<DBIx::Class::ResultSourceProxy::Table> component, which defines
70 the L<table|DBIx::Class::ResultSourceProxy::Table/table> method.
71 When called, C<table> creates and stores an instance of
72 L<DBIx::Class::ResultSoure::Table>. Luckily, to use tables as result
73 sources, you don't need to remember any of this.
75 Result sources representing select queries, or views, can also be
76 created, see L<DBIx::Class::ResultSource::View> for full details.
78 =head2 Finding result source objects
80 As mentioned above, a result source instance is created and stored for
81 you when you define a L<Result Class|DBIx::Class::Manual::Glossary/Result Class>.
83 You can retrieve the result source at runtime in the following ways:
87 =item From a Schema object:
89 $schema->source($source_name);
91 =item From a Row object:
95 =item From a ResultSet object:
108 my ($class, $attrs) = @_;
109 $class = ref $class if ref $class;
111 my $new = bless { %{$attrs || {}} }, $class;
112 $new->{resultset_class} ||= 'DBIx::Class::ResultSet';
113 $new->{resultset_attributes} = { %{$new->{resultset_attributes} || {}} };
114 $new->{_ordered_columns} = [ @{$new->{_ordered_columns}||[]}];
115 $new->{_columns} = { %{$new->{_columns}||{}} };
116 $new->{_relationships} = { %{$new->{_relationships}||{}} };
117 $new->{name} ||= "!!NAME NOT SET!!";
118 $new->{_columns_info_loaded} ||= 0;
119 $new->{sqlt_deploy_callback} ||= "default_sqlt_deploy_hook";
129 =item Arguments: @columns
131 =item Return value: The ResultSource object
135 $source->add_columns(qw/col1 col2 col3/);
137 $source->add_columns('col1' => \%col1_info, 'col2' => \%col2_info, ...);
139 Adds columns to the result source. If supplied colname => hashref
140 pairs, uses the hashref as the L</column_info> for that column. Repeated
141 calls of this method will add more columns, not replace them.
143 The column names given will be created as accessor methods on your
144 L<DBIx::Class::Row> objects. You can change the name of the accessor
145 by supplying an L</accessor> in the column_info hash.
147 If a column name beginning with a plus sign ('+col1') is provided, the
148 attributes provided will be merged with any existing attributes for the
149 column, with the new attributes taking precedence in the case that an
150 attribute already exists. Using this without a hashref
151 (C<< $source->add_columns(qw/+col1 +col2/) >>) is legal, but useless --
152 it does the same thing it would do without the plus.
154 The contents of the column_info are not set in stone. The following
155 keys are currently recognised/used by DBIx::Class:
161 { accessor => '_name' }
163 # example use, replace standard accessor with one of your own:
165 my ($self, $value) = @_;
167 die "Name cannot contain digits!" if($value =~ /\d/);
168 $self->_name($value);
170 return $self->_name();
173 Use this to set the name of the accessor method for this column. If unset,
174 the name of the column will be used.
178 { data_type => 'integer' }
180 This contains the column type. It is automatically filled if you use the
181 L<SQL::Translator::Producer::DBIx::Class::File> producer, or the
182 L<DBIx::Class::Schema::Loader> module.
184 Currently there is no standard set of values for the data_type. Use
185 whatever your database supports.
191 The length of your column, if it is a column type that can have a size
192 restriction. This is currently only used to create tables from your
193 schema, see L<DBIx::Class::Schema/deploy>.
199 Set this to a true value for a columns that is allowed to contain NULL
200 values, default is false. This is currently only used to create tables
201 from your schema, see L<DBIx::Class::Schema/deploy>.
203 =item is_auto_increment
205 { is_auto_increment => 1 }
207 Set this to a true value for a column whose value is somehow
208 automatically set, defaults to false. This is used to determine which
209 columns to empty when cloning objects using
210 L<DBIx::Class::Row/copy>. It is also used by
211 L<DBIx::Class::Schema/deploy>.
217 Set this to a true or false value (not C<undef>) to explicitly specify
218 if this column contains numeric data. This controls how set_column
219 decides whether to consider a column dirty after an update: if
220 C<is_numeric> is true a numeric comparison C<< != >> will take place
221 instead of the usual C<eq>
223 If not specified the storage class will attempt to figure this out on
224 first access to the column, based on the column C<data_type>. The
225 result will be cached in this attribute.
229 { is_foreign_key => 1 }
231 Set this to a true value for a column that contains a key from a
232 foreign table, defaults to false. This is currently only used to
233 create tables from your schema, see L<DBIx::Class::Schema/deploy>.
237 { default_value => \'now()' }
239 Set this to the default value which will be inserted into a column by
240 the database. Can contain either a value or a function (use a
241 reference to a scalar e.g. C<\'now()'> if you want a function). This
242 is currently only used to create tables from your schema, see
243 L<DBIx::Class::Schema/deploy>.
245 See the note on L<DBIx::Class::Row/new> for more information about possible
246 issues related to db-side default values.
250 { sequence => 'my_table_seq' }
252 Set this on a primary key column to the name of the sequence used to
253 generate a new key value. If not specified, L<DBIx::Class::PK::Auto>
254 will attempt to retrieve the name of the sequence from the database
259 Set this to a true value for a column whose value is retrieved automatically
260 from a sequence or function (if supported by your Storage driver.) For a
261 sequence, if you do not use a trigger to get the nextval, you have to set the
262 L</sequence> value as well.
264 Also set this for MSSQL columns with the 'uniqueidentifier'
265 L<data_type|DBIx::Class::ResultSource/data_type> whose values you want to
266 automatically generate using C<NEWID()>, unless they are a primary key in which
267 case this will be done anyway.
271 This is used by L<DBIx::Class::Schema/deploy> and L<SQL::Translator>
272 to add extra non-generic data to the column. For example: C<< extra
273 => { unsigned => 1} >> is used by the MySQL producer to set an integer
274 column to unsigned. For more details, see
275 L<SQL::Translator::Producer::MySQL>.
283 =item Arguments: $colname, \%columninfo?
285 =item Return value: 1/0 (true/false)
289 $source->add_column('col' => \%info);
291 Add a single column and optional column info. Uses the same column
292 info keys as L</add_columns>.
297 my ($self, @cols) = @_;
298 $self->_ordered_columns(\@cols) unless $self->_ordered_columns;
301 my $columns = $self->_columns;
302 while (my $col = shift @cols) {
303 my $column_info = {};
304 if ($col =~ s/^\+//) {
305 $column_info = $self->column_info($col);
308 # If next entry is { ... } use that for the column info, if not
309 # use an empty hashref
311 my $new_info = shift(@cols);
312 %$column_info = (%$column_info, %$new_info);
314 push(@added, $col) unless exists $columns->{$col};
315 $columns->{$col} = $column_info;
317 push @{ $self->_ordered_columns }, @added;
321 sub add_column { shift->add_columns(@_); } # DO NOT CHANGE THIS TO GLOB
327 =item Arguments: $colname
329 =item Return value: 1/0 (true/false)
333 if ($source->has_column($colname)) { ... }
335 Returns true if the source has a column of this name, false otherwise.
340 my ($self, $column) = @_;
341 return exists $self->_columns->{$column};
348 =item Arguments: $colname
350 =item Return value: Hashref of info
354 my $info = $source->column_info($col);
356 Returns the column metadata hashref for a column, as originally passed
357 to L</add_columns>. See L</add_columns> above for information on the
358 contents of the hashref.
363 my ($self, $column) = @_;
364 $self->throw_exception("No such column $column")
365 unless exists $self->_columns->{$column};
367 if ( ! $self->_columns->{$column}{data_type}
368 and ! $self->{_columns_info_loaded}
369 and $self->column_info_from_storage
370 and my $stor = try { $self->storage } )
372 $self->{_columns_info_loaded}++;
374 # try for the case of storage without table
376 my $info = $stor->columns_info_for( $self->from );
378 { (lc $_) => $info->{$_} }
382 foreach my $col ( keys %{$self->_columns} ) {
383 $self->_columns->{$col} = {
384 %{ $self->_columns->{$col} },
385 %{ $info->{$col} || $lc_info->{lc $col} || {} }
391 return $self->_columns->{$column};
398 =item Arguments: None
400 =item Return value: Ordered list of column names
404 my @column_names = $source->columns;
406 Returns all column names in the order they were declared to L</add_columns>.
412 $self->throw_exception(
413 "columns() is a read-only accessor, did you mean add_columns()?"
415 return @{$self->{_ordered_columns}||[]};
422 =item Arguments: \@colnames ?
424 =item Return value: Hashref of column name/info pairs
428 my $columns_info = $source->columns_info;
430 Like L</column_info> but returns information for the requested columns. If
431 the optional column-list arrayref is ommitted it returns info on all columns
432 currently defined on the ResultSource via L</add_columns>.
437 my ($self, $columns) = @_;
439 my $colinfo = $self->_columns;
442 first { ! $_->{data_type} } values %$colinfo
444 ! $self->{_columns_info_loaded}
446 $self->column_info_from_storage
448 my $stor = try { $self->storage }
450 $self->{_columns_info_loaded}++;
452 # try for the case of storage without table
454 my $info = $stor->columns_info_for( $self->from );
456 { (lc $_) => $info->{$_} }
460 foreach my $col ( keys %$colinfo ) {
462 %{ $colinfo->{$col} },
463 %{ $info->{$col} || $lc_info->{lc $col} || {} }
473 if (my $inf = $colinfo->{$_}) {
477 $self->throw_exception( sprintf (
478 "No such column '%s' on source %s",
492 =head2 remove_columns
496 =item Arguments: @colnames
498 =item Return value: undefined
502 $source->remove_columns(qw/col1 col2 col3/);
504 Removes the given list of columns by name, from the result source.
506 B<Warning>: Removing a column that is also used in the sources primary
507 key, or in one of the sources unique constraints, B<will> result in a
508 broken result source.
514 =item Arguments: $colname
516 =item Return value: undefined
520 $source->remove_column('col');
522 Remove a single column by name from the result source, similar to
525 B<Warning>: Removing a column that is also used in the sources primary
526 key, or in one of the sources unique constraints, B<will> result in a
527 broken result source.
532 my ($self, @to_remove) = @_;
534 my $columns = $self->_columns
539 delete $columns->{$_};
543 $self->_ordered_columns([ grep { not $to_remove{$_} } @{$self->_ordered_columns} ]);
546 sub remove_column { shift->remove_columns(@_); } # DO NOT CHANGE THIS TO GLOB
548 =head2 set_primary_key
552 =item Arguments: @cols
554 =item Return value: undefined
558 Defines one or more columns as primary key for this source. Must be
559 called after L</add_columns>.
561 Additionally, defines a L<unique constraint|add_unique_constraint>
564 Note: you normally do want to define a primary key on your sources
565 B<even if the underlying database table does not have a primary key>.
567 L<DBIx::Class::Manual::Intro/The Significance and Importance of Primary Keys>
572 sub set_primary_key {
573 my ($self, @cols) = @_;
574 # check if primary key columns are valid columns
575 foreach my $col (@cols) {
576 $self->throw_exception("No such column $col on table " . $self->name)
577 unless $self->has_column($col);
579 $self->_primaries(\@cols);
581 $self->add_unique_constraint(primary => \@cols);
584 =head2 primary_columns
588 =item Arguments: None
590 =item Return value: Ordered list of primary column names
594 Read-only accessor which returns the list of primary keys, supplied by
599 sub primary_columns {
600 return @{shift->_primaries||[]};
603 # a helper method that will automatically die with a descriptive message if
604 # no pk is defined on the source in question. For internal use to save
605 # on if @pks... boilerplate
608 my @pcols = $self->primary_columns
609 or $self->throw_exception (sprintf(
610 "Operation requires a primary key to be declared on '%s' via set_primary_key",
611 # source_name is set only after schema-registration
612 $self->source_name || $self->result_class || $self->name || 'Unknown source...?',
619 Manually define the correct sequence for your table, to avoid the overhead
620 associated with looking up the sequence automatically. The supplied sequence
621 will be applied to the L</column_info> of each L<primary_key|/set_primary_key>
625 =item Arguments: $sequence_name
627 =item Return value: undefined
634 my ($self,$seq) = @_;
636 my @pks = $self->primary_columns
639 $_->{sequence} = $seq
640 for values %{ $self->columns_info (\@pks) };
644 =head2 add_unique_constraint
648 =item Arguments: $name?, \@colnames
650 =item Return value: undefined
654 Declare a unique constraint on this source. Call once for each unique
657 # For UNIQUE (column1, column2)
658 __PACKAGE__->add_unique_constraint(
659 constraint_name => [ qw/column1 column2/ ],
662 Alternatively, you can specify only the columns:
664 __PACKAGE__->add_unique_constraint([ qw/column1 column2/ ]);
666 This will result in a unique constraint named
667 C<table_column1_column2>, where C<table> is replaced with the table
670 Unique constraints are used, for example, when you pass the constraint
671 name as the C<key> attribute to L<DBIx::Class::ResultSet/find>. Then
672 only columns in the constraint are searched.
674 Throws an error if any of the given column names do not yet exist on
679 sub add_unique_constraint {
683 $self->throw_exception(
684 'add_unique_constraint() does not accept multiple constraints, use '
685 . 'add_unique_constraints() instead'
690 if (ref $cols ne 'ARRAY') {
691 $self->throw_exception (
692 'Expecting an arrayref of constraint columns, got ' . ($cols||'NOTHING')
698 $name ||= $self->name_unique_constraint($cols);
700 foreach my $col (@$cols) {
701 $self->throw_exception("No such column $col on table " . $self->name)
702 unless $self->has_column($col);
705 my %unique_constraints = $self->unique_constraints;
706 $unique_constraints{$name} = $cols;
707 $self->_unique_constraints(\%unique_constraints);
710 =head2 add_unique_constraints
714 =item Arguments: @constraints
716 =item Return value: undefined
720 Declare multiple unique constraints on this source.
722 __PACKAGE__->add_unique_constraints(
723 constraint_name1 => [ qw/column1 column2/ ],
724 constraint_name2 => [ qw/column2 column3/ ],
727 Alternatively, you can specify only the columns:
729 __PACKAGE__->add_unique_constraints(
730 [ qw/column1 column2/ ],
731 [ qw/column3 column4/ ]
734 This will result in unique constraints named C<table_column1_column2> and
735 C<table_column3_column4>, where C<table> is replaced with the table name.
737 Throws an error if any of the given column names do not yet exist on
740 See also L</add_unique_constraint>.
744 sub add_unique_constraints {
746 my @constraints = @_;
748 if ( !(@constraints % 2) && first { ref $_ ne 'ARRAY' } @constraints ) {
749 # with constraint name
750 while (my ($name, $constraint) = splice @constraints, 0, 2) {
751 $self->add_unique_constraint($name => $constraint);
756 foreach my $constraint (@constraints) {
757 $self->add_unique_constraint($constraint);
762 =head2 name_unique_constraint
766 =item Arguments: \@colnames
768 =item Return value: Constraint name
772 $source->table('mytable');
773 $source->name_unique_constraint(['col1', 'col2']);
777 Return a name for a unique constraint containing the specified
778 columns. The name is created by joining the table name and each column
779 name, using an underscore character.
781 For example, a constraint on a table named C<cd> containing the columns
782 C<artist> and C<title> would result in a constraint name of C<cd_artist_title>.
784 This is used by L</add_unique_constraint> if you do not specify the
785 optional constraint name.
789 sub name_unique_constraint {
790 my ($self, $cols) = @_;
792 my $name = $self->name;
793 $name = $$name if (ref $name eq 'SCALAR');
795 return join '_', $name, @$cols;
798 =head2 unique_constraints
802 =item Arguments: None
804 =item Return value: Hash of unique constraint data
808 $source->unique_constraints();
810 Read-only accessor which returns a hash of unique constraints on this
813 The hash is keyed by constraint name, and contains an arrayref of
814 column names as values.
818 sub unique_constraints {
819 return %{shift->_unique_constraints||{}};
822 =head2 unique_constraint_names
826 =item Arguments: None
828 =item Return value: Unique constraint names
832 $source->unique_constraint_names();
834 Returns the list of unique constraint names defined on this source.
838 sub unique_constraint_names {
841 my %unique_constraints = $self->unique_constraints;
843 return keys %unique_constraints;
846 =head2 unique_constraint_columns
850 =item Arguments: $constraintname
852 =item Return value: List of constraint columns
856 $source->unique_constraint_columns('myconstraint');
858 Returns the list of columns that make up the specified unique constraint.
862 sub unique_constraint_columns {
863 my ($self, $constraint_name) = @_;
865 my %unique_constraints = $self->unique_constraints;
867 $self->throw_exception(
868 "Unknown unique constraint $constraint_name on '" . $self->name . "'"
869 ) unless exists $unique_constraints{$constraint_name};
871 return @{ $unique_constraints{$constraint_name} };
874 =head2 sqlt_deploy_callback
878 =item Arguments: $callback
882 __PACKAGE__->sqlt_deploy_callback('mycallbackmethod');
884 An accessor to set a callback to be called during deployment of
885 the schema via L<DBIx::Class::Schema/create_ddl_dir> or
886 L<DBIx::Class::Schema/deploy>.
888 The callback can be set as either a code reference or the name of a
889 method in the current result class.
891 If not set, the L</default_sqlt_deploy_hook> is called.
893 Your callback will be passed the $source object representing the
894 ResultSource instance being deployed, and the
895 L<SQL::Translator::Schema::Table> object being created from it. The
896 callback can be used to manipulate the table object or add your own
897 customised indexes. If you need to manipulate a non-table object, use
898 the L<DBIx::Class::Schema/sqlt_deploy_hook>.
900 See L<DBIx::Class::Manual::Cookbook/Adding Indexes And Functions To
901 Your SQL> for examples.
903 This sqlt deployment callback can only be used to manipulate
904 SQL::Translator objects as they get turned into SQL. To execute
905 post-deploy statements which SQL::Translator does not currently
906 handle, override L<DBIx::Class::Schema/deploy> in your Schema class
907 and call L<dbh_do|DBIx::Class::Storage::DBI/dbh_do>.
909 =head2 default_sqlt_deploy_hook
913 =item Arguments: $source, $sqlt_table
915 =item Return value: undefined
919 This is the sensible default for L</sqlt_deploy_callback>.
921 If a method named C<sqlt_deploy_hook> exists in your Result class, it
922 will be called and passed the current C<$source> and the
923 C<$sqlt_table> being deployed.
927 sub default_sqlt_deploy_hook {
930 my $class = $self->result_class;
932 if ($class and $class->can('sqlt_deploy_hook')) {
933 $class->sqlt_deploy_hook(@_);
937 sub _invoke_sqlt_deploy_hook {
939 if ( my $hook = $self->sqlt_deploy_callback) {
948 =item Arguments: None
950 =item Return value: $resultset
954 Returns a resultset for the given source. This will initially be created
957 $self->resultset_class->new($self, $self->resultset_attributes)
959 but is cached from then on unless resultset_class changes.
961 =head2 resultset_class
965 =item Arguments: $classname
967 =item Return value: $classname
971 package My::Schema::ResultSet::Artist;
972 use base 'DBIx::Class::ResultSet';
975 # In the result class
976 __PACKAGE__->resultset_class('My::Schema::ResultSet::Artist');
979 $source->resultset_class('My::Schema::ResultSet::Artist');
981 Set the class of the resultset. This is useful if you want to create your
982 own resultset methods. Create your own class derived from
983 L<DBIx::Class::ResultSet>, and set it here. If called with no arguments,
984 this method returns the name of the existing resultset class, if one
987 =head2 resultset_attributes
991 =item Arguments: \%attrs
993 =item Return value: \%attrs
997 # In the result class
998 __PACKAGE__->resultset_attributes({ order_by => [ 'id' ] });
1001 $source->resultset_attributes({ order_by => [ 'id' ] });
1003 Store a collection of resultset attributes, that will be set on every
1004 L<DBIx::Class::ResultSet> produced from this result source. For a full
1005 list see L<DBIx::Class::ResultSet/ATTRIBUTES>.
1011 $self->throw_exception(
1012 'resultset does not take any arguments. If you want another resultset, '.
1013 'call it on the schema instead.'
1016 $self->resultset_class->new(
1019 try { %{$self->schema->default_resultset_attributes} },
1020 %{$self->{resultset_attributes}},
1029 =item Arguments: $source_name
1031 =item Result value: $source_name
1035 Set an alternate name for the result source when it is loaded into a schema.
1036 This is useful if you want to refer to a result source by a name other than
1039 package ArchivedBooks;
1040 use base qw/DBIx::Class/;
1041 __PACKAGE__->table('books_archive');
1042 __PACKAGE__->source_name('Books');
1044 # from your schema...
1045 $schema->resultset('Books')->find(1);
1051 =item Arguments: None
1053 =item Return value: FROM clause
1057 my $from_clause = $source->from();
1059 Returns an expression of the source to be supplied to storage to specify
1060 retrieval from this source. In the case of a database, the required FROM
1067 =item Arguments: $schema
1069 =item Return value: A schema object
1073 my $schema = $source->schema();
1075 Sets and/or returns the L<DBIx::Class::Schema> object to which this
1076 result source instance has been attached to.
1082 $_[0]->{schema} = $_[1];
1085 $_[0]->{schema} || do {
1086 my $name = $_[0]->{source_name} || '_unnamed_';
1087 my $err = 'Unable to perform storage-dependent operations with a detached result source '
1088 . "(source '$name' is not associated with a schema).";
1090 $err .= ' You need to use $schema->thaw() or manually set'
1091 . ' $DBIx::Class::ResultSourceHandle::thaw_schema while thawing.'
1092 if $_[0]->{_detached_thaw};
1094 DBIx::Class::Exception->throw($err);
1103 =item Arguments: None
1105 =item Return value: A Storage object
1109 $source->storage->debug(1);
1111 Returns the storage handle for the current schema.
1113 See also: L<DBIx::Class::Storage>
1117 sub storage { shift->schema->storage; }
1119 =head2 add_relationship
1123 =item Arguments: $relname, $related_source_name, \%cond, [ \%attrs ]
1125 =item Return value: 1/true if it succeeded
1129 $source->add_relationship('relname', 'related_source', $cond, $attrs);
1131 L<DBIx::Class::Relationship> describes a series of methods which
1132 create pre-defined useful types of relationships. Look there first
1133 before using this method directly.
1135 The relationship name can be arbitrary, but must be unique for each
1136 relationship attached to this result source. 'related_source' should
1137 be the name with which the related result source was registered with
1138 the current schema. For example:
1140 $schema->source('Book')->add_relationship('reviews', 'Review', {
1141 'foreign.book_id' => 'self.id',
1144 The condition C<$cond> needs to be an L<SQL::Abstract>-style
1145 representation of the join between the tables. For example, if you're
1146 creating a relation from Author to Book,
1148 { 'foreign.author_id' => 'self.id' }
1150 will result in the JOIN clause
1152 author me JOIN book foreign ON foreign.author_id = me.id
1154 You can specify as many foreign => self mappings as necessary.
1156 Valid attributes are as follows:
1162 Explicitly specifies the type of join to use in the relationship. Any
1163 SQL join type is valid, e.g. C<LEFT> or C<RIGHT>. It will be placed in
1164 the SQL command immediately before C<JOIN>.
1168 An arrayref containing a list of accessors in the foreign class to proxy in
1169 the main class. If, for example, you do the following:
1171 CD->might_have(liner_notes => 'LinerNotes', undef, {
1172 proxy => [ qw/notes/ ],
1175 Then, assuming LinerNotes has an accessor named notes, you can do:
1177 my $cd = CD->find(1);
1178 # set notes -- LinerNotes object is created if it doesn't exist
1179 $cd->notes('Notes go here');
1183 Specifies the type of accessor that should be created for the
1184 relationship. Valid values are C<single> (for when there is only a single
1185 related object), C<multi> (when there can be many), and C<filter> (for
1186 when there is a single related object, but you also want the relationship
1187 accessor to double as a column accessor). For C<multi> accessors, an
1188 add_to_* method is also created, which calls C<create_related> for the
1193 Throws an exception if the condition is improperly supplied, or cannot
1198 sub add_relationship {
1199 my ($self, $rel, $f_source_name, $cond, $attrs) = @_;
1200 $self->throw_exception("Can't create relationship without join condition")
1204 # Check foreign and self are right in cond
1205 if ( (ref $cond ||'') eq 'HASH') {
1207 $self->throw_exception("Keys of condition should be of form 'foreign.col', not '$_'")
1208 if /\./ && !/^foreign\./;
1212 my %rels = %{ $self->_relationships };
1213 $rels{$rel} = { class => $f_source_name,
1214 source => $f_source_name,
1217 $self->_relationships(\%rels);
1221 # XXX disabled. doesn't work properly currently. skip in tests.
1223 my $f_source = $self->schema->source($f_source_name);
1224 unless ($f_source) {
1225 $self->ensure_class_loaded($f_source_name);
1226 $f_source = $f_source_name->result_source;
1227 #my $s_class = ref($self->schema);
1228 #$f_source_name =~ m/^${s_class}::(.*)$/;
1229 #$self->schema->register_class(($1 || $f_source_name), $f_source_name);
1230 #$f_source = $self->schema->source($f_source_name);
1232 return unless $f_source; # Can't test rel without f_source
1234 try { $self->_resolve_join($rel, 'me', {}, []) }
1236 # If the resolve failed, back out and re-throw the error
1238 $self->_relationships(\%rels);
1239 $self->throw_exception("Error creating relationship $rel: $_");
1245 =head2 relationships
1249 =item Arguments: None
1251 =item Return value: List of relationship names
1255 my @relnames = $source->relationships();
1257 Returns all relationship names for this source.
1262 return keys %{shift->_relationships};
1265 =head2 relationship_info
1269 =item Arguments: $relname
1271 =item Return value: Hashref of relation data,
1275 Returns a hash of relationship information for the specified relationship
1276 name. The keys/values are as specified for L</add_relationship>.
1280 sub relationship_info {
1281 my ($self, $rel) = @_;
1282 return $self->_relationships->{$rel};
1285 =head2 has_relationship
1289 =item Arguments: $rel
1291 =item Return value: 1/0 (true/false)
1295 Returns true if the source has a relationship of this name, false otherwise.
1299 sub has_relationship {
1300 my ($self, $rel) = @_;
1301 return exists $self->_relationships->{$rel};
1304 =head2 reverse_relationship_info
1308 =item Arguments: $relname
1310 =item Return value: Hashref of relationship data
1314 Looks through all the relationships on the source this relationship
1315 points to, looking for one whose condition is the reverse of the
1316 condition on this relationship.
1318 A common use of this is to find the name of the C<belongs_to> relation
1319 opposing a C<has_many> relation. For definition of these look in
1320 L<DBIx::Class::Relationship>.
1322 The returned hashref is keyed by the name of the opposing
1323 relationship, and contains its data in the same manner as
1324 L</relationship_info>.
1328 sub reverse_relationship_info {
1329 my ($self, $rel) = @_;
1330 my $rel_info = $self->relationship_info($rel);
1333 return $ret unless ((ref $rel_info->{cond}) eq 'HASH');
1335 my @cond = keys(%{$rel_info->{cond}});
1336 my @refkeys = map {/^\w+\.(\w+)$/} @cond;
1337 my @keys = map {$rel_info->{cond}->{$_} =~ /^\w+\.(\w+)$/} @cond;
1339 # Get the related result source for this relationship
1340 my $othertable = $self->related_source($rel);
1342 # Get all the relationships for that source that related to this source
1343 # whose foreign column set are our self columns on $rel and whose self
1344 # columns are our foreign columns on $rel.
1345 my @otherrels = $othertable->relationships();
1346 my $otherrelationship;
1347 foreach my $otherrel (@otherrels) {
1348 # this may be a partial schema with the related source not being
1350 my $back = try { $othertable->related_source($otherrel) } or next;
1352 # did we get back to ourselves?
1353 next unless $back->source_name eq $self->source_name;
1355 my $otherrel_info = $othertable->relationship_info($otherrel);
1358 if (ref $otherrel_info->{cond} eq 'HASH') {
1359 @othertestconds = ($otherrel_info->{cond});
1361 elsif (ref $otherrel_info->{cond} eq 'ARRAY') {
1362 @othertestconds = @{$otherrel_info->{cond}};
1368 foreach my $othercond (@othertestconds) {
1369 my @other_cond = keys(%$othercond);
1370 my @other_refkeys = map {/^\w+\.(\w+)$/} @other_cond;
1371 my @other_keys = map {$othercond->{$_} =~ /^\w+\.(\w+)$/} @other_cond;
1372 next if (!$self->_compare_relationship_keys(\@refkeys, \@other_keys) ||
1373 !$self->_compare_relationship_keys(\@other_refkeys, \@keys));
1374 $ret->{$otherrel} = $otherrel_info;
1380 sub compare_relationship_keys {
1381 carp 'compare_relationship_keys is a private method, stop calling it';
1383 $self->_compare_relationship_keys (@_);
1386 # Returns true if both sets of keynames are the same, false otherwise.
1387 sub _compare_relationship_keys {
1388 my ($self, $keys1, $keys2) = @_;
1390 # Make sure every keys1 is in keys2
1392 foreach my $key (@$keys1) {
1394 foreach my $prim (@$keys2) {
1395 if ($prim eq $key) {
1403 # Make sure every key2 is in key1
1405 foreach my $prim (@$keys2) {
1407 foreach my $key (@$keys1) {
1408 if ($prim eq $key) {
1420 # Returns the {from} structure used to express JOIN conditions
1422 my ($self, $join, $alias, $seen, $jpath, $parent_force_left) = @_;
1424 # we need a supplied one, because we do in-place modifications, no returns
1425 $self->throw_exception ('You must supply a seen hashref as the 3rd argument to _resolve_join')
1426 unless ref $seen eq 'HASH';
1428 $self->throw_exception ('You must supply a joinpath arrayref as the 4th argument to _resolve_join')
1429 unless ref $jpath eq 'ARRAY';
1431 $jpath = [@$jpath]; # copy
1433 if (not defined $join) {
1436 elsif (ref $join eq 'ARRAY') {
1439 $self->_resolve_join($_, $alias, $seen, $jpath, $parent_force_left);
1442 elsif (ref $join eq 'HASH') {
1445 for my $rel (keys %$join) {
1447 my $rel_info = $self->relationship_info($rel)
1448 or $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
1450 my $force_left = $parent_force_left;
1451 $force_left ||= lc($rel_info->{attrs}{join_type}||'') eq 'left';
1453 # the actual seen value will be incremented by the recursion
1454 my $as = $self->storage->relname_to_table_alias(
1455 $rel, ($seen->{$rel} && $seen->{$rel} + 1)
1459 $self->_resolve_join($rel, $alias, $seen, [@$jpath], $force_left),
1460 $self->related_source($rel)->_resolve_join(
1461 $join->{$rel}, $as, $seen, [@$jpath, { $rel => $as }], $force_left
1469 $self->throw_exception("No idea how to resolve join reftype ".ref $join);
1472 my $count = ++$seen->{$join};
1473 my $as = $self->storage->relname_to_table_alias(
1474 $join, ($count > 1 && $count)
1477 my $rel_info = $self->relationship_info($join)
1478 or $self->throw_exception("No such relationship $join on " . $self->source_name);
1480 my $rel_src = $self->related_source($join);
1481 return [ { $as => $rel_src->from,
1483 -join_type => $parent_force_left
1485 : $rel_info->{attrs}{join_type}
1487 -join_path => [@$jpath, { $join => $as } ],
1489 $rel_info->{attrs}{accessor}
1491 first { $rel_info->{attrs}{accessor} eq $_ } (qw/single filter/)
1494 -relation_chain_depth => $seen->{-relation_chain_depth} || 0,
1496 $self->_resolve_condition($rel_info->{cond}, $as, $alias) ];
1501 carp 'pk_depends_on is a private method, stop calling it';
1503 $self->_pk_depends_on (@_);
1506 # Determines whether a relation is dependent on an object from this source
1507 # having already been inserted. Takes the name of the relationship and a
1508 # hashref of columns of the related object.
1509 sub _pk_depends_on {
1510 my ($self, $relname, $rel_data) = @_;
1512 my $relinfo = $self->relationship_info($relname);
1514 # don't assume things if the relationship direction is specified
1515 return $relinfo->{attrs}{is_foreign_key_constraint}
1516 if exists ($relinfo->{attrs}{is_foreign_key_constraint});
1518 my $cond = $relinfo->{cond};
1519 return 0 unless ref($cond) eq 'HASH';
1521 # map { foreign.foo => 'self.bar' } to { bar => 'foo' }
1522 my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond };
1524 # assume anything that references our PK probably is dependent on us
1525 # rather than vice versa, unless the far side is (a) defined or (b)
1527 my $rel_source = $self->related_source($relname);
1529 foreach my $p ($self->primary_columns) {
1530 if (exists $keyhash->{$p}) {
1531 unless (defined($rel_data->{$keyhash->{$p}})
1532 || $rel_source->column_info($keyhash->{$p})
1533 ->{is_auto_increment}) {
1542 sub resolve_condition {
1543 carp 'resolve_condition is a private method, stop calling it';
1545 $self->_resolve_condition (@_);
1548 # Resolves the passed condition to a concrete query fragment. If given an alias,
1549 # returns a join condition; if given an object, inverts that object to produce
1550 # a related conditional from that object.
1551 our $UNRESOLVABLE_CONDITION = \'1 = 0';
1553 sub _resolve_condition {
1554 my ($self, $cond, $as, $for) = @_;
1555 if (ref $cond eq 'HASH') {
1557 foreach my $k (keys %{$cond}) {
1558 my $v = $cond->{$k};
1559 # XXX should probably check these are valid columns
1560 $k =~ s/^foreign\.// ||
1561 $self->throw_exception("Invalid rel cond key ${k}");
1562 $v =~ s/^self\.// ||
1563 $self->throw_exception("Invalid rel cond val ${v}");
1564 if (ref $for) { # Object
1565 #warn "$self $k $for $v";
1566 unless ($for->has_column_loaded($v)) {
1567 if ($for->in_storage) {
1568 $self->throw_exception(sprintf
1569 "Unable to resolve relationship '%s' from object %s: column '%s' not "
1570 . 'loaded from storage (or not passed to new() prior to insert()). You '
1571 . 'probably need to call ->discard_changes to get the server-side defaults '
1572 . 'from the database.',
1578 return $UNRESOLVABLE_CONDITION;
1580 $ret{$k} = $for->get_column($v);
1581 #$ret{$k} = $for->get_column($v) if $for->has_column_loaded($v);
1583 } elsif (!defined $for) { # undef, i.e. "no object"
1585 } elsif (ref $as eq 'HASH') { # reverse hashref
1586 $ret{$v} = $as->{$k};
1587 } elsif (ref $as) { # reverse object
1588 $ret{$v} = $as->get_column($k);
1589 } elsif (!defined $as) { # undef, i.e. "no reverse object"
1592 $ret{"${as}.${k}"} = "${for}.${v}";
1596 } elsif (ref $cond eq 'ARRAY') {
1597 return [ map { $self->_resolve_condition($_, $as, $for) } @$cond ];
1599 die("Can't handle condition $cond yet :(");
1604 # Accepts one or more relationships for the current source and returns an
1605 # array of column names for each of those relationships. Column names are
1606 # prefixed relative to the current source, in accordance with where they appear
1607 # in the supplied relationships.
1609 sub _resolve_prefetch {
1610 my ($self, $pre, $alias, $alias_map, $order, $collapse, $pref_path) = @_;
1613 if (not defined $pre) {
1616 elsif( ref $pre eq 'ARRAY' ) {
1618 map { $self->_resolve_prefetch( $_, $alias, $alias_map, $order, $collapse, [ @$pref_path ] ) }
1621 elsif( ref $pre eq 'HASH' ) {
1624 $self->_resolve_prefetch($_, $alias, $alias_map, $order, $collapse, [ @$pref_path ] ),
1625 $self->related_source($_)->_resolve_prefetch(
1626 $pre->{$_}, "${alias}.$_", $alias_map, $order, $collapse, [ @$pref_path, $_] )
1631 $self->throw_exception(
1632 "don't know how to resolve prefetch reftype ".ref($pre));
1636 $p = $p->{$_} for (@$pref_path, $pre);
1638 $self->throw_exception (
1639 "Unable to resolve prefetch '$pre' - join alias map does not contain an entry for path: "
1640 . join (' -> ', @$pref_path, $pre)
1641 ) if (ref $p->{-join_aliases} ne 'ARRAY' or not @{$p->{-join_aliases}} );
1643 my $as = shift @{$p->{-join_aliases}};
1645 my $rel_info = $self->relationship_info( $pre );
1646 $self->throw_exception( $self->source_name . " has no such relationship '$pre'" )
1648 my $as_prefix = ($alias =~ /^.*?\.(.+)$/ ? $1.'.' : '');
1649 my $rel_source = $self->related_source($pre);
1651 if ($rel_info->{attrs}{accessor} && $rel_info->{attrs}{accessor} eq 'multi') {
1652 $self->throw_exception(
1653 "Can't prefetch has_many ${pre} (join cond too complex)")
1654 unless ref($rel_info->{cond}) eq 'HASH';
1655 my $dots = @{[$as_prefix =~ m/\./g]} + 1; # +1 to match the ".${as_prefix}"
1656 if (my ($fail) = grep { @{[$_ =~ m/\./g]} == $dots }
1657 keys %{$collapse}) {
1658 my ($last) = ($fail =~ /([^\.]+)$/);
1660 "Prefetching multiple has_many rels ${last} and ${pre} "
1661 .(length($as_prefix)
1662 ? "at the same level (${as_prefix}) "
1665 . 'will explode the number of row objects retrievable via ->next or ->all. '
1666 . 'Use at your own risk.'
1669 #my @col = map { (/^self\.(.+)$/ ? ("${as_prefix}.$1") : ()); }
1670 # values %{$rel_info->{cond}};
1671 $collapse->{".${as_prefix}${pre}"} = [ $rel_source->_pri_cols ];
1672 # action at a distance. prepending the '.' allows simpler code
1673 # in ResultSet->_collapse_result
1674 my @key = map { (/^foreign\.(.+)$/ ? ($1) : ()); }
1675 keys %{$rel_info->{cond}};
1676 push @$order, map { "${as}.$_" } @key;
1678 if (my $rel_order = $rel_info->{attrs}{order_by}) {
1679 # this is kludgy and incomplete, I am well aware
1680 # but the parent method is going away entirely anyway
1682 my $sql_maker = $self->storage->sql_maker;
1683 my ($orig_ql, $orig_qr) = $sql_maker->_quote_chars;
1684 my $sep = $sql_maker->name_sep;
1686 # install our own quoter, so we can catch unqualified stuff
1687 local $sql_maker->{quote_char} = ["\x00", "\xFF"];
1689 my $quoted_prefix = "\x00${as}\xFF";
1691 for my $chunk ( $sql_maker->_order_by_chunks ($rel_order) ) {
1693 ($chunk, @bind) = @$chunk if ref $chunk;
1695 $chunk = "${quoted_prefix}${sep}${chunk}"
1696 unless $chunk =~ /\Q$sep/;
1698 $chunk =~ s/\x00/$orig_ql/g;
1699 $chunk =~ s/\xFF/$orig_qr/g;
1700 push @$order, \[$chunk, @bind];
1705 return map { [ "${as}.$_", "${as_prefix}${pre}.$_", ] }
1706 $rel_source->columns;
1710 =head2 related_source
1714 =item Arguments: $relname
1716 =item Return value: $source
1720 Returns the result source object for the given relationship.
1724 sub related_source {
1725 my ($self, $rel) = @_;
1726 if( !$self->has_relationship( $rel ) ) {
1727 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
1729 return $self->schema->source($self->relationship_info($rel)->{source});
1732 =head2 related_class
1736 =item Arguments: $relname
1738 =item Return value: $classname
1742 Returns the class name for objects in the given relationship.
1747 my ($self, $rel) = @_;
1748 if( !$self->has_relationship( $rel ) ) {
1749 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
1751 return $self->schema->class($self->relationship_info($rel)->{source});
1758 =item Arguments: None
1760 =item Return value: $source_handle
1764 Obtain a new L<result source handle instance|DBIx::Class::ResultSourceHandle>
1765 for this source. Used as a serializable pointer to this resultsource, as it is not
1766 easy (nor advisable) to serialize CODErefs which may very well be present in e.g.
1767 relationship definitions.
1772 return DBIx::Class::ResultSourceHandle->new({
1773 source_moniker => $_[0]->source_name,
1775 # so that a detached thaw can be re-frozen
1776 $_[0]->{_detached_thaw}
1777 ? ( _detached_source => $_[0] )
1778 : ( schema => $_[0]->schema )
1784 my $global_phase_destroy;
1786 # SpeedyCGI runs END blocks every cycle but keeps object instances
1787 # hence we have to disable the globaldestroy hatch, and rely on the
1788 # eval trap below (which appears to work, but is risky done so late)
1789 END { $global_phase_destroy = 1 unless $CGI::SpeedyCGI::i_am_speedy }
1792 return if $global_phase_destroy;
1798 # Under no circumstances shall $_[0] be stored anywhere else (like copied to
1799 # a lexical variable, or shifted, or anything else). Doing so will mess up
1800 # the refcount of this particular result source, and will allow the $schema
1801 # we are trying to save to reattach back to the source we are destroying.
1802 # The relevant code checking refcounts is in ::Schema::DESTROY()
1804 # if we are not a schema instance holder - we don't matter
1806 ! ref $_[0]->{schema}
1808 isweak $_[0]->{schema}
1811 # weaken our schema hold forcing the schema to find somewhere else to live
1812 # during global destruction (if we have not yet bailed out) this will throw
1813 # which will serve as a signal to not try doing anything else
1816 weaken $_[0]->{schema};
1819 $global_phase_destroy = 1;
1824 # if schema is still there reintroduce ourselves with strong refs back to us
1825 if ($_[0]->{schema}) {
1826 my $srcregs = $_[0]->{schema}->source_registrations;
1827 for (keys %$srcregs) {
1828 next unless $srcregs->{$_};
1829 $srcregs->{$_} = $_[0] if $srcregs->{$_} == $_[0];
1835 sub STORABLE_freeze { nfreeze($_[0]->handle) }
1838 my ($self, $cloning, $ice) = @_;
1839 %$self = %{ (thaw $ice)->resolve };
1842 =head2 throw_exception
1844 See L<DBIx::Class::Schema/"throw_exception">.
1848 sub throw_exception {
1852 ? $self->{schema}->throw_exception(@_)
1853 : DBIx::Class::Exception->throw(@_)
1859 Stores a hashref of per-source metadata. No specific key names
1860 have yet been standardized, the examples below are purely hypothetical
1861 and don't actually accomplish anything on their own:
1863 __PACKAGE__->source_info({
1864 "_tablespace" => 'fast_disk_array_3',
1865 "_engine" => 'InnoDB',
1872 $class->new({attribute_name => value});
1874 Creates a new ResultSource object. Not normally called directly by end users.
1876 =head2 column_info_from_storage
1880 =item Arguments: 1/0 (default: 0)
1882 =item Return value: 1/0
1886 __PACKAGE__->column_info_from_storage(1);
1888 Enables the on-demand automatic loading of the above column
1889 metadata from storage as necessary. This is *deprecated*, and
1890 should not be used. It will be removed before 1.0.
1895 Matt S. Trout <mst@shadowcatsystems.co.uk>
1899 You may distribute this code under the same terms as Perl itself.