1 package DBIx::Class::ResultSource;
6 use DBIx::Class::ResultSet;
7 use DBIx::Class::ResultSourceHandle;
10 use Devel::GlobalDestruction;
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/
19 source_name name source_info
20 _ordered_columns _columns _primaries _unique_constraints
21 _relationships resultset_attributes
22 column_info_from_storage
25 __PACKAGE__->mk_group_accessors(component_class => qw/
30 __PACKAGE__->mk_classdata( sqlt_deploy_callback => 'default_sqlt_deploy_hook' );
34 DBIx::Class::ResultSource - Result source object
38 # Create a table based result source, in a result class.
40 package MyApp::Schema::Result::Artist;
41 use base qw/DBIx::Class::Core/;
43 __PACKAGE__->table('artist');
44 __PACKAGE__->add_columns(qw/ artistid name /);
45 __PACKAGE__->set_primary_key('artistid');
46 __PACKAGE__->has_many(cds => 'MyApp::Schema::Result::CD');
50 # Create a query (view) based result source, in a result class
51 package MyApp::Schema::Result::Year2000CDs;
52 use base qw/DBIx::Class::Core/;
54 __PACKAGE__->load_components('InflateColumn::DateTime');
55 __PACKAGE__->table_class('DBIx::Class::ResultSource::View');
57 __PACKAGE__->table('year2000cds');
58 __PACKAGE__->result_source_instance->is_virtual(1);
59 __PACKAGE__->result_source_instance->view_definition(
60 "SELECT cdid, artist, title FROM cd WHERE year ='2000'"
66 A ResultSource is an object that represents a source of data for querying.
68 This class is a base class for various specialised types of result
69 sources, for example L<DBIx::Class::ResultSource::Table>. Table is the
70 default result source type, so one is created for you when defining a
71 result class as described in the synopsis above.
73 More specifically, the L<DBIx::Class::Core> base class pulls in the
74 L<DBIx::Class::ResultSourceProxy::Table> component, which defines
75 the L<table|DBIx::Class::ResultSourceProxy::Table/table> method.
76 When called, C<table> creates and stores an instance of
77 L<DBIx::Class::ResultSoure::Table>. Luckily, to use tables as result
78 sources, you don't need to remember any of this.
80 Result sources representing select queries, or views, can also be
81 created, see L<DBIx::Class::ResultSource::View> for full details.
83 =head2 Finding result source objects
85 As mentioned above, a result source instance is created and stored for
86 you when you define a L<Result Class|DBIx::Class::Manual::Glossary/Result Class>.
88 You can retrieve the result source at runtime in the following ways:
92 =item From a Schema object:
94 $schema->source($source_name);
96 =item From a Result object:
100 =item From a ResultSet object:
113 my ($class, $attrs) = @_;
114 $class = ref $class if ref $class;
116 my $new = bless { %{$attrs || {}} }, $class;
117 $new->{resultset_class} ||= 'DBIx::Class::ResultSet';
118 $new->{resultset_attributes} = { %{$new->{resultset_attributes} || {}} };
119 $new->{_ordered_columns} = [ @{$new->{_ordered_columns}||[]}];
120 $new->{_columns} = { %{$new->{_columns}||{}} };
121 $new->{_relationships} = { %{$new->{_relationships}||{}} };
122 $new->{name} ||= "!!NAME NOT SET!!";
123 $new->{_columns_info_loaded} ||= 0;
133 =item Arguments: @columns
135 =item Return Value: L<$result_source|/new>
139 $source->add_columns(qw/col1 col2 col3/);
141 $source->add_columns('col1' => \%col1_info, 'col2' => \%col2_info, ...);
143 Adds columns to the result source. If supplied colname => hashref
144 pairs, uses the hashref as the L</column_info> for that column. Repeated
145 calls of this method will add more columns, not replace them.
147 The column names given will be created as accessor methods on your
148 L<Result|DBIx::Class::Manual::ResultClass> objects. You can change the name of the accessor
149 by supplying an L</accessor> in the column_info hash.
151 If a column name beginning with a plus sign ('+col1') is provided, the
152 attributes provided will be merged with any existing attributes for the
153 column, with the new attributes taking precedence in the case that an
154 attribute already exists. Using this without a hashref
155 (C<< $source->add_columns(qw/+col1 +col2/) >>) is legal, but useless --
156 it does the same thing it would do without the plus.
158 The contents of the column_info are not set in stone. The following
159 keys are currently recognised/used by DBIx::Class:
165 { accessor => '_name' }
167 # example use, replace standard accessor with one of your own:
169 my ($self, $value) = @_;
171 die "Name cannot contain digits!" if($value =~ /\d/);
172 $self->_name($value);
174 return $self->_name();
177 Use this to set the name of the accessor method for this column. If unset,
178 the name of the column will be used.
182 { data_type => 'integer' }
184 This contains the column type. It is automatically filled if you use the
185 L<SQL::Translator::Producer::DBIx::Class::File> producer, or the
186 L<DBIx::Class::Schema::Loader> module.
188 Currently there is no standard set of values for the data_type. Use
189 whatever your database supports.
195 The length of your column, if it is a column type that can have a size
196 restriction. This is currently only used to create tables from your
197 schema, see L<DBIx::Class::Schema/deploy>.
203 Set this to a true value for a columns that is allowed to contain NULL
204 values, default is false. This is currently only used to create tables
205 from your schema, see L<DBIx::Class::Schema/deploy>.
207 =item is_auto_increment
209 { is_auto_increment => 1 }
211 Set this to a true value for a column whose value is somehow
212 automatically set, defaults to false. This is used to determine which
213 columns to empty when cloning objects using
214 L<DBIx::Class::Row/copy>. It is also used by
215 L<DBIx::Class::Schema/deploy>.
221 Set this to a true or false value (not C<undef>) to explicitly specify
222 if this column contains numeric data. This controls how set_column
223 decides whether to consider a column dirty after an update: if
224 C<is_numeric> is true a numeric comparison C<< != >> will take place
225 instead of the usual C<eq>
227 If not specified the storage class will attempt to figure this out on
228 first access to the column, based on the column C<data_type>. The
229 result will be cached in this attribute.
233 { is_foreign_key => 1 }
235 Set this to a true value for a column that contains a key from a
236 foreign table, defaults to false. This is currently only used to
237 create tables from your schema, see L<DBIx::Class::Schema/deploy>.
241 { default_value => \'now()' }
243 Set this to the default value which will be inserted into a column by
244 the database. Can contain either a value or a function (use a
245 reference to a scalar e.g. C<\'now()'> if you want a function). This
246 is currently only used to create tables from your schema, see
247 L<DBIx::Class::Schema/deploy>.
249 See the note on L<DBIx::Class::Row/new> for more information about possible
250 issues related to db-side default values.
254 { sequence => 'my_table_seq' }
256 Set this on a primary key column to the name of the sequence used to
257 generate a new key value. If not specified, L<DBIx::Class::PK::Auto>
258 will attempt to retrieve the name of the sequence from the database
261 =item retrieve_on_insert
263 { retrieve_on_insert => 1 }
265 For every column where this is set to true, DBIC will retrieve the RDBMS-side
266 value upon a new row insertion (normally only the autoincrement PK is
267 retrieved on insert). C<INSERT ... RETURNING> is used automatically if
268 supported by the underlying storage, otherwise an extra SELECT statement is
269 executed to retrieve the missing data.
273 { auto_nextval => 1 }
275 Set this to a true value for a column whose value is retrieved automatically
276 from a sequence or function (if supported by your Storage driver.) For a
277 sequence, if you do not use a trigger to get the nextval, you have to set the
278 L</sequence> value as well.
280 Also set this for MSSQL columns with the 'uniqueidentifier'
281 L<data_type|DBIx::Class::ResultSource/data_type> whose values you want to
282 automatically generate using C<NEWID()>, unless they are a primary key in which
283 case this will be done anyway.
287 This is used by L<DBIx::Class::Schema/deploy> and L<SQL::Translator>
288 to add extra non-generic data to the column. For example: C<< extra
289 => { unsigned => 1} >> is used by the MySQL producer to set an integer
290 column to unsigned. For more details, see
291 L<SQL::Translator::Producer::MySQL>.
299 =item Arguments: $colname, \%columninfo?
301 =item Return Value: 1/0 (true/false)
305 $source->add_column('col' => \%info);
307 Add a single column and optional column info. Uses the same column
308 info keys as L</add_columns>.
313 my ($self, @cols) = @_;
314 $self->_ordered_columns(\@cols) unless $self->_ordered_columns;
317 my $columns = $self->_columns;
318 while (my $col = shift @cols) {
319 my $column_info = {};
320 if ($col =~ s/^\+//) {
321 $column_info = $self->column_info($col);
324 # If next entry is { ... } use that for the column info, if not
325 # use an empty hashref
327 my $new_info = shift(@cols);
328 %$column_info = (%$column_info, %$new_info);
330 push(@added, $col) unless exists $columns->{$col};
331 $columns->{$col} = $column_info;
333 push @{ $self->_ordered_columns }, @added;
337 sub add_column { shift->add_columns(@_); } # DO NOT CHANGE THIS TO GLOB
343 =item Arguments: $colname
345 =item Return Value: 1/0 (true/false)
349 if ($source->has_column($colname)) { ... }
351 Returns true if the source has a column of this name, false otherwise.
356 my ($self, $column) = @_;
357 return exists $self->_columns->{$column};
364 =item Arguments: $colname
366 =item Return Value: Hashref of info
370 my $info = $source->column_info($col);
372 Returns the column metadata hashref for a column, as originally passed
373 to L</add_columns>. See L</add_columns> above for information on the
374 contents of the hashref.
379 my ($self, $column) = @_;
380 $self->throw_exception("No such column $column")
381 unless exists $self->_columns->{$column};
383 if ( ! $self->_columns->{$column}{data_type}
384 and ! $self->{_columns_info_loaded}
385 and $self->column_info_from_storage
386 and my $stor = try { $self->storage } )
388 $self->{_columns_info_loaded}++;
390 # try for the case of storage without table
392 my $info = $stor->columns_info_for( $self->from );
394 { (lc $_) => $info->{$_} }
398 foreach my $col ( keys %{$self->_columns} ) {
399 $self->_columns->{$col} = {
400 %{ $self->_columns->{$col} },
401 %{ $info->{$col} || $lc_info->{lc $col} || {} }
407 return $self->_columns->{$column};
414 =item Arguments: none
416 =item Return Value: Ordered list of column names
420 my @column_names = $source->columns;
422 Returns all column names in the order they were declared to L</add_columns>.
428 $self->throw_exception(
429 "columns() is a read-only accessor, did you mean add_columns()?"
431 return @{$self->{_ordered_columns}||[]};
438 =item Arguments: \@colnames ?
440 =item Return Value: Hashref of column name/info pairs
444 my $columns_info = $source->columns_info;
446 Like L</column_info> but returns information for the requested columns. If
447 the optional column-list arrayref is omitted it returns info on all columns
448 currently defined on the ResultSource via L</add_columns>.
453 my ($self, $columns) = @_;
455 my $colinfo = $self->_columns;
458 first { ! $_->{data_type} } values %$colinfo
460 ! $self->{_columns_info_loaded}
462 $self->column_info_from_storage
464 my $stor = try { $self->storage }
466 $self->{_columns_info_loaded}++;
468 # try for the case of storage without table
470 my $info = $stor->columns_info_for( $self->from );
472 { (lc $_) => $info->{$_} }
476 foreach my $col ( keys %$colinfo ) {
478 %{ $colinfo->{$col} },
479 %{ $info->{$col} || $lc_info->{lc $col} || {} }
489 if (my $inf = $colinfo->{$_}) {
493 $self->throw_exception( sprintf (
494 "No such column '%s' on source %s",
508 =head2 remove_columns
512 =item Arguments: @colnames
514 =item Return Value: not defined
518 $source->remove_columns(qw/col1 col2 col3/);
520 Removes the given list of columns by name, from the result source.
522 B<Warning>: Removing a column that is also used in the sources primary
523 key, or in one of the sources unique constraints, B<will> result in a
524 broken result source.
530 =item Arguments: $colname
532 =item Return Value: not defined
536 $source->remove_column('col');
538 Remove a single column by name from the result source, similar to
541 B<Warning>: Removing a column that is also used in the sources primary
542 key, or in one of the sources unique constraints, B<will> result in a
543 broken result source.
548 my ($self, @to_remove) = @_;
550 my $columns = $self->_columns
555 delete $columns->{$_};
559 $self->_ordered_columns([ grep { not $to_remove{$_} } @{$self->_ordered_columns} ]);
562 sub remove_column { shift->remove_columns(@_); } # DO NOT CHANGE THIS TO GLOB
564 =head2 set_primary_key
568 =item Arguments: @cols
570 =item Return Value: not defined
574 Defines one or more columns as primary key for this source. Must be
575 called after L</add_columns>.
577 Additionally, defines a L<unique constraint|add_unique_constraint>
580 Note: you normally do want to define a primary key on your sources
581 B<even if the underlying database table does not have a primary key>.
583 L<DBIx::Class::Manual::Intro/The Significance and Importance of Primary Keys>
588 sub set_primary_key {
589 my ($self, @cols) = @_;
590 # check if primary key columns are valid columns
591 foreach my $col (@cols) {
592 $self->throw_exception("No such column $col on table " . $self->name)
593 unless $self->has_column($col);
595 $self->_primaries(\@cols);
597 $self->add_unique_constraint(primary => \@cols);
600 =head2 primary_columns
604 =item Arguments: none
606 =item Return Value: Ordered list of primary column names
610 Read-only accessor which returns the list of primary keys, supplied by
615 sub primary_columns {
616 return @{shift->_primaries||[]};
619 # a helper method that will automatically die with a descriptive message if
620 # no pk is defined on the source in question. For internal use to save
621 # on if @pks... boilerplate
624 my @pcols = $self->primary_columns
625 or $self->throw_exception (sprintf(
626 "Operation requires a primary key to be declared on '%s' via set_primary_key",
627 # source_name is set only after schema-registration
628 $self->source_name || $self->result_class || $self->name || 'Unknown source...?',
635 Manually define the correct sequence for your table, to avoid the overhead
636 associated with looking up the sequence automatically. The supplied sequence
637 will be applied to the L</column_info> of each L<primary_key|/set_primary_key>
641 =item Arguments: $sequence_name
643 =item Return Value: not defined
650 my ($self,$seq) = @_;
652 my @pks = $self->primary_columns
655 $_->{sequence} = $seq
656 for values %{ $self->columns_info (\@pks) };
660 =head2 add_unique_constraint
664 =item Arguments: $name?, \@colnames
666 =item Return Value: not defined
670 Declare a unique constraint on this source. Call once for each unique
673 # For UNIQUE (column1, column2)
674 __PACKAGE__->add_unique_constraint(
675 constraint_name => [ qw/column1 column2/ ],
678 Alternatively, you can specify only the columns:
680 __PACKAGE__->add_unique_constraint([ qw/column1 column2/ ]);
682 This will result in a unique constraint named
683 C<table_column1_column2>, where C<table> is replaced with the table
686 Unique constraints are used, for example, when you pass the constraint
687 name as the C<key> attribute to L<DBIx::Class::ResultSet/find>. Then
688 only columns in the constraint are searched.
690 Throws an error if any of the given column names do not yet exist on
695 sub add_unique_constraint {
699 $self->throw_exception(
700 'add_unique_constraint() does not accept multiple constraints, use '
701 . 'add_unique_constraints() instead'
706 if (ref $cols ne 'ARRAY') {
707 $self->throw_exception (
708 'Expecting an arrayref of constraint columns, got ' . ($cols||'NOTHING')
714 $name ||= $self->name_unique_constraint($cols);
716 foreach my $col (@$cols) {
717 $self->throw_exception("No such column $col on table " . $self->name)
718 unless $self->has_column($col);
721 my %unique_constraints = $self->unique_constraints;
722 $unique_constraints{$name} = $cols;
723 $self->_unique_constraints(\%unique_constraints);
726 =head2 add_unique_constraints
730 =item Arguments: @constraints
732 =item Return Value: not defined
736 Declare multiple unique constraints on this source.
738 __PACKAGE__->add_unique_constraints(
739 constraint_name1 => [ qw/column1 column2/ ],
740 constraint_name2 => [ qw/column2 column3/ ],
743 Alternatively, you can specify only the columns:
745 __PACKAGE__->add_unique_constraints(
746 [ qw/column1 column2/ ],
747 [ qw/column3 column4/ ]
750 This will result in unique constraints named C<table_column1_column2> and
751 C<table_column3_column4>, where C<table> is replaced with the table name.
753 Throws an error if any of the given column names do not yet exist on
756 See also L</add_unique_constraint>.
760 sub add_unique_constraints {
762 my @constraints = @_;
764 if ( !(@constraints % 2) && first { ref $_ ne 'ARRAY' } @constraints ) {
765 # with constraint name
766 while (my ($name, $constraint) = splice @constraints, 0, 2) {
767 $self->add_unique_constraint($name => $constraint);
772 foreach my $constraint (@constraints) {
773 $self->add_unique_constraint($constraint);
778 =head2 name_unique_constraint
782 =item Arguments: \@colnames
784 =item Return Value: Constraint name
788 $source->table('mytable');
789 $source->name_unique_constraint(['col1', 'col2']);
793 Return a name for a unique constraint containing the specified
794 columns. The name is created by joining the table name and each column
795 name, using an underscore character.
797 For example, a constraint on a table named C<cd> containing the columns
798 C<artist> and C<title> would result in a constraint name of C<cd_artist_title>.
800 This is used by L</add_unique_constraint> if you do not specify the
801 optional constraint name.
805 sub name_unique_constraint {
806 my ($self, $cols) = @_;
808 my $name = $self->name;
809 $name = $$name if (ref $name eq 'SCALAR');
811 return join '_', $name, @$cols;
814 =head2 unique_constraints
818 =item Arguments: none
820 =item Return Value: Hash of unique constraint data
824 $source->unique_constraints();
826 Read-only accessor which returns a hash of unique constraints on this
829 The hash is keyed by constraint name, and contains an arrayref of
830 column names as values.
834 sub unique_constraints {
835 return %{shift->_unique_constraints||{}};
838 =head2 unique_constraint_names
842 =item Arguments: none
844 =item Return Value: Unique constraint names
848 $source->unique_constraint_names();
850 Returns the list of unique constraint names defined on this source.
854 sub unique_constraint_names {
857 my %unique_constraints = $self->unique_constraints;
859 return keys %unique_constraints;
862 =head2 unique_constraint_columns
866 =item Arguments: $constraintname
868 =item Return Value: List of constraint columns
872 $source->unique_constraint_columns('myconstraint');
874 Returns the list of columns that make up the specified unique constraint.
878 sub unique_constraint_columns {
879 my ($self, $constraint_name) = @_;
881 my %unique_constraints = $self->unique_constraints;
883 $self->throw_exception(
884 "Unknown unique constraint $constraint_name on '" . $self->name . "'"
885 ) unless exists $unique_constraints{$constraint_name};
887 return @{ $unique_constraints{$constraint_name} };
890 =head2 sqlt_deploy_callback
894 =item Arguments: $callback_name | \&callback_code
896 =item Return Value: $callback_name | \&callback_code
900 __PACKAGE__->sqlt_deploy_callback('mycallbackmethod');
904 __PACKAGE__->sqlt_deploy_callback(sub {
905 my ($source_instance, $sqlt_table) = @_;
909 An accessor to set a callback to be called during deployment of
910 the schema via L<DBIx::Class::Schema/create_ddl_dir> or
911 L<DBIx::Class::Schema/deploy>.
913 The callback can be set as either a code reference or the name of a
914 method in the current result class.
916 Defaults to L</default_sqlt_deploy_hook>.
918 Your callback will be passed the $source object representing the
919 ResultSource instance being deployed, and the
920 L<SQL::Translator::Schema::Table> object being created from it. The
921 callback can be used to manipulate the table object or add your own
922 customised indexes. If you need to manipulate a non-table object, use
923 the L<DBIx::Class::Schema/sqlt_deploy_hook>.
925 See L<DBIx::Class::Manual::Cookbook/Adding Indexes And Functions To
926 Your SQL> for examples.
928 This sqlt deployment callback can only be used to manipulate
929 SQL::Translator objects as they get turned into SQL. To execute
930 post-deploy statements which SQL::Translator does not currently
931 handle, override L<DBIx::Class::Schema/deploy> in your Schema class
932 and call L<dbh_do|DBIx::Class::Storage::DBI/dbh_do>.
934 =head2 default_sqlt_deploy_hook
936 This is the default deploy hook implementation which checks if your
937 current Result class has a C<sqlt_deploy_hook> method, and if present
938 invokes it B<on the Result class directly>. This is to preserve the
939 semantics of C<sqlt_deploy_hook> which was originally designed to expect
940 the Result class name and the
941 L<$sqlt_table instance|SQL::Translator::Schema::Table> of the table being
946 sub default_sqlt_deploy_hook {
949 my $class = $self->result_class;
951 if ($class and $class->can('sqlt_deploy_hook')) {
952 $class->sqlt_deploy_hook(@_);
956 sub _invoke_sqlt_deploy_hook {
958 if ( my $hook = $self->sqlt_deploy_callback) {
967 =item Arguments: $classname
969 =item Return Value: $classname
973 use My::Schema::ResultClass::Inflator;
976 use My::Schema::Artist;
978 __PACKAGE__->result_class('My::Schema::ResultClass::Inflator');
980 Set the default result class for this source. You can use this to create
981 and use your own result inflator. See L<DBIx::Class::ResultSet/result_class>
984 Please note that setting this to something like
985 L<DBIx::Class::ResultClass::HashRefInflator> will make every result unblessed
986 and make life more difficult. Inflators like those are better suited to
987 temporary usage via L<DBIx::Class::ResultSet/result_class>.
993 =item Arguments: none
995 =item Return Value: L<$resultset|DBIx::Class::ResultSet>
999 Returns a resultset for the given source. This will initially be created
1000 on demand by calling
1002 $self->resultset_class->new($self, $self->resultset_attributes)
1004 but is cached from then on unless resultset_class changes.
1006 =head2 resultset_class
1010 =item Arguments: $classname
1012 =item Return Value: $classname
1016 package My::Schema::ResultSet::Artist;
1017 use base 'DBIx::Class::ResultSet';
1020 # In the result class
1021 __PACKAGE__->resultset_class('My::Schema::ResultSet::Artist');
1024 $source->resultset_class('My::Schema::ResultSet::Artist');
1026 Set the class of the resultset. This is useful if you want to create your
1027 own resultset methods. Create your own class derived from
1028 L<DBIx::Class::ResultSet>, and set it here. If called with no arguments,
1029 this method returns the name of the existing resultset class, if one
1032 =head2 resultset_attributes
1036 =item Arguments: L<\%attrs|DBIx::Class::ResultSet/ATTRIBUTES>
1038 =item Return Value: L<\%attrs|DBIx::Class::ResultSet/ATTRIBUTES>
1042 # In the result class
1043 __PACKAGE__->resultset_attributes({ order_by => [ 'id' ] });
1046 $source->resultset_attributes({ order_by => [ 'id' ] });
1048 Store a collection of resultset attributes, that will be set on every
1049 L<DBIx::Class::ResultSet> produced from this result source.
1051 B<CAVEAT>: C<resultset_attributes> comes with its own set of issues and
1052 bugs! While C<resultset_attributes> isn't deprecated per se, its usage is
1055 Since relationships use attributes to link tables together, the "default"
1056 attributes you set may cause unpredictable and undesired behavior. Furthermore,
1057 the defaults cannot be turned off, so you are stuck with them.
1059 In most cases, what you should actually be using are project-specific methods:
1061 package My::Schema::ResultSet::Artist;
1062 use base 'DBIx::Class::ResultSet';
1066 #__PACKAGE__->resultset_attributes({ prefetch => 'tracks' });
1069 sub with_tracks { shift->search({}, { prefetch => 'tracks' }) }
1072 $schema->resultset('Artist')->with_tracks->...
1074 This gives you the flexibility of not using it when you don't need it.
1076 For more complex situations, another solution would be to use a virtual view
1077 via L<DBIx::Class::ResultSource::View>.
1083 $self->throw_exception(
1084 'resultset does not take any arguments. If you want another resultset, '.
1085 'call it on the schema instead.'
1088 $self->resultset_class->new(
1091 try { %{$self->schema->default_resultset_attributes} },
1092 %{$self->{resultset_attributes}},
1101 =item Arguments: none
1103 =item Result value: $name
1107 Returns the name of the result source, which will typically be the table
1108 name. This may be a scalar reference if the result source has a non-standard
1115 =item Arguments: $source_name
1117 =item Result value: $source_name
1121 Set an alternate name for the result source when it is loaded into a schema.
1122 This is useful if you want to refer to a result source by a name other than
1125 package ArchivedBooks;
1126 use base qw/DBIx::Class/;
1127 __PACKAGE__->table('books_archive');
1128 __PACKAGE__->source_name('Books');
1130 # from your schema...
1131 $schema->resultset('Books')->find(1);
1137 =item Arguments: none
1139 =item Return Value: FROM clause
1143 my $from_clause = $source->from();
1145 Returns an expression of the source to be supplied to storage to specify
1146 retrieval from this source. In the case of a database, the required FROM
1151 sub from { die 'Virtual method!' }
1157 =item Arguments: L<$schema?|DBIx::Class::Schema>
1159 =item Return Value: L<$schema|DBIx::Class::Schema>
1163 my $schema = $source->schema();
1165 Sets and/or returns the L<DBIx::Class::Schema> object to which this
1166 result source instance has been attached to.
1172 $_[0]->{schema} = $_[1];
1175 $_[0]->{schema} || do {
1176 my $name = $_[0]->{source_name} || '_unnamed_';
1177 my $err = 'Unable to perform storage-dependent operations with a detached result source '
1178 . "(source '$name' is not associated with a schema).";
1180 $err .= ' You need to use $schema->thaw() or manually set'
1181 . ' $DBIx::Class::ResultSourceHandle::thaw_schema while thawing.'
1182 if $_[0]->{_detached_thaw};
1184 DBIx::Class::Exception->throw($err);
1193 =item Arguments: none
1195 =item Return Value: L<$storage|DBIx::Class::Storage>
1199 $source->storage->debug(1);
1201 Returns the L<storage handle|DBIx::Class::Storage> for the current schema.
1205 sub storage { shift->schema->storage; }
1207 =head2 add_relationship
1211 =item Arguments: $rel_name, $related_source_name, \%cond, \%attrs?
1213 =item Return Value: 1/true if it succeeded
1217 $source->add_relationship('rel_name', 'related_source', $cond, $attrs);
1219 L<DBIx::Class::Relationship> describes a series of methods which
1220 create pre-defined useful types of relationships. Look there first
1221 before using this method directly.
1223 The relationship name can be arbitrary, but must be unique for each
1224 relationship attached to this result source. 'related_source' should
1225 be the name with which the related result source was registered with
1226 the current schema. For example:
1228 $schema->source('Book')->add_relationship('reviews', 'Review', {
1229 'foreign.book_id' => 'self.id',
1232 The condition C<$cond> needs to be an L<SQL::Abstract>-style
1233 representation of the join between the tables. For example, if you're
1234 creating a relation from Author to Book,
1236 { 'foreign.author_id' => 'self.id' }
1238 will result in the JOIN clause
1240 author me JOIN book foreign ON foreign.author_id = me.id
1242 You can specify as many foreign => self mappings as necessary.
1244 Valid attributes are as follows:
1250 Explicitly specifies the type of join to use in the relationship. Any
1251 SQL join type is valid, e.g. C<LEFT> or C<RIGHT>. It will be placed in
1252 the SQL command immediately before C<JOIN>.
1256 An arrayref containing a list of accessors in the foreign class to proxy in
1257 the main class. If, for example, you do the following:
1259 CD->might_have(liner_notes => 'LinerNotes', undef, {
1260 proxy => [ qw/notes/ ],
1263 Then, assuming LinerNotes has an accessor named notes, you can do:
1265 my $cd = CD->find(1);
1266 # set notes -- LinerNotes object is created if it doesn't exist
1267 $cd->notes('Notes go here');
1271 Specifies the type of accessor that should be created for the
1272 relationship. Valid values are C<single> (for when there is only a single
1273 related object), C<multi> (when there can be many), and C<filter> (for
1274 when there is a single related object, but you also want the relationship
1275 accessor to double as a column accessor). For C<multi> accessors, an
1276 add_to_* method is also created, which calls C<create_related> for the
1281 Throws an exception if the condition is improperly supplied, or cannot
1286 sub add_relationship {
1287 my ($self, $rel, $f_source_name, $cond, $attrs) = @_;
1288 $self->throw_exception("Can't create relationship without join condition")
1292 # Check foreign and self are right in cond
1293 if ( (ref $cond ||'') eq 'HASH') {
1295 $self->throw_exception("Keys of condition should be of form 'foreign.col', not '$_'")
1296 if /\./ && !/^foreign\./;
1300 my %rels = %{ $self->_relationships };
1301 $rels{$rel} = { class => $f_source_name,
1302 source => $f_source_name,
1305 $self->_relationships(\%rels);
1309 # XXX disabled. doesn't work properly currently. skip in tests.
1311 my $f_source = $self->schema->source($f_source_name);
1312 unless ($f_source) {
1313 $self->ensure_class_loaded($f_source_name);
1314 $f_source = $f_source_name->result_source;
1315 #my $s_class = ref($self->schema);
1316 #$f_source_name =~ m/^${s_class}::(.*)$/;
1317 #$self->schema->register_class(($1 || $f_source_name), $f_source_name);
1318 #$f_source = $self->schema->source($f_source_name);
1320 return unless $f_source; # Can't test rel without f_source
1322 try { $self->_resolve_join($rel, 'me', {}, []) }
1324 # If the resolve failed, back out and re-throw the error
1326 $self->_relationships(\%rels);
1327 $self->throw_exception("Error creating relationship $rel: $_");
1333 =head2 relationships
1337 =item Arguments: none
1339 =item Return Value: L<@rel_names|DBIx::Class::Relationship>
1343 my @relnames = $source->relationships();
1345 Returns all relationship names for this source.
1350 return keys %{shift->_relationships};
1353 =head2 relationship_info
1357 =item Arguments: L<$rel_name|DBIx::Class::Relationship>
1359 =item Return Value: L<\%rel_data|DBIx::Class::Relationship::Base/add_relationship>
1363 Returns a hash of relationship information for the specified relationship
1364 name. The keys/values are as specified for L<DBIx::Class::Relationship::Base/add_relationship>.
1368 sub relationship_info {
1369 #my ($self, $rel) = @_;
1370 return shift->_relationships->{+shift};
1373 =head2 has_relationship
1377 =item Arguments: L<$rel_name|DBIx::Class::Relationship>
1379 =item Return Value: 1/0 (true/false)
1383 Returns true if the source has a relationship of this name, false otherwise.
1387 sub has_relationship {
1388 #my ($self, $rel) = @_;
1389 return exists shift->_relationships->{+shift};
1392 =head2 reverse_relationship_info
1396 =item Arguments: L<$rel_name|DBIx::Class::Relationship>
1398 =item Return Value: L<\%rel_data|DBIx::Class::Relationship::Base/add_relationship>
1402 Looks through all the relationships on the source this relationship
1403 points to, looking for one whose condition is the reverse of the
1404 condition on this relationship.
1406 A common use of this is to find the name of the C<belongs_to> relation
1407 opposing a C<has_many> relation. For definition of these look in
1408 L<DBIx::Class::Relationship>.
1410 The returned hashref is keyed by the name of the opposing
1411 relationship, and contains its data in the same manner as
1412 L</relationship_info>.
1416 sub reverse_relationship_info {
1417 my ($self, $rel) = @_;
1419 my $rel_info = $self->relationship_info($rel)
1420 or $self->throw_exception("No such relationship '$rel'");
1424 return $ret unless ((ref $rel_info->{cond}) eq 'HASH');
1426 my $stripped_cond = $self->__strip_relcond ($rel_info->{cond});
1428 my $rsrc_schema_moniker = $self->source_name
1429 if try { $self->schema };
1431 # this may be a partial schema or something else equally esoteric
1432 my $other_rsrc = try { $self->related_source($rel) }
1435 # Get all the relationships for that source that related to this source
1436 # whose foreign column set are our self columns on $rel and whose self
1437 # columns are our foreign columns on $rel
1438 foreach my $other_rel ($other_rsrc->relationships) {
1440 # only consider stuff that points back to us
1441 # "us" here is tricky - if we are in a schema registration, we want
1442 # to use the source_names, otherwise we will use the actual classes
1444 # the schema may be partial
1445 my $roundtrip_rsrc = try { $other_rsrc->related_source($other_rel) }
1448 if ($rsrc_schema_moniker and try { $roundtrip_rsrc->schema } ) {
1449 next unless $rsrc_schema_moniker eq $roundtrip_rsrc->source_name;
1452 next unless $self->result_class eq $roundtrip_rsrc->result_class;
1455 my $other_rel_info = $other_rsrc->relationship_info($other_rel);
1457 # this can happen when we have a self-referential class
1458 next if $other_rel_info eq $rel_info;
1460 next unless ref $other_rel_info->{cond} eq 'HASH';
1461 my $other_stripped_cond = $self->__strip_relcond($other_rel_info->{cond});
1463 $ret->{$other_rel} = $other_rel_info if (
1464 $self->_compare_relationship_keys (
1465 [ keys %$stripped_cond ], [ values %$other_stripped_cond ]
1468 $self->_compare_relationship_keys (
1469 [ values %$stripped_cond ], [ keys %$other_stripped_cond ]
1477 # all this does is removes the foreign/self prefix from a condition
1478 sub __strip_relcond {
1481 { map { /^ (?:foreign|self) \. (\w+) $/x } ($_, $_[1]{$_}) }
1486 sub compare_relationship_keys {
1487 carp 'compare_relationship_keys is a private method, stop calling it';
1489 $self->_compare_relationship_keys (@_);
1492 # Returns true if both sets of keynames are the same, false otherwise.
1493 sub _compare_relationship_keys {
1494 # my ($self, $keys1, $keys2) = @_;
1496 join ("\x00", sort @{$_[1]})
1498 join ("\x00", sort @{$_[2]})
1502 # optionally takes either an arrayref of column names, or a hashref of already
1503 # retrieved colinfos
1504 # returns an arrayref of column names of the shortest unique constraint
1505 # (matching some of the input if any), giving preference to the PK
1506 sub _identifying_column_set {
1507 my ($self, $cols) = @_;
1509 my %unique = $self->unique_constraints;
1510 my $colinfos = ref $cols eq 'HASH' ? $cols : $self->columns_info($cols||());
1512 # always prefer the PK first, and then shortest constraints first
1514 for my $set (delete $unique{primary}, sort { @$a <=> @$b } (values %unique) ) {
1515 next unless $set && @$set;
1518 next USET unless ($colinfos->{$_} && !$colinfos->{$_}{is_nullable} );
1521 # copy so we can mangle it at will
1528 # Returns the {from} structure used to express JOIN conditions
1530 my ($self, $join, $alias, $seen, $jpath, $parent_force_left) = @_;
1532 # we need a supplied one, because we do in-place modifications, no returns
1533 $self->throw_exception ('You must supply a seen hashref as the 3rd argument to _resolve_join')
1534 unless ref $seen eq 'HASH';
1536 $self->throw_exception ('You must supply a joinpath arrayref as the 4th argument to _resolve_join')
1537 unless ref $jpath eq 'ARRAY';
1539 $jpath = [@$jpath]; # copy
1541 if (not defined $join or not length $join) {
1544 elsif (ref $join eq 'ARRAY') {
1547 $self->_resolve_join($_, $alias, $seen, $jpath, $parent_force_left);
1550 elsif (ref $join eq 'HASH') {
1553 for my $rel (keys %$join) {
1555 my $rel_info = $self->relationship_info($rel)
1556 or $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
1558 my $force_left = $parent_force_left;
1559 $force_left ||= lc($rel_info->{attrs}{join_type}||'') eq 'left';
1561 # the actual seen value will be incremented by the recursion
1562 my $as = $self->storage->relname_to_table_alias(
1563 $rel, ($seen->{$rel} && $seen->{$rel} + 1)
1567 $self->_resolve_join($rel, $alias, $seen, [@$jpath], $force_left),
1568 $self->related_source($rel)->_resolve_join(
1569 $join->{$rel}, $as, $seen, [@$jpath, { $rel => $as }], $force_left
1577 $self->throw_exception("No idea how to resolve join reftype ".ref $join);
1580 my $count = ++$seen->{$join};
1581 my $as = $self->storage->relname_to_table_alias(
1582 $join, ($count > 1 && $count)
1585 my $rel_info = $self->relationship_info($join)
1586 or $self->throw_exception("No such relationship $join on " . $self->source_name);
1588 my $rel_src = $self->related_source($join);
1589 return [ { $as => $rel_src->from,
1591 -join_type => $parent_force_left
1593 : $rel_info->{attrs}{join_type}
1595 -join_path => [@$jpath, { $join => $as } ],
1597 $rel_info->{attrs}{accessor}
1599 first { $rel_info->{attrs}{accessor} eq $_ } (qw/single filter/)
1602 -relation_chain_depth => $seen->{-relation_chain_depth} || 0,
1604 scalar $self->_resolve_condition($rel_info->{cond}, $as, $alias, $join)
1610 carp 'pk_depends_on is a private method, stop calling it';
1612 $self->_pk_depends_on (@_);
1615 # Determines whether a relation is dependent on an object from this source
1616 # having already been inserted. Takes the name of the relationship and a
1617 # hashref of columns of the related object.
1618 sub _pk_depends_on {
1619 my ($self, $rel_name, $rel_data) = @_;
1621 my $relinfo = $self->relationship_info($rel_name);
1623 # don't assume things if the relationship direction is specified
1624 return $relinfo->{attrs}{is_foreign_key_constraint}
1625 if exists ($relinfo->{attrs}{is_foreign_key_constraint});
1627 my $cond = $relinfo->{cond};
1628 return 0 unless ref($cond) eq 'HASH';
1630 # map { foreign.foo => 'self.bar' } to { bar => 'foo' }
1631 my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond };
1633 # assume anything that references our PK probably is dependent on us
1634 # rather than vice versa, unless the far side is (a) defined or (b)
1636 my $rel_source = $self->related_source($rel_name);
1638 foreach my $p ($self->primary_columns) {
1639 if (exists $keyhash->{$p}) {
1640 unless (defined($rel_data->{$keyhash->{$p}})
1641 || $rel_source->column_info($keyhash->{$p})
1642 ->{is_auto_increment}) {
1651 sub resolve_condition {
1652 carp 'resolve_condition is a private method, stop calling it';
1654 $self->_resolve_condition (@_);
1657 our $UNRESOLVABLE_CONDITION = \ '1 = 0';
1659 # Resolves the passed condition to a concrete query fragment and a flag
1660 # indicating whether this is a cross-table condition. Also an optional
1661 # list of non-triviail values (notmally conditions) returned as a part
1662 # of a joinfree condition hash
1663 sub _resolve_condition {
1664 my ($self, $cond, $as, $for, $rel_name) = @_;
1666 my $obj_rel = !!blessed $for;
1668 if (ref $cond eq 'CODE') {
1669 my $relalias = $obj_rel ? 'me' : $as;
1671 my ($crosstable_cond, $joinfree_cond) = $cond->({
1672 self_alias => $obj_rel ? $as : $for,
1673 foreign_alias => $relalias,
1674 self_resultsource => $self,
1675 foreign_relname => $rel_name || ($obj_rel ? $as : $for),
1676 self_rowobj => $obj_rel ? $for : undef
1680 if ($joinfree_cond) {
1682 # FIXME sanity check until things stabilize, remove at some point
1683 $self->throw_exception (
1684 "A join-free condition returned for relationship '$rel_name' without a row-object to chain from"
1687 # FIXME another sanity check
1689 ref $joinfree_cond ne 'HASH'
1691 first { $_ !~ /^\Q$relalias.\E.+/ } keys %$joinfree_cond
1693 $self->throw_exception (
1694 "The join-free condition returned for relationship '$rel_name' must be a hash "
1695 .'reference with all keys being valid columns on the related result source'
1700 for (values %$joinfree_cond) {
1710 # see which parts of the joinfree cond are conditionals
1711 my $relcol_list = { map { $_ => 1 } $self->related_source($rel_name)->columns };
1713 for my $c (keys %$joinfree_cond) {
1714 my ($colname) = $c =~ /^ (?: \Q$relalias.\E )? (.+)/x;
1716 unless ($relcol_list->{$colname}) {
1717 push @$cond_cols, $colname;
1722 ref $joinfree_cond->{$c}
1724 ref $joinfree_cond->{$c} ne 'SCALAR'
1726 ref $joinfree_cond->{$c} ne 'REF'
1728 push @$cond_cols, $colname;
1733 return wantarray ? ($joinfree_cond, 0, $cond_cols) : $joinfree_cond;
1736 return wantarray ? ($crosstable_cond, 1) : $crosstable_cond;
1739 elsif (ref $cond eq 'HASH') {
1741 foreach my $k (keys %{$cond}) {
1742 my $v = $cond->{$k};
1743 # XXX should probably check these are valid columns
1744 $k =~ s/^foreign\.// ||
1745 $self->throw_exception("Invalid rel cond key ${k}");
1746 $v =~ s/^self\.// ||
1747 $self->throw_exception("Invalid rel cond val ${v}");
1748 if (ref $for) { # Object
1749 #warn "$self $k $for $v";
1750 unless ($for->has_column_loaded($v)) {
1751 if ($for->in_storage) {
1752 $self->throw_exception(sprintf
1753 "Unable to resolve relationship '%s' from object %s: column '%s' not "
1754 . 'loaded from storage (or not passed to new() prior to insert()). You '
1755 . 'probably need to call ->discard_changes to get the server-side defaults '
1756 . 'from the database.',
1762 return $UNRESOLVABLE_CONDITION;
1764 $ret{$k} = $for->get_column($v);
1765 #$ret{$k} = $for->get_column($v) if $for->has_column_loaded($v);
1767 } elsif (!defined $for) { # undef, i.e. "no object"
1769 } elsif (ref $as eq 'HASH') { # reverse hashref
1770 $ret{$v} = $as->{$k};
1771 } elsif (ref $as) { # reverse object
1772 $ret{$v} = $as->get_column($k);
1773 } elsif (!defined $as) { # undef, i.e. "no reverse object"
1776 $ret{"${as}.${k}"} = { -ident => "${for}.${v}" };
1781 ? ( \%ret, ($obj_rel || !defined $as || ref $as) ? 0 : 1 )
1785 elsif (ref $cond eq 'ARRAY') {
1786 my (@ret, $crosstable);
1788 my ($cond, $crosstab) = $self->_resolve_condition($_, $as, $for, $rel_name);
1790 $crosstable ||= $crosstab;
1792 return wantarray ? (\@ret, $crosstable) : \@ret;
1795 $self->throw_exception ("Can't handle condition $cond for relationship '$rel_name' yet :(");
1799 # Accepts one or more relationships for the current source and returns an
1800 # array of column names for each of those relationships. Column names are
1801 # prefixed relative to the current source, in accordance with where they appear
1802 # in the supplied relationships.
1803 sub _resolve_prefetch {
1804 my ($self, $pre, $alias, $alias_map, $order, $collapse, $pref_path) = @_;
1807 if (not defined $pre or not length $pre) {
1810 elsif( ref $pre eq 'ARRAY' ) {
1812 map { $self->_resolve_prefetch( $_, $alias, $alias_map, $order, $collapse, [ @$pref_path ] ) }
1815 elsif( ref $pre eq 'HASH' ) {
1818 $self->_resolve_prefetch($_, $alias, $alias_map, $order, $collapse, [ @$pref_path ] ),
1819 $self->related_source($_)->_resolve_prefetch(
1820 $pre->{$_}, "${alias}.$_", $alias_map, $order, $collapse, [ @$pref_path, $_] )
1825 $self->throw_exception(
1826 "don't know how to resolve prefetch reftype ".ref($pre));
1830 $p = $p->{$_} for (@$pref_path, $pre);
1832 $self->throw_exception (
1833 "Unable to resolve prefetch '$pre' - join alias map does not contain an entry for path: "
1834 . join (' -> ', @$pref_path, $pre)
1835 ) if (ref $p->{-join_aliases} ne 'ARRAY' or not @{$p->{-join_aliases}} );
1837 my $as = shift @{$p->{-join_aliases}};
1839 my $rel_info = $self->relationship_info( $pre );
1840 $self->throw_exception( $self->source_name . " has no such relationship '$pre'" )
1842 my $as_prefix = ($alias =~ /^.*?\.(.+)$/ ? $1.'.' : '');
1843 my $rel_source = $self->related_source($pre);
1845 if ($rel_info->{attrs}{accessor} && $rel_info->{attrs}{accessor} eq 'multi') {
1846 $self->throw_exception(
1847 "Can't prefetch has_many ${pre} (join cond too complex)")
1848 unless ref($rel_info->{cond}) eq 'HASH';
1849 my $dots = @{[$as_prefix =~ m/\./g]} + 1; # +1 to match the ".${as_prefix}"
1851 if (my ($fail) = grep { @{[$_ =~ m/\./g]} == $dots }
1852 keys %{$collapse}) {
1853 my ($last) = ($fail =~ /([^\.]+)$/);
1855 "Prefetching multiple has_many rels ${last} and ${pre} "
1856 .(length($as_prefix)
1857 ? "at the same level (${as_prefix}) "
1860 . 'will explode the number of row objects retrievable via ->next or ->all. '
1861 . 'Use at your own risk.'
1865 #my @col = map { (/^self\.(.+)$/ ? ("${as_prefix}.$1") : ()); }
1866 # values %{$rel_info->{cond}};
1867 $collapse->{".${as_prefix}${pre}"} = [ $rel_source->_pri_cols ];
1868 # action at a distance. prepending the '.' allows simpler code
1869 # in ResultSet->_collapse_result
1870 my @key = map { (/^foreign\.(.+)$/ ? ($1) : ()); }
1871 keys %{$rel_info->{cond}};
1872 push @$order, map { "${as}.$_" } @key;
1874 if (my $rel_order = $rel_info->{attrs}{order_by}) {
1875 # this is kludgy and incomplete, I am well aware
1876 # but the parent method is going away entirely anyway
1878 my $sql_maker = $self->storage->sql_maker;
1879 my ($orig_ql, $orig_qr) = $sql_maker->_quote_chars;
1880 my $sep = $sql_maker->name_sep;
1882 # install our own quoter, so we can catch unqualified stuff
1883 local $sql_maker->{quote_char} = ["\x00", "\xFF"];
1885 my $quoted_prefix = "\x00${as}\xFF";
1887 for my $chunk ( $sql_maker->_order_by_chunks ($rel_order) ) {
1889 ($chunk, @bind) = @$chunk if ref $chunk;
1891 $chunk = "${quoted_prefix}${sep}${chunk}"
1892 unless $chunk =~ /\Q$sep/;
1894 $chunk =~ s/\x00/$orig_ql/g;
1895 $chunk =~ s/\xFF/$orig_qr/g;
1896 push @$order, \[$chunk, @bind];
1901 return map { [ "${as}.$_", "${as_prefix}${pre}.$_", ] }
1902 $rel_source->columns;
1906 =head2 related_source
1910 =item Arguments: $rel_name
1912 =item Return Value: $source
1916 Returns the result source object for the given relationship.
1920 sub related_source {
1921 my ($self, $rel) = @_;
1922 if( !$self->has_relationship( $rel ) ) {
1923 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
1926 # if we are not registered with a schema - just use the prototype
1927 # however if we do have a schema - ask for the source by name (and
1928 # throw in the process if all fails)
1929 if (my $schema = try { $self->schema }) {
1930 $schema->source($self->relationship_info($rel)->{source});
1933 my $class = $self->relationship_info($rel)->{class};
1934 $self->ensure_class_loaded($class);
1935 $class->result_source_instance;
1939 =head2 related_class
1943 =item Arguments: $rel_name
1945 =item Return Value: $classname
1949 Returns the class name for objects in the given relationship.
1954 my ($self, $rel) = @_;
1955 if( !$self->has_relationship( $rel ) ) {
1956 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
1958 return $self->schema->class($self->relationship_info($rel)->{source});
1965 =item Arguments: none
1967 =item Return Value: L<$source_handle|DBIx::Class::ResultSourceHandle>
1971 Obtain a new L<result source handle instance|DBIx::Class::ResultSourceHandle>
1972 for this source. Used as a serializable pointer to this resultsource, as it is not
1973 easy (nor advisable) to serialize CODErefs which may very well be present in e.g.
1974 relationship definitions.
1979 return DBIx::Class::ResultSourceHandle->new({
1980 source_moniker => $_[0]->source_name,
1982 # so that a detached thaw can be re-frozen
1983 $_[0]->{_detached_thaw}
1984 ? ( _detached_source => $_[0] )
1985 : ( schema => $_[0]->schema )
1990 my $global_phase_destroy;
1992 return if $global_phase_destroy ||= in_global_destruction;
1998 # Under no circumstances shall $_[0] be stored anywhere else (like copied to
1999 # a lexical variable, or shifted, or anything else). Doing so will mess up
2000 # the refcount of this particular result source, and will allow the $schema
2001 # we are trying to save to reattach back to the source we are destroying.
2002 # The relevant code checking refcounts is in ::Schema::DESTROY()
2004 # if we are not a schema instance holder - we don't matter
2006 ! ref $_[0]->{schema}
2008 isweak $_[0]->{schema}
2011 # weaken our schema hold forcing the schema to find somewhere else to live
2012 # during global destruction (if we have not yet bailed out) this will throw
2013 # which will serve as a signal to not try doing anything else
2014 # however beware - on older perls the exception seems randomly untrappable
2015 # due to some weird race condition during thread joining :(((
2018 weaken $_[0]->{schema};
2020 # if schema is still there reintroduce ourselves with strong refs back to us
2021 if ($_[0]->{schema}) {
2022 my $srcregs = $_[0]->{schema}->source_registrations;
2023 for (keys %$srcregs) {
2024 next unless $srcregs->{$_};
2025 $srcregs->{$_} = $_[0] if $srcregs->{$_} == $_[0];
2031 $global_phase_destroy = 1;
2037 sub STORABLE_freeze { Storable::nfreeze($_[0]->handle) }
2040 my ($self, $cloning, $ice) = @_;
2041 %$self = %{ (Storable::thaw($ice))->resolve };
2044 =head2 throw_exception
2046 See L<DBIx::Class::Schema/"throw_exception">.
2050 sub throw_exception {
2054 ? $self->{schema}->throw_exception(@_)
2055 : DBIx::Class::Exception->throw(@_)
2061 Stores a hashref of per-source metadata. No specific key names
2062 have yet been standardized, the examples below are purely hypothetical
2063 and don't actually accomplish anything on their own:
2065 __PACKAGE__->source_info({
2066 "_tablespace" => 'fast_disk_array_3',
2067 "_engine" => 'InnoDB',
2074 $class->new({attribute_name => value});
2076 Creates a new ResultSource object. Not normally called directly by end users.
2078 =head2 column_info_from_storage
2082 =item Arguments: 1/0 (default: 0)
2084 =item Return Value: 1/0
2088 __PACKAGE__->column_info_from_storage(1);
2090 Enables the on-demand automatic loading of the above column
2091 metadata from storage as necessary. This is *deprecated*, and
2092 should not be used. It will be removed before 1.0.
2095 =head1 AUTHOR AND CONTRIBUTORS
2097 See L<AUTHOR|DBIx::Class/AUTHOR> and L<CONTRIBUTORS|DBIx::Class/CONTRIBUTORS> in DBIx::Class
2101 You may distribute this code under the same terms as Perl itself.