1 package DBIx::Class::ResultSource;
6 use DBIx::Class::ResultSet;
7 use DBIx::Class::ResultSourceHandle;
9 use DBIx::Class::Exception;
10 use DBIx::Class::Carp;
11 use Devel::GlobalDestruction;
13 use List::Util 'first';
14 use Scalar::Util qw/blessed weaken isweak/;
17 use base qw/DBIx::Class/;
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",
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) = @_;
591 # check if primary key columns are valid columns
592 foreach my $col (@cols) {
593 $self->throw_exception("No such column $col on table " . $self->name)
594 unless $self->has_column($col);
596 $self->_primaries(\@cols);
598 $self->add_unique_constraint(primary => \@cols);
601 =head2 primary_columns
605 =item Arguments: none
607 =item Return Value: Ordered list of primary column names
611 Read-only accessor which returns the list of primary keys, supplied by
616 sub primary_columns {
617 return @{shift->_primaries||[]};
620 # a helper method that will automatically die with a descriptive message if
621 # no pk is defined on the source in question. For internal use to save
622 # on if @pks... boilerplate
625 my @pcols = $self->primary_columns
626 or $self->throw_exception (sprintf(
627 "Operation requires a primary key to be declared on '%s' via set_primary_key",
628 # source_name is set only after schema-registration
629 $self->source_name || $self->result_class || $self->name || 'Unknown source...?',
636 Manually define the correct sequence for your table, to avoid the overhead
637 associated with looking up the sequence automatically. The supplied sequence
638 will be applied to the L</column_info> of each L<primary_key|/set_primary_key>
642 =item Arguments: $sequence_name
644 =item Return Value: not defined
651 my ($self,$seq) = @_;
653 my @pks = $self->primary_columns
656 $_->{sequence} = $seq
657 for values %{ $self->columns_info (\@pks) };
661 =head2 add_unique_constraint
665 =item Arguments: $name?, \@colnames
667 =item Return Value: not defined
671 Declare a unique constraint on this source. Call once for each unique
674 # For UNIQUE (column1, column2)
675 __PACKAGE__->add_unique_constraint(
676 constraint_name => [ qw/column1 column2/ ],
679 Alternatively, you can specify only the columns:
681 __PACKAGE__->add_unique_constraint([ qw/column1 column2/ ]);
683 This will result in a unique constraint named
684 C<table_column1_column2>, where C<table> is replaced with the table
687 Unique constraints are used, for example, when you pass the constraint
688 name as the C<key> attribute to L<DBIx::Class::ResultSet/find>. Then
689 only columns in the constraint are searched.
691 Throws an error if any of the given column names do not yet exist on
696 sub add_unique_constraint {
700 $self->throw_exception(
701 'add_unique_constraint() does not accept multiple constraints, use '
702 . 'add_unique_constraints() instead'
707 if (ref $cols ne 'ARRAY') {
708 $self->throw_exception (
709 'Expecting an arrayref of constraint columns, got ' . ($cols||'NOTHING')
715 $name ||= $self->name_unique_constraint($cols);
717 foreach my $col (@$cols) {
718 $self->throw_exception("No such column $col on table " . $self->name)
719 unless $self->has_column($col);
722 my %unique_constraints = $self->unique_constraints;
723 $unique_constraints{$name} = $cols;
724 $self->_unique_constraints(\%unique_constraints);
727 =head2 add_unique_constraints
731 =item Arguments: @constraints
733 =item Return Value: not defined
737 Declare multiple unique constraints on this source.
739 __PACKAGE__->add_unique_constraints(
740 constraint_name1 => [ qw/column1 column2/ ],
741 constraint_name2 => [ qw/column2 column3/ ],
744 Alternatively, you can specify only the columns:
746 __PACKAGE__->add_unique_constraints(
747 [ qw/column1 column2/ ],
748 [ qw/column3 column4/ ]
751 This will result in unique constraints named C<table_column1_column2> and
752 C<table_column3_column4>, where C<table> is replaced with the table name.
754 Throws an error if any of the given column names do not yet exist on
757 See also L</add_unique_constraint>.
761 sub add_unique_constraints {
763 my @constraints = @_;
765 if ( !(@constraints % 2) && first { ref $_ ne 'ARRAY' } @constraints ) {
766 # with constraint name
767 while (my ($name, $constraint) = splice @constraints, 0, 2) {
768 $self->add_unique_constraint($name => $constraint);
773 foreach my $constraint (@constraints) {
774 $self->add_unique_constraint($constraint);
779 =head2 name_unique_constraint
783 =item Arguments: \@colnames
785 =item Return Value: Constraint name
789 $source->table('mytable');
790 $source->name_unique_constraint(['col1', 'col2']);
794 Return a name for a unique constraint containing the specified
795 columns. The name is created by joining the table name and each column
796 name, using an underscore character.
798 For example, a constraint on a table named C<cd> containing the columns
799 C<artist> and C<title> would result in a constraint name of C<cd_artist_title>.
801 This is used by L</add_unique_constraint> if you do not specify the
802 optional constraint name.
806 sub name_unique_constraint {
807 my ($self, $cols) = @_;
809 my $name = $self->name;
810 $name = $$name if (ref $name eq 'SCALAR');
812 return join '_', $name, @$cols;
815 =head2 unique_constraints
819 =item Arguments: none
821 =item Return Value: Hash of unique constraint data
825 $source->unique_constraints();
827 Read-only accessor which returns a hash of unique constraints on this
830 The hash is keyed by constraint name, and contains an arrayref of
831 column names as values.
835 sub unique_constraints {
836 return %{shift->_unique_constraints||{}};
839 =head2 unique_constraint_names
843 =item Arguments: none
845 =item Return Value: Unique constraint names
849 $source->unique_constraint_names();
851 Returns the list of unique constraint names defined on this source.
855 sub unique_constraint_names {
858 my %unique_constraints = $self->unique_constraints;
860 return keys %unique_constraints;
863 =head2 unique_constraint_columns
867 =item Arguments: $constraintname
869 =item Return Value: List of constraint columns
873 $source->unique_constraint_columns('myconstraint');
875 Returns the list of columns that make up the specified unique constraint.
879 sub unique_constraint_columns {
880 my ($self, $constraint_name) = @_;
882 my %unique_constraints = $self->unique_constraints;
884 $self->throw_exception(
885 "Unknown unique constraint $constraint_name on '" . $self->name . "'"
886 ) unless exists $unique_constraints{$constraint_name};
888 return @{ $unique_constraints{$constraint_name} };
891 =head2 sqlt_deploy_callback
895 =item Arguments: $callback_name | \&callback_code
897 =item Return Value: $callback_name | \&callback_code
901 __PACKAGE__->sqlt_deploy_callback('mycallbackmethod');
905 __PACKAGE__->sqlt_deploy_callback(sub {
906 my ($source_instance, $sqlt_table) = @_;
910 An accessor to set a callback to be called during deployment of
911 the schema via L<DBIx::Class::Schema/create_ddl_dir> or
912 L<DBIx::Class::Schema/deploy>.
914 The callback can be set as either a code reference or the name of a
915 method in the current result class.
917 Defaults to L</default_sqlt_deploy_hook>.
919 Your callback will be passed the $source object representing the
920 ResultSource instance being deployed, and the
921 L<SQL::Translator::Schema::Table> object being created from it. The
922 callback can be used to manipulate the table object or add your own
923 customised indexes. If you need to manipulate a non-table object, use
924 the L<DBIx::Class::Schema/sqlt_deploy_hook>.
926 See L<DBIx::Class::Manual::Cookbook/Adding Indexes And Functions To
927 Your SQL> for examples.
929 This sqlt deployment callback can only be used to manipulate
930 SQL::Translator objects as they get turned into SQL. To execute
931 post-deploy statements which SQL::Translator does not currently
932 handle, override L<DBIx::Class::Schema/deploy> in your Schema class
933 and call L<dbh_do|DBIx::Class::Storage::DBI/dbh_do>.
935 =head2 default_sqlt_deploy_hook
937 This is the default deploy hook implementation which checks if your
938 current Result class has a C<sqlt_deploy_hook> method, and if present
939 invokes it B<on the Result class directly>. This is to preserve the
940 semantics of C<sqlt_deploy_hook> which was originally designed to expect
941 the Result class name and the
942 L<$sqlt_table instance|SQL::Translator::Schema::Table> of the table being
947 sub default_sqlt_deploy_hook {
950 my $class = $self->result_class;
952 if ($class and $class->can('sqlt_deploy_hook')) {
953 $class->sqlt_deploy_hook(@_);
957 sub _invoke_sqlt_deploy_hook {
959 if ( my $hook = $self->sqlt_deploy_callback) {
968 =item Arguments: $classname
970 =item Return Value: $classname
974 use My::Schema::ResultClass::Inflator;
977 use My::Schema::Artist;
979 __PACKAGE__->result_class('My::Schema::ResultClass::Inflator');
981 Set the default result class for this source. You can use this to create
982 and use your own result inflator. See L<DBIx::Class::ResultSet/result_class>
985 Please note that setting this to something like
986 L<DBIx::Class::ResultClass::HashRefInflator> will make every result unblessed
987 and make life more difficult. Inflators like those are better suited to
988 temporary usage via L<DBIx::Class::ResultSet/result_class>.
994 =item Arguments: none
996 =item Return Value: L<$resultset|DBIx::Class::ResultSet>
1000 Returns a resultset for the given source. This will initially be created
1001 on demand by calling
1003 $self->resultset_class->new($self, $self->resultset_attributes)
1005 but is cached from then on unless resultset_class changes.
1007 =head2 resultset_class
1011 =item Arguments: $classname
1013 =item Return Value: $classname
1017 package My::Schema::ResultSet::Artist;
1018 use base 'DBIx::Class::ResultSet';
1021 # In the result class
1022 __PACKAGE__->resultset_class('My::Schema::ResultSet::Artist');
1025 $source->resultset_class('My::Schema::ResultSet::Artist');
1027 Set the class of the resultset. This is useful if you want to create your
1028 own resultset methods. Create your own class derived from
1029 L<DBIx::Class::ResultSet>, and set it here. If called with no arguments,
1030 this method returns the name of the existing resultset class, if one
1033 =head2 resultset_attributes
1037 =item Arguments: L<\%attrs|DBIx::Class::ResultSet/ATTRIBUTES>
1039 =item Return Value: L<\%attrs|DBIx::Class::ResultSet/ATTRIBUTES>
1043 # In the result class
1044 __PACKAGE__->resultset_attributes({ order_by => [ 'id' ] });
1047 $source->resultset_attributes({ order_by => [ 'id' ] });
1049 Store a collection of resultset attributes, that will be set on every
1050 L<DBIx::Class::ResultSet> produced from this result source.
1052 B<CAVEAT>: C<resultset_attributes> comes with its own set of issues and
1053 bugs! While C<resultset_attributes> isn't deprecated per se, its usage is
1056 Since relationships use attributes to link tables together, the "default"
1057 attributes you set may cause unpredictable and undesired behavior. Furthermore,
1058 the defaults cannot be turned off, so you are stuck with them.
1060 In most cases, what you should actually be using are project-specific methods:
1062 package My::Schema::ResultSet::Artist;
1063 use base 'DBIx::Class::ResultSet';
1067 #__PACKAGE__->resultset_attributes({ prefetch => 'tracks' });
1070 sub with_tracks { shift->search({}, { prefetch => 'tracks' }) }
1073 $schema->resultset('Artist')->with_tracks->...
1075 This gives you the flexibility of not using it when you don't need it.
1077 For more complex situations, another solution would be to use a virtual view
1078 via L<DBIx::Class::ResultSource::View>.
1084 $self->throw_exception(
1085 'resultset does not take any arguments. If you want another resultset, '.
1086 'call it on the schema instead.'
1089 $self->resultset_class->new(
1092 try { %{$self->schema->default_resultset_attributes} },
1093 %{$self->{resultset_attributes}},
1102 =item Arguments: none
1104 =item Result value: $name
1108 Returns the name of the result source, which will typically be the table
1109 name. This may be a scalar reference if the result source has a non-standard
1116 =item Arguments: $source_name
1118 =item Result value: $source_name
1122 Set an alternate name for the result source when it is loaded into a schema.
1123 This is useful if you want to refer to a result source by a name other than
1126 package ArchivedBooks;
1127 use base qw/DBIx::Class/;
1128 __PACKAGE__->table('books_archive');
1129 __PACKAGE__->source_name('Books');
1131 # from your schema...
1132 $schema->resultset('Books')->find(1);
1138 =item Arguments: none
1140 =item Return Value: FROM clause
1144 my $from_clause = $source->from();
1146 Returns an expression of the source to be supplied to storage to specify
1147 retrieval from this source. In the case of a database, the required FROM
1152 sub from { die 'Virtual method!' }
1158 =item Arguments: L<$schema?|DBIx::Class::Schema>
1160 =item Return Value: L<$schema|DBIx::Class::Schema>
1164 my $schema = $source->schema();
1166 Sets and/or returns the L<DBIx::Class::Schema> object to which this
1167 result source instance has been attached to.
1173 $_[0]->{schema} = $_[1];
1176 $_[0]->{schema} || do {
1177 my $name = $_[0]->{source_name} || '_unnamed_';
1178 my $err = 'Unable to perform storage-dependent operations with a detached result source '
1179 . "(source '$name' is not associated with a schema).";
1181 $err .= ' You need to use $schema->thaw() or manually set'
1182 . ' $DBIx::Class::ResultSourceHandle::thaw_schema while thawing.'
1183 if $_[0]->{_detached_thaw};
1185 DBIx::Class::Exception->throw($err);
1194 =item Arguments: none
1196 =item Return Value: L<$storage|DBIx::Class::Storage>
1200 $source->storage->debug(1);
1202 Returns the L<storage handle|DBIx::Class::Storage> for the current schema.
1206 sub storage { shift->schema->storage; }
1208 =head2 add_relationship
1212 =item Arguments: $rel_name, $related_source_name, \%cond, \%attrs?
1214 =item Return Value: 1/true if it succeeded
1218 $source->add_relationship('rel_name', 'related_source', $cond, $attrs);
1220 L<DBIx::Class::Relationship> describes a series of methods which
1221 create pre-defined useful types of relationships. Look there first
1222 before using this method directly.
1224 The relationship name can be arbitrary, but must be unique for each
1225 relationship attached to this result source. 'related_source' should
1226 be the name with which the related result source was registered with
1227 the current schema. For example:
1229 $schema->source('Book')->add_relationship('reviews', 'Review', {
1230 'foreign.book_id' => 'self.id',
1233 The condition C<$cond> needs to be an L<SQL::Abstract>-style
1234 representation of the join between the tables. For example, if you're
1235 creating a relation from Author to Book,
1237 { 'foreign.author_id' => 'self.id' }
1239 will result in the JOIN clause
1241 author me JOIN book foreign ON foreign.author_id = me.id
1243 You can specify as many foreign => self mappings as necessary.
1245 Valid attributes are as follows:
1251 Explicitly specifies the type of join to use in the relationship. Any
1252 SQL join type is valid, e.g. C<LEFT> or C<RIGHT>. It will be placed in
1253 the SQL command immediately before C<JOIN>.
1257 An arrayref containing a list of accessors in the foreign class to proxy in
1258 the main class. If, for example, you do the following:
1260 CD->might_have(liner_notes => 'LinerNotes', undef, {
1261 proxy => [ qw/notes/ ],
1264 Then, assuming LinerNotes has an accessor named notes, you can do:
1266 my $cd = CD->find(1);
1267 # set notes -- LinerNotes object is created if it doesn't exist
1268 $cd->notes('Notes go here');
1272 Specifies the type of accessor that should be created for the
1273 relationship. Valid values are C<single> (for when there is only a single
1274 related object), C<multi> (when there can be many), and C<filter> (for
1275 when there is a single related object, but you also want the relationship
1276 accessor to double as a column accessor). For C<multi> accessors, an
1277 add_to_* method is also created, which calls C<create_related> for the
1282 Throws an exception if the condition is improperly supplied, or cannot
1287 sub add_relationship {
1288 my ($self, $rel, $f_source_name, $cond, $attrs) = @_;
1289 $self->throw_exception("Can't create relationship without join condition")
1293 # Check foreign and self are right in cond
1294 if ( (ref $cond ||'') eq 'HASH') {
1296 $self->throw_exception("Keys of condition should be of form 'foreign.col', not '$_'")
1297 if /\./ && !/^foreign\./;
1301 my %rels = %{ $self->_relationships };
1302 $rels{$rel} = { class => $f_source_name,
1303 source => $f_source_name,
1306 $self->_relationships(\%rels);
1310 # XXX disabled. doesn't work properly currently. skip in tests.
1312 my $f_source = $self->schema->source($f_source_name);
1313 unless ($f_source) {
1314 $self->ensure_class_loaded($f_source_name);
1315 $f_source = $f_source_name->result_source;
1316 #my $s_class = ref($self->schema);
1317 #$f_source_name =~ m/^${s_class}::(.*)$/;
1318 #$self->schema->register_class(($1 || $f_source_name), $f_source_name);
1319 #$f_source = $self->schema->source($f_source_name);
1321 return unless $f_source; # Can't test rel without f_source
1323 try { $self->_resolve_join($rel, 'me', {}, []) }
1325 # If the resolve failed, back out and re-throw the error
1327 $self->_relationships(\%rels);
1328 $self->throw_exception("Error creating relationship $rel: $_");
1334 =head2 relationships
1338 =item Arguments: none
1340 =item Return Value: L<@rel_names|DBIx::Class::Relationship>
1344 my @relnames = $source->relationships();
1346 Returns all relationship names for this source.
1351 return keys %{shift->_relationships};
1354 =head2 relationship_info
1358 =item Arguments: L<$rel_name|DBIx::Class::Relationship>
1360 =item Return Value: L<\%rel_data|DBIx::Class::Relationship::Base/add_relationship>
1364 Returns a hash of relationship information for the specified relationship
1365 name. The keys/values are as specified for L<DBIx::Class::Relationship::Base/add_relationship>.
1369 sub relationship_info {
1370 my ($self, $rel) = @_;
1371 return $self->_relationships->{$rel};
1374 =head2 has_relationship
1378 =item Arguments: L<$rel_name|DBIx::Class::Relationship>
1380 =item Return Value: 1/0 (true/false)
1384 Returns true if the source has a relationship of this name, false otherwise.
1388 sub has_relationship {
1389 my ($self, $rel) = @_;
1390 return exists $self->_relationships->{$rel};
1393 =head2 reverse_relationship_info
1397 =item Arguments: L<$rel_name|DBIx::Class::Relationship>
1399 =item Return Value: L<\%rel_data|DBIx::Class::Relationship::Base/add_relationship>
1403 Looks through all the relationships on the source this relationship
1404 points to, looking for one whose condition is the reverse of the
1405 condition on this relationship.
1407 A common use of this is to find the name of the C<belongs_to> relation
1408 opposing a C<has_many> relation. For definition of these look in
1409 L<DBIx::Class::Relationship>.
1411 The returned hashref is keyed by the name of the opposing
1412 relationship, and contains its data in the same manner as
1413 L</relationship_info>.
1417 sub reverse_relationship_info {
1418 my ($self, $rel) = @_;
1420 my $rel_info = $self->relationship_info($rel)
1421 or $self->throw_exception("No such relationship '$rel'");
1425 return $ret unless ((ref $rel_info->{cond}) eq 'HASH');
1427 my $stripped_cond = $self->__strip_relcond ($rel_info->{cond});
1429 my $rsrc_schema_moniker = $self->source_name
1430 if try { $self->schema };
1432 # this may be a partial schema or something else equally esoteric
1433 my $other_rsrc = try { $self->related_source($rel) }
1436 # Get all the relationships for that source that related to this source
1437 # whose foreign column set are our self columns on $rel and whose self
1438 # columns are our foreign columns on $rel
1439 foreach my $other_rel ($other_rsrc->relationships) {
1441 # only consider stuff that points back to us
1442 # "us" here is tricky - if we are in a schema registration, we want
1443 # to use the source_names, otherwise we will use the actual classes
1445 # the schema may be partial
1446 my $roundtrip_rsrc = try { $other_rsrc->related_source($other_rel) }
1449 if ($rsrc_schema_moniker and try { $roundtrip_rsrc->schema } ) {
1450 next unless $rsrc_schema_moniker eq $roundtrip_rsrc->source_name;
1453 next unless $self->result_class eq $roundtrip_rsrc->result_class;
1456 my $other_rel_info = $other_rsrc->relationship_info($other_rel);
1458 # this can happen when we have a self-referential class
1459 next if $other_rel_info eq $rel_info;
1461 next unless ref $other_rel_info->{cond} eq 'HASH';
1462 my $other_stripped_cond = $self->__strip_relcond($other_rel_info->{cond});
1464 $ret->{$other_rel} = $other_rel_info if (
1465 $self->_compare_relationship_keys (
1466 [ keys %$stripped_cond ], [ values %$other_stripped_cond ]
1469 $self->_compare_relationship_keys (
1470 [ values %$stripped_cond ], [ keys %$other_stripped_cond ]
1478 # all this does is removes the foreign/self prefix from a condition
1479 sub __strip_relcond {
1482 { map { /^ (?:foreign|self) \. (\w+) $/x } ($_, $_[1]{$_}) }
1487 sub compare_relationship_keys {
1488 carp 'compare_relationship_keys is a private method, stop calling it';
1490 $self->_compare_relationship_keys (@_);
1493 # Returns true if both sets of keynames are the same, false otherwise.
1494 sub _compare_relationship_keys {
1495 # my ($self, $keys1, $keys2) = @_;
1497 join ("\x00", sort @{$_[1]})
1499 join ("\x00", sort @{$_[2]})
1503 # optionally takes either an arrayref of column names, or a hashref of already
1504 # retrieved colinfos
1505 # returns an arrayref of column names of the shortest unique constraint
1506 # (matching some of the input if any), giving preference to the PK
1507 sub _identifying_column_set {
1508 my ($self, $cols) = @_;
1510 my %unique = $self->unique_constraints;
1511 my $colinfos = ref $cols eq 'HASH' ? $cols : $self->columns_info($cols||());
1513 # always prefer the PK first, and then shortest constraints first
1515 for my $set (delete $unique{primary}, sort { @$a <=> @$b } (values %unique) ) {
1516 next unless $set && @$set;
1519 next USET unless ($colinfos->{$_} && !$colinfos->{$_}{is_nullable} );
1522 # copy so we can mangle it at will
1529 # Returns the {from} structure used to express JOIN conditions
1531 my ($self, $join, $alias, $seen, $jpath, $parent_force_left) = @_;
1533 # we need a supplied one, because we do in-place modifications, no returns
1534 $self->throw_exception ('You must supply a seen hashref as the 3rd argument to _resolve_join')
1535 unless ref $seen eq 'HASH';
1537 $self->throw_exception ('You must supply a joinpath arrayref as the 4th argument to _resolve_join')
1538 unless ref $jpath eq 'ARRAY';
1540 $jpath = [@$jpath]; # copy
1542 if (not defined $join or not length $join) {
1545 elsif (ref $join eq 'ARRAY') {
1548 $self->_resolve_join($_, $alias, $seen, $jpath, $parent_force_left);
1551 elsif (ref $join eq 'HASH') {
1554 for my $rel (keys %$join) {
1556 my $rel_info = $self->relationship_info($rel)
1557 or $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
1559 my $force_left = $parent_force_left;
1560 $force_left ||= lc($rel_info->{attrs}{join_type}||'') eq 'left';
1562 # the actual seen value will be incremented by the recursion
1563 my $as = $self->storage->relname_to_table_alias(
1564 $rel, ($seen->{$rel} && $seen->{$rel} + 1)
1568 $self->_resolve_join($rel, $alias, $seen, [@$jpath], $force_left),
1569 $self->related_source($rel)->_resolve_join(
1570 $join->{$rel}, $as, $seen, [@$jpath, { $rel => $as }], $force_left
1578 $self->throw_exception("No idea how to resolve join reftype ".ref $join);
1581 my $count = ++$seen->{$join};
1582 my $as = $self->storage->relname_to_table_alias(
1583 $join, ($count > 1 && $count)
1586 my $rel_info = $self->relationship_info($join)
1587 or $self->throw_exception("No such relationship $join on " . $self->source_name);
1589 my $rel_src = $self->related_source($join);
1590 return [ { $as => $rel_src->from,
1592 -join_type => $parent_force_left
1594 : $rel_info->{attrs}{join_type}
1596 -join_path => [@$jpath, { $join => $as } ],
1598 $rel_info->{attrs}{accessor}
1600 first { $rel_info->{attrs}{accessor} eq $_ } (qw/single filter/)
1603 -relation_chain_depth => $seen->{-relation_chain_depth} || 0,
1605 scalar $self->_resolve_condition($rel_info->{cond}, $as, $alias, $join)
1611 carp 'pk_depends_on is a private method, stop calling it';
1613 $self->_pk_depends_on (@_);
1616 # Determines whether a relation is dependent on an object from this source
1617 # having already been inserted. Takes the name of the relationship and a
1618 # hashref of columns of the related object.
1619 sub _pk_depends_on {
1620 my ($self, $rel_name, $rel_data) = @_;
1622 my $relinfo = $self->relationship_info($rel_name);
1624 # don't assume things if the relationship direction is specified
1625 return $relinfo->{attrs}{is_foreign_key_constraint}
1626 if exists ($relinfo->{attrs}{is_foreign_key_constraint});
1628 my $cond = $relinfo->{cond};
1629 return 0 unless ref($cond) eq 'HASH';
1631 # map { foreign.foo => 'self.bar' } to { bar => 'foo' }
1632 my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond };
1634 # assume anything that references our PK probably is dependent on us
1635 # rather than vice versa, unless the far side is (a) defined or (b)
1637 my $rel_source = $self->related_source($rel_name);
1639 foreach my $p ($self->primary_columns) {
1640 if (exists $keyhash->{$p}) {
1641 unless (defined($rel_data->{$keyhash->{$p}})
1642 || $rel_source->column_info($keyhash->{$p})
1643 ->{is_auto_increment}) {
1652 sub resolve_condition {
1653 carp 'resolve_condition is a private method, stop calling it';
1655 $self->_resolve_condition (@_);
1658 our $UNRESOLVABLE_CONDITION = \ '1 = 0';
1660 # Resolves the passed condition to a concrete query fragment and a flag
1661 # indicating whether this is a cross-table condition. Also an optional
1662 # list of non-triviail values (notmally conditions) returned as a part
1663 # of a joinfree condition hash
1664 sub _resolve_condition {
1665 my ($self, $cond, $as, $for, $rel_name) = @_;
1667 my $obj_rel = !!blessed $for;
1669 if (ref $cond eq 'CODE') {
1670 my $relalias = $obj_rel ? 'me' : $as;
1672 my ($crosstable_cond, $joinfree_cond) = $cond->({
1673 self_alias => $obj_rel ? $as : $for,
1674 foreign_alias => $relalias,
1675 self_resultsource => $self,
1676 foreign_relname => $rel_name || ($obj_rel ? $as : $for),
1677 self_rowobj => $obj_rel ? $for : undef
1681 if ($joinfree_cond) {
1683 # FIXME sanity check until things stabilize, remove at some point
1684 $self->throw_exception (
1685 "A join-free condition returned for relationship '$rel_name' without a row-object to chain from"
1688 # FIXME another sanity check
1690 ref $joinfree_cond ne 'HASH'
1692 first { $_ !~ /^\Q$relalias.\E.+/ } keys %$joinfree_cond
1694 $self->throw_exception (
1695 "The join-free condition returned for relationship '$rel_name' must be a hash "
1696 .'reference with all keys being valid columns on the related result source'
1701 for (values %$joinfree_cond) {
1711 # see which parts of the joinfree cond are conditionals
1712 my $relcol_list = { map { $_ => 1 } $self->related_source($rel_name)->columns };
1714 for my $c (keys %$joinfree_cond) {
1715 my ($colname) = $c =~ /^ (?: \Q$relalias.\E )? (.+)/x;
1717 unless ($relcol_list->{$colname}) {
1718 push @$cond_cols, $colname;
1723 ref $joinfree_cond->{$c}
1725 ref $joinfree_cond->{$c} ne 'SCALAR'
1727 ref $joinfree_cond->{$c} ne 'REF'
1729 push @$cond_cols, $colname;
1734 return wantarray ? ($joinfree_cond, 0, $cond_cols) : $joinfree_cond;
1737 return wantarray ? ($crosstable_cond, 1) : $crosstable_cond;
1740 elsif (ref $cond eq 'HASH') {
1742 foreach my $k (keys %{$cond}) {
1743 my $v = $cond->{$k};
1744 # XXX should probably check these are valid columns
1745 $k =~ s/^foreign\.// ||
1746 $self->throw_exception("Invalid rel cond key ${k}");
1747 $v =~ s/^self\.// ||
1748 $self->throw_exception("Invalid rel cond val ${v}");
1749 if (ref $for) { # Object
1750 #warn "$self $k $for $v";
1751 unless ($for->has_column_loaded($v)) {
1752 if ($for->in_storage) {
1753 $self->throw_exception(sprintf
1754 "Unable to resolve relationship '%s' from object %s: column '%s' not "
1755 . 'loaded from storage (or not passed to new() prior to insert()). You '
1756 . 'probably need to call ->discard_changes to get the server-side defaults '
1757 . 'from the database.',
1763 return $UNRESOLVABLE_CONDITION;
1765 $ret{$k} = $for->get_column($v);
1766 #$ret{$k} = $for->get_column($v) if $for->has_column_loaded($v);
1768 } elsif (!defined $for) { # undef, i.e. "no object"
1770 } elsif (ref $as eq 'HASH') { # reverse hashref
1771 $ret{$v} = $as->{$k};
1772 } elsif (ref $as) { # reverse object
1773 $ret{$v} = $as->get_column($k);
1774 } elsif (!defined $as) { # undef, i.e. "no reverse object"
1777 $ret{"${as}.${k}"} = { -ident => "${for}.${v}" };
1782 ? ( \%ret, ($obj_rel || !defined $as || ref $as) ? 0 : 1 )
1786 elsif (ref $cond eq 'ARRAY') {
1787 my (@ret, $crosstable);
1789 my ($cond, $crosstab) = $self->_resolve_condition($_, $as, $for, $rel_name);
1791 $crosstable ||= $crosstab;
1793 return wantarray ? (\@ret, $crosstable) : \@ret;
1796 $self->throw_exception ("Can't handle condition $cond for relationship '$rel_name' yet :(");
1800 # Accepts one or more relationships for the current source and returns an
1801 # array of column names for each of those relationships. Column names are
1802 # prefixed relative to the current source, in accordance with where they appear
1803 # in the supplied relationships.
1804 sub _resolve_prefetch {
1805 my ($self, $pre, $alias, $alias_map, $order, $collapse, $pref_path) = @_;
1808 if (not defined $pre or not length $pre) {
1811 elsif( ref $pre eq 'ARRAY' ) {
1813 map { $self->_resolve_prefetch( $_, $alias, $alias_map, $order, $collapse, [ @$pref_path ] ) }
1816 elsif( ref $pre eq 'HASH' ) {
1819 $self->_resolve_prefetch($_, $alias, $alias_map, $order, $collapse, [ @$pref_path ] ),
1820 $self->related_source($_)->_resolve_prefetch(
1821 $pre->{$_}, "${alias}.$_", $alias_map, $order, $collapse, [ @$pref_path, $_] )
1826 $self->throw_exception(
1827 "don't know how to resolve prefetch reftype ".ref($pre));
1831 $p = $p->{$_} for (@$pref_path, $pre);
1833 $self->throw_exception (
1834 "Unable to resolve prefetch '$pre' - join alias map does not contain an entry for path: "
1835 . join (' -> ', @$pref_path, $pre)
1836 ) if (ref $p->{-join_aliases} ne 'ARRAY' or not @{$p->{-join_aliases}} );
1838 my $as = shift @{$p->{-join_aliases}};
1840 my $rel_info = $self->relationship_info( $pre );
1841 $self->throw_exception( $self->source_name . " has no such relationship '$pre'" )
1843 my $as_prefix = ($alias =~ /^.*?\.(.+)$/ ? $1.'.' : '');
1844 my $rel_source = $self->related_source($pre);
1846 if ($rel_info->{attrs}{accessor} && $rel_info->{attrs}{accessor} eq 'multi') {
1847 $self->throw_exception(
1848 "Can't prefetch has_many ${pre} (join cond too complex)")
1849 unless ref($rel_info->{cond}) eq 'HASH';
1850 my $dots = @{[$as_prefix =~ m/\./g]} + 1; # +1 to match the ".${as_prefix}"
1852 if (my ($fail) = grep { @{[$_ =~ m/\./g]} == $dots }
1853 keys %{$collapse}) {
1854 my ($last) = ($fail =~ /([^\.]+)$/);
1856 "Prefetching multiple has_many rels ${last} and ${pre} "
1857 .(length($as_prefix)
1858 ? "at the same level (${as_prefix}) "
1861 . 'will explode the number of row objects retrievable via ->next or ->all. '
1862 . 'Use at your own risk.'
1866 #my @col = map { (/^self\.(.+)$/ ? ("${as_prefix}.$1") : ()); }
1867 # values %{$rel_info->{cond}};
1868 $collapse->{".${as_prefix}${pre}"} = [ $rel_source->_pri_cols ];
1869 # action at a distance. prepending the '.' allows simpler code
1870 # in ResultSet->_collapse_result
1871 my @key = map { (/^foreign\.(.+)$/ ? ($1) : ()); }
1872 keys %{$rel_info->{cond}};
1873 push @$order, map { "${as}.$_" } @key;
1875 if (my $rel_order = $rel_info->{attrs}{order_by}) {
1876 # this is kludgy and incomplete, I am well aware
1877 # but the parent method is going away entirely anyway
1879 my $sql_maker = $self->storage->sql_maker;
1880 my ($orig_ql, $orig_qr) = $sql_maker->_quote_chars;
1881 my $sep = $sql_maker->name_sep;
1883 # install our own quoter, so we can catch unqualified stuff
1884 local $sql_maker->{quote_char} = ["\x00", "\xFF"];
1886 my $quoted_prefix = "\x00${as}\xFF";
1888 for my $chunk ( $sql_maker->_order_by_chunks ($rel_order) ) {
1890 ($chunk, @bind) = @$chunk if ref $chunk;
1892 $chunk = "${quoted_prefix}${sep}${chunk}"
1893 unless $chunk =~ /\Q$sep/;
1895 $chunk =~ s/\x00/$orig_ql/g;
1896 $chunk =~ s/\xFF/$orig_qr/g;
1897 push @$order, \[$chunk, @bind];
1902 return map { [ "${as}.$_", "${as_prefix}${pre}.$_", ] }
1903 $rel_source->columns;
1907 =head2 related_source
1911 =item Arguments: $rel_name
1913 =item Return Value: $source
1917 Returns the result source object for the given relationship.
1921 sub related_source {
1922 my ($self, $rel) = @_;
1923 if( !$self->has_relationship( $rel ) ) {
1924 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
1927 # if we are not registered with a schema - just use the prototype
1928 # however if we do have a schema - ask for the source by name (and
1929 # throw in the process if all fails)
1930 if (my $schema = try { $self->schema }) {
1931 $schema->source($self->relationship_info($rel)->{source});
1934 my $class = $self->relationship_info($rel)->{class};
1935 $self->ensure_class_loaded($class);
1936 $class->result_source_instance;
1940 =head2 related_class
1944 =item Arguments: $rel_name
1946 =item Return Value: $classname
1950 Returns the class name for objects in the given relationship.
1955 my ($self, $rel) = @_;
1956 if( !$self->has_relationship( $rel ) ) {
1957 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
1959 return $self->schema->class($self->relationship_info($rel)->{source});
1966 =item Arguments: none
1968 =item Return Value: L<$source_handle|DBIx::Class::ResultSourceHandle>
1972 Obtain a new L<result source handle instance|DBIx::Class::ResultSourceHandle>
1973 for this source. Used as a serializable pointer to this resultsource, as it is not
1974 easy (nor advisable) to serialize CODErefs which may very well be present in e.g.
1975 relationship definitions.
1980 return DBIx::Class::ResultSourceHandle->new({
1981 source_moniker => $_[0]->source_name,
1983 # so that a detached thaw can be re-frozen
1984 $_[0]->{_detached_thaw}
1985 ? ( _detached_source => $_[0] )
1986 : ( schema => $_[0]->schema )
1991 my $global_phase_destroy;
1993 return if $global_phase_destroy ||= in_global_destruction;
1999 # Under no circumstances shall $_[0] be stored anywhere else (like copied to
2000 # a lexical variable, or shifted, or anything else). Doing so will mess up
2001 # the refcount of this particular result source, and will allow the $schema
2002 # we are trying to save to reattach back to the source we are destroying.
2003 # The relevant code checking refcounts is in ::Schema::DESTROY()
2005 # if we are not a schema instance holder - we don't matter
2007 ! ref $_[0]->{schema}
2009 isweak $_[0]->{schema}
2012 # weaken our schema hold forcing the schema to find somewhere else to live
2013 # during global destruction (if we have not yet bailed out) this will throw
2014 # which will serve as a signal to not try doing anything else
2015 # however beware - on older perls the exception seems randomly untrappable
2016 # due to some weird race condition during thread joining :(((
2019 weaken $_[0]->{schema};
2021 # if schema is still there reintroduce ourselves with strong refs back to us
2022 if ($_[0]->{schema}) {
2023 my $srcregs = $_[0]->{schema}->source_registrations;
2024 for (keys %$srcregs) {
2025 next unless $srcregs->{$_};
2026 $srcregs->{$_} = $_[0] if $srcregs->{$_} == $_[0];
2032 $global_phase_destroy = 1;
2038 sub STORABLE_freeze { Storable::nfreeze($_[0]->handle) }
2041 my ($self, $cloning, $ice) = @_;
2042 %$self = %{ (Storable::thaw($ice))->resolve };
2045 =head2 throw_exception
2047 See L<DBIx::Class::Schema/"throw_exception">.
2051 sub throw_exception {
2055 ? $self->{schema}->throw_exception(@_)
2056 : DBIx::Class::Exception->throw(@_)
2062 Stores a hashref of per-source metadata. No specific key names
2063 have yet been standardized, the examples below are purely hypothetical
2064 and don't actually accomplish anything on their own:
2066 __PACKAGE__->source_info({
2067 "_tablespace" => 'fast_disk_array_3',
2068 "_engine" => 'InnoDB',
2075 $class->new({attribute_name => value});
2077 Creates a new ResultSource object. Not normally called directly by end users.
2079 =head2 column_info_from_storage
2083 =item Arguments: 1/0 (default: 0)
2085 =item Return Value: 1/0
2089 __PACKAGE__->column_info_from_storage(1);
2091 Enables the on-demand automatic loading of the above column
2092 metadata from storage as necessary. This is *deprecated*, and
2093 should not be used. It will be removed before 1.0.
2096 =head1 AUTHOR AND CONTRIBUTORS
2098 See L<AUTHOR|DBIx::Class/AUTHOR> and L<CONTRIBUTORS|DBIx::Class/CONTRIBUTORS> in DBIx::Class
2102 You may distribute this code under the same terms as Perl itself.