1 package DBIx::Class::ResultSource;
5 # Some of the methods defined here will be around()-ed by code at the
6 # end of ::ResultSourceProxy. The reason for this strange arrangement
7 # is that the list of around()s of methods in this class depends
8 # directly on the list of may-not-be-defined-yet methods within
9 # ::ResultSourceProxy itself.
10 # If this sounds terrible - it is. But got to work with what we have.
16 use base 'DBIx::Class::ResultSource::RowParser';
18 use DBIx::Class::Carp;
19 use DBIx::Class::_Util qw(
20 UNRESOLVABLE_CONDITION
21 dbic_internal_try fail_on_internal_call
22 refdesc emit_loud_diag
24 use DBIx::Class::SQLMaker::Util qw( normalize_sqla_condition extract_equality_conditions );
25 use SQL::Abstract 'is_literal_value';
26 use Devel::GlobalDestruction;
27 use Scalar::Util qw( blessed weaken isweak refaddr );
29 # FIXME - somehow breaks ResultSetManager, do not remove until investigated
30 use DBIx::Class::ResultSet;
34 # This global is present for the afaik nonexistent, but nevertheless possible
35 # case of folks using stock ::ResultSet with a completely custom Result-class
36 # hierarchy, not derived from DBIx::Class::Row at all
37 # Instead of patching stuff all over the place - this would be one convenient
38 # place to override things if need be
39 our $__expected_result_class_isa = 'DBIx::Class::Row';
41 my @hashref_attributes = qw(
42 source_info resultset_attributes
43 _columns _unique_constraints _relationships
45 my @arrayref_attributes = qw(
46 _ordered_columns _primaries
48 __PACKAGE__->mk_group_accessors(rsrc_instance_specific_attribute =>
51 qw( source_name name column_info_from_storage sqlt_deploy_callback ),
54 __PACKAGE__->mk_group_accessors(rsrc_instance_specific_handler => qw(
61 DBIx::Class::ResultSource - Result source object
65 # Create a table based result source, in a result class.
67 package MyApp::Schema::Result::Artist;
68 use base qw/DBIx::Class::Core/;
70 __PACKAGE__->table('artist');
71 __PACKAGE__->add_columns(qw/ artistid name /);
72 __PACKAGE__->set_primary_key('artistid');
73 __PACKAGE__->has_many(cds => 'MyApp::Schema::Result::CD');
77 # Create a query (view) based result source, in a result class
78 package MyApp::Schema::Result::Year2000CDs;
79 use base qw/DBIx::Class::Core/;
81 __PACKAGE__->load_components('InflateColumn::DateTime');
82 __PACKAGE__->table_class('DBIx::Class::ResultSource::View');
84 __PACKAGE__->table('year2000cds');
85 __PACKAGE__->result_source->is_virtual(1);
86 __PACKAGE__->result_source->view_definition(
87 "SELECT cdid, artist, title FROM cd WHERE year ='2000'"
93 A ResultSource is an object that represents a source of data for querying.
95 This class is a base class for various specialised types of result
96 sources, for example L<DBIx::Class::ResultSource::Table>. Table is the
97 default result source type, so one is created for you when defining a
98 result class as described in the synopsis above.
100 More specifically, the L<DBIx::Class::Core> base class pulls in the
101 L<DBIx::Class::ResultSourceProxy::Table> component, which defines
102 the L<table|DBIx::Class::ResultSourceProxy::Table/table> method.
103 When called, C<table> creates and stores an instance of
104 L<DBIx::Class::ResultSource::Table>. Luckily, to use tables as result
105 sources, you don't need to remember any of this.
107 Result sources representing select queries, or views, can also be
108 created, see L<DBIx::Class::ResultSource::View> for full details.
110 =head2 Finding result source objects
112 As mentioned above, a result source instance is created and stored for
113 you when you define a
114 L<Result Class|DBIx::Class::Manual::Glossary/Result Class>.
116 You can retrieve the result source at runtime in the following ways:
120 =item From a Schema object:
122 $schema->source($source_name);
124 =item From a Result object:
126 $result->result_source;
128 =item From a ResultSet object:
140 $class->new({attribute_name => value});
142 Creates a new ResultSource object. Not normally called directly by end users.
149 sub __derived_instances {
151 (defined $_->{weakref})
154 } values %{ $rsrc_registry->{ refaddr($_[0]) }{ derivatives } }
158 my ($class, $attrs) = @_;
159 $class = ref $class if ref $class;
161 my $ancestor = delete $attrs->{__derived_from};
163 my $self = bless { %$attrs }, $class;
166 DBIx::Class::_ENV_::ASSERT_NO_ERRONEOUS_METAINSTANCE_USE
168 # a constructor with 'name' as sole arg clearly isn't "inheriting" from anything
169 ( not ( keys(%$self) == 1 and exists $self->{name} ) )
171 defined CORE::caller(1)
173 (CORE::caller(1))[3] !~ / ::new$ | ^ DBIx::Class :: (?:
174 ResultSourceProxy::Table::table
176 ResultSourceProxy::Table::_init_result_source_instance
181 local $Carp::CarpLevel = $Carp::CarpLevel + 1
183 Carp::confess("Incorrect instantiation of '$self': you almost certainly wanted to call ->clone() instead");
186 my $own_slot = $rsrc_registry->{
187 my $own_addr = refaddr $self
188 } = { derivatives => {} };
190 weaken( $own_slot->{weakref} = $self );
195 my $ancestor_slot = $rsrc_registry->{
196 my $ancestor_addr = refaddr $ancestor
200 # on ancestry recording compact registry slots, prevent unbound growth
201 for my $r ( $rsrc_registry, map { $_->{derivatives} } values %$rsrc_registry ) {
202 defined $r->{$_}{weakref} or delete $r->{$_}
206 weaken( $_->{$own_addr} = $own_slot ) for map
207 { $_->{derivatives} }
211 { defined $_->{derivatives}{$ancestor_addr} }
212 values %$rsrc_registry
219 $self->{resultset_class} ||= 'DBIx::Class::ResultSet';
220 $self->{name} ||= "!!NAME NOT SET!!";
221 $self->{_columns_info_loaded} ||= 0;
222 $self->{sqlt_deploy_callback} ||= 'default_sqlt_deploy_hook';
224 $self->{$_} = { %{ $self->{$_} || {} } }
225 for @hashref_attributes, '__metadata_divergencies';
227 $self->{$_} = [ @{ $self->{$_} || [] } ]
228 for @arrayref_attributes;
233 sub DBIx::Class::__Rsrc_Ancestry_iThreads_handler__::CLONE {
234 for my $r ( $rsrc_registry, map { $_->{derivatives} } values %$rsrc_registry ) {
236 defined $_->{weakref}
237 ? ( refaddr $_->{weakref} => $_ )
244 # needs direct access to $rsrc_registry under an assert
246 sub set_rsrc_instance_specific_attribute {
248 # only mark if we are setting something different
253 defined( $_[0]->{$_[1]} )
265 length ref( $_[0]->{$_[1]} )
268 # both refs (the mark-on-same-ref is deliberate)
271 # both differing strings
272 $_[2] ne $_[0]->{$_[1]}
278 # need to protect $_ here
280 $_[0]->__derived_instances,
282 # DO NOT REMOVE - this blob is marking *ancestors* as tainted, here to
283 # weed out any fallout from https://github.com/dbsrgits/dbix-class/commit/9e36e3ec
284 # Note that there is no way to kill this warning, aside from never
285 # calling set_primary_key etc more than once per hierarchy
286 # (this is why the entire thing is guarded by an assert)
289 DBIx::Class::_ENV_::ASSERT_NO_ERRONEOUS_METAINSTANCE_USE
291 grep { $_[1] eq $_ } qw( _unique_constraints _primaries source_info )
295 { defined($_->{weakref}) ? $_->{weakref} : () }
297 { defined( ( $_->{derivatives}{refaddr($_[0])} || {} )->{weakref} ) }
298 values %$rsrc_registry
304 $derivative->{__metadata_divergencies}{$_[1]}{ $callsite ||= do {
307 # FIXME - this is horrible, but it's the best we can do for now
308 # Replace when Carp::Skip is written (it *MUST* take this use-case
309 # into consideration)
311 my ($cs) = DBIx::Class::Carp::__find_caller(__PACKAGE__);
313 my ($fr_num, @fr) = 1;
314 while( @fr = CORE::caller($fr_num++) ) {
315 $cs =~ /^ \Qat $fr[1] line $fr[2]\E (?: $ | \n )/x
322 # FIXME - using refdesc here isn't great, but I can't think of anything
323 # better at this moment
325 ? "@{[ refdesc $_[0] ]}->$fr[3](...) $cs"
332 $_[0]->{$_[1]} = $_[2];
336 sub get_rsrc_instance_specific_attribute {
338 $_[0]->__emit_stale_metadata_diag( $_[1] ) if (
339 ! $_[0]->{__in_rsrc_setter_callstack}
341 $_[0]->{__metadata_divergencies}{$_[1]}
348 # reuse the elaborate set logic of instance_specific_attr
349 sub set_rsrc_instance_specific_handler {
350 $_[0]->set_rsrc_instance_specific_attribute($_[1], $_[2]);
352 # trigger a load for the case of $foo->handler_accessor("bar")->new
353 $_[0]->get_rsrc_instance_specific_handler($_[1])
354 if defined wantarray;
357 # This is essentially the same logic as get_component_class
358 # (in DBIC::AccessorGroup). However the latter is a grouped
359 # accessor type, and here we are strictly after a 'simple'
360 # So we go ahead and recreate the logic as found in ::AG
361 sub get_rsrc_instance_specific_handler {
363 # emit desync warnings if any
364 my $val = $_[0]->get_rsrc_instance_specific_attribute( $_[1] );
366 # plain string means class - load it
371 # inherited CAG can't be set to undef effectively, so people may use ''
374 ! defined blessed $val
376 ! ${"${val}::__LOADED__BY__DBIC__CAG__COMPONENT_CLASS__"}
378 $_[0]->ensure_class_loaded($val);
380 ${"${val}::__LOADED__BY__DBIC__CAG__COMPONENT_CLASS__"}
381 = do { \(my $anon = 'loaded') };
388 sub __construct_stale_metadata_diag {
389 return '' unless $_[0]->{__metadata_divergencies}{$_[1]};
393 # find the CAG getter FIRST
394 # allows unlimited user-namespace overrides without screwing around with
397 @fr = CORE::caller(++$fr_num)
399 $fr[3] ne 'DBIx::Class::ResultSource::get_rsrc_instance_specific_attribute'
402 Carp::confess( "You are not supposed to call __construct_stale_metadata_diag here..." )
405 # then find the first non-local, non-private reportable callsite
407 @fr = CORE::caller(++$fr_num)
414 $fr[1] =~ /^\(eval \d+\)$/
416 $fr[3] =~ /::(?: __ANON__ | _\w+ )$/x
418 $fr[0] =~ /^DBIx::Class::ResultSource/
422 my $by = ( @fr and $fr[3] =~ s/.+::// )
423 # FIXME - using refdesc here isn't great, but I can't think of anything
424 # better at this moment
425 ? " by 'getter' @{[ refdesc $_[0] ]}->$fr[3](...)\n within the callstack beginning"
429 # Given the full stacktrace combined with the really involved callstack
430 # there is no chance the emitter will properly deduplicate this
431 # Only complain once per callsite per source
432 return( ( $by and $_[0]->{__encountered_divergencies}{$by}++ )
436 : "$_[0] (the metadata instance of source '@{[ $_[0]->source_name ]}') is "
437 . "*OUTDATED*, and does not reflect the modifications of its "
438 . "*ancestors* as follows:\n"
443 { $a->[1] cmp $b->[1] }
445 { [ $_, ( $_ =~ /( at .+? line \d+)/ ) ] }
446 keys %{ $_[0]->{__metadata_divergencies}{$_[1]} }
448 . "\nStale metadata accessed${by}"
452 sub __emit_stale_metadata_diag {
455 # short circuit: no message - no diag
456 $_[0]->__construct_stale_metadata_diag($_[1])
460 # the constructor already does deduplication
462 confess => DBIx::Class::_ENV_::ASSERT_NO_ERRONEOUS_METAINSTANCE_USE,
468 $rsrc_instance->clone( atribute_name => overridden_value );
470 A wrapper around L</new> inheriting any defaults from the callee. This method
471 also not normally invoked directly by end users.
481 ? ( %$self, __derived_from => $self )
485 (@_ == 1 and ref $_[0] eq 'HASH')
498 =item Arguments: @columns
500 =item Return Value: L<$result_source|/new>
504 $source->add_columns(qw/col1 col2 col3/);
506 $source->add_columns('col1' => \%col1_info, 'col2' => \%col2_info, ...);
508 $source->add_columns(
509 'col1' => { data_type => 'integer', is_nullable => 1, ... },
510 'col2' => { data_type => 'text', is_auto_increment => 1, ... },
513 Adds columns to the result source. If supplied colname => hashref
514 pairs, uses the hashref as the L</column_info> for that column. Repeated
515 calls of this method will add more columns, not replace them.
517 The column names given will be created as accessor methods on your
518 L<Result|DBIx::Class::Manual::ResultClass> objects. You can change the name of the accessor
519 by supplying an L</accessor> in the column_info hash.
521 If a column name beginning with a plus sign ('+col1') is provided, the
522 attributes provided will be merged with any existing attributes for the
523 column, with the new attributes taking precedence in the case that an
524 attribute already exists. Using this without a hashref
525 (C<< $source->add_columns(qw/+col1 +col2/) >>) is legal, but useless --
526 it does the same thing it would do without the plus.
528 The contents of the column_info are not set in stone. The following
529 keys are currently recognised/used by DBIx::Class:
535 { accessor => '_name' }
537 # example use, replace standard accessor with one of your own:
539 my ($self, $value) = @_;
541 die "Name cannot contain digits!" if($value =~ /\d/);
542 $self->_name($value);
544 return $self->_name();
547 Use this to set the name of the accessor method for this column. If unset,
548 the name of the column will be used.
552 { data_type => 'integer' }
554 This contains the column type. It is automatically filled if you use the
555 L<SQL::Translator::Producer::DBIx::Class::File> producer, or the
556 L<DBIx::Class::Schema::Loader> module.
558 Currently there is no standard set of values for the data_type. Use
559 whatever your database supports.
565 The length of your column, if it is a column type that can have a size
566 restriction. This is currently only used to create tables from your
567 schema, see L<DBIx::Class::Schema/deploy>.
571 For decimal or float values you can specify an ArrayRef in order to
572 control precision, assuming your database's
573 L<SQL::Translator::Producer> supports it.
579 Set this to a true value for a column that is allowed to contain NULL
580 values, default is false. This is currently only used to create tables
581 from your schema, see L<DBIx::Class::Schema/deploy>.
583 =item is_auto_increment
585 { is_auto_increment => 1 }
587 Set this to a true value for a column whose value is somehow
588 automatically set, defaults to false. This is used to determine which
589 columns to empty when cloning objects using
590 L<DBIx::Class::Row/copy>. It is also used by
591 L<DBIx::Class::Schema/deploy>.
597 Set this to a true or false value (not C<undef>) to explicitly specify
598 if this column contains numeric data. This controls how set_column
599 decides whether to consider a column dirty after an update: if
600 C<is_numeric> is true a numeric comparison C<< != >> will take place
601 instead of the usual C<eq>
603 If not specified the storage class will attempt to figure this out on
604 first access to the column, based on the column C<data_type>. The
605 result will be cached in this attribute.
609 { is_foreign_key => 1 }
611 Set this to a true value for a column that contains a key from a
612 foreign table, defaults to false. This is currently only used to
613 create tables from your schema, see L<DBIx::Class::Schema/deploy>.
617 { default_value => \'now()' }
619 Set this to the default value which will be inserted into a column by
620 the database. Can contain either a value or a function (use a
621 reference to a scalar e.g. C<\'now()'> if you want a function). This
622 is currently only used to create tables from your schema, see
623 L<DBIx::Class::Schema/deploy>.
625 See the note on L<DBIx::Class::Row/new> for more information about possible
626 issues related to db-side default values.
630 { sequence => 'my_table_seq' }
632 Set this on a primary key column to the name of the sequence used to
633 generate a new key value. If not specified, L<DBIx::Class::PK::Auto>
634 will attempt to retrieve the name of the sequence from the database
637 =item retrieve_on_insert
639 { retrieve_on_insert => 1 }
641 For every column where this is set to true, DBIC will retrieve the RDBMS-side
642 value upon a new row insertion (normally only the autoincrement PK is
643 retrieved on insert). C<INSERT ... RETURNING> is used automatically if
644 supported by the underlying storage, otherwise an extra SELECT statement is
645 executed to retrieve the missing data.
649 { auto_nextval => 1 }
651 Set this to a true value for a column whose value is retrieved automatically
652 from a sequence or function (if supported by your Storage driver.) For a
653 sequence, if you do not use a trigger to get the nextval, you have to set the
654 L</sequence> value as well.
656 Also set this for MSSQL columns with the 'uniqueidentifier'
657 L<data_type|DBIx::Class::ResultSource/data_type> whose values you want to
658 automatically generate using C<NEWID()>, unless they are a primary key in which
659 case this will be done anyway.
663 This is used by L<DBIx::Class::Schema/deploy> and L<SQL::Translator>
664 to add extra non-generic data to the column. For example: C<< extra
665 => { unsigned => 1} >> is used by the MySQL producer to set an integer
666 column to unsigned. For more details, see
667 L<SQL::Translator::Producer::MySQL>.
675 =item Arguments: $colname, \%columninfo?
677 =item Return Value: 1/0 (true/false)
681 $source->add_column('col' => \%info);
683 Add a single column and optional column info. Uses the same column
684 info keys as L</add_columns>.
689 my ($self, @cols) = @_;
691 local $self->{__in_rsrc_setter_callstack} = 1
692 unless $self->{__in_rsrc_setter_callstack};
694 $self->_ordered_columns(\@cols) unless $self->_ordered_columns;
696 my ( @added, $colinfos );
697 my $columns = $self->_columns;
699 while (my $col = shift @cols) {
704 ( $colinfos ||= $self->columns_info )->{$col}
710 # If next entry is { ... } use that for the column info, if not
711 # use an empty hashref
713 my $new_info = shift(@cols);
714 %$column_info = (%$column_info, %$new_info);
716 push(@added, $col) unless exists $columns->{$col};
717 $columns->{$col} = $column_info;
720 push @{ $self->_ordered_columns }, @added;
721 $self->_columns($columns);
725 sub add_column :DBIC_method_is_indirect_sugar {
726 DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
727 shift->add_columns(@_)
734 =item Arguments: $colname
736 =item Return Value: 1/0 (true/false)
740 if ($source->has_column($colname)) { ... }
742 Returns true if the source has a column of this name, false otherwise.
747 my ($self, $column) = @_;
748 return exists $self->_columns->{$column};
755 =item Arguments: $colname
757 =item Return Value: Hashref of info
761 my $info = $source->column_info($col);
763 Returns the column metadata hashref for a column, as originally passed
764 to L</add_columns>. See L</add_columns> above for information on the
765 contents of the hashref.
769 sub column_info :DBIC_method_is_indirect_sugar {
770 DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
772 #my ($self, $column) = @_;
773 $_[0]->columns_info([ $_[1] ])->{$_[1]};
780 =item Arguments: none
782 =item Return Value: Ordered list of column names
786 my @column_names = $source->columns;
788 Returns all column names in the order they were declared to L</add_columns>.
794 $self->throw_exception(
795 "columns() is a read-only accessor, did you mean add_columns()?"
797 return @{$self->{_ordered_columns}||[]};
804 =item Arguments: \@colnames ?
806 =item Return Value: Hashref of column name/info pairs
810 my $columns_info = $source->columns_info;
812 Like L</column_info> but returns information for the requested columns. If
813 the optional column-list arrayref is omitted it returns info on all columns
814 currently defined on the ResultSource via L</add_columns>.
819 my ($self, $columns) = @_;
821 my $colinfo = $self->_columns;
824 ! $self->{_columns_info_loaded}
826 $self->column_info_from_storage
828 grep { ! $_->{data_type} } values %$colinfo
830 my $stor = dbic_internal_try { $self->schema->storage }
832 $self->{_columns_info_loaded}++;
834 # try for the case of storage without table
836 my $info = $stor->columns_info_for( $self->from );
838 { (lc $_) => $info->{$_} }
842 foreach my $col ( keys %$colinfo ) {
844 %{ $colinfo->{$col} },
845 %{ $info->{$col} || $lc_info->{lc $col} || {} }
855 if (my $inf = $colinfo->{$_}) {
859 $self->throw_exception( sprintf (
860 "No such column '%s' on source '%s'",
862 $self->source_name || $self->name || 'Unknown source...?',
868 # the shallow copy is crucial - there are exists() checks within
876 =head2 remove_columns
880 =item Arguments: @colnames
882 =item Return Value: not defined
886 $source->remove_columns(qw/col1 col2 col3/);
888 Removes the given list of columns by name, from the result source.
890 B<Warning>: Removing a column that is also used in the sources primary
891 key, or in one of the sources unique constraints, B<will> result in a
892 broken result source.
898 =item Arguments: $colname
900 =item Return Value: not defined
904 $source->remove_column('col');
906 Remove a single column by name from the result source, similar to
909 B<Warning>: Removing a column that is also used in the sources primary
910 key, or in one of the sources unique constraints, B<will> result in a
911 broken result source.
916 my ($self, @to_remove) = @_;
918 local $self->{__in_rsrc_setter_callstack} = 1
919 unless $self->{__in_rsrc_setter_callstack};
921 my $columns = $self->_columns
926 delete $columns->{$_};
930 $self->_ordered_columns([ grep { not $to_remove{$_} } @{$self->_ordered_columns} ]);
933 sub remove_column :DBIC_method_is_indirect_sugar {
934 DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
935 shift->remove_columns(@_)
938 =head2 set_primary_key
942 =item Arguments: @cols
944 =item Return Value: not defined
948 Defines one or more columns as primary key for this source. Must be
949 called after L</add_columns>.
951 Additionally, defines a L<unique constraint|/add_unique_constraint>
954 Note: you normally do want to define a primary key on your sources
955 B<even if the underlying database table does not have a primary key>.
957 L<DBIx::Class::Manual::Intro/The Significance and Importance of Primary Keys>
962 sub set_primary_key {
963 my ($self, @cols) = @_;
965 local $self->{__in_rsrc_setter_callstack} = 1
966 unless $self->{__in_rsrc_setter_callstack};
968 my $colinfo = $self->columns_info(\@cols);
969 for my $col (@cols) {
970 carp_unique(sprintf (
971 "Primary key of source '%s' includes the column '%s' which has its "
972 . "'is_nullable' attribute set to true. This is a mistake and will cause "
973 . 'various Result-object operations to fail',
974 $self->source_name || $self->name || 'Unknown source...?',
976 )) if $colinfo->{$col}{is_nullable};
979 $self->_primaries(\@cols);
981 $self->add_unique_constraint(primary => \@cols);
984 =head2 primary_columns
988 =item Arguments: none
990 =item Return Value: Ordered list of primary column names
994 Read-only accessor which returns the list of primary keys, supplied by
999 sub primary_columns {
1000 return @{shift->_primaries||[]};
1003 # a helper method that will automatically die with a descriptive message if
1004 # no pk is defined on the source in question. For internal use to save
1005 # on if @pks... boilerplate
1006 sub _pri_cols_or_die {
1008 my @pcols = $self->primary_columns
1009 or $self->throw_exception (sprintf(
1010 "Operation requires a primary key to be declared on '%s' via set_primary_key",
1011 # source_name is set only after schema-registration
1012 $self->source_name || $self->result_class || $self->name || 'Unknown source...?',
1017 # same as above but mandating single-column PK (used by relationship condition
1019 sub _single_pri_col_or_die {
1021 my ($pri, @too_many) = $self->_pri_cols_or_die;
1023 $self->throw_exception( sprintf(
1024 "Operation requires a single-column primary key declared on '%s'",
1025 $self->source_name || $self->result_class || $self->name || 'Unknown source...?',
1033 Manually define the correct sequence for your table, to avoid the overhead
1034 associated with looking up the sequence automatically. The supplied sequence
1035 will be applied to the L</column_info> of each L<primary_key|/set_primary_key>
1039 =item Arguments: $sequence_name
1041 =item Return Value: not defined
1048 my ($self,$seq) = @_;
1050 local $self->{__in_rsrc_setter_callstack} = 1
1051 unless $self->{__in_rsrc_setter_callstack};
1053 my @pks = $self->primary_columns
1056 $_->{sequence} = $seq
1057 for values %{ $self->columns_info (\@pks) };
1061 =head2 add_unique_constraint
1065 =item Arguments: $name?, \@colnames
1067 =item Return Value: not defined
1071 Declare a unique constraint on this source. Call once for each unique
1074 # For UNIQUE (column1, column2)
1075 __PACKAGE__->add_unique_constraint(
1076 constraint_name => [ qw/column1 column2/ ],
1079 Alternatively, you can specify only the columns:
1081 __PACKAGE__->add_unique_constraint([ qw/column1 column2/ ]);
1083 This will result in a unique constraint named
1084 C<table_column1_column2>, where C<table> is replaced with the table
1087 Unique constraints are used, for example, when you pass the constraint
1088 name as the C<key> attribute to L<DBIx::Class::ResultSet/find>. Then
1089 only columns in the constraint are searched.
1091 Throws an error if any of the given column names do not yet exist on
1096 sub add_unique_constraint {
1099 local $self->{__in_rsrc_setter_callstack} = 1
1100 unless $self->{__in_rsrc_setter_callstack};
1103 $self->throw_exception(
1104 'add_unique_constraint() does not accept multiple constraints, use '
1105 . 'add_unique_constraints() instead'
1110 if (ref $cols ne 'ARRAY') {
1111 $self->throw_exception (
1112 'Expecting an arrayref of constraint columns, got ' . ($cols||'NOTHING')
1116 my $name = shift @_;
1118 $name ||= $self->name_unique_constraint($cols);
1120 foreach my $col (@$cols) {
1121 $self->throw_exception("No such column $col on table " . $self->name)
1122 unless $self->has_column($col);
1125 my %unique_constraints = $self->unique_constraints;
1126 $unique_constraints{$name} = $cols;
1127 $self->_unique_constraints(\%unique_constraints);
1130 =head2 add_unique_constraints
1134 =item Arguments: @constraints
1136 =item Return Value: not defined
1140 Declare multiple unique constraints on this source.
1142 __PACKAGE__->add_unique_constraints(
1143 constraint_name1 => [ qw/column1 column2/ ],
1144 constraint_name2 => [ qw/column2 column3/ ],
1147 Alternatively, you can specify only the columns:
1149 __PACKAGE__->add_unique_constraints(
1150 [ qw/column1 column2/ ],
1151 [ qw/column3 column4/ ]
1154 This will result in unique constraints named C<table_column1_column2> and
1155 C<table_column3_column4>, where C<table> is replaced with the table name.
1157 Throws an error if any of the given column names do not yet exist on
1160 See also L</add_unique_constraint>.
1164 sub add_unique_constraints :DBIC_method_is_indirect_sugar {
1165 DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
1168 my @constraints = @_;
1170 if ( !(@constraints % 2) && grep { ref $_ ne 'ARRAY' } @constraints ) {
1171 # with constraint name
1172 while (my ($name, $constraint) = splice @constraints, 0, 2) {
1173 $self->add_unique_constraint($name => $constraint);
1177 # no constraint name
1178 foreach my $constraint (@constraints) {
1179 $self->add_unique_constraint($constraint);
1184 =head2 name_unique_constraint
1188 =item Arguments: \@colnames
1190 =item Return Value: Constraint name
1194 $source->table('mytable');
1195 $source->name_unique_constraint(['col1', 'col2']);
1199 Return a name for a unique constraint containing the specified
1200 columns. The name is created by joining the table name and each column
1201 name, using an underscore character.
1203 For example, a constraint on a table named C<cd> containing the columns
1204 C<artist> and C<title> would result in a constraint name of C<cd_artist_title>.
1206 This is used by L</add_unique_constraint> if you do not specify the
1207 optional constraint name.
1211 sub name_unique_constraint {
1212 my ($self, $cols) = @_;
1214 my $name = $self->name;
1215 $name = $$name if (ref $name eq 'SCALAR');
1216 $name =~ s/ ^ [^\.]+ \. //x; # strip possible schema qualifier
1218 return join '_', $name, @$cols;
1221 =head2 unique_constraints
1225 =item Arguments: none
1227 =item Return Value: Hash of unique constraint data
1231 $source->unique_constraints();
1233 Read-only accessor which returns a hash of unique constraints on this
1236 The hash is keyed by constraint name, and contains an arrayref of
1237 column names as values.
1241 sub unique_constraints {
1242 return %{shift->_unique_constraints||{}};
1245 =head2 unique_constraint_names
1249 =item Arguments: none
1251 =item Return Value: Unique constraint names
1255 $source->unique_constraint_names();
1257 Returns the list of unique constraint names defined on this source.
1261 sub unique_constraint_names {
1264 my %unique_constraints = $self->unique_constraints;
1266 return keys %unique_constraints;
1269 =head2 unique_constraint_columns
1273 =item Arguments: $constraintname
1275 =item Return Value: List of constraint columns
1279 $source->unique_constraint_columns('myconstraint');
1281 Returns the list of columns that make up the specified unique constraint.
1285 sub unique_constraint_columns {
1286 my ($self, $constraint_name) = @_;
1288 my %unique_constraints = $self->unique_constraints;
1290 $self->throw_exception(
1291 "Unknown unique constraint $constraint_name on '" . $self->name . "'"
1292 ) unless exists $unique_constraints{$constraint_name};
1294 return @{ $unique_constraints{$constraint_name} };
1297 =head2 sqlt_deploy_callback
1301 =item Arguments: $callback_name | \&callback_code
1303 =item Return Value: $callback_name | \&callback_code
1307 __PACKAGE__->result_source->sqlt_deploy_callback('mycallbackmethod');
1311 __PACKAGE__->result_source->sqlt_deploy_callback(sub {
1312 my ($source_instance, $sqlt_table) = @_;
1316 An accessor to set a callback to be called during deployment of
1317 the schema via L<DBIx::Class::Schema/create_ddl_dir> or
1318 L<DBIx::Class::Schema/deploy>.
1320 The callback can be set as either a code reference or the name of a
1321 method in the current result class.
1323 Defaults to L</default_sqlt_deploy_hook>.
1325 Your callback will be passed the $source object representing the
1326 ResultSource instance being deployed, and the
1327 L<SQL::Translator::Schema::Table> object being created from it. The
1328 callback can be used to manipulate the table object or add your own
1329 customised indexes. If you need to manipulate a non-table object, use
1330 the L<DBIx::Class::Schema/sqlt_deploy_hook>.
1332 See L<DBIx::Class::Manual::Cookbook/Adding Indexes And Functions To
1333 Your SQL> for examples.
1335 This sqlt deployment callback can only be used to manipulate
1336 SQL::Translator objects as they get turned into SQL. To execute
1337 post-deploy statements which SQL::Translator does not currently
1338 handle, override L<DBIx::Class::Schema/deploy> in your Schema class
1339 and call L<dbh_do|DBIx::Class::Storage::DBI/dbh_do>.
1341 =head2 default_sqlt_deploy_hook
1343 This is the default deploy hook implementation which checks if your
1344 current Result class has a C<sqlt_deploy_hook> method, and if present
1345 invokes it B<on the Result class directly>. This is to preserve the
1346 semantics of C<sqlt_deploy_hook> which was originally designed to expect
1347 the Result class name and the
1348 L<$sqlt_table instance|SQL::Translator::Schema::Table> of the table being
1353 sub default_sqlt_deploy_hook {
1356 my $class = $self->result_class;
1358 if ($class and $class->can('sqlt_deploy_hook')) {
1359 $class->sqlt_deploy_hook(@_);
1363 sub _invoke_sqlt_deploy_hook {
1365 if ( my $hook = $self->sqlt_deploy_callback) {
1374 =item Arguments: $classname
1376 =item Return Value: $classname
1380 use My::Schema::ResultClass::Inflator;
1383 use My::Schema::Artist;
1385 __PACKAGE__->result_class('My::Schema::ResultClass::Inflator');
1387 Set the default result class for this source. You can use this to create
1388 and use your own result inflator. See L<DBIx::Class::ResultSet/result_class>
1391 Please note that setting this to something like
1392 L<DBIx::Class::ResultClass::HashRefInflator> will make every result unblessed
1393 and make life more difficult. Inflators like those are better suited to
1394 temporary usage via L<DBIx::Class::ResultSet/result_class>.
1400 =item Arguments: none
1402 =item Return Value: L<$resultset|DBIx::Class::ResultSet>
1406 Returns a resultset for the given source. This will initially be created
1407 on demand by calling
1409 $self->resultset_class->new($self, $self->resultset_attributes)
1411 but is cached from then on unless resultset_class changes.
1413 =head2 resultset_class
1417 =item Arguments: $classname
1419 =item Return Value: $classname
1423 package My::Schema::ResultSet::Artist;
1424 use base 'DBIx::Class::ResultSet';
1427 # In the result class
1428 __PACKAGE__->resultset_class('My::Schema::ResultSet::Artist');
1431 $source->resultset_class('My::Schema::ResultSet::Artist');
1433 Set the class of the resultset. This is useful if you want to create your
1434 own resultset methods. Create your own class derived from
1435 L<DBIx::Class::ResultSet>, and set it here. If called with no arguments,
1436 this method returns the name of the existing resultset class, if one
1439 =head2 resultset_attributes
1443 =item Arguments: L<\%attrs|DBIx::Class::ResultSet/ATTRIBUTES>
1445 =item Return Value: L<\%attrs|DBIx::Class::ResultSet/ATTRIBUTES>
1449 # In the result class
1450 __PACKAGE__->resultset_attributes({ order_by => [ 'id' ] });
1453 $source->resultset_attributes({ order_by => [ 'id' ] });
1455 Store a collection of resultset attributes, that will be set on every
1456 L<DBIx::Class::ResultSet> produced from this result source.
1458 B<CAVEAT>: C<resultset_attributes> comes with its own set of issues and
1459 bugs! Notably the contents of the attributes are B<entirely static>, which
1460 greatly hinders composability (things like L<current_source_alias
1461 |DBIx::Class::ResultSet/current_source_alias> can not possibly be respected).
1462 While C<resultset_attributes> isn't deprecated per se, you are strongly urged
1463 to seek alternatives.
1465 Since relationships use attributes to link tables together, the "default"
1466 attributes you set may cause unpredictable and undesired behavior. Furthermore,
1467 the defaults B<cannot be turned off>, so you are stuck with them.
1469 In most cases, what you should actually be using are project-specific methods:
1471 package My::Schema::ResultSet::Artist;
1472 use base 'DBIx::Class::ResultSet';
1476 #__PACKAGE__->resultset_attributes({ prefetch => 'tracks' });
1479 sub with_tracks { shift->search({}, { prefetch => 'tracks' }) }
1482 $schema->resultset('Artist')->with_tracks->...
1484 This gives you the flexibility of not using it when you don't need it.
1486 For more complex situations, another solution would be to use a virtual view
1487 via L<DBIx::Class::ResultSource::View>.
1493 $self->throw_exception(
1494 'resultset does not take any arguments. If you want another resultset, '.
1495 'call it on the schema instead.'
1498 $self->resultset_class->new(
1501 ( dbic_internal_try { %{$self->schema->default_resultset_attributes} } ),
1502 %{$self->{resultset_attributes}},
1511 =item Arguments: none
1513 =item Result value: $name
1517 Returns the name of the result source, which will typically be the table
1518 name. This may be a scalar reference if the result source has a non-standard
1525 =item Arguments: $source_name
1527 =item Result value: $source_name
1531 Set an alternate name for the result source when it is loaded into a schema.
1532 This is useful if you want to refer to a result source by a name other than
1535 package ArchivedBooks;
1536 use base qw/DBIx::Class/;
1537 __PACKAGE__->table('books_archive');
1538 __PACKAGE__->source_name('Books');
1540 # from your schema...
1541 $schema->resultset('Books')->find(1);
1547 =item Arguments: none
1549 =item Return Value: FROM clause
1553 my $from_clause = $source->from();
1555 Returns an expression of the source to be supplied to storage to specify
1556 retrieval from this source. In the case of a database, the required FROM
1561 sub from { die 'Virtual method!' }
1565 Stores a hashref of per-source metadata. No specific key names
1566 have yet been standardized, the examples below are purely hypothetical
1567 and don't actually accomplish anything on their own:
1569 __PACKAGE__->source_info({
1570 "_tablespace" => 'fast_disk_array_3',
1571 "_engine" => 'InnoDB',
1578 =item Arguments: L<$schema?|DBIx::Class::Schema>
1580 =item Return Value: L<$schema|DBIx::Class::Schema>
1584 my $schema = $source->schema();
1586 Sets and/or returns the L<DBIx::Class::Schema> object to which this
1587 result source instance has been attached to.
1593 # invoke the mark-diverging logic
1594 $_[0]->set_rsrc_instance_specific_attribute( schema => $_[1] );
1597 $_[0]->get_rsrc_instance_specific_attribute( 'schema' ) || do {
1598 my $name = $_[0]->{source_name} || '_unnamed_';
1599 my $err = 'Unable to perform storage-dependent operations with a detached result source '
1600 . "(source '$name' is not associated with a schema).";
1602 $err .= ' You need to use $schema->thaw() or manually set'
1603 . ' $DBIx::Class::ResultSourceHandle::thaw_schema while thawing.'
1604 if $_[0]->{_detached_thaw};
1606 DBIx::Class::Exception->throw($err);
1615 =item Arguments: none
1617 =item Return Value: L<$storage|DBIx::Class::Storage>
1621 $source->storage->debug(1);
1623 Returns the L<storage handle|DBIx::Class::Storage> for the current schema.
1627 sub storage :DBIC_method_is_indirect_sugar {
1628 DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
1629 $_[0]->schema->storage
1632 =head2 add_relationship
1636 =item Arguments: $rel_name, $related_source_name, \%cond, \%attrs?
1638 =item Return Value: 1/true if it succeeded
1642 $source->add_relationship('rel_name', 'related_source', $cond, $attrs);
1644 L<DBIx::Class::Relationship> describes a series of methods which
1645 create pre-defined useful types of relationships. Look there first
1646 before using this method directly.
1648 The relationship name can be arbitrary, but must be unique for each
1649 relationship attached to this result source. 'related_source' should
1650 be the name with which the related result source was registered with
1651 the current schema. For example:
1653 $schema->source('Book')->add_relationship('reviews', 'Review', {
1654 'foreign.book_id' => 'self.id',
1657 The condition C<$cond> needs to be an L<SQL::Abstract>-style
1658 representation of the join between the tables. For example, if you're
1659 creating a relation from Author to Book,
1661 { 'foreign.author_id' => 'self.id' }
1663 will result in the JOIN clause
1665 author me JOIN book foreign ON foreign.author_id = me.id
1667 You can specify as many foreign => self mappings as necessary.
1669 Valid attributes are as follows:
1675 Explicitly specifies the type of join to use in the relationship. Any
1676 SQL join type is valid, e.g. C<LEFT> or C<RIGHT>. It will be placed in
1677 the SQL command immediately before C<JOIN>.
1681 An arrayref containing a list of accessors in the foreign class to proxy in
1682 the main class. If, for example, you do the following:
1684 CD->might_have(liner_notes => 'LinerNotes', undef, {
1685 proxy => [ qw/notes/ ],
1688 Then, assuming LinerNotes has an accessor named notes, you can do:
1690 my $cd = CD->find(1);
1691 # set notes -- LinerNotes object is created if it doesn't exist
1692 $cd->notes('Notes go here');
1696 Specifies the type of accessor that should be created for the
1697 relationship. Valid values are C<single> (for when there is only a single
1698 related object), C<multi> (when there can be many), and C<filter> (for
1699 when there is a single related object, but you also want the relationship
1700 accessor to double as a column accessor). For C<multi> accessors, an
1701 add_to_* method is also created, which calls C<create_related> for the
1706 Throws an exception if the condition is improperly supplied, or cannot
1711 sub add_relationship {
1712 my ($self, $rel, $f_source_name, $cond, $attrs) = @_;
1714 local $self->{__in_rsrc_setter_callstack} = 1
1715 unless $self->{__in_rsrc_setter_callstack};
1717 $self->throw_exception("Can't create relationship without join condition")
1721 # Check foreign and self are right in cond
1722 if ( (ref $cond ||'') eq 'HASH') {
1723 $_ =~ /^foreign\./ or $self->throw_exception("Malformed relationship condition key '$_': must be prefixed with 'foreign.'")
1726 $_ =~ /^self\./ or $self->throw_exception("Malformed relationship condition value '$_': must be prefixed with 'self.'")
1730 my %rels = %{ $self->_relationships };
1731 $rels{$rel} = { class => $f_source_name,
1732 source => $f_source_name,
1735 $self->_relationships(\%rels);
1740 =head2 relationships
1744 =item Arguments: none
1746 =item Return Value: L<@rel_names|DBIx::Class::Relationship>
1750 my @rel_names = $source->relationships();
1752 Returns all relationship names for this source.
1757 keys %{$_[0]->_relationships};
1760 =head2 relationship_info
1764 =item Arguments: L<$rel_name|DBIx::Class::Relationship>
1766 =item Return Value: L<\%rel_data|DBIx::Class::Relationship::Base/add_relationship>
1770 Returns a hash of relationship information for the specified relationship
1771 name. The keys/values are as specified for L<DBIx::Class::Relationship::Base/add_relationship>.
1775 sub relationship_info {
1776 #my ($self, $rel) = @_;
1777 return shift->_relationships->{+shift};
1780 =head2 has_relationship
1784 =item Arguments: L<$rel_name|DBIx::Class::Relationship>
1786 =item Return Value: 1/0 (true/false)
1790 Returns true if the source has a relationship of this name, false otherwise.
1794 sub has_relationship {
1795 #my ($self, $rel) = @_;
1796 return exists shift->_relationships->{+shift};
1799 =head2 reverse_relationship_info
1803 =item Arguments: L<$rel_name|DBIx::Class::Relationship>
1805 =item Return Value: L<\%rel_data|DBIx::Class::Relationship::Base/add_relationship>
1809 Looks through all the relationships on the source this relationship
1810 points to, looking for one whose condition is the reverse of the
1811 condition on this relationship.
1813 A common use of this is to find the name of the C<belongs_to> relation
1814 opposing a C<has_many> relation. For definition of these look in
1815 L<DBIx::Class::Relationship>.
1817 The returned hashref is keyed by the name of the opposing
1818 relationship, and contains its data in the same manner as
1819 L</relationship_info>.
1823 sub reverse_relationship_info {
1824 my ($self, $rel) = @_;
1826 my $rel_info = $self->relationship_info($rel)
1827 or $self->throw_exception("No such relationship '$rel'");
1831 return $ret unless ((ref $rel_info->{cond}) eq 'HASH');
1833 my $stripped_cond = $self->__strip_relcond ($rel_info->{cond});
1835 my $registered_source_name = $self->source_name;
1837 # this may be a partial schema or something else equally esoteric
1838 my $other_rsrc = $self->related_source($rel);
1840 # Get all the relationships for that source that related to this source
1841 # whose foreign column set are our self columns on $rel and whose self
1842 # columns are our foreign columns on $rel
1843 foreach my $other_rel ($other_rsrc->relationships) {
1845 # only consider stuff that points back to us
1846 # "us" here is tricky - if we are in a schema registration, we want
1847 # to use the source_names, otherwise we will use the actual classes
1849 # the schema may be partial
1850 my $roundtrip_rsrc = dbic_internal_try { $other_rsrc->related_source($other_rel) }
1853 if ($registered_source_name) {
1854 next if $registered_source_name ne ($roundtrip_rsrc->source_name || '')
1857 next if $self->result_class ne $roundtrip_rsrc->result_class;
1860 my $other_rel_info = $other_rsrc->relationship_info($other_rel);
1862 # this can happen when we have a self-referential class
1863 next if $other_rel_info eq $rel_info;
1865 next unless ref $other_rel_info->{cond} eq 'HASH';
1866 my $other_stripped_cond = $self->__strip_relcond($other_rel_info->{cond});
1868 $ret->{$other_rel} = $other_rel_info if (
1869 $self->_compare_relationship_keys (
1870 [ keys %$stripped_cond ], [ values %$other_stripped_cond ]
1873 $self->_compare_relationship_keys (
1874 [ values %$stripped_cond ], [ keys %$other_stripped_cond ]
1882 # all this does is removes the foreign/self prefix from a condition
1883 sub __strip_relcond {
1886 { map { /^ (?:foreign|self) \. (\w+) $/x } ($_, $_[1]{$_}) }
1891 sub compare_relationship_keys {
1892 carp 'compare_relationship_keys is a private method, stop calling it';
1894 $self->_compare_relationship_keys (@_);
1897 # Returns true if both sets of keynames are the same, false otherwise.
1898 sub _compare_relationship_keys {
1899 # my ($self, $keys1, $keys2) = @_;
1901 join ("\x00", sort @{$_[1]})
1903 join ("\x00", sort @{$_[2]})
1907 # optionally takes either an arrayref of column names, or a hashref of already
1908 # retrieved colinfos
1909 # returns an arrayref of column names of the shortest unique constraint
1910 # (matching some of the input if any), giving preference to the PK
1911 sub _identifying_column_set {
1912 my ($self, $cols) = @_;
1914 my %unique = $self->unique_constraints;
1915 my $colinfos = ref $cols eq 'HASH' ? $cols : $self->columns_info($cols||());
1917 # always prefer the PK first, and then shortest constraints first
1919 for my $set (delete $unique{primary}, sort { @$a <=> @$b } (values %unique) ) {
1920 next unless $set && @$set;
1923 next USET unless ($colinfos->{$_} && !$colinfos->{$_}{is_nullable} );
1926 # copy so we can mangle it at will
1933 sub _minimal_valueset_satisfying_constraint {
1935 my $args = { ref $_[0] eq 'HASH' ? %{ $_[0] } : @_ };
1937 $args->{columns_info} ||= $self->columns_info;
1939 my $vals = extract_equality_conditions(
1941 ($args->{carp_on_nulls} ? 'consider_nulls' : undef ),
1945 for my $col ($self->unique_constraint_columns($args->{constraint_name}) ) {
1946 if( ! exists $vals->{$col} or ( $vals->{$col}||'' ) eq UNRESOLVABLE_CONDITION ) {
1947 $cols->{missing}{$col} = undef;
1949 elsif( ! defined $vals->{$col} ) {
1950 $cols->{$args->{carp_on_nulls} ? 'undefined' : 'missing'}{$col} = undef;
1953 # we need to inject back the '=' as extract_equality_conditions()
1954 # will strip it from literals and values alike, resulting in an invalid
1955 # condition in the end
1956 $cols->{present}{$col} = { '=' => $vals->{$col} };
1959 $cols->{fc}{$col} = 1 if (
1960 ( ! $cols->{missing} or ! exists $cols->{missing}{$col} )
1962 keys %{ $args->{columns_info}{$col}{_filter_info} || {} }
1966 $self->throw_exception( sprintf ( "Unable to satisfy requested constraint '%s', missing values for column(s): %s",
1967 $args->{constraint_name},
1968 join (', ', map { "'$_'" } sort keys %{$cols->{missing}} ),
1969 ) ) if $cols->{missing};
1971 $self->throw_exception( sprintf (
1972 "Unable to satisfy requested constraint '%s', FilterColumn values not usable for column(s): %s",
1973 $args->{constraint_name},
1974 join (', ', map { "'$_'" } sort keys %{$cols->{fc}}),
1980 !$ENV{DBIC_NULLABLE_KEY_NOWARN}
1982 carp_unique ( sprintf (
1983 "NULL/undef values supplied for requested unique constraint '%s' (NULL "
1984 . 'values in column(s): %s). This is almost certainly not what you wanted, '
1985 . 'though you can set DBIC_NULLABLE_KEY_NOWARN to disable this warning.',
1986 $args->{constraint_name},
1987 join (', ', map { "'$_'" } sort keys %{$cols->{undefined}}),
1991 return { map { %{ $cols->{$_}||{} } } qw(present undefined) };
1994 # Returns the {from} structure used to express JOIN conditions
1996 my ($self, $join, $alias, $seen, $jpath, $parent_force_left) = @_;
1998 # we need a supplied one, because we do in-place modifications, no returns
1999 $self->throw_exception ('You must supply a seen hashref as the 3rd argument to _resolve_join')
2000 unless ref $seen eq 'HASH';
2002 $self->throw_exception ('You must supply a joinpath arrayref as the 4th argument to _resolve_join')
2003 unless ref $jpath eq 'ARRAY';
2005 $jpath = [@$jpath]; # copy
2007 if (not defined $join or not length $join) {
2010 elsif (ref $join eq 'ARRAY') {
2013 $self->_resolve_join($_, $alias, $seen, $jpath, $parent_force_left);
2016 elsif (ref $join eq 'HASH') {
2019 for my $rel (keys %$join) {
2021 my $rel_info = $self->relationship_info($rel)
2022 or $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
2024 my $force_left = $parent_force_left;
2025 $force_left ||= lc($rel_info->{attrs}{join_type}||'') eq 'left';
2027 # the actual seen value will be incremented by the recursion
2028 my $as = $self->schema->storage->relname_to_table_alias(
2029 $rel, ($seen->{$rel} && $seen->{$rel} + 1)
2033 $self->_resolve_join($rel, $alias, $seen, [@$jpath], $force_left),
2034 $self->related_source($rel)->_resolve_join(
2035 $join->{$rel}, $as, $seen, [@$jpath, { $rel => $as }], $force_left
2043 $self->throw_exception("No idea how to resolve join reftype ".ref $join);
2046 my $count = ++$seen->{$join};
2047 my $as = $self->schema->storage->relname_to_table_alias(
2048 $join, ($count > 1 && $count)
2051 my $rel_info = $self->relationship_info($join)
2052 or $self->throw_exception("No such relationship $join on " . $self->source_name);
2054 my $rel_src = $self->related_source($join);
2055 return [ { $as => $rel_src->from,
2057 -join_type => $parent_force_left
2059 : $rel_info->{attrs}{join_type}
2061 -join_path => [@$jpath, { $join => $as } ],
2063 ! $rel_info->{attrs}{accessor}
2065 $rel_info->{attrs}{accessor} eq 'single'
2067 $rel_info->{attrs}{accessor} eq 'filter'
2070 -relation_chain_depth => ( $seen->{-relation_chain_depth} || 0 ) + 1,
2072 $self->_resolve_relationship_condition(
2074 self_alias => $alias,
2075 foreign_alias => $as,
2082 carp 'pk_depends_on is a private method, stop calling it';
2084 $self->_pk_depends_on (@_);
2087 # Determines whether a relation is dependent on an object from this source
2088 # having already been inserted. Takes the name of the relationship and a
2089 # hashref of columns of the related object.
2090 sub _pk_depends_on {
2091 my ($self, $rel_name, $rel_data) = @_;
2093 my $relinfo = $self->relationship_info($rel_name);
2095 # don't assume things if the relationship direction is specified
2096 return $relinfo->{attrs}{is_foreign_key_constraint}
2097 if exists ($relinfo->{attrs}{is_foreign_key_constraint});
2099 my $cond = $relinfo->{cond};
2100 return 0 unless ref($cond) eq 'HASH';
2102 # map { foreign.foo => 'self.bar' } to { bar => 'foo' }
2103 my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond };
2105 # assume anything that references our PK probably is dependent on us
2106 # rather than vice versa, unless the far side is (a) defined or (b)
2108 my $rel_source = $self->related_source($rel_name);
2112 foreach my $p ($self->primary_columns) {
2114 exists $keyhash->{$p}
2116 ! defined( $rel_data->{$keyhash->{$p}} )
2118 ! ( $colinfos ||= $rel_source->columns_info )
2119 ->{$keyhash->{$p}}{is_auto_increment}
2126 sub resolve_condition {
2127 carp 'resolve_condition is a private method, stop calling it';
2128 shift->_resolve_condition (@_);
2131 sub _resolve_condition {
2132 # carp_unique sprintf
2133 # '_resolve_condition is a private method, and moreover is about to go '
2134 # . 'away. Please contact the development team at %s if you believe you '
2135 # . 'have a genuine use for this method, in order to discuss alternatives.',
2136 # DBIx::Class::_ENV_::HELP_URL,
2139 #######################
2140 ### API Design? What's that...? (a backwards compatible shim, kill me now)
2142 my ($self, $cond, @res_args, $rel_name);
2144 # we *SIMPLY DON'T KNOW YET* which arg is which, yay
2145 ($self, $cond, $res_args[0], $res_args[1], $rel_name) = @_;
2147 # assume that an undef is an object-like unset (set_from_related(undef))
2148 my @is_objlike = map { ! defined $_ or length ref $_ } (@res_args);
2150 # turn objlike into proper objects for saner code further down
2152 next unless $is_objlike[$_];
2154 if ( defined blessed $res_args[$_] ) {
2156 # but wait - there is more!!! WHAT THE FUCK?!?!?!?!
2157 if ($res_args[$_]->isa('DBIx::Class::ResultSet')) {
2158 carp('Passing a resultset for relationship resolution makes no sense - invoking __gremlins__');
2159 $is_objlike[$_] = 0;
2160 $res_args[$_] = '__gremlins__';
2164 $res_args[$_] ||= {};
2166 # hate everywhere - have to pass in as a plain hash
2167 # pretending to be an object at least for now
2168 $self->throw_exception("Unsupported object-like structure encountered: $res_args[$_]")
2169 unless ref $res_args[$_] eq 'HASH';
2174 # where-is-waldo block guesses relname, then further down we override it if available
2176 $is_objlike[1] ? ( rel_name => $res_args[0], self_alias => $res_args[0], foreign_alias => 'me', self_result_object => $res_args[1] )
2177 : $is_objlike[0] ? ( rel_name => $res_args[1], self_alias => 'me', foreign_alias => $res_args[1], foreign_values => $res_args[0] )
2178 : ( rel_name => $res_args[0], self_alias => $res_args[1], foreign_alias => $res_args[0] )
2181 ( $rel_name ? ( rel_name => $rel_name ) : () ),
2184 # Allowing passing relconds different than the relationshup itself is cute,
2185 # but likely dangerous. Remove that from the (still unofficial) API of
2186 # _resolve_relationship_condition, and instead make it "hard on purpose"
2187 local $self->relationship_info( $args->{rel_name} )->{cond} = $cond if defined $cond;
2189 #######################
2191 # now it's fucking easy isn't it?!
2192 my $rc = $self->_resolve_relationship_condition( $args );
2195 ( $rc->{join_free_condition} || $rc->{condition} ),
2196 ! $rc->{join_free_condition},
2199 # _resolve_relationship_condition always returns qualified cols even in the
2200 # case of join_free_condition, but nothing downstream expects this
2201 if ($rc->{join_free_condition} and ref $res[0] eq 'HASH') {
2203 { ($_ =~ /\.(.+)/) => $res[0]{$_} }
2209 return wantarray ? @res : $res[0];
2212 # Keep this indefinitely. There is evidence of both CPAN and
2213 # darkpan using it, and there isn't much harm in an extra var
2215 our $UNRESOLVABLE_CONDITION = UNRESOLVABLE_CONDITION;
2216 # YES I KNOW THIS IS EVIL
2217 # it is there to save darkpan from themselves, since internally
2218 # we are moving to a constant
2219 Internals::SvREADONLY($UNRESOLVABLE_CONDITION => 1);
2221 # Resolves the passed condition to a concrete query fragment and extra
2224 ## self-explanatory API, modeled on the custom cond coderef:
2225 # rel_name => (scalar)
2226 # foreign_alias => (scalar)
2227 # foreign_values => (either not supplied, or a hashref, or a foreign ResultObject (to be ->get_columns()ed), or plain undef )
2228 # self_alias => (scalar)
2229 # self_result_object => (either not supplied or a result object)
2230 # require_join_free_condition => (boolean, throws on failure to construct a JF-cond)
2231 # infer_values_based_on => (either not supplied or a hashref, implies require_join_free_condition)
2234 # condition => (a valid *likely fully qualified* sqla cond structure)
2235 # identity_map => (a hashref of foreign-to-self *unqualified* column equality names)
2236 # join_free_condition => (a valid *fully qualified* sqla cond structure, maybe unset)
2237 # inferred_values => (in case of an available join_free condition, this is a hashref of
2238 # *unqualified* column/value *EQUALITY* pairs, representing an amalgamation
2239 # of the JF-cond parse and infer_values_based_on
2240 # always either complete or unset)
2242 sub _resolve_relationship_condition {
2245 my $args = { ref $_[0] eq 'HASH' ? %{ $_[0] } : @_ };
2247 for ( qw( rel_name self_alias foreign_alias ) ) {
2248 $self->throw_exception("Mandatory argument '$_' to _resolve_relationship_condition() is not a plain string")
2249 if !defined $args->{$_} or length ref $args->{$_};
2252 $self->throw_exception("Arguments 'self_alias' and 'foreign_alias' may not be identical")
2253 if $args->{self_alias} eq $args->{foreign_alias};
2256 my $exception_rel_id = "relationship '$args->{rel_name}' on source '@{[ $self->source_name ]}'";
2258 my $rel_info = $self->relationship_info($args->{rel_name})
2260 # or $self->throw_exception( "No such $exception_rel_id" );
2261 or carp_unique("Requesting resolution on non-existent relationship '$args->{rel_name}' on source '@{[ $self->source_name ]}': fix your code *soon*, as it will break with the next major version");
2264 $exception_rel_id = "relationship '$rel_info->{_original_name}' on source '@{[ $self->source_name ]}'"
2265 if $rel_info and exists $rel_info->{_original_name};
2267 $self->throw_exception("No practical way to resolve $exception_rel_id between two data structures")
2268 if exists $args->{self_result_object} and exists $args->{foreign_values};
2270 $self->throw_exception( "Argument to infer_values_based_on must be a hash" )
2271 if exists $args->{infer_values_based_on} and ref $args->{infer_values_based_on} ne 'HASH';
2273 $args->{require_join_free_condition} ||= !!$args->{infer_values_based_on};
2275 $self->throw_exception( "Argument 'self_result_object' must be an object inheriting from '$__expected_result_class_isa'" )
2277 exists $args->{self_result_object}
2280 ! defined blessed $args->{self_result_object}
2282 ! $args->{self_result_object}->isa( $__expected_result_class_isa )
2287 my $rel_rsrc = $self->related_source($args->{rel_name});
2288 my $storage = $self->schema->storage;
2290 if (exists $args->{foreign_values}) {
2292 if (! defined $args->{foreign_values} ) {
2293 # fallback: undef => {}
2294 $args->{foreign_values} = {};
2296 elsif (defined blessed $args->{foreign_values}) {
2298 $self->throw_exception( "Objects supplied as 'foreign_values' ($args->{foreign_values}) must inherit from '$__expected_result_class_isa'" )
2299 unless $args->{foreign_values}->isa( $__expected_result_class_isa );
2302 "Objects supplied as 'foreign_values' ($args->{foreign_values}) "
2303 . "usually should inherit from the related ResultClass ('@{[ $rel_rsrc->result_class ]}'), "
2304 . "perhaps you've made a mistake invoking the condition resolver?"
2305 ) unless $args->{foreign_values}->isa($rel_rsrc->result_class);
2307 $args->{foreign_values} = { $args->{foreign_values}->get_columns };
2309 elsif ( ref $args->{foreign_values} eq 'HASH' ) {
2311 # re-build {foreign_values} excluding identically named rels
2312 if( keys %{$args->{foreign_values}} ) {
2314 my ($col_idx, $rel_idx) = map
2315 { { map { $_ => 1 } $rel_rsrc->$_ } }
2316 qw( columns relationships )
2319 my $equivalencies = extract_equality_conditions(
2320 $args->{foreign_values},
2324 $args->{foreign_values} = { map {
2325 # skip if relationship *and* a non-literal ref
2326 # this means a multicreate stub was passed in
2330 length ref $args->{foreign_values}{$_}
2332 ! is_literal_value($args->{foreign_values}{$_})
2337 ? $self->throw_exception( "Key '$_' supplied as 'foreign_values' is not a column on related source '@{[ $rel_rsrc->source_name ]}'" )
2338 : ( !exists $equivalencies->{$_} or ($equivalencies->{$_}||'') eq UNRESOLVABLE_CONDITION )
2339 ? $self->throw_exception( "Value supplied for '...{foreign_values}{$_}' is not a direct equivalence expression" )
2340 : $args->{foreign_values}{$_}
2342 } keys %{$args->{foreign_values}} };
2346 $self->throw_exception(
2347 "Argument 'foreign_values' must be either an object inheriting from '@{[ $rel_rsrc->result_class ]}', "
2348 . "or a hash reference, or undef"
2355 if (ref $rel_info->{cond} eq 'CODE') {
2358 rel_name => $args->{rel_name},
2359 self_resultsource => $self,
2360 self_alias => $args->{self_alias},
2361 foreign_alias => $args->{foreign_alias},
2363 { (exists $args->{$_}) ? ( $_ => $args->{$_} ) : () }
2364 qw( self_result_object foreign_values )
2368 # legacy - never remove these!!!
2369 $cref_args->{foreign_relname} = $cref_args->{rel_name};
2371 $cref_args->{self_rowobj} = $cref_args->{self_result_object}
2372 if exists $cref_args->{self_result_object};
2374 ($ret->{condition}, $ret->{join_free_condition}, my @extra) = $rel_info->{cond}->($cref_args);
2377 $self->throw_exception("A custom condition coderef can return at most 2 conditions, but $exception_rel_id returned extra values: @extra")
2380 if (my $jfc = $ret->{join_free_condition}) {
2382 $self->throw_exception (
2383 "The join-free condition returned for $exception_rel_id must be a hash reference"
2384 ) unless ref $jfc eq 'HASH';
2386 my ($joinfree_alias, $joinfree_source);
2387 if (defined $args->{self_result_object}) {
2388 $joinfree_alias = $args->{foreign_alias};
2389 $joinfree_source = $rel_rsrc;
2391 elsif (defined $args->{foreign_values}) {
2392 $joinfree_alias = $args->{self_alias};
2393 $joinfree_source = $self;
2396 # FIXME sanity check until things stabilize, remove at some point
2397 $self->throw_exception (
2398 "A join-free condition returned for $exception_rel_id without a result object to chain from"
2399 ) unless $joinfree_alias;
2401 my $fq_col_list = { map
2402 { ( "$joinfree_alias.$_" => 1 ) }
2403 $joinfree_source->columns
2406 exists $fq_col_list->{$_} or $self->throw_exception (
2407 "The join-free condition returned for $exception_rel_id may only "
2408 . 'contain keys that are fully qualified column names of the corresponding source '
2409 . "'$joinfree_alias' (instead it returned '$_')"
2415 $_->isa( $__expected_result_class_isa )
2417 $self->throw_exception (
2418 "The join-free condition returned for $exception_rel_id may not "
2419 . 'contain result objects as values - perhaps instead of invoking '
2420 . '->$something you meant to return ->get_column($something)'
2426 elsif (ref $rel_info->{cond} eq 'HASH') {
2428 # the condition is static - use parallel arrays
2429 # for a "pivot" depending on which side of the
2430 # rel did we get as an object
2431 my (@f_cols, @l_cols);
2432 for my $fc (keys %{ $rel_info->{cond} }) {
2433 my $lc = $rel_info->{cond}{$fc};
2435 # FIXME STRICTMODE should probably check these are valid columns
2436 $fc =~ s/^foreign\.// ||
2437 $self->throw_exception("Invalid rel cond key '$fc'");
2439 $lc =~ s/^self\.// ||
2440 $self->throw_exception("Invalid rel cond val '$lc'");
2446 # construct the crosstable condition and the identity map
2448 $ret->{condition}{"$args->{foreign_alias}.$f_cols[$_]"} = { -ident => "$args->{self_alias}.$l_cols[$_]" };
2449 $ret->{identity_map}{$l_cols[$_]} = $f_cols[$_];
2452 if ($args->{foreign_values}) {
2453 $ret->{join_free_condition}{"$args->{self_alias}.$l_cols[$_]"} = $args->{foreign_values}{$f_cols[$_]}
2456 elsif (defined $args->{self_result_object}) {
2458 for my $i (0..$#l_cols) {
2459 if ( $args->{self_result_object}->has_column_loaded($l_cols[$i]) ) {
2460 $ret->{join_free_condition}{"$args->{foreign_alias}.$f_cols[$i]"} = $args->{self_result_object}->get_column($l_cols[$i]);
2463 $self->throw_exception(sprintf
2464 "Unable to resolve relationship '%s' from object '%s': column '%s' not "
2465 . 'loaded from storage (or not passed to new() prior to insert()). You '
2466 . 'probably need to call ->discard_changes to get the server-side defaults '
2467 . 'from the database.',
2469 $args->{self_result_object},
2471 ) if $args->{self_result_object}->in_storage;
2473 # FIXME - temporarly force-override
2474 delete $args->{require_join_free_condition};
2475 $ret->{join_free_condition} = UNRESOLVABLE_CONDITION;
2481 elsif (ref $rel_info->{cond} eq 'ARRAY') {
2482 if (@{ $rel_info->{cond} } == 0) {
2484 condition => UNRESOLVABLE_CONDITION,
2485 join_free_condition => UNRESOLVABLE_CONDITION,
2489 my @subconds = map {
2490 local $rel_info->{cond} = $_;
2491 $self->_resolve_relationship_condition( $args );
2492 } @{ $rel_info->{cond} };
2494 if( @{ $rel_info->{cond} } == 1 ) {
2495 $ret = $subconds[0];
2498 # we are discarding inferred values here... likely incorrect...
2499 # then again - the entire thing is an OR, so we *can't* use them anyway
2500 for my $subcond ( @subconds ) {
2501 $self->throw_exception('Either all or none of the OR-condition members must resolve to a join-free condition')
2502 if ( $ret and ( $ret->{join_free_condition} xor $subcond->{join_free_condition} ) );
2504 $subcond->{$_} and push @{$ret->{$_}}, $subcond->{$_} for (qw(condition join_free_condition));
2510 $self->throw_exception ("Can't handle condition $rel_info->{cond} for $exception_rel_id yet :(");
2514 $args->{require_join_free_condition}
2516 ( ! $ret->{join_free_condition} or $ret->{join_free_condition} eq UNRESOLVABLE_CONDITION )
2518 $self->throw_exception(
2519 ucfirst sprintf "$exception_rel_id does not resolve to a %sjoin-free condition fragment",
2520 exists $args->{foreign_values}
2521 ? "'foreign_values'-based reversed-"
2526 # we got something back - sanity check and infer values if we can
2529 $ret->{join_free_condition}
2531 $ret->{join_free_condition} ne UNRESOLVABLE_CONDITION
2533 my $jfc = normalize_sqla_condition( $ret->{join_free_condition} )
2536 my $jfc_eqs = extract_equality_conditions( $jfc, 'consider_nulls' );
2538 if (keys %$jfc_eqs) {
2541 # $jfc is fully qualified by definition
2542 my ($col) = $_ =~ /\.(.+)/;
2544 if (exists $jfc_eqs->{$_} and ($jfc_eqs->{$_}||'') ne UNRESOLVABLE_CONDITION) {
2545 $ret->{inferred_values}{$col} = $jfc_eqs->{$_};
2547 elsif ( !$args->{infer_values_based_on} or ! exists $args->{infer_values_based_on}{$col} ) {
2548 push @nonvalues, $col;
2553 delete $ret->{inferred_values} if @nonvalues;
2557 # did the user explicitly ask
2558 if ($args->{infer_values_based_on}) {
2560 $self->throw_exception(sprintf (
2561 "Unable to complete value inferrence - custom $exception_rel_id returns conditions instead of values for column(s): %s",
2562 map { "'$_'" } @nonvalues
2566 $ret->{inferred_values} ||= {};
2568 $ret->{inferred_values}{$_} = $args->{infer_values_based_on}{$_}
2569 for keys %{$args->{infer_values_based_on}};
2572 # add the identities based on the main condition
2573 # (may already be there, since easy to calculate on the fly in the HASH case)
2574 if ( ! $ret->{identity_map} ) {
2576 my $col_eqs = extract_equality_conditions($ret->{condition});
2579 for my $lhs (keys %$col_eqs) {
2581 next if $col_eqs->{$lhs} eq UNRESOLVABLE_CONDITION;
2583 # there is no way to know who is right and who is left in a cref
2584 # therefore a full blown resolution call, and figure out the
2585 # direction a bit further below
2586 $colinfos ||= $storage->_resolve_column_info([
2587 { -alias => $args->{self_alias}, -rsrc => $self },
2588 { -alias => $args->{foreign_alias}, -rsrc => $rel_rsrc },
2591 next unless $colinfos->{$lhs}; # someone is engaging in witchcraft
2593 if ( my $rhs_ref = is_literal_value( $col_eqs->{$lhs} ) ) {
2596 $colinfos->{$rhs_ref->[0]}
2598 $colinfos->{$lhs}{-source_alias} ne $colinfos->{$rhs_ref->[0]}{-source_alias}
2600 ( $colinfos->{$lhs}{-source_alias} eq $args->{self_alias} )
2601 ? ( $ret->{identity_map}{$colinfos->{$lhs}{-colname}} = $colinfos->{$rhs_ref->[0]}{-colname} )
2602 : ( $ret->{identity_map}{$colinfos->{$rhs_ref->[0]}{-colname}} = $colinfos->{$lhs}{-colname} )
2607 $col_eqs->{$lhs} =~ /^ ( \Q$args->{self_alias}\E \. .+ ) /x
2609 ($colinfos->{$1}||{})->{-result_source} == $rel_rsrc
2611 my ($lcol, $rcol) = map
2612 { $colinfos->{$_}{-colname} }
2616 "The $exception_rel_id specifies equality of column '$lcol' and the "
2617 . "*VALUE* '$rcol' (you did not use the { -ident => ... } operator)"
2623 # FIXME - temporary, to fool the idiotic check in SQLMaker::_join_condition
2624 $ret->{condition} = { -and => [ $ret->{condition} ] }
2625 unless $ret->{condition} eq UNRESOLVABLE_CONDITION;
2630 =head2 related_source
2634 =item Arguments: $rel_name
2636 =item Return Value: $source
2640 Returns the result source object for the given relationship.
2644 sub related_source {
2645 my ($self, $rel) = @_;
2646 if( !$self->has_relationship( $rel ) ) {
2647 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
2650 # if we are not registered with a schema - just use the prototype
2651 # however if we do have a schema - ask for the source by name (and
2652 # throw in the process if all fails)
2653 if (my $schema = dbic_internal_try { $self->schema }) {
2654 $schema->source($self->relationship_info($rel)->{source});
2657 my $class = $self->relationship_info($rel)->{class};
2658 $self->ensure_class_loaded($class);
2659 $class->result_source;
2663 =head2 related_class
2667 =item Arguments: $rel_name
2669 =item Return Value: $classname
2673 Returns the class name for objects in the given relationship.
2678 my ($self, $rel) = @_;
2679 if( !$self->has_relationship( $rel ) ) {
2680 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
2682 return $self->schema->class($self->relationship_info($rel)->{source});
2689 =item Arguments: none
2691 =item Return Value: L<$source_handle|DBIx::Class::ResultSourceHandle>
2695 Obtain a new L<result source handle instance|DBIx::Class::ResultSourceHandle>
2696 for this source. Used as a serializable pointer to this resultsource, as it is not
2697 easy (nor advisable) to serialize CODErefs which may very well be present in e.g.
2698 relationship definitions.
2703 require DBIx::Class::ResultSourceHandle;
2704 return DBIx::Class::ResultSourceHandle->new({
2705 source_moniker => $_[0]->source_name,
2707 # so that a detached thaw can be re-frozen
2708 $_[0]->{_detached_thaw}
2709 ? ( _detached_source => $_[0] )
2710 : ( schema => $_[0]->schema )
2715 my $global_phase_destroy;
2717 ### NO detected_reinvoked_destructor check
2718 ### This code very much relies on being called multuple times
2720 return if $global_phase_destroy ||= in_global_destruction;
2726 # Under no circumstances shall $_[0] be stored anywhere else (like copied to
2727 # a lexical variable, or shifted, or anything else). Doing so will mess up
2728 # the refcount of this particular result source, and will allow the $schema
2729 # we are trying to save to reattach back to the source we are destroying.
2730 # The relevant code checking refcounts is in ::Schema::DESTROY()
2732 # if we are not a schema instance holder - we don't matter
2734 ! ref $_[0]->{schema}
2736 isweak $_[0]->{schema}
2739 # weaken our schema hold forcing the schema to find somewhere else to live
2740 # during global destruction (if we have not yet bailed out) this will throw
2741 # which will serve as a signal to not try doing anything else
2742 # however beware - on older perls the exception seems randomly untrappable
2743 # due to some weird race condition during thread joining :(((
2744 local $SIG{__DIE__} if $SIG{__DIE__};
2745 local $@ if DBIx::Class::_ENV_::UNSTABLE_DOLLARAT;
2747 weaken $_[0]->{schema};
2749 # if schema is still there reintroduce ourselves with strong refs back to us
2750 if ($_[0]->{schema}) {
2751 my $srcregs = $_[0]->{schema}->source_registrations;
2753 defined $srcregs->{$_}
2755 $srcregs->{$_} == $_[0]
2757 $srcregs->{$_} = $_[0]
2765 $global_phase_destroy = 1;
2768 # Dummy NEXTSTATE ensuring the all temporaries on the stack are garbage
2769 # collected before leaving this scope. Depending on the code above, this
2770 # may very well be just a preventive measure guarding future modifications
2774 sub STORABLE_freeze { Storable::nfreeze($_[0]->handle) }
2777 my ($self, $cloning, $ice) = @_;
2778 %$self = %{ (Storable::thaw($ice))->resolve };
2781 =head2 throw_exception
2783 See L<DBIx::Class::Schema/"throw_exception">.
2787 sub throw_exception {
2791 ? $self->{schema}->throw_exception(@_)
2792 : DBIx::Class::Exception->throw(@_)
2796 =head2 column_info_from_storage
2800 =item Arguments: 1/0 (default: 0)
2802 =item Return Value: 1/0
2806 __PACKAGE__->column_info_from_storage(1);
2808 Enables the on-demand automatic loading of the above column
2809 metadata from storage as necessary. This is *deprecated*, and
2810 should not be used. It will be removed before 1.0.
2812 =head1 FURTHER QUESTIONS?
2814 Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
2816 =head1 COPYRIGHT AND LICENSE
2818 This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
2819 by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
2820 redistribute it and/or modify it under the same terms as the
2821 L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.