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::Carp;
12 use Devel::GlobalDestruction;
14 use List::Util 'first';
15 use Scalar::Util qw/blessed weaken isweak/;
19 __PACKAGE__->mk_group_accessors(simple => qw/
20 source_name name source_info
21 _ordered_columns _columns _primaries _unique_constraints
22 _relationships resultset_attributes
23 column_info_from_storage
26 __PACKAGE__->mk_group_accessors(component_class => qw/
31 __PACKAGE__->mk_classdata( sqlt_deploy_callback => 'default_sqlt_deploy_hook' );
35 DBIx::Class::ResultSource - Result source object
39 # Create a table based result source, in a result class.
41 package MyApp::Schema::Result::Artist;
42 use base qw/DBIx::Class::Core/;
44 __PACKAGE__->table('artist');
45 __PACKAGE__->add_columns(qw/ artistid name /);
46 __PACKAGE__->set_primary_key('artistid');
47 __PACKAGE__->has_many(cds => 'MyApp::Schema::Result::CD');
51 # Create a query (view) based result source, in a result class
52 package MyApp::Schema::Result::Year2000CDs;
53 use base qw/DBIx::Class::Core/;
55 __PACKAGE__->load_components('InflateColumn::DateTime');
56 __PACKAGE__->table_class('DBIx::Class::ResultSource::View');
58 __PACKAGE__->table('year2000cds');
59 __PACKAGE__->result_source_instance->is_virtual(1);
60 __PACKAGE__->result_source_instance->view_definition(
61 "SELECT cdid, artist, title FROM cd WHERE year ='2000'"
67 A ResultSource is an object that represents a source of data for querying.
69 This class is a base class for various specialised types of result
70 sources, for example L<DBIx::Class::ResultSource::Table>. Table is the
71 default result source type, so one is created for you when defining a
72 result class as described in the synopsis above.
74 More specifically, the L<DBIx::Class::Core> base class pulls in the
75 L<DBIx::Class::ResultSourceProxy::Table> component, which defines
76 the L<table|DBIx::Class::ResultSourceProxy::Table/table> method.
77 When called, C<table> creates and stores an instance of
78 L<DBIx::Class::ResultSoure::Table>. Luckily, to use tables as result
79 sources, you don't need to remember any of this.
81 Result sources representing select queries, or views, can also be
82 created, see L<DBIx::Class::ResultSource::View> for full details.
84 =head2 Finding result source objects
86 As mentioned above, a result source instance is created and stored for
87 you when you define a L<Result Class|DBIx::Class::Manual::Glossary/Result Class>.
89 You can retrieve the result source at runtime in the following ways:
93 =item From a Schema object:
95 $schema->source($source_name);
97 =item From a Result object:
101 =item From a ResultSet object:
114 my ($class, $attrs) = @_;
115 $class = ref $class if ref $class;
117 my $new = bless { %{$attrs || {}} }, $class;
118 $new->{resultset_class} ||= 'DBIx::Class::ResultSet';
119 $new->{resultset_attributes} = { %{$new->{resultset_attributes} || {}} };
120 $new->{_ordered_columns} = [ @{$new->{_ordered_columns}||[]}];
121 $new->{_columns} = { %{$new->{_columns}||{}} };
122 $new->{_relationships} = { %{$new->{_relationships}||{}} };
123 $new->{name} ||= "!!NAME NOT SET!!";
124 $new->{_columns_info_loaded} ||= 0;
134 =item Arguments: @columns
136 =item Return Value: L<$result_source|/new>
140 $source->add_columns(qw/col1 col2 col3/);
142 $source->add_columns('col1' => \%col1_info, 'col2' => \%col2_info, ...);
144 Adds columns to the result source. If supplied colname => hashref
145 pairs, uses the hashref as the L</column_info> for that column. Repeated
146 calls of this method will add more columns, not replace them.
148 The column names given will be created as accessor methods on your
149 L<Result|DBIx::Class::Manual::ResultClass> objects. You can change the name of the accessor
150 by supplying an L</accessor> in the column_info hash.
152 If a column name beginning with a plus sign ('+col1') is provided, the
153 attributes provided will be merged with any existing attributes for the
154 column, with the new attributes taking precedence in the case that an
155 attribute already exists. Using this without a hashref
156 (C<< $source->add_columns(qw/+col1 +col2/) >>) is legal, but useless --
157 it does the same thing it would do without the plus.
159 The contents of the column_info are not set in stone. The following
160 keys are currently recognised/used by DBIx::Class:
166 { accessor => '_name' }
168 # example use, replace standard accessor with one of your own:
170 my ($self, $value) = @_;
172 die "Name cannot contain digits!" if($value =~ /\d/);
173 $self->_name($value);
175 return $self->_name();
178 Use this to set the name of the accessor method for this column. If unset,
179 the name of the column will be used.
183 { data_type => 'integer' }
185 This contains the column type. It is automatically filled if you use the
186 L<SQL::Translator::Producer::DBIx::Class::File> producer, or the
187 L<DBIx::Class::Schema::Loader> module.
189 Currently there is no standard set of values for the data_type. Use
190 whatever your database supports.
196 The length of your column, if it is a column type that can have a size
197 restriction. This is currently only used to create tables from your
198 schema, see L<DBIx::Class::Schema/deploy>.
204 Set this to a true value for a columns that is allowed to contain NULL
205 values, default is false. This is currently only used to create tables
206 from your schema, see L<DBIx::Class::Schema/deploy>.
208 =item is_auto_increment
210 { is_auto_increment => 1 }
212 Set this to a true value for a column whose value is somehow
213 automatically set, defaults to false. This is used to determine which
214 columns to empty when cloning objects using
215 L<DBIx::Class::Row/copy>. It is also used by
216 L<DBIx::Class::Schema/deploy>.
222 Set this to a true or false value (not C<undef>) to explicitly specify
223 if this column contains numeric data. This controls how set_column
224 decides whether to consider a column dirty after an update: if
225 C<is_numeric> is true a numeric comparison C<< != >> will take place
226 instead of the usual C<eq>
228 If not specified the storage class will attempt to figure this out on
229 first access to the column, based on the column C<data_type>. The
230 result will be cached in this attribute.
234 { is_foreign_key => 1 }
236 Set this to a true value for a column that contains a key from a
237 foreign table, defaults to false. This is currently only used to
238 create tables from your schema, see L<DBIx::Class::Schema/deploy>.
242 { default_value => \'now()' }
244 Set this to the default value which will be inserted into a column by
245 the database. Can contain either a value or a function (use a
246 reference to a scalar e.g. C<\'now()'> if you want a function). This
247 is currently only used to create tables from your schema, see
248 L<DBIx::Class::Schema/deploy>.
250 See the note on L<DBIx::Class::Row/new> for more information about possible
251 issues related to db-side default values.
255 { sequence => 'my_table_seq' }
257 Set this on a primary key column to the name of the sequence used to
258 generate a new key value. If not specified, L<DBIx::Class::PK::Auto>
259 will attempt to retrieve the name of the sequence from the database
262 =item retrieve_on_insert
264 { retrieve_on_insert => 1 }
266 For every column where this is set to true, DBIC will retrieve the RDBMS-side
267 value upon a new row insertion (normally only the autoincrement PK is
268 retrieved on insert). C<INSERT ... RETURNING> is used automatically if
269 supported by the underlying storage, otherwise an extra SELECT statement is
270 executed to retrieve the missing data.
274 { auto_nextval => 1 }
276 Set this to a true value for a column whose value is retrieved automatically
277 from a sequence or function (if supported by your Storage driver.) For a
278 sequence, if you do not use a trigger to get the nextval, you have to set the
279 L</sequence> value as well.
281 Also set this for MSSQL columns with the 'uniqueidentifier'
282 L<data_type|DBIx::Class::ResultSource/data_type> whose values you want to
283 automatically generate using C<NEWID()>, unless they are a primary key in which
284 case this will be done anyway.
288 This is used by L<DBIx::Class::Schema/deploy> and L<SQL::Translator>
289 to add extra non-generic data to the column. For example: C<< extra
290 => { unsigned => 1} >> is used by the MySQL producer to set an integer
291 column to unsigned. For more details, see
292 L<SQL::Translator::Producer::MySQL>.
300 =item Arguments: $colname, \%columninfo?
302 =item Return Value: 1/0 (true/false)
306 $source->add_column('col' => \%info);
308 Add a single column and optional column info. Uses the same column
309 info keys as L</add_columns>.
314 my ($self, @cols) = @_;
315 $self->_ordered_columns(\@cols) unless $self->_ordered_columns;
318 my $columns = $self->_columns;
319 while (my $col = shift @cols) {
320 my $column_info = {};
321 if ($col =~ s/^\+//) {
322 $column_info = $self->column_info($col);
325 # If next entry is { ... } use that for the column info, if not
326 # use an empty hashref
328 my $new_info = shift(@cols);
329 %$column_info = (%$column_info, %$new_info);
331 push(@added, $col) unless exists $columns->{$col};
332 $columns->{$col} = $column_info;
334 push @{ $self->_ordered_columns }, @added;
338 sub add_column { shift->add_columns(@_); } # DO NOT CHANGE THIS TO GLOB
344 =item Arguments: $colname
346 =item Return Value: 1/0 (true/false)
350 if ($source->has_column($colname)) { ... }
352 Returns true if the source has a column of this name, false otherwise.
357 my ($self, $column) = @_;
358 return exists $self->_columns->{$column};
365 =item Arguments: $colname
367 =item Return Value: Hashref of info
371 my $info = $source->column_info($col);
373 Returns the column metadata hashref for a column, as originally passed
374 to L</add_columns>. See L</add_columns> above for information on the
375 contents of the hashref.
380 my ($self, $column) = @_;
381 $self->throw_exception("No such column $column")
382 unless exists $self->_columns->{$column};
384 if ( ! $self->_columns->{$column}{data_type}
385 and ! $self->{_columns_info_loaded}
386 and $self->column_info_from_storage
387 and my $stor = try { $self->storage } )
389 $self->{_columns_info_loaded}++;
391 # try for the case of storage without table
393 my $info = $stor->columns_info_for( $self->from );
395 { (lc $_) => $info->{$_} }
399 foreach my $col ( keys %{$self->_columns} ) {
400 $self->_columns->{$col} = {
401 %{ $self->_columns->{$col} },
402 %{ $info->{$col} || $lc_info->{lc $col} || {} }
408 return $self->_columns->{$column};
415 =item Arguments: none
417 =item Return Value: Ordered list of column names
421 my @column_names = $source->columns;
423 Returns all column names in the order they were declared to L</add_columns>.
429 $self->throw_exception(
430 "columns() is a read-only accessor, did you mean add_columns()?"
432 return @{$self->{_ordered_columns}||[]};
439 =item Arguments: \@colnames ?
441 =item Return Value: Hashref of column name/info pairs
445 my $columns_info = $source->columns_info;
447 Like L</column_info> but returns information for the requested columns. If
448 the optional column-list arrayref is omitted it returns info on all columns
449 currently defined on the ResultSource via L</add_columns>.
454 my ($self, $columns) = @_;
456 my $colinfo = $self->_columns;
459 first { ! $_->{data_type} } values %$colinfo
461 ! $self->{_columns_info_loaded}
463 $self->column_info_from_storage
465 my $stor = try { $self->storage }
467 $self->{_columns_info_loaded}++;
469 # try for the case of storage without table
471 my $info = $stor->columns_info_for( $self->from );
473 { (lc $_) => $info->{$_} }
477 foreach my $col ( keys %$colinfo ) {
479 %{ $colinfo->{$col} },
480 %{ $info->{$col} || $lc_info->{lc $col} || {} }
490 if (my $inf = $colinfo->{$_}) {
494 $self->throw_exception( sprintf (
495 "No such column '%s' on source '%s'",
497 $self->source_name || $self->name || 'Unknown source...?',
509 =head2 remove_columns
513 =item Arguments: @colnames
515 =item Return Value: not defined
519 $source->remove_columns(qw/col1 col2 col3/);
521 Removes the given list of columns by name, from the result source.
523 B<Warning>: Removing a column that is also used in the sources primary
524 key, or in one of the sources unique constraints, B<will> result in a
525 broken result source.
531 =item Arguments: $colname
533 =item Return Value: not defined
537 $source->remove_column('col');
539 Remove a single column by name from the result source, similar to
542 B<Warning>: Removing a column that is also used in the sources primary
543 key, or in one of the sources unique constraints, B<will> result in a
544 broken result source.
549 my ($self, @to_remove) = @_;
551 my $columns = $self->_columns
556 delete $columns->{$_};
560 $self->_ordered_columns([ grep { not $to_remove{$_} } @{$self->_ordered_columns} ]);
563 sub remove_column { shift->remove_columns(@_); } # DO NOT CHANGE THIS TO GLOB
565 =head2 set_primary_key
569 =item Arguments: @cols
571 =item Return Value: not defined
575 Defines one or more columns as primary key for this source. Must be
576 called after L</add_columns>.
578 Additionally, defines a L<unique constraint|add_unique_constraint>
581 Note: you normally do want to define a primary key on your sources
582 B<even if the underlying database table does not have a primary key>.
584 L<DBIx::Class::Manual::Intro/The Significance and Importance of Primary Keys>
589 sub set_primary_key {
590 my ($self, @cols) = @_;
592 my $colinfo = $self->columns_info(\@cols);
593 for my $col (@cols) {
594 carp_unique(sprintf (
595 "Primary key of source '%s' includes the column '%s' which has its "
596 . "'is_nullable' attribute set to true. This is a mistake and will cause "
597 . 'various Result-object operations to fail',
598 $self->source_name || $self->name || 'Unknown source...?',
600 )) if $colinfo->{$col}{is_nullable};
603 $self->_primaries(\@cols);
605 $self->add_unique_constraint(primary => \@cols);
608 =head2 primary_columns
612 =item Arguments: none
614 =item Return Value: Ordered list of primary column names
618 Read-only accessor which returns the list of primary keys, supplied by
623 sub primary_columns {
624 return @{shift->_primaries||[]};
627 # a helper method that will automatically die with a descriptive message if
628 # no pk is defined on the source in question. For internal use to save
629 # on if @pks... boilerplate
632 my @pcols = $self->primary_columns
633 or $self->throw_exception (sprintf(
634 "Operation requires a primary key to be declared on '%s' via set_primary_key",
635 # source_name is set only after schema-registration
636 $self->source_name || $self->result_class || $self->name || 'Unknown source...?',
643 Manually define the correct sequence for your table, to avoid the overhead
644 associated with looking up the sequence automatically. The supplied sequence
645 will be applied to the L</column_info> of each L<primary_key|/set_primary_key>
649 =item Arguments: $sequence_name
651 =item Return Value: not defined
658 my ($self,$seq) = @_;
660 my @pks = $self->primary_columns
663 $_->{sequence} = $seq
664 for values %{ $self->columns_info (\@pks) };
668 =head2 add_unique_constraint
672 =item Arguments: $name?, \@colnames
674 =item Return Value: not defined
678 Declare a unique constraint on this source. Call once for each unique
681 # For UNIQUE (column1, column2)
682 __PACKAGE__->add_unique_constraint(
683 constraint_name => [ qw/column1 column2/ ],
686 Alternatively, you can specify only the columns:
688 __PACKAGE__->add_unique_constraint([ qw/column1 column2/ ]);
690 This will result in a unique constraint named
691 C<table_column1_column2>, where C<table> is replaced with the table
694 Unique constraints are used, for example, when you pass the constraint
695 name as the C<key> attribute to L<DBIx::Class::ResultSet/find>. Then
696 only columns in the constraint are searched.
698 Throws an error if any of the given column names do not yet exist on
703 sub add_unique_constraint {
707 $self->throw_exception(
708 'add_unique_constraint() does not accept multiple constraints, use '
709 . 'add_unique_constraints() instead'
714 if (ref $cols ne 'ARRAY') {
715 $self->throw_exception (
716 'Expecting an arrayref of constraint columns, got ' . ($cols||'NOTHING')
722 $name ||= $self->name_unique_constraint($cols);
724 foreach my $col (@$cols) {
725 $self->throw_exception("No such column $col on table " . $self->name)
726 unless $self->has_column($col);
729 my %unique_constraints = $self->unique_constraints;
730 $unique_constraints{$name} = $cols;
731 $self->_unique_constraints(\%unique_constraints);
734 =head2 add_unique_constraints
738 =item Arguments: @constraints
740 =item Return Value: not defined
744 Declare multiple unique constraints on this source.
746 __PACKAGE__->add_unique_constraints(
747 constraint_name1 => [ qw/column1 column2/ ],
748 constraint_name2 => [ qw/column2 column3/ ],
751 Alternatively, you can specify only the columns:
753 __PACKAGE__->add_unique_constraints(
754 [ qw/column1 column2/ ],
755 [ qw/column3 column4/ ]
758 This will result in unique constraints named C<table_column1_column2> and
759 C<table_column3_column4>, where C<table> is replaced with the table name.
761 Throws an error if any of the given column names do not yet exist on
764 See also L</add_unique_constraint>.
768 sub add_unique_constraints {
770 my @constraints = @_;
772 if ( !(@constraints % 2) && first { ref $_ ne 'ARRAY' } @constraints ) {
773 # with constraint name
774 while (my ($name, $constraint) = splice @constraints, 0, 2) {
775 $self->add_unique_constraint($name => $constraint);
780 foreach my $constraint (@constraints) {
781 $self->add_unique_constraint($constraint);
786 =head2 name_unique_constraint
790 =item Arguments: \@colnames
792 =item Return Value: Constraint name
796 $source->table('mytable');
797 $source->name_unique_constraint(['col1', 'col2']);
801 Return a name for a unique constraint containing the specified
802 columns. The name is created by joining the table name and each column
803 name, using an underscore character.
805 For example, a constraint on a table named C<cd> containing the columns
806 C<artist> and C<title> would result in a constraint name of C<cd_artist_title>.
808 This is used by L</add_unique_constraint> if you do not specify the
809 optional constraint name.
813 sub name_unique_constraint {
814 my ($self, $cols) = @_;
816 my $name = $self->name;
817 $name = $$name if (ref $name eq 'SCALAR');
819 return join '_', $name, @$cols;
822 =head2 unique_constraints
826 =item Arguments: none
828 =item Return Value: Hash of unique constraint data
832 $source->unique_constraints();
834 Read-only accessor which returns a hash of unique constraints on this
837 The hash is keyed by constraint name, and contains an arrayref of
838 column names as values.
842 sub unique_constraints {
843 return %{shift->_unique_constraints||{}};
846 =head2 unique_constraint_names
850 =item Arguments: none
852 =item Return Value: Unique constraint names
856 $source->unique_constraint_names();
858 Returns the list of unique constraint names defined on this source.
862 sub unique_constraint_names {
865 my %unique_constraints = $self->unique_constraints;
867 return keys %unique_constraints;
870 =head2 unique_constraint_columns
874 =item Arguments: $constraintname
876 =item Return Value: List of constraint columns
880 $source->unique_constraint_columns('myconstraint');
882 Returns the list of columns that make up the specified unique constraint.
886 sub unique_constraint_columns {
887 my ($self, $constraint_name) = @_;
889 my %unique_constraints = $self->unique_constraints;
891 $self->throw_exception(
892 "Unknown unique constraint $constraint_name on '" . $self->name . "'"
893 ) unless exists $unique_constraints{$constraint_name};
895 return @{ $unique_constraints{$constraint_name} };
898 =head2 sqlt_deploy_callback
902 =item Arguments: $callback_name | \&callback_code
904 =item Return Value: $callback_name | \&callback_code
908 __PACKAGE__->sqlt_deploy_callback('mycallbackmethod');
912 __PACKAGE__->sqlt_deploy_callback(sub {
913 my ($source_instance, $sqlt_table) = @_;
917 An accessor to set a callback to be called during deployment of
918 the schema via L<DBIx::Class::Schema/create_ddl_dir> or
919 L<DBIx::Class::Schema/deploy>.
921 The callback can be set as either a code reference or the name of a
922 method in the current result class.
924 Defaults to L</default_sqlt_deploy_hook>.
926 Your callback will be passed the $source object representing the
927 ResultSource instance being deployed, and the
928 L<SQL::Translator::Schema::Table> object being created from it. The
929 callback can be used to manipulate the table object or add your own
930 customised indexes. If you need to manipulate a non-table object, use
931 the L<DBIx::Class::Schema/sqlt_deploy_hook>.
933 See L<DBIx::Class::Manual::Cookbook/Adding Indexes And Functions To
934 Your SQL> for examples.
936 This sqlt deployment callback can only be used to manipulate
937 SQL::Translator objects as they get turned into SQL. To execute
938 post-deploy statements which SQL::Translator does not currently
939 handle, override L<DBIx::Class::Schema/deploy> in your Schema class
940 and call L<dbh_do|DBIx::Class::Storage::DBI/dbh_do>.
942 =head2 default_sqlt_deploy_hook
944 This is the default deploy hook implementation which checks if your
945 current Result class has a C<sqlt_deploy_hook> method, and if present
946 invokes it B<on the Result class directly>. This is to preserve the
947 semantics of C<sqlt_deploy_hook> which was originally designed to expect
948 the Result class name and the
949 L<$sqlt_table instance|SQL::Translator::Schema::Table> of the table being
954 sub default_sqlt_deploy_hook {
957 my $class = $self->result_class;
959 if ($class and $class->can('sqlt_deploy_hook')) {
960 $class->sqlt_deploy_hook(@_);
964 sub _invoke_sqlt_deploy_hook {
966 if ( my $hook = $self->sqlt_deploy_callback) {
975 =item Arguments: $classname
977 =item Return Value: $classname
981 use My::Schema::ResultClass::Inflator;
984 use My::Schema::Artist;
986 __PACKAGE__->result_class('My::Schema::ResultClass::Inflator');
988 Set the default result class for this source. You can use this to create
989 and use your own result inflator. See L<DBIx::Class::ResultSet/result_class>
992 Please note that setting this to something like
993 L<DBIx::Class::ResultClass::HashRefInflator> will make every result unblessed
994 and make life more difficult. Inflators like those are better suited to
995 temporary usage via L<DBIx::Class::ResultSet/result_class>.
1001 =item Arguments: none
1003 =item Return Value: L<$resultset|DBIx::Class::ResultSet>
1007 Returns a resultset for the given source. This will initially be created
1008 on demand by calling
1010 $self->resultset_class->new($self, $self->resultset_attributes)
1012 but is cached from then on unless resultset_class changes.
1014 =head2 resultset_class
1018 =item Arguments: $classname
1020 =item Return Value: $classname
1024 package My::Schema::ResultSet::Artist;
1025 use base 'DBIx::Class::ResultSet';
1028 # In the result class
1029 __PACKAGE__->resultset_class('My::Schema::ResultSet::Artist');
1032 $source->resultset_class('My::Schema::ResultSet::Artist');
1034 Set the class of the resultset. This is useful if you want to create your
1035 own resultset methods. Create your own class derived from
1036 L<DBIx::Class::ResultSet>, and set it here. If called with no arguments,
1037 this method returns the name of the existing resultset class, if one
1040 =head2 resultset_attributes
1044 =item Arguments: L<\%attrs|DBIx::Class::ResultSet/ATTRIBUTES>
1046 =item Return Value: L<\%attrs|DBIx::Class::ResultSet/ATTRIBUTES>
1050 # In the result class
1051 __PACKAGE__->resultset_attributes({ order_by => [ 'id' ] });
1054 $source->resultset_attributes({ order_by => [ 'id' ] });
1056 Store a collection of resultset attributes, that will be set on every
1057 L<DBIx::Class::ResultSet> produced from this result source.
1059 B<CAVEAT>: C<resultset_attributes> comes with its own set of issues and
1060 bugs! While C<resultset_attributes> isn't deprecated per se, its usage is
1063 Since relationships use attributes to link tables together, the "default"
1064 attributes you set may cause unpredictable and undesired behavior. Furthermore,
1065 the defaults cannot be turned off, so you are stuck with them.
1067 In most cases, what you should actually be using are project-specific methods:
1069 package My::Schema::ResultSet::Artist;
1070 use base 'DBIx::Class::ResultSet';
1074 #__PACKAGE__->resultset_attributes({ prefetch => 'tracks' });
1077 sub with_tracks { shift->search({}, { prefetch => 'tracks' }) }
1080 $schema->resultset('Artist')->with_tracks->...
1082 This gives you the flexibility of not using it when you don't need it.
1084 For more complex situations, another solution would be to use a virtual view
1085 via L<DBIx::Class::ResultSource::View>.
1091 $self->throw_exception(
1092 'resultset does not take any arguments. If you want another resultset, '.
1093 'call it on the schema instead.'
1096 $self->resultset_class->new(
1099 try { %{$self->schema->default_resultset_attributes} },
1100 %{$self->{resultset_attributes}},
1109 =item Arguments: none
1111 =item Result value: $name
1115 Returns the name of the result source, which will typically be the table
1116 name. This may be a scalar reference if the result source has a non-standard
1123 =item Arguments: $source_name
1125 =item Result value: $source_name
1129 Set an alternate name for the result source when it is loaded into a schema.
1130 This is useful if you want to refer to a result source by a name other than
1133 package ArchivedBooks;
1134 use base qw/DBIx::Class/;
1135 __PACKAGE__->table('books_archive');
1136 __PACKAGE__->source_name('Books');
1138 # from your schema...
1139 $schema->resultset('Books')->find(1);
1145 =item Arguments: none
1147 =item Return Value: FROM clause
1151 my $from_clause = $source->from();
1153 Returns an expression of the source to be supplied to storage to specify
1154 retrieval from this source. In the case of a database, the required FROM
1159 sub from { die 'Virtual method!' }
1165 =item Arguments: L<$schema?|DBIx::Class::Schema>
1167 =item Return Value: L<$schema|DBIx::Class::Schema>
1171 my $schema = $source->schema();
1173 Sets and/or returns the L<DBIx::Class::Schema> object to which this
1174 result source instance has been attached to.
1180 $_[0]->{schema} = $_[1];
1183 $_[0]->{schema} || do {
1184 my $name = $_[0]->{source_name} || '_unnamed_';
1185 my $err = 'Unable to perform storage-dependent operations with a detached result source '
1186 . "(source '$name' is not associated with a schema).";
1188 $err .= ' You need to use $schema->thaw() or manually set'
1189 . ' $DBIx::Class::ResultSourceHandle::thaw_schema while thawing.'
1190 if $_[0]->{_detached_thaw};
1192 DBIx::Class::Exception->throw($err);
1201 =item Arguments: none
1203 =item Return Value: L<$storage|DBIx::Class::Storage>
1207 $source->storage->debug(1);
1209 Returns the L<storage handle|DBIx::Class::Storage> for the current schema.
1213 sub storage { shift->schema->storage; }
1215 =head2 add_relationship
1219 =item Arguments: $rel_name, $related_source_name, \%cond, \%attrs?
1221 =item Return Value: 1/true if it succeeded
1225 $source->add_relationship('rel_name', 'related_source', $cond, $attrs);
1227 L<DBIx::Class::Relationship> describes a series of methods which
1228 create pre-defined useful types of relationships. Look there first
1229 before using this method directly.
1231 The relationship name can be arbitrary, but must be unique for each
1232 relationship attached to this result source. 'related_source' should
1233 be the name with which the related result source was registered with
1234 the current schema. For example:
1236 $schema->source('Book')->add_relationship('reviews', 'Review', {
1237 'foreign.book_id' => 'self.id',
1240 The condition C<$cond> needs to be an L<SQL::Abstract>-style
1241 representation of the join between the tables. For example, if you're
1242 creating a relation from Author to Book,
1244 { 'foreign.author_id' => 'self.id' }
1246 will result in the JOIN clause
1248 author me JOIN book foreign ON foreign.author_id = me.id
1250 You can specify as many foreign => self mappings as necessary.
1252 Valid attributes are as follows:
1258 Explicitly specifies the type of join to use in the relationship. Any
1259 SQL join type is valid, e.g. C<LEFT> or C<RIGHT>. It will be placed in
1260 the SQL command immediately before C<JOIN>.
1264 An arrayref containing a list of accessors in the foreign class to proxy in
1265 the main class. If, for example, you do the following:
1267 CD->might_have(liner_notes => 'LinerNotes', undef, {
1268 proxy => [ qw/notes/ ],
1271 Then, assuming LinerNotes has an accessor named notes, you can do:
1273 my $cd = CD->find(1);
1274 # set notes -- LinerNotes object is created if it doesn't exist
1275 $cd->notes('Notes go here');
1279 Specifies the type of accessor that should be created for the
1280 relationship. Valid values are C<single> (for when there is only a single
1281 related object), C<multi> (when there can be many), and C<filter> (for
1282 when there is a single related object, but you also want the relationship
1283 accessor to double as a column accessor). For C<multi> accessors, an
1284 add_to_* method is also created, which calls C<create_related> for the
1289 Throws an exception if the condition is improperly supplied, or cannot
1294 sub add_relationship {
1295 my ($self, $rel, $f_source_name, $cond, $attrs) = @_;
1296 $self->throw_exception("Can't create relationship without join condition")
1300 # Check foreign and self are right in cond
1301 if ( (ref $cond ||'') eq 'HASH') {
1303 $self->throw_exception("Keys of condition should be of form 'foreign.col', not '$_'")
1304 if /\./ && !/^foreign\./;
1308 my %rels = %{ $self->_relationships };
1309 $rels{$rel} = { class => $f_source_name,
1310 source => $f_source_name,
1313 $self->_relationships(\%rels);
1317 # XXX disabled. doesn't work properly currently. skip in tests.
1319 my $f_source = $self->schema->source($f_source_name);
1320 unless ($f_source) {
1321 $self->ensure_class_loaded($f_source_name);
1322 $f_source = $f_source_name->result_source;
1323 #my $s_class = ref($self->schema);
1324 #$f_source_name =~ m/^${s_class}::(.*)$/;
1325 #$self->schema->register_class(($1 || $f_source_name), $f_source_name);
1326 #$f_source = $self->schema->source($f_source_name);
1328 return unless $f_source; # Can't test rel without f_source
1330 try { $self->_resolve_join($rel, 'me', {}, []) }
1332 # If the resolve failed, back out and re-throw the error
1334 $self->_relationships(\%rels);
1335 $self->throw_exception("Error creating relationship $rel: $_");
1341 =head2 relationships
1345 =item Arguments: none
1347 =item Return Value: L<@rel_names|DBIx::Class::Relationship>
1351 my @relnames = $source->relationships();
1353 Returns all relationship names for this source.
1358 return keys %{shift->_relationships};
1361 =head2 relationship_info
1365 =item Arguments: L<$rel_name|DBIx::Class::Relationship>
1367 =item Return Value: L<\%rel_data|DBIx::Class::Relationship::Base/add_relationship>
1371 Returns a hash of relationship information for the specified relationship
1372 name. The keys/values are as specified for L<DBIx::Class::Relationship::Base/add_relationship>.
1376 sub relationship_info {
1377 #my ($self, $rel) = @_;
1378 return shift->_relationships->{+shift};
1381 =head2 has_relationship
1385 =item Arguments: L<$rel_name|DBIx::Class::Relationship>
1387 =item Return Value: 1/0 (true/false)
1391 Returns true if the source has a relationship of this name, false otherwise.
1395 sub has_relationship {
1396 #my ($self, $rel) = @_;
1397 return exists shift->_relationships->{+shift};
1400 =head2 reverse_relationship_info
1404 =item Arguments: L<$rel_name|DBIx::Class::Relationship>
1406 =item Return Value: L<\%rel_data|DBIx::Class::Relationship::Base/add_relationship>
1410 Looks through all the relationships on the source this relationship
1411 points to, looking for one whose condition is the reverse of the
1412 condition on this relationship.
1414 A common use of this is to find the name of the C<belongs_to> relation
1415 opposing a C<has_many> relation. For definition of these look in
1416 L<DBIx::Class::Relationship>.
1418 The returned hashref is keyed by the name of the opposing
1419 relationship, and contains its data in the same manner as
1420 L</relationship_info>.
1424 sub reverse_relationship_info {
1425 my ($self, $rel) = @_;
1427 my $rel_info = $self->relationship_info($rel)
1428 or $self->throw_exception("No such relationship '$rel'");
1432 return $ret unless ((ref $rel_info->{cond}) eq 'HASH');
1434 my $stripped_cond = $self->__strip_relcond ($rel_info->{cond});
1436 my $registered_source_name = $self->source_name;
1438 # this may be a partial schema or something else equally esoteric
1439 my $other_rsrc = $self->related_source($rel);
1441 # Get all the relationships for that source that related to this source
1442 # whose foreign column set are our self columns on $rel and whose self
1443 # columns are our foreign columns on $rel
1444 foreach my $other_rel ($other_rsrc->relationships) {
1446 # only consider stuff that points back to us
1447 # "us" here is tricky - if we are in a schema registration, we want
1448 # to use the source_names, otherwise we will use the actual classes
1450 # the schema may be partial
1451 my $roundtrip_rsrc = try { $other_rsrc->related_source($other_rel) }
1454 if ($registered_source_name) {
1455 next if $registered_source_name ne ($roundtrip_rsrc->source_name || '')
1458 next if $self->result_class ne $roundtrip_rsrc->result_class;
1461 my $other_rel_info = $other_rsrc->relationship_info($other_rel);
1463 # this can happen when we have a self-referential class
1464 next if $other_rel_info eq $rel_info;
1466 next unless ref $other_rel_info->{cond} eq 'HASH';
1467 my $other_stripped_cond = $self->__strip_relcond($other_rel_info->{cond});
1469 $ret->{$other_rel} = $other_rel_info if (
1470 $self->_compare_relationship_keys (
1471 [ keys %$stripped_cond ], [ values %$other_stripped_cond ]
1474 $self->_compare_relationship_keys (
1475 [ values %$stripped_cond ], [ keys %$other_stripped_cond ]
1483 # all this does is removes the foreign/self prefix from a condition
1484 sub __strip_relcond {
1487 { map { /^ (?:foreign|self) \. (\w+) $/x } ($_, $_[1]{$_}) }
1492 sub compare_relationship_keys {
1493 carp 'compare_relationship_keys is a private method, stop calling it';
1495 $self->_compare_relationship_keys (@_);
1498 # Returns true if both sets of keynames are the same, false otherwise.
1499 sub _compare_relationship_keys {
1500 # my ($self, $keys1, $keys2) = @_;
1502 join ("\x00", sort @{$_[1]})
1504 join ("\x00", sort @{$_[2]})
1508 # optionally takes either an arrayref of column names, or a hashref of already
1509 # retrieved colinfos
1510 # returns an arrayref of column names of the shortest unique constraint
1511 # (matching some of the input if any), giving preference to the PK
1512 sub _identifying_column_set {
1513 my ($self, $cols) = @_;
1515 my %unique = $self->unique_constraints;
1516 my $colinfos = ref $cols eq 'HASH' ? $cols : $self->columns_info($cols||());
1518 # always prefer the PK first, and then shortest constraints first
1520 for my $set (delete $unique{primary}, sort { @$a <=> @$b } (values %unique) ) {
1521 next unless $set && @$set;
1524 next USET unless ($colinfos->{$_} && !$colinfos->{$_}{is_nullable} );
1527 # copy so we can mangle it at will
1534 # Returns the {from} structure used to express JOIN conditions
1536 my ($self, $join, $alias, $seen, $jpath, $parent_force_left) = @_;
1538 # we need a supplied one, because we do in-place modifications, no returns
1539 $self->throw_exception ('You must supply a seen hashref as the 3rd argument to _resolve_join')
1540 unless ref $seen eq 'HASH';
1542 $self->throw_exception ('You must supply a joinpath arrayref as the 4th argument to _resolve_join')
1543 unless ref $jpath eq 'ARRAY';
1545 $jpath = [@$jpath]; # copy
1547 if (not defined $join or not length $join) {
1550 elsif (ref $join eq 'ARRAY') {
1553 $self->_resolve_join($_, $alias, $seen, $jpath, $parent_force_left);
1556 elsif (ref $join eq 'HASH') {
1559 for my $rel (keys %$join) {
1561 my $rel_info = $self->relationship_info($rel)
1562 or $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
1564 my $force_left = $parent_force_left;
1565 $force_left ||= lc($rel_info->{attrs}{join_type}||'') eq 'left';
1567 # the actual seen value will be incremented by the recursion
1568 my $as = $self->storage->relname_to_table_alias(
1569 $rel, ($seen->{$rel} && $seen->{$rel} + 1)
1573 $self->_resolve_join($rel, $alias, $seen, [@$jpath], $force_left),
1574 $self->related_source($rel)->_resolve_join(
1575 $join->{$rel}, $as, $seen, [@$jpath, { $rel => $as }], $force_left
1583 $self->throw_exception("No idea how to resolve join reftype ".ref $join);
1586 my $count = ++$seen->{$join};
1587 my $as = $self->storage->relname_to_table_alias(
1588 $join, ($count > 1 && $count)
1591 my $rel_info = $self->relationship_info($join)
1592 or $self->throw_exception("No such relationship $join on " . $self->source_name);
1594 my $rel_src = $self->related_source($join);
1595 return [ { $as => $rel_src->from,
1597 -join_type => $parent_force_left
1599 : $rel_info->{attrs}{join_type}
1601 -join_path => [@$jpath, { $join => $as } ],
1603 (! $rel_info->{attrs}{accessor})
1605 first { $rel_info->{attrs}{accessor} eq $_ } (qw/single filter/)
1608 -relation_chain_depth => ( $seen->{-relation_chain_depth} || 0 ) + 1,
1610 scalar $self->_resolve_condition($rel_info->{cond}, $as, $alias, $join)
1616 carp 'pk_depends_on is a private method, stop calling it';
1618 $self->_pk_depends_on (@_);
1621 # Determines whether a relation is dependent on an object from this source
1622 # having already been inserted. Takes the name of the relationship and a
1623 # hashref of columns of the related object.
1624 sub _pk_depends_on {
1625 my ($self, $rel_name, $rel_data) = @_;
1627 my $relinfo = $self->relationship_info($rel_name);
1629 # don't assume things if the relationship direction is specified
1630 return $relinfo->{attrs}{is_foreign_key_constraint}
1631 if exists ($relinfo->{attrs}{is_foreign_key_constraint});
1633 my $cond = $relinfo->{cond};
1634 return 0 unless ref($cond) eq 'HASH';
1636 # map { foreign.foo => 'self.bar' } to { bar => 'foo' }
1637 my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond };
1639 # assume anything that references our PK probably is dependent on us
1640 # rather than vice versa, unless the far side is (a) defined or (b)
1642 my $rel_source = $self->related_source($rel_name);
1644 foreach my $p ($self->primary_columns) {
1645 if (exists $keyhash->{$p}) {
1646 unless (defined($rel_data->{$keyhash->{$p}})
1647 || $rel_source->column_info($keyhash->{$p})
1648 ->{is_auto_increment}) {
1657 sub resolve_condition {
1658 carp 'resolve_condition is a private method, stop calling it';
1660 $self->_resolve_condition (@_);
1663 our $UNRESOLVABLE_CONDITION = \ '1 = 0';
1665 # Resolves the passed condition to a concrete query fragment and a flag
1666 # indicating whether this is a cross-table condition. Also an optional
1667 # list of non-triviail values (notmally conditions) returned as a part
1668 # of a joinfree condition hash
1669 sub _resolve_condition {
1670 my ($self, $cond, $as, $for, $rel_name) = @_;
1672 my $obj_rel = !!blessed $for;
1674 if (ref $cond eq 'CODE') {
1675 my $relalias = $obj_rel ? 'me' : $as;
1677 my ($crosstable_cond, $joinfree_cond) = $cond->({
1678 self_alias => $obj_rel ? $as : $for,
1679 foreign_alias => $relalias,
1680 self_resultsource => $self,
1681 foreign_relname => $rel_name || ($obj_rel ? $as : $for),
1682 self_rowobj => $obj_rel ? $for : undef
1686 if ($joinfree_cond) {
1688 # FIXME sanity check until things stabilize, remove at some point
1689 $self->throw_exception (
1690 "A join-free condition returned for relationship '$rel_name' without a row-object to chain from"
1693 # FIXME another sanity check
1695 ref $joinfree_cond ne 'HASH'
1697 first { $_ !~ /^\Q$relalias.\E.+/ } keys %$joinfree_cond
1699 $self->throw_exception (
1700 "The join-free condition returned for relationship '$rel_name' must be a hash "
1701 .'reference with all keys being valid columns on the related result source'
1706 for (values %$joinfree_cond) {
1716 # see which parts of the joinfree cond are conditionals
1717 my $relcol_list = { map { $_ => 1 } $self->related_source($rel_name)->columns };
1719 for my $c (keys %$joinfree_cond) {
1720 my ($colname) = $c =~ /^ (?: \Q$relalias.\E )? (.+)/x;
1722 unless ($relcol_list->{$colname}) {
1723 push @$cond_cols, $colname;
1728 ref $joinfree_cond->{$c}
1730 ref $joinfree_cond->{$c} ne 'SCALAR'
1732 ref $joinfree_cond->{$c} ne 'REF'
1734 push @$cond_cols, $colname;
1739 return wantarray ? ($joinfree_cond, 0, $cond_cols) : $joinfree_cond;
1742 return wantarray ? ($crosstable_cond, 1) : $crosstable_cond;
1745 elsif (ref $cond eq 'HASH') {
1747 foreach my $k (keys %{$cond}) {
1748 my $v = $cond->{$k};
1749 # XXX should probably check these are valid columns
1750 $k =~ s/^foreign\.// ||
1751 $self->throw_exception("Invalid rel cond key ${k}");
1752 $v =~ s/^self\.// ||
1753 $self->throw_exception("Invalid rel cond val ${v}");
1754 if (ref $for) { # Object
1755 #warn "$self $k $for $v";
1756 unless ($for->has_column_loaded($v)) {
1757 if ($for->in_storage) {
1758 $self->throw_exception(sprintf
1759 "Unable to resolve relationship '%s' from object %s: column '%s' not "
1760 . 'loaded from storage (or not passed to new() prior to insert()). You '
1761 . 'probably need to call ->discard_changes to get the server-side defaults '
1762 . 'from the database.',
1768 return $UNRESOLVABLE_CONDITION;
1770 $ret{$k} = $for->get_column($v);
1771 #$ret{$k} = $for->get_column($v) if $for->has_column_loaded($v);
1773 } elsif (!defined $for) { # undef, i.e. "no object"
1775 } elsif (ref $as eq 'HASH') { # reverse hashref
1776 $ret{$v} = $as->{$k};
1777 } elsif (ref $as) { # reverse object
1778 $ret{$v} = $as->get_column($k);
1779 } elsif (!defined $as) { # undef, i.e. "no reverse object"
1782 $ret{"${as}.${k}"} = { -ident => "${for}.${v}" };
1787 ? ( \%ret, ($obj_rel || !defined $as || ref $as) ? 0 : 1 )
1791 elsif (ref $cond eq 'ARRAY') {
1792 my (@ret, $crosstable);
1794 my ($cond, $crosstab) = $self->_resolve_condition($_, $as, $for, $rel_name);
1796 $crosstable ||= $crosstab;
1798 return wantarray ? (\@ret, $crosstable) : \@ret;
1801 $self->throw_exception ("Can't handle condition $cond for relationship '$rel_name' yet :(");
1805 =head2 related_source
1809 =item Arguments: $rel_name
1811 =item Return Value: $source
1815 Returns the result source object for the given relationship.
1819 sub related_source {
1820 my ($self, $rel) = @_;
1821 if( !$self->has_relationship( $rel ) ) {
1822 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
1825 # if we are not registered with a schema - just use the prototype
1826 # however if we do have a schema - ask for the source by name (and
1827 # throw in the process if all fails)
1828 if (my $schema = try { $self->schema }) {
1829 $schema->source($self->relationship_info($rel)->{source});
1832 my $class = $self->relationship_info($rel)->{class};
1833 $self->ensure_class_loaded($class);
1834 $class->result_source_instance;
1838 =head2 related_class
1842 =item Arguments: $rel_name
1844 =item Return Value: $classname
1848 Returns the class name for objects in the given relationship.
1853 my ($self, $rel) = @_;
1854 if( !$self->has_relationship( $rel ) ) {
1855 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
1857 return $self->schema->class($self->relationship_info($rel)->{source});
1864 =item Arguments: none
1866 =item Return Value: L<$source_handle|DBIx::Class::ResultSourceHandle>
1870 Obtain a new L<result source handle instance|DBIx::Class::ResultSourceHandle>
1871 for this source. Used as a serializable pointer to this resultsource, as it is not
1872 easy (nor advisable) to serialize CODErefs which may very well be present in e.g.
1873 relationship definitions.
1878 return DBIx::Class::ResultSourceHandle->new({
1879 source_moniker => $_[0]->source_name,
1881 # so that a detached thaw can be re-frozen
1882 $_[0]->{_detached_thaw}
1883 ? ( _detached_source => $_[0] )
1884 : ( schema => $_[0]->schema )
1889 my $global_phase_destroy;
1891 return if $global_phase_destroy ||= in_global_destruction;
1897 # Under no circumstances shall $_[0] be stored anywhere else (like copied to
1898 # a lexical variable, or shifted, or anything else). Doing so will mess up
1899 # the refcount of this particular result source, and will allow the $schema
1900 # we are trying to save to reattach back to the source we are destroying.
1901 # The relevant code checking refcounts is in ::Schema::DESTROY()
1903 # if we are not a schema instance holder - we don't matter
1905 ! ref $_[0]->{schema}
1907 isweak $_[0]->{schema}
1910 # weaken our schema hold forcing the schema to find somewhere else to live
1911 # during global destruction (if we have not yet bailed out) this will throw
1912 # which will serve as a signal to not try doing anything else
1913 # however beware - on older perls the exception seems randomly untrappable
1914 # due to some weird race condition during thread joining :(((
1917 weaken $_[0]->{schema};
1919 # if schema is still there reintroduce ourselves with strong refs back to us
1920 if ($_[0]->{schema}) {
1921 my $srcregs = $_[0]->{schema}->source_registrations;
1922 for (keys %$srcregs) {
1923 next unless $srcregs->{$_};
1924 $srcregs->{$_} = $_[0] if $srcregs->{$_} == $_[0];
1930 $global_phase_destroy = 1;
1936 sub STORABLE_freeze { Storable::nfreeze($_[0]->handle) }
1939 my ($self, $cloning, $ice) = @_;
1940 %$self = %{ (Storable::thaw($ice))->resolve };
1943 =head2 throw_exception
1945 See L<DBIx::Class::Schema/"throw_exception">.
1949 sub throw_exception {
1953 ? $self->{schema}->throw_exception(@_)
1954 : DBIx::Class::Exception->throw(@_)
1960 Stores a hashref of per-source metadata. No specific key names
1961 have yet been standardized, the examples below are purely hypothetical
1962 and don't actually accomplish anything on their own:
1964 __PACKAGE__->source_info({
1965 "_tablespace" => 'fast_disk_array_3',
1966 "_engine" => 'InnoDB',
1973 $class->new({attribute_name => value});
1975 Creates a new ResultSource object. Not normally called directly by end users.
1977 =head2 column_info_from_storage
1981 =item Arguments: 1/0 (default: 0)
1983 =item Return Value: 1/0
1987 __PACKAGE__->column_info_from_storage(1);
1989 Enables the on-demand automatic loading of the above column
1990 metadata from storage as necessary. This is *deprecated*, and
1991 should not be used. It will be removed before 1.0.
1994 =head1 AUTHOR AND CONTRIBUTORS
1996 See L<AUTHOR|DBIx::Class/AUTHOR> and L<CONTRIBUTORS|DBIx::Class/CONTRIBUTORS> in DBIx::Class
2000 You may distribute this code under the same terms as Perl itself.