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 MyDB::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 => 'MyDB::Schema::Result::CD');
44 # Create a query (view) based result source, in a result class
45 package MyDB::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
258 Set this to a true value for a column whose value is retrieved automatically
259 from a sequence or function (if supported by your Storage driver.) For a
260 sequence, if you do not use a trigger to get the nextval, you have to set the
261 L</sequence> value as well.
263 Also set this for MSSQL columns with the 'uniqueidentifier'
264 L<data_type|DBIx::Class::ResultSource/data_type> whose values you want to
265 automatically generate using C<NEWID()>, unless they are a primary key in which
266 case this will be done anyway.
270 This is used by L<DBIx::Class::Schema/deploy> and L<SQL::Translator>
271 to add extra non-generic data to the column. For example: C<< extra
272 => { unsigned => 1} >> is used by the MySQL producer to set an integer
273 column to unsigned. For more details, see
274 L<SQL::Translator::Producer::MySQL>.
282 =item Arguments: $colname, \%columninfo?
284 =item Return value: 1/0 (true/false)
288 $source->add_column('col' => \%info);
290 Add a single column and optional column info. Uses the same column
291 info keys as L</add_columns>.
296 my ($self, @cols) = @_;
297 $self->_ordered_columns(\@cols) unless $self->_ordered_columns;
300 my $columns = $self->_columns;
301 while (my $col = shift @cols) {
302 my $column_info = {};
303 if ($col =~ s/^\+//) {
304 $column_info = $self->column_info($col);
307 # If next entry is { ... } use that for the column info, if not
308 # use an empty hashref
310 my $new_info = shift(@cols);
311 %$column_info = (%$column_info, %$new_info);
313 push(@added, $col) unless exists $columns->{$col};
314 $columns->{$col} = $column_info;
316 push @{ $self->_ordered_columns }, @added;
320 sub add_column { shift->add_columns(@_); } # DO NOT CHANGE THIS TO GLOB
326 =item Arguments: $colname
328 =item Return value: 1/0 (true/false)
332 if ($source->has_column($colname)) { ... }
334 Returns true if the source has a column of this name, false otherwise.
339 my ($self, $column) = @_;
340 return exists $self->_columns->{$column};
347 =item Arguments: $colname
349 =item Return value: Hashref of info
353 my $info = $source->column_info($col);
355 Returns the column metadata hashref for a column, as originally passed
356 to L</add_columns>. See L</add_columns> above for information on the
357 contents of the hashref.
362 my ($self, $column) = @_;
363 $self->throw_exception("No such column $column")
364 unless exists $self->_columns->{$column};
366 if ( ! $self->_columns->{$column}{data_type}
367 and ! $self->{_columns_info_loaded}
368 and $self->column_info_from_storage
369 and my $stor = try { $self->storage } )
371 $self->{_columns_info_loaded}++;
373 # try for the case of storage without table
375 my $info = $stor->columns_info_for( $self->from );
377 { (lc $_) => $info->{$_} }
381 foreach my $col ( keys %{$self->_columns} ) {
382 $self->_columns->{$col} = {
383 %{ $self->_columns->{$col} },
384 %{ $info->{$col} || $lc_info->{lc $col} || {} }
390 return $self->_columns->{$column};
397 =item Arguments: None
399 =item Return value: Ordered list of column names
403 my @column_names = $source->columns;
405 Returns all column names in the order they were declared to L</add_columns>.
411 $self->throw_exception(
412 "columns() is a read-only accessor, did you mean add_columns()?"
414 return @{$self->{_ordered_columns}||[]};
421 =item Arguments: \@colnames ?
423 =item Return value: Hashref of column name/info pairs
427 my $columns_info = $source->columns_info;
429 Like L</column_info> but returns information for the requested columns. If
430 the optional column-list arrayref is omitted it returns info on all columns
431 currently defined on the ResultSource via L</add_columns>.
436 my ($self, $columns) = @_;
438 my $colinfo = $self->_columns;
441 first { ! $_->{data_type} } values %$colinfo
443 ! $self->{_columns_info_loaded}
445 $self->column_info_from_storage
447 my $stor = try { $self->storage }
449 $self->{_columns_info_loaded}++;
451 # try for the case of storage without table
453 my $info = $stor->columns_info_for( $self->from );
455 { (lc $_) => $info->{$_} }
459 foreach my $col ( keys %$colinfo ) {
461 %{ $colinfo->{$col} },
462 %{ $info->{$col} || $lc_info->{lc $col} || {} }
472 if (my $inf = $colinfo->{$_}) {
476 $self->throw_exception( sprintf (
477 "No such column '%s' on source %s",
491 =head2 remove_columns
495 =item Arguments: @colnames
497 =item Return value: undefined
501 $source->remove_columns(qw/col1 col2 col3/);
503 Removes the given list of columns by name, from the result source.
505 B<Warning>: Removing a column that is also used in the sources primary
506 key, or in one of the sources unique constraints, B<will> result in a
507 broken result source.
513 =item Arguments: $colname
515 =item Return value: undefined
519 $source->remove_column('col');
521 Remove a single column by name from the result source, similar to
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.
531 my ($self, @to_remove) = @_;
533 my $columns = $self->_columns
538 delete $columns->{$_};
542 $self->_ordered_columns([ grep { not $to_remove{$_} } @{$self->_ordered_columns} ]);
545 sub remove_column { shift->remove_columns(@_); } # DO NOT CHANGE THIS TO GLOB
547 =head2 set_primary_key
551 =item Arguments: @cols
553 =item Return value: undefined
557 Defines one or more columns as primary key for this source. Must be
558 called after L</add_columns>.
560 Additionally, defines a L<unique constraint|add_unique_constraint>
563 Note: you normally do want to define a primary key on your sources
564 B<even if the underlying database table does not have a primary key>.
566 L<DBIx::Class::Manual::Intro/The Significance and Importance of Primary Keys>
571 sub set_primary_key {
572 my ($self, @cols) = @_;
573 # check if primary key columns are valid columns
574 foreach my $col (@cols) {
575 $self->throw_exception("No such column $col on table " . $self->name)
576 unless $self->has_column($col);
578 $self->_primaries(\@cols);
580 $self->add_unique_constraint(primary => \@cols);
583 =head2 primary_columns
587 =item Arguments: None
589 =item Return value: Ordered list of primary column names
593 Read-only accessor which returns the list of primary keys, supplied by
598 sub primary_columns {
599 return @{shift->_primaries||[]};
602 # a helper method that will automatically die with a descriptive message if
603 # no pk is defined on the source in question. For internal use to save
604 # on if @pks... boilerplate
607 my @pcols = $self->primary_columns
608 or $self->throw_exception (sprintf(
609 "Operation requires a primary key to be declared on '%s' via set_primary_key",
610 # source_name is set only after schema-registration
611 $self->source_name || $self->result_class || $self->name || 'Unknown source...?',
618 Manually define the correct sequence for your table, to avoid the overhead
619 associated with looking up the sequence automatically. The supplied sequence
620 will be applied to the L</column_info> of each L<primary_key|/set_primary_key>
624 =item Arguments: $sequence_name
626 =item Return value: undefined
633 my ($self,$seq) = @_;
635 my @pks = $self->primary_columns
638 $_->{sequence} = $seq
639 for values %{ $self->columns_info (\@pks) };
643 =head2 add_unique_constraint
647 =item Arguments: $name?, \@colnames
649 =item Return value: undefined
653 Declare a unique constraint on this source. Call once for each unique
656 # For UNIQUE (column1, column2)
657 __PACKAGE__->add_unique_constraint(
658 constraint_name => [ qw/column1 column2/ ],
661 Alternatively, you can specify only the columns:
663 __PACKAGE__->add_unique_constraint([ qw/column1 column2/ ]);
665 This will result in a unique constraint named
666 C<table_column1_column2>, where C<table> is replaced with the table
669 Unique constraints are used, for example, when you pass the constraint
670 name as the C<key> attribute to L<DBIx::Class::ResultSet/find>. Then
671 only columns in the constraint are searched.
673 Throws an error if any of the given column names do not yet exist on
678 sub add_unique_constraint {
682 $self->throw_exception(
683 'add_unique_constraint() does not accept multiple constraints, use '
684 . 'add_unique_constraints() instead'
689 if (ref $cols ne 'ARRAY') {
690 $self->throw_exception (
691 'Expecting an arrayref of constraint columns, got ' . ($cols||'NOTHING')
697 $name ||= $self->name_unique_constraint($cols);
699 foreach my $col (@$cols) {
700 $self->throw_exception("No such column $col on table " . $self->name)
701 unless $self->has_column($col);
704 my %unique_constraints = $self->unique_constraints;
705 $unique_constraints{$name} = $cols;
706 $self->_unique_constraints(\%unique_constraints);
709 =head2 add_unique_constraints
713 =item Arguments: @constraints
715 =item Return value: undefined
719 Declare multiple unique constraints on this source.
721 __PACKAGE__->add_unique_constraints(
722 constraint_name1 => [ qw/column1 column2/ ],
723 constraint_name2 => [ qw/column2 column3/ ],
726 Alternatively, you can specify only the columns:
728 __PACKAGE__->add_unique_constraints(
729 [ qw/column1 column2/ ],
730 [ qw/column3 column4/ ]
733 This will result in unique constraints named C<table_column1_column2> and
734 C<table_column3_column4>, where C<table> is replaced with the table name.
736 Throws an error if any of the given column names do not yet exist on
739 See also L</add_unique_constraint>.
743 sub add_unique_constraints {
745 my @constraints = @_;
747 if ( !(@constraints % 2) && first { ref $_ ne 'ARRAY' } @constraints ) {
748 # with constraint name
749 while (my ($name, $constraint) = splice @constraints, 0, 2) {
750 $self->add_unique_constraint($name => $constraint);
755 foreach my $constraint (@constraints) {
756 $self->add_unique_constraint($constraint);
761 =head2 name_unique_constraint
765 =item Arguments: \@colnames
767 =item Return value: Constraint name
771 $source->table('mytable');
772 $source->name_unique_constraint(['col1', 'col2']);
776 Return a name for a unique constraint containing the specified
777 columns. The name is created by joining the table name and each column
778 name, using an underscore character.
780 For example, a constraint on a table named C<cd> containing the columns
781 C<artist> and C<title> would result in a constraint name of C<cd_artist_title>.
783 This is used by L</add_unique_constraint> if you do not specify the
784 optional constraint name.
788 sub name_unique_constraint {
789 my ($self, $cols) = @_;
791 my $name = $self->name;
792 $name = $$name if (ref $name eq 'SCALAR');
794 return join '_', $name, @$cols;
797 =head2 unique_constraints
801 =item Arguments: None
803 =item Return value: Hash of unique constraint data
807 $source->unique_constraints();
809 Read-only accessor which returns a hash of unique constraints on this
812 The hash is keyed by constraint name, and contains an arrayref of
813 column names as values.
817 sub unique_constraints {
818 return %{shift->_unique_constraints||{}};
821 =head2 unique_constraint_names
825 =item Arguments: None
827 =item Return value: Unique constraint names
831 $source->unique_constraint_names();
833 Returns the list of unique constraint names defined on this source.
837 sub unique_constraint_names {
840 my %unique_constraints = $self->unique_constraints;
842 return keys %unique_constraints;
845 =head2 unique_constraint_columns
849 =item Arguments: $constraintname
851 =item Return value: List of constraint columns
855 $source->unique_constraint_columns('myconstraint');
857 Returns the list of columns that make up the specified unique constraint.
861 sub unique_constraint_columns {
862 my ($self, $constraint_name) = @_;
864 my %unique_constraints = $self->unique_constraints;
866 $self->throw_exception(
867 "Unknown unique constraint $constraint_name on '" . $self->name . "'"
868 ) unless exists $unique_constraints{$constraint_name};
870 return @{ $unique_constraints{$constraint_name} };
873 =head2 sqlt_deploy_callback
877 =item Arguments: $callback
881 __PACKAGE__->sqlt_deploy_callback('mycallbackmethod');
883 An accessor to set a callback to be called during deployment of
884 the schema via L<DBIx::Class::Schema/create_ddl_dir> or
885 L<DBIx::Class::Schema/deploy>.
887 The callback can be set as either a code reference or the name of a
888 method in the current result class.
890 If not set, the L</default_sqlt_deploy_hook> is called.
892 Your callback will be passed the $source object representing the
893 ResultSource instance being deployed, and the
894 L<SQL::Translator::Schema::Table> object being created from it. The
895 callback can be used to manipulate the table object or add your own
896 customised indexes. If you need to manipulate a non-table object, use
897 the L<DBIx::Class::Schema/sqlt_deploy_hook>.
899 See L<DBIx::Class::Manual::Cookbook/Adding Indexes And Functions To
900 Your SQL> for examples.
902 This sqlt deployment callback can only be used to manipulate
903 SQL::Translator objects as they get turned into SQL. To execute
904 post-deploy statements which SQL::Translator does not currently
905 handle, override L<DBIx::Class::Schema/deploy> in your Schema class
906 and call L<dbh_do|DBIx::Class::Storage::DBI/dbh_do>.
908 =head2 default_sqlt_deploy_hook
912 =item Arguments: $source, $sqlt_table
914 =item Return value: undefined
918 This is the sensible default for L</sqlt_deploy_callback>.
920 If a method named C<sqlt_deploy_hook> exists in your Result class, it
921 will be called and passed the current C<$source> and the
922 C<$sqlt_table> being deployed.
926 sub default_sqlt_deploy_hook {
929 my $class = $self->result_class;
931 if ($class and $class->can('sqlt_deploy_hook')) {
932 $class->sqlt_deploy_hook(@_);
936 sub _invoke_sqlt_deploy_hook {
938 if ( my $hook = $self->sqlt_deploy_callback) {
947 =item Arguments: None
949 =item Return value: $resultset
953 Returns a resultset for the given source. This will initially be created
956 $self->resultset_class->new($self, $self->resultset_attributes)
958 but is cached from then on unless resultset_class changes.
960 =head2 resultset_class
964 =item Arguments: $classname
966 =item Return value: $classname
970 package My::Schema::ResultSet::Artist;
971 use base 'DBIx::Class::ResultSet';
974 # In the result class
975 __PACKAGE__->resultset_class('My::Schema::ResultSet::Artist');
978 $source->resultset_class('My::Schema::ResultSet::Artist');
980 Set the class of the resultset. This is useful if you want to create your
981 own resultset methods. Create your own class derived from
982 L<DBIx::Class::ResultSet>, and set it here. If called with no arguments,
983 this method returns the name of the existing resultset class, if one
986 =head2 resultset_attributes
990 =item Arguments: \%attrs
992 =item Return value: \%attrs
996 # In the result class
997 __PACKAGE__->resultset_attributes({ order_by => [ 'id' ] });
1000 $source->resultset_attributes({ order_by => [ 'id' ] });
1002 Store a collection of resultset attributes, that will be set on every
1003 L<DBIx::Class::ResultSet> produced from this result source. For a full
1004 list see L<DBIx::Class::ResultSet/ATTRIBUTES>.
1010 $self->throw_exception(
1011 'resultset does not take any arguments. If you want another resultset, '.
1012 'call it on the schema instead.'
1015 $self->resultset_class->new(
1018 try { %{$self->schema->default_resultset_attributes} },
1019 %{$self->{resultset_attributes}},
1028 =item Arguments: $source_name
1030 =item Result value: $source_name
1034 Set an alternate name for the result source when it is loaded into a schema.
1035 This is useful if you want to refer to a result source by a name other than
1038 package ArchivedBooks;
1039 use base qw/DBIx::Class/;
1040 __PACKAGE__->table('books_archive');
1041 __PACKAGE__->source_name('Books');
1043 # from your schema...
1044 $schema->resultset('Books')->find(1);
1050 =item Arguments: None
1052 =item Return value: FROM clause
1056 my $from_clause = $source->from();
1058 Returns an expression of the source to be supplied to storage to specify
1059 retrieval from this source. In the case of a database, the required FROM
1066 =item Arguments: $schema
1068 =item Return value: A schema object
1072 my $schema = $source->schema();
1074 Sets and/or returns the L<DBIx::Class::Schema> object to which this
1075 result source instance has been attached to.
1081 $_[0]->{schema} = $_[1];
1084 $_[0]->{schema} || do {
1085 my $name = $_[0]->{source_name} || '_unnamed_';
1086 my $err = 'Unable to perform storage-dependent operations with a detached result source '
1087 . "(source '$name' is not associated with a schema).";
1089 $err .= ' You need to use $schema->thaw() or manually set'
1090 . ' $DBIx::Class::ResultSourceHandle::thaw_schema while thawing.'
1091 if $_[0]->{_detached_thaw};
1093 DBIx::Class::Exception->throw($err);
1102 =item Arguments: None
1104 =item Return value: A Storage object
1108 $source->storage->debug(1);
1110 Returns the storage handle for the current schema.
1112 See also: L<DBIx::Class::Storage>
1116 sub storage { shift->schema->storage; }
1118 =head2 add_relationship
1122 =item Arguments: $relname, $related_source_name, \%cond, [ \%attrs ]
1124 =item Return value: 1/true if it succeeded
1128 $source->add_relationship('relname', 'related_source', $cond, $attrs);
1130 L<DBIx::Class::Relationship> describes a series of methods which
1131 create pre-defined useful types of relationships. Look there first
1132 before using this method directly.
1134 The relationship name can be arbitrary, but must be unique for each
1135 relationship attached to this result source. 'related_source' should
1136 be the name with which the related result source was registered with
1137 the current schema. For example:
1139 $schema->source('Book')->add_relationship('reviews', 'Review', {
1140 'foreign.book_id' => 'self.id',
1143 The condition C<$cond> needs to be an L<SQL::Abstract>-style
1144 representation of the join between the tables. For example, if you're
1145 creating a relation from Author to Book,
1147 { 'foreign.author_id' => 'self.id' }
1149 will result in the JOIN clause
1151 author me JOIN book foreign ON foreign.author_id = me.id
1153 You can specify as many foreign => self mappings as necessary.
1155 Valid attributes are as follows:
1161 Explicitly specifies the type of join to use in the relationship. Any
1162 SQL join type is valid, e.g. C<LEFT> or C<RIGHT>. It will be placed in
1163 the SQL command immediately before C<JOIN>.
1167 An arrayref containing a list of accessors in the foreign class to proxy in
1168 the main class. If, for example, you do the following:
1170 CD->might_have(liner_notes => 'LinerNotes', undef, {
1171 proxy => [ qw/notes/ ],
1174 Then, assuming LinerNotes has an accessor named notes, you can do:
1176 my $cd = CD->find(1);
1177 # set notes -- LinerNotes object is created if it doesn't exist
1178 $cd->notes('Notes go here');
1182 Specifies the type of accessor that should be created for the
1183 relationship. Valid values are C<single> (for when there is only a single
1184 related object), C<multi> (when there can be many), and C<filter> (for
1185 when there is a single related object, but you also want the relationship
1186 accessor to double as a column accessor). For C<multi> accessors, an
1187 add_to_* method is also created, which calls C<create_related> for the
1192 Throws an exception if the condition is improperly supplied, or cannot
1197 sub add_relationship {
1198 my ($self, $rel, $f_source_name, $cond, $attrs) = @_;
1199 $self->throw_exception("Can't create relationship without join condition")
1203 # Check foreign and self are right in cond
1204 if ( (ref $cond ||'') eq 'HASH') {
1206 $self->throw_exception("Keys of condition should be of form 'foreign.col', not '$_'")
1207 if /\./ && !/^foreign\./;
1211 my %rels = %{ $self->_relationships };
1212 $rels{$rel} = { class => $f_source_name,
1213 source => $f_source_name,
1216 $self->_relationships(\%rels);
1220 # XXX disabled. doesn't work properly currently. skip in tests.
1222 my $f_source = $self->schema->source($f_source_name);
1223 unless ($f_source) {
1224 $self->ensure_class_loaded($f_source_name);
1225 $f_source = $f_source_name->result_source;
1226 #my $s_class = ref($self->schema);
1227 #$f_source_name =~ m/^${s_class}::(.*)$/;
1228 #$self->schema->register_class(($1 || $f_source_name), $f_source_name);
1229 #$f_source = $self->schema->source($f_source_name);
1231 return unless $f_source; # Can't test rel without f_source
1233 try { $self->_resolve_join($rel, 'me', {}, []) }
1235 # If the resolve failed, back out and re-throw the error
1237 $self->_relationships(\%rels);
1238 $self->throw_exception("Error creating relationship $rel: $_");
1244 =head2 relationships
1248 =item Arguments: None
1250 =item Return value: List of relationship names
1254 my @relnames = $source->relationships();
1256 Returns all relationship names for this source.
1261 return keys %{shift->_relationships};
1264 =head2 relationship_info
1268 =item Arguments: $relname
1270 =item Return value: Hashref of relation data,
1274 Returns a hash of relationship information for the specified relationship
1275 name. The keys/values are as specified for L</add_relationship>.
1279 sub relationship_info {
1280 my ($self, $rel) = @_;
1281 return $self->_relationships->{$rel};
1284 =head2 has_relationship
1288 =item Arguments: $rel
1290 =item Return value: 1/0 (true/false)
1294 Returns true if the source has a relationship of this name, false otherwise.
1298 sub has_relationship {
1299 my ($self, $rel) = @_;
1300 return exists $self->_relationships->{$rel};
1303 =head2 reverse_relationship_info
1307 =item Arguments: $relname
1309 =item Return value: Hashref of relationship data
1313 Looks through all the relationships on the source this relationship
1314 points to, looking for one whose condition is the reverse of the
1315 condition on this relationship.
1317 A common use of this is to find the name of the C<belongs_to> relation
1318 opposing a C<has_many> relation. For definition of these look in
1319 L<DBIx::Class::Relationship>.
1321 The returned hashref is keyed by the name of the opposing
1322 relationship, and contains its data in the same manner as
1323 L</relationship_info>.
1327 sub reverse_relationship_info {
1328 my ($self, $rel) = @_;
1330 my $rel_info = $self->relationship_info($rel)
1331 or $self->throw_exception("No such relationship '$rel'");
1335 return $ret unless ((ref $rel_info->{cond}) eq 'HASH');
1337 my $stripped_cond = $self->__strip_relcond ($rel_info->{cond});
1339 my $rsrc_schema_moniker = $self->source_name
1340 if try { $self->schema };
1342 # this may be a partial schema or something else equally esoteric
1343 my $other_rsrc = try { $self->related_source($rel) }
1346 # Get all the relationships for that source that related to this source
1347 # whose foreign column set are our self columns on $rel and whose self
1348 # columns are our foreign columns on $rel
1349 foreach my $other_rel ($other_rsrc->relationships) {
1351 # only consider stuff that points back to us
1352 # "us" here is tricky - if we are in a schema registration, we want
1353 # to use the source_names, otherwise we will use the actual classes
1355 # the schema may be partial
1356 my $roundtrip_rsrc = try { $other_rsrc->related_source($other_rel) }
1359 if ($rsrc_schema_moniker and try { $roundtrip_rsrc->schema } ) {
1360 next unless $rsrc_schema_moniker eq $roundtrip_rsrc->source_name;
1363 next unless $self->result_class eq $roundtrip_rsrc->result_class;
1366 my $other_rel_info = $other_rsrc->relationship_info($other_rel);
1368 # this can happen when we have a self-referential class
1369 next if $other_rel_info eq $rel_info;
1371 next unless ref $other_rel_info->{cond} eq 'HASH';
1372 my $other_stripped_cond = $self->__strip_relcond($other_rel_info->{cond});
1374 $ret->{$other_rel} = $other_rel_info if (
1375 $self->_compare_relationship_keys (
1376 [ keys %$stripped_cond ], [ values %$other_stripped_cond ]
1379 $self->_compare_relationship_keys (
1380 [ values %$stripped_cond ], [ keys %$other_stripped_cond ]
1388 # all this does is removes the foreign/self prefix from a condition
1389 sub __strip_relcond {
1392 { map { /^ (?:foreign|self) \. (\w+) $/x } ($_, $_[1]{$_}) }
1397 sub compare_relationship_keys {
1398 carp 'compare_relationship_keys is a private method, stop calling it';
1400 $self->_compare_relationship_keys (@_);
1403 # Returns true if both sets of keynames are the same, false otherwise.
1404 sub _compare_relationship_keys {
1405 # my ($self, $keys1, $keys2) = @_;
1407 join ("\x00", sort @{$_[1]})
1409 join ("\x00", sort @{$_[2]})
1413 # Returns the {from} structure used to express JOIN conditions
1415 my ($self, $join, $alias, $seen, $jpath, $parent_force_left) = @_;
1417 # we need a supplied one, because we do in-place modifications, no returns
1418 $self->throw_exception ('You must supply a seen hashref as the 3rd argument to _resolve_join')
1419 unless ref $seen eq 'HASH';
1421 $self->throw_exception ('You must supply a joinpath arrayref as the 4th argument to _resolve_join')
1422 unless ref $jpath eq 'ARRAY';
1424 $jpath = [@$jpath]; # copy
1426 if (not defined $join) {
1429 elsif (ref $join eq 'ARRAY') {
1432 $self->_resolve_join($_, $alias, $seen, $jpath, $parent_force_left);
1435 elsif (ref $join eq 'HASH') {
1438 for my $rel (keys %$join) {
1440 my $rel_info = $self->relationship_info($rel)
1441 or $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
1443 my $force_left = $parent_force_left;
1444 $force_left ||= lc($rel_info->{attrs}{join_type}||'') eq 'left';
1446 # the actual seen value will be incremented by the recursion
1447 my $as = $self->storage->relname_to_table_alias(
1448 $rel, ($seen->{$rel} && $seen->{$rel} + 1)
1452 $self->_resolve_join($rel, $alias, $seen, [@$jpath], $force_left),
1453 $self->related_source($rel)->_resolve_join(
1454 $join->{$rel}, $as, $seen, [@$jpath, { $rel => $as }], $force_left
1462 $self->throw_exception("No idea how to resolve join reftype ".ref $join);
1465 my $count = ++$seen->{$join};
1466 my $as = $self->storage->relname_to_table_alias(
1467 $join, ($count > 1 && $count)
1470 my $rel_info = $self->relationship_info($join)
1471 or $self->throw_exception("No such relationship $join on " . $self->source_name);
1473 my $rel_src = $self->related_source($join);
1474 return [ { $as => $rel_src->from,
1476 -join_type => $parent_force_left
1478 : $rel_info->{attrs}{join_type}
1480 -join_path => [@$jpath, { $join => $as } ],
1482 $rel_info->{attrs}{accessor}
1484 first { $rel_info->{attrs}{accessor} eq $_ } (qw/single filter/)
1487 -relation_chain_depth => $seen->{-relation_chain_depth} || 0,
1489 $self->_resolve_condition($rel_info->{cond}, $as, $alias, $join)
1495 carp 'pk_depends_on is a private method, stop calling it';
1497 $self->_pk_depends_on (@_);
1500 # Determines whether a relation is dependent on an object from this source
1501 # having already been inserted. Takes the name of the relationship and a
1502 # hashref of columns of the related object.
1503 sub _pk_depends_on {
1504 my ($self, $relname, $rel_data) = @_;
1506 my $relinfo = $self->relationship_info($relname);
1508 # don't assume things if the relationship direction is specified
1509 return $relinfo->{attrs}{is_foreign_key_constraint}
1510 if exists ($relinfo->{attrs}{is_foreign_key_constraint});
1512 my $cond = $relinfo->{cond};
1513 return 0 unless ref($cond) eq 'HASH';
1515 # map { foreign.foo => 'self.bar' } to { bar => 'foo' }
1516 my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond };
1518 # assume anything that references our PK probably is dependent on us
1519 # rather than vice versa, unless the far side is (a) defined or (b)
1521 my $rel_source = $self->related_source($relname);
1523 foreach my $p ($self->primary_columns) {
1524 if (exists $keyhash->{$p}) {
1525 unless (defined($rel_data->{$keyhash->{$p}})
1526 || $rel_source->column_info($keyhash->{$p})
1527 ->{is_auto_increment}) {
1536 sub resolve_condition {
1537 carp 'resolve_condition is a private method, stop calling it';
1539 $self->_resolve_condition (@_);
1542 our $UNRESOLVABLE_CONDITION = \ '1 = 0';
1544 # Resolves the passed condition to a concrete query fragment and a flag
1545 # indicating whether this is a cross-table condition. Also an optional
1546 # list of non-triviail values (notmally conditions) returned as a part
1547 # of a joinfree condition hash
1548 sub _resolve_condition {
1549 my ($self, $cond, $as, $for, $relname) = @_;
1551 my $obj_rel = !!blessed $for;
1553 if (ref $cond eq 'CODE') {
1554 my $relalias = $obj_rel ? 'me' : $as;
1556 my ($crosstable_cond, $joinfree_cond) = $cond->({
1557 self_alias => $obj_rel ? $as : $for,
1558 foreign_alias => $relalias,
1559 self_resultsource => $self,
1560 foreign_relname => $relname || ($obj_rel ? $as : $for),
1561 self_rowobj => $obj_rel ? $for : undef
1565 if ($joinfree_cond) {
1567 # FIXME sanity check until things stabilize, remove at some point
1568 $self->throw_exception (
1569 "A join-free condition returned for relationship '$relname' whithout a row-object to chain from"
1572 # FIXME another sanity check
1574 ref $joinfree_cond ne 'HASH'
1576 first { $_ !~ /^\Q$relalias.\E.+/ } keys %$joinfree_cond
1578 $self->throw_exception (
1579 "The join-free condition returned for relationship '$relname' must be a hash "
1580 .'reference with all keys being valid columns on the related result source'
1585 for (values %$joinfree_cond) {
1595 # see which parts of the joinfree cond are conditionals
1596 my $relcol_list = { map { $_ => 1 } $self->related_source($relname)->columns };
1598 for my $c (keys %$joinfree_cond) {
1599 my ($colname) = $c =~ /^ (?: \Q$relalias.\E )? (.+)/x;
1601 unless ($relcol_list->{$colname}) {
1602 push @$cond_cols, $colname;
1607 ref $joinfree_cond->{$c}
1609 ref $joinfree_cond->{$c} ne 'SCALAR'
1611 ref $joinfree_cond->{$c} ne 'REF'
1613 push @$cond_cols, $colname;
1618 return wantarray ? ($joinfree_cond, 0, $cond_cols) : $joinfree_cond;
1621 return wantarray ? ($crosstable_cond, 1) : $crosstable_cond;
1624 elsif (ref $cond eq 'HASH') {
1626 foreach my $k (keys %{$cond}) {
1627 my $v = $cond->{$k};
1628 # XXX should probably check these are valid columns
1629 $k =~ s/^foreign\.// ||
1630 $self->throw_exception("Invalid rel cond key ${k}");
1631 $v =~ s/^self\.// ||
1632 $self->throw_exception("Invalid rel cond val ${v}");
1633 if (ref $for) { # Object
1634 #warn "$self $k $for $v";
1635 unless ($for->has_column_loaded($v)) {
1636 if ($for->in_storage) {
1637 $self->throw_exception(sprintf
1638 "Unable to resolve relationship '%s' from object %s: column '%s' not "
1639 . 'loaded from storage (or not passed to new() prior to insert()). You '
1640 . 'probably need to call ->discard_changes to get the server-side defaults '
1641 . 'from the database.',
1647 return $UNRESOLVABLE_CONDITION;
1649 $ret{$k} = $for->get_column($v);
1650 #$ret{$k} = $for->get_column($v) if $for->has_column_loaded($v);
1652 } elsif (!defined $for) { # undef, i.e. "no object"
1654 } elsif (ref $as eq 'HASH') { # reverse hashref
1655 $ret{$v} = $as->{$k};
1656 } elsif (ref $as) { # reverse object
1657 $ret{$v} = $as->get_column($k);
1658 } elsif (!defined $as) { # undef, i.e. "no reverse object"
1661 $ret{"${as}.${k}"} = { -ident => "${for}.${v}" };
1666 ? ( \%ret, ($obj_rel || !defined $as || ref $as) ? 0 : 1 )
1670 elsif (ref $cond eq 'ARRAY') {
1671 my (@ret, $crosstable);
1673 my ($cond, $crosstab) = $self->_resolve_condition($_, $as, $for, $relname);
1675 $crosstable ||= $crosstab;
1677 return wantarray ? (\@ret, $crosstable) : \@ret;
1680 $self->throw_exception ("Can't handle condition $cond for relationship '$relname' yet :(");
1684 # Accepts one or more relationships for the current source and returns an
1685 # array of column names for each of those relationships. Column names are
1686 # prefixed relative to the current source, in accordance with where they appear
1687 # in the supplied relationships.
1689 sub _resolve_prefetch {
1690 my ($self, $pre, $alias, $alias_map, $order, $collapse, $pref_path) = @_;
1693 if (not defined $pre) {
1696 elsif( ref $pre eq 'ARRAY' ) {
1698 map { $self->_resolve_prefetch( $_, $alias, $alias_map, $order, $collapse, [ @$pref_path ] ) }
1701 elsif( ref $pre eq 'HASH' ) {
1704 $self->_resolve_prefetch($_, $alias, $alias_map, $order, $collapse, [ @$pref_path ] ),
1705 $self->related_source($_)->_resolve_prefetch(
1706 $pre->{$_}, "${alias}.$_", $alias_map, $order, $collapse, [ @$pref_path, $_] )
1711 $self->throw_exception(
1712 "don't know how to resolve prefetch reftype ".ref($pre));
1716 $p = $p->{$_} for (@$pref_path, $pre);
1718 $self->throw_exception (
1719 "Unable to resolve prefetch '$pre' - join alias map does not contain an entry for path: "
1720 . join (' -> ', @$pref_path, $pre)
1721 ) if (ref $p->{-join_aliases} ne 'ARRAY' or not @{$p->{-join_aliases}} );
1723 my $as = shift @{$p->{-join_aliases}};
1725 my $rel_info = $self->relationship_info( $pre );
1726 $self->throw_exception( $self->source_name . " has no such relationship '$pre'" )
1728 my $as_prefix = ($alias =~ /^.*?\.(.+)$/ ? $1.'.' : '');
1729 my $rel_source = $self->related_source($pre);
1731 if ($rel_info->{attrs}{accessor} && $rel_info->{attrs}{accessor} eq 'multi') {
1732 $self->throw_exception(
1733 "Can't prefetch has_many ${pre} (join cond too complex)")
1734 unless ref($rel_info->{cond}) eq 'HASH';
1735 my $dots = @{[$as_prefix =~ m/\./g]} + 1; # +1 to match the ".${as_prefix}"
1737 if (my ($fail) = grep { @{[$_ =~ m/\./g]} == $dots }
1738 keys %{$collapse}) {
1739 my ($last) = ($fail =~ /([^\.]+)$/);
1741 "Prefetching multiple has_many rels ${last} and ${pre} "
1742 .(length($as_prefix)
1743 ? "at the same level (${as_prefix}) "
1746 . 'will explode the number of row objects retrievable via ->next or ->all. '
1747 . 'Use at your own risk.'
1751 #my @col = map { (/^self\.(.+)$/ ? ("${as_prefix}.$1") : ()); }
1752 # values %{$rel_info->{cond}};
1753 $collapse->{".${as_prefix}${pre}"} = [ $rel_source->_pri_cols ];
1754 # action at a distance. prepending the '.' allows simpler code
1755 # in ResultSet->_collapse_result
1756 my @key = map { (/^foreign\.(.+)$/ ? ($1) : ()); }
1757 keys %{$rel_info->{cond}};
1758 push @$order, map { "${as}.$_" } @key;
1760 if (my $rel_order = $rel_info->{attrs}{order_by}) {
1761 # this is kludgy and incomplete, I am well aware
1762 # but the parent method is going away entirely anyway
1764 my $sql_maker = $self->storage->sql_maker;
1765 my ($orig_ql, $orig_qr) = $sql_maker->_quote_chars;
1766 my $sep = $sql_maker->name_sep;
1768 # install our own quoter, so we can catch unqualified stuff
1769 local $sql_maker->{quote_char} = ["\x00", "\xFF"];
1771 my $quoted_prefix = "\x00${as}\xFF";
1773 for my $chunk ( $sql_maker->_order_by_chunks ($rel_order) ) {
1775 ($chunk, @bind) = @$chunk if ref $chunk;
1777 $chunk = "${quoted_prefix}${sep}${chunk}"
1778 unless $chunk =~ /\Q$sep/;
1780 $chunk =~ s/\x00/$orig_ql/g;
1781 $chunk =~ s/\xFF/$orig_qr/g;
1782 push @$order, \[$chunk, @bind];
1787 return map { [ "${as}.$_", "${as_prefix}${pre}.$_", ] }
1788 $rel_source->columns;
1792 =head2 related_source
1796 =item Arguments: $relname
1798 =item Return value: $source
1802 Returns the result source object for the given relationship.
1806 sub related_source {
1807 my ($self, $rel) = @_;
1808 if( !$self->has_relationship( $rel ) ) {
1809 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
1812 # if we are not registered with a schema - just use the prototype
1813 # however if we do have a schema - ask for the source by name (and
1814 # throw in the process if all fails)
1815 if (my $schema = try { $self->schema }) {
1816 $schema->source($self->relationship_info($rel)->{source});
1819 my $class = $self->relationship_info($rel)->{class};
1820 $self->ensure_class_loaded($class);
1821 $class->result_source_instance;
1825 =head2 related_class
1829 =item Arguments: $relname
1831 =item Return value: $classname
1835 Returns the class name for objects in the given relationship.
1840 my ($self, $rel) = @_;
1841 if( !$self->has_relationship( $rel ) ) {
1842 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
1844 return $self->schema->class($self->relationship_info($rel)->{source});
1851 =item Arguments: None
1853 =item Return value: $source_handle
1857 Obtain a new L<result source handle instance|DBIx::Class::ResultSourceHandle>
1858 for this source. Used as a serializable pointer to this resultsource, as it is not
1859 easy (nor advisable) to serialize CODErefs which may very well be present in e.g.
1860 relationship definitions.
1865 return DBIx::Class::ResultSourceHandle->new({
1866 source_moniker => $_[0]->source_name,
1868 # so that a detached thaw can be re-frozen
1869 $_[0]->{_detached_thaw}
1870 ? ( _detached_source => $_[0] )
1871 : ( schema => $_[0]->schema )
1877 my $global_phase_destroy;
1879 # SpeedyCGI runs END blocks every cycle but keeps object instances
1880 # hence we have to disable the globaldestroy hatch, and rely on the
1881 # eval trap below (which appears to work, but is risky done so late)
1882 END { $global_phase_destroy = 1 unless $CGI::SpeedyCGI::i_am_speedy }
1885 return if $global_phase_destroy;
1891 # Under no circumstances shall $_[0] be stored anywhere else (like copied to
1892 # a lexical variable, or shifted, or anything else). Doing so will mess up
1893 # the refcount of this particular result source, and will allow the $schema
1894 # we are trying to save to reattach back to the source we are destroying.
1895 # The relevant code checking refcounts is in ::Schema::DESTROY()
1897 # if we are not a schema instance holder - we don't matter
1899 ! ref $_[0]->{schema}
1901 isweak $_[0]->{schema}
1904 # weaken our schema hold forcing the schema to find somewhere else to live
1905 # during global destruction (if we have not yet bailed out) this will throw
1906 # which will serve as a signal to not try doing anything else
1909 weaken $_[0]->{schema};
1912 $global_phase_destroy = 1;
1917 # if schema is still there reintroduce ourselves with strong refs back to us
1918 if ($_[0]->{schema}) {
1919 my $srcregs = $_[0]->{schema}->source_registrations;
1920 for (keys %$srcregs) {
1921 next unless $srcregs->{$_};
1922 $srcregs->{$_} = $_[0] if $srcregs->{$_} == $_[0];
1928 sub STORABLE_freeze { Storable::nfreeze($_[0]->handle) }
1931 my ($self, $cloning, $ice) = @_;
1932 %$self = %{ (Storable::thaw($ice))->resolve };
1935 =head2 throw_exception
1937 See L<DBIx::Class::Schema/"throw_exception">.
1941 sub throw_exception {
1945 ? $self->{schema}->throw_exception(@_)
1946 : DBIx::Class::Exception->throw(@_)
1952 Stores a hashref of per-source metadata. No specific key names
1953 have yet been standardized, the examples below are purely hypothetical
1954 and don't actually accomplish anything on their own:
1956 __PACKAGE__->source_info({
1957 "_tablespace" => 'fast_disk_array_3',
1958 "_engine" => 'InnoDB',
1965 $class->new({attribute_name => value});
1967 Creates a new ResultSource object. Not normally called directly by end users.
1969 =head2 column_info_from_storage
1973 =item Arguments: 1/0 (default: 0)
1975 =item Return value: 1/0
1979 __PACKAGE__->column_info_from_storage(1);
1981 Enables the on-demand automatic loading of the above column
1982 metadata from storage as necessary. This is *deprecated*, and
1983 should not be used. It will be removed before 1.0.
1988 Matt S. Trout <mst@shadowcatsystems.co.uk>
1992 You may distribute this code under the same terms as Perl itself.