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 DBIx::Class::ResultSource::FromSpec::Util 'fromspec_columns_info';
26 use SQL::Abstract 'is_literal_value';
27 use Devel::GlobalDestruction;
28 use Scalar::Util qw( blessed weaken isweak refaddr );
30 # FIXME - somehow breaks ResultSetManager, do not remove until investigated
31 use DBIx::Class::ResultSet;
35 # This global is present for the afaik nonexistent, but nevertheless possible
36 # case of folks using stock ::ResultSet with a completely custom Result-class
37 # hierarchy, not derived from DBIx::Class::Row at all
38 # Instead of patching stuff all over the place - this would be one convenient
39 # place to override things if need be
40 our $__expected_result_class_isa = 'DBIx::Class::Row';
42 my @hashref_attributes = qw(
43 source_info resultset_attributes
44 _columns _unique_constraints _relationships
46 my @arrayref_attributes = qw(
47 _ordered_columns _primaries
49 __PACKAGE__->mk_group_accessors(rsrc_instance_specific_attribute =>
52 qw( source_name name column_info_from_storage sqlt_deploy_callback ),
55 __PACKAGE__->mk_group_accessors(rsrc_instance_specific_handler => qw(
62 DBIx::Class::ResultSource - Result source object
66 # Create a table based result source, in a result class.
68 package MyApp::Schema::Result::Artist;
69 use base qw/DBIx::Class::Core/;
71 __PACKAGE__->table('artist');
72 __PACKAGE__->add_columns(qw/ artistid name /);
73 __PACKAGE__->set_primary_key('artistid');
74 __PACKAGE__->has_many(cds => 'MyApp::Schema::Result::CD');
78 # Create a query (view) based result source, in a result class
79 package MyApp::Schema::Result::Year2000CDs;
80 use base qw/DBIx::Class::Core/;
82 __PACKAGE__->load_components('InflateColumn::DateTime');
83 __PACKAGE__->table_class('DBIx::Class::ResultSource::View');
85 __PACKAGE__->table('year2000cds');
86 __PACKAGE__->result_source->is_virtual(1);
87 __PACKAGE__->result_source->view_definition(
88 "SELECT cdid, artist, title FROM cd WHERE year ='2000'"
94 A ResultSource is an object that represents a source of data for querying.
96 This class is a base class for various specialised types of result
97 sources, for example L<DBIx::Class::ResultSource::Table>. Table is the
98 default result source type, so one is created for you when defining a
99 result class as described in the synopsis above.
101 More specifically, the L<DBIx::Class::Core> base class pulls in the
102 L<DBIx::Class::ResultSourceProxy::Table> component, which defines
103 the L<table|DBIx::Class::ResultSourceProxy::Table/table> method.
104 When called, C<table> creates and stores an instance of
105 L<DBIx::Class::ResultSource::Table>. Luckily, to use tables as result
106 sources, you don't need to remember any of this.
108 Result sources representing select queries, or views, can also be
109 created, see L<DBIx::Class::ResultSource::View> for full details.
111 =head2 Finding result source objects
113 As mentioned above, a result source instance is created and stored for
114 you when you define a
115 L<Result Class|DBIx::Class::Manual::Glossary/Result Class>.
117 You can retrieve the result source at runtime in the following ways:
121 =item From a Schema object:
123 $schema->source($source_name);
125 =item From a Result object:
127 $result->result_source;
129 =item From a ResultSet object:
141 $class->new({attribute_name => value});
143 Creates a new ResultSource object. Not normally called directly by end users.
150 sub __derived_instances {
152 (defined $_->{weakref})
155 } values %{ $rsrc_registry->{ refaddr($_[0]) }{ derivatives } }
159 my ($class, $attrs) = @_;
160 $class = ref $class if ref $class;
162 my $ancestor = delete $attrs->{__derived_from};
164 my $self = bless { %$attrs }, $class;
167 DBIx::Class::_ENV_::ASSERT_NO_ERRONEOUS_METAINSTANCE_USE
169 # a constructor with 'name' as sole arg clearly isn't "inheriting" from anything
170 ( not ( keys(%$self) == 1 and exists $self->{name} ) )
172 defined CORE::caller(1)
174 (CORE::caller(1))[3] !~ / ::new$ | ^ DBIx::Class :: (?:
175 ResultSourceProxy::Table::table
177 ResultSourceProxy::Table::_init_result_source_instance
182 local $Carp::CarpLevel = $Carp::CarpLevel + 1
184 Carp::confess("Incorrect instantiation of '$self': you almost certainly wanted to call ->clone() instead");
187 my $own_slot = $rsrc_registry->{
188 my $own_addr = refaddr $self
189 } = { derivatives => {} };
191 weaken( $own_slot->{weakref} = $self );
196 my $ancestor_slot = $rsrc_registry->{
197 my $ancestor_addr = refaddr $ancestor
201 # on ancestry recording compact registry slots, prevent unbound growth
202 for my $r ( $rsrc_registry, map { $_->{derivatives} } values %$rsrc_registry ) {
203 defined $r->{$_}{weakref} or delete $r->{$_}
207 weaken( $_->{$own_addr} = $own_slot ) for map
208 { $_->{derivatives} }
212 { defined $_->{derivatives}{$ancestor_addr} }
213 values %$rsrc_registry
220 $self->{resultset_class} ||= 'DBIx::Class::ResultSet';
221 $self->{name} ||= "!!NAME NOT SET!!";
222 $self->{_columns_info_loaded} ||= 0;
223 $self->{sqlt_deploy_callback} ||= 'default_sqlt_deploy_hook';
225 $self->{$_} = { %{ $self->{$_} || {} } }
226 for @hashref_attributes, '__metadata_divergencies';
228 $self->{$_} = [ @{ $self->{$_} || [] } ]
229 for @arrayref_attributes;
234 sub DBIx::Class::__Rsrc_Ancestry_iThreads_handler__::CLONE {
235 for my $r ( $rsrc_registry, map { $_->{derivatives} } values %$rsrc_registry ) {
237 defined $_->{weakref}
238 ? ( refaddr $_->{weakref} => $_ )
245 # needs direct access to $rsrc_registry under an assert
247 sub set_rsrc_instance_specific_attribute {
249 # only mark if we are setting something different
254 defined( $_[0]->{$_[1]} )
266 length ref( $_[0]->{$_[1]} )
269 # both refs (the mark-on-same-ref is deliberate)
272 # both differing strings
273 $_[2] ne $_[0]->{$_[1]}
279 # need to protect $_ here
281 $_[0]->__derived_instances,
283 # DO NOT REMOVE - this blob is marking *ancestors* as tainted, here to
284 # weed out any fallout from https://github.com/dbsrgits/dbix-class/commit/9e36e3ec
285 # Note that there is no way to kill this warning, aside from never
286 # calling set_primary_key etc more than once per hierarchy
287 # (this is why the entire thing is guarded by an assert)
290 DBIx::Class::_ENV_::ASSERT_NO_ERRONEOUS_METAINSTANCE_USE
292 grep { $_[1] eq $_ } qw( _unique_constraints _primaries source_info )
296 { defined($_->{weakref}) ? $_->{weakref} : () }
298 { defined( ( $_->{derivatives}{refaddr($_[0])} || {} )->{weakref} ) }
299 values %$rsrc_registry
305 $derivative->{__metadata_divergencies}{$_[1]}{ $callsite ||= do {
308 # FIXME - this is horrible, but it's the best we can do for now
309 # Replace when Carp::Skip is written (it *MUST* take this use-case
310 # into consideration)
312 my ($cs) = DBIx::Class::Carp::__find_caller(__PACKAGE__);
314 my ($fr_num, @fr) = 1;
315 while( @fr = CORE::caller($fr_num++) ) {
316 $cs =~ /^ \Qat $fr[1] line $fr[2]\E (?: $ | \n )/x
323 # FIXME - using refdesc here isn't great, but I can't think of anything
324 # better at this moment
326 ? "@{[ refdesc $_[0] ]}->$fr[3](...) $cs"
333 $_[0]->{$_[1]} = $_[2];
337 sub get_rsrc_instance_specific_attribute {
339 $_[0]->__emit_stale_metadata_diag( $_[1] ) if (
340 ! $_[0]->{__in_rsrc_setter_callstack}
342 $_[0]->{__metadata_divergencies}{$_[1]}
349 # reuse the elaborate set logic of instance_specific_attr
350 sub set_rsrc_instance_specific_handler {
351 $_[0]->set_rsrc_instance_specific_attribute($_[1], $_[2]);
353 # trigger a load for the case of $foo->handler_accessor("bar")->new
354 $_[0]->get_rsrc_instance_specific_handler($_[1])
355 if defined wantarray;
358 # This is essentially the same logic as get_component_class
359 # (in DBIC::AccessorGroup). However the latter is a grouped
360 # accessor type, and here we are strictly after a 'simple'
361 # So we go ahead and recreate the logic as found in ::AG
362 sub get_rsrc_instance_specific_handler {
364 # emit desync warnings if any
365 my $val = $_[0]->get_rsrc_instance_specific_attribute( $_[1] );
367 # plain string means class - load it
372 # inherited CAG can't be set to undef effectively, so people may use ''
375 ! defined blessed $val
377 ! ${"${val}::__LOADED__BY__DBIC__CAG__COMPONENT_CLASS__"}
379 $_[0]->ensure_class_loaded($val);
381 ${"${val}::__LOADED__BY__DBIC__CAG__COMPONENT_CLASS__"}
382 = do { \(my $anon = 'loaded') };
389 sub __construct_stale_metadata_diag {
390 return '' unless $_[0]->{__metadata_divergencies}{$_[1]};
394 # find the CAG getter FIRST
395 # allows unlimited user-namespace overrides without screwing around with
398 @fr = CORE::caller(++$fr_num)
400 $fr[3] ne 'DBIx::Class::ResultSource::get_rsrc_instance_specific_attribute'
403 Carp::confess( "You are not supposed to call __construct_stale_metadata_diag here..." )
406 # then find the first non-local, non-private reportable callsite
408 @fr = CORE::caller(++$fr_num)
415 $fr[1] =~ /^\(eval \d+\)$/
417 $fr[3] =~ /::(?: __ANON__ | _\w+ )$/x
419 $fr[0] =~ /^DBIx::Class::ResultSource/
423 my $by = ( @fr and $fr[3] =~ s/.+::// )
424 # FIXME - using refdesc here isn't great, but I can't think of anything
425 # better at this moment
426 ? " by 'getter' @{[ refdesc $_[0] ]}->$fr[3](...)\n within the callstack beginning"
430 # Given the full stacktrace combined with the really involved callstack
431 # there is no chance the emitter will properly deduplicate this
432 # Only complain once per callsite per source
433 return( ( $by and $_[0]->{__encountered_divergencies}{$by}++ )
437 : "$_[0] (the metadata instance of source '@{[ $_[0]->source_name ]}') is "
438 . "*OUTDATED*, and does not reflect the modifications of its "
439 . "*ancestors* as follows:\n"
444 { $a->[1] cmp $b->[1] }
446 { [ $_, ( $_ =~ /( at .+? line \d+)/ ) ] }
447 keys %{ $_[0]->{__metadata_divergencies}{$_[1]} }
449 . "\nStale metadata accessed${by}"
453 sub __emit_stale_metadata_diag {
456 # short circuit: no message - no diag
457 $_[0]->__construct_stale_metadata_diag($_[1])
461 # the constructor already does deduplication
463 confess => DBIx::Class::_ENV_::ASSERT_NO_ERRONEOUS_METAINSTANCE_USE,
469 $rsrc_instance->clone( atribute_name => overridden_value );
471 A wrapper around L</new> inheriting any defaults from the callee. This method
472 also not normally invoked directly by end users.
482 ? ( %$self, __derived_from => $self )
486 (@_ == 1 and ref $_[0] eq 'HASH')
499 =item Arguments: @columns
501 =item Return Value: L<$result_source|/new>
505 $source->add_columns(qw/col1 col2 col3/);
507 $source->add_columns('col1' => \%col1_info, 'col2' => \%col2_info, ...);
509 $source->add_columns(
510 'col1' => { data_type => 'integer', is_nullable => 1, ... },
511 'col2' => { data_type => 'text', is_auto_increment => 1, ... },
514 Adds columns to the result source. If supplied colname => hashref
515 pairs, uses the hashref as the L</column_info> for that column. Repeated
516 calls of this method will add more columns, not replace them.
518 The column names given will be created as accessor methods on your
519 L<Result|DBIx::Class::Manual::ResultClass> objects. You can change the name of the accessor
520 by supplying an L</accessor> in the column_info hash.
522 If a column name beginning with a plus sign ('+col1') is provided, the
523 attributes provided will be merged with any existing attributes for the
524 column, with the new attributes taking precedence in the case that an
525 attribute already exists. Using this without a hashref
526 (C<< $source->add_columns(qw/+col1 +col2/) >>) is legal, but useless --
527 it does the same thing it would do without the plus.
529 The contents of the column_info are not set in stone. The following
530 keys are currently recognised/used by DBIx::Class:
536 { accessor => '_name' }
538 # example use, replace standard accessor with one of your own:
540 my ($self, $value) = @_;
542 die "Name cannot contain digits!" if($value =~ /\d/);
543 $self->_name($value);
545 return $self->_name();
548 Use this to set the name of the accessor method for this column. If unset,
549 the name of the column will be used.
553 { data_type => 'integer' }
555 This contains the column type. It is automatically filled if you use the
556 L<SQL::Translator::Producer::DBIx::Class::File> producer, or the
557 L<DBIx::Class::Schema::Loader> module.
559 Currently there is no standard set of values for the data_type. Use
560 whatever your database supports.
566 The length of your column, if it is a column type that can have a size
567 restriction. This is currently only used to create tables from your
568 schema, see L<DBIx::Class::Schema/deploy>.
572 For decimal or float values you can specify an ArrayRef in order to
573 control precision, assuming your database's
574 L<SQL::Translator::Producer> supports it.
580 Set this to a true value for a column that is allowed to contain NULL
581 values, default is false. This is currently only used to create tables
582 from your schema, see L<DBIx::Class::Schema/deploy>.
584 =item is_auto_increment
586 { is_auto_increment => 1 }
588 Set this to a true value for a column whose value is somehow
589 automatically set, defaults to false. This is used to determine which
590 columns to empty when cloning objects using
591 L<DBIx::Class::Row/copy>. It is also used by
592 L<DBIx::Class::Schema/deploy>.
598 Set this to a true or false value (not C<undef>) to explicitly specify
599 if this column contains numeric data. This controls how set_column
600 decides whether to consider a column dirty after an update: if
601 C<is_numeric> is true a numeric comparison C<< != >> will take place
602 instead of the usual C<eq>
604 If not specified the storage class will attempt to figure this out on
605 first access to the column, based on the column C<data_type>. The
606 result will be cached in this attribute.
610 { is_foreign_key => 1 }
612 Set this to a true value for a column that contains a key from a
613 foreign table, defaults to false. This is currently only used to
614 create tables from your schema, see L<DBIx::Class::Schema/deploy>.
618 { default_value => \'now()' }
620 Set this to the default value which will be inserted into a column by
621 the database. Can contain either a value or a function (use a
622 reference to a scalar e.g. C<\'now()'> if you want a function). This
623 is currently only used to create tables from your schema, see
624 L<DBIx::Class::Schema/deploy>.
626 See the note on L<DBIx::Class::Row/new> for more information about possible
627 issues related to db-side default values.
631 { sequence => 'my_table_seq' }
633 Set this on a primary key column to the name of the sequence used to
634 generate a new key value. If not specified, L<DBIx::Class::PK::Auto>
635 will attempt to retrieve the name of the sequence from the database
638 =item retrieve_on_insert
640 { retrieve_on_insert => 1 }
642 For every column where this is set to true, DBIC will retrieve the RDBMS-side
643 value upon a new row insertion (normally only the autoincrement PK is
644 retrieved on insert). C<INSERT ... RETURNING> is used automatically if
645 supported by the underlying storage, otherwise an extra SELECT statement is
646 executed to retrieve the missing data.
650 { auto_nextval => 1 }
652 Set this to a true value for a column whose value is retrieved automatically
653 from a sequence or function (if supported by your Storage driver.) For a
654 sequence, if you do not use a trigger to get the nextval, you have to set the
655 L</sequence> value as well.
657 Also set this for MSSQL columns with the 'uniqueidentifier'
658 L<data_type|DBIx::Class::ResultSource/data_type> whose values you want to
659 automatically generate using C<NEWID()>, unless they are a primary key in which
660 case this will be done anyway.
664 This is used by L<DBIx::Class::Schema/deploy> and L<SQL::Translator>
665 to add extra non-generic data to the column. For example: C<< extra
666 => { unsigned => 1} >> is used by the MySQL producer to set an integer
667 column to unsigned. For more details, see
668 L<SQL::Translator::Producer::MySQL>.
676 =item Arguments: $colname, \%columninfo?
678 =item Return Value: 1/0 (true/false)
682 $source->add_column('col' => \%info);
684 Add a single column and optional column info. Uses the same column
685 info keys as L</add_columns>.
690 my ($self, @cols) = @_;
692 local $self->{__in_rsrc_setter_callstack} = 1
693 unless $self->{__in_rsrc_setter_callstack};
695 $self->_ordered_columns(\@cols) unless $self->_ordered_columns;
697 my ( @added, $colinfos );
698 my $columns = $self->_columns;
700 while (my $col = shift @cols) {
705 ( $colinfos ||= $self->columns_info )->{$col}
711 # If next entry is { ... } use that for the column info, if not
712 # use an empty hashref
714 my $new_info = shift(@cols);
715 %$column_info = (%$column_info, %$new_info);
717 push(@added, $col) unless exists $columns->{$col};
718 $columns->{$col} = $column_info;
721 push @{ $self->_ordered_columns }, @added;
722 $self->_columns($columns);
726 sub add_column :DBIC_method_is_indirect_sugar {
727 DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
728 shift->add_columns(@_)
735 =item Arguments: $colname
737 =item Return Value: 1/0 (true/false)
741 if ($source->has_column($colname)) { ... }
743 Returns true if the source has a column of this name, false otherwise.
748 my ($self, $column) = @_;
749 return exists $self->_columns->{$column};
756 =item Arguments: $colname
758 =item Return Value: Hashref of info
762 my $info = $source->column_info($col);
764 Returns the column metadata hashref for a column, as originally passed
765 to L</add_columns>. See L</add_columns> above for information on the
766 contents of the hashref.
770 sub column_info :DBIC_method_is_indirect_sugar {
771 DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
773 #my ($self, $column) = @_;
774 $_[0]->columns_info([ $_[1] ])->{$_[1]};
781 =item Arguments: none
783 =item Return Value: Ordered list of column names
787 my @column_names = $source->columns;
789 Returns all column names in the order they were declared to L</add_columns>.
795 $self->throw_exception(
796 "columns() is a read-only accessor, did you mean add_columns()?"
798 return @{$self->{_ordered_columns}||[]};
805 =item Arguments: \@colnames ?
807 =item Return Value: Hashref of column name/info pairs
811 my $columns_info = $source->columns_info;
813 Like L</column_info> but returns information for the requested columns. If
814 the optional column-list arrayref is omitted it returns info on all columns
815 currently defined on the ResultSource via L</add_columns>.
820 my ($self, $columns) = @_;
822 my $colinfo = $self->_columns;
825 ! $self->{_columns_info_loaded}
827 $self->column_info_from_storage
829 grep { ! $_->{data_type} } values %$colinfo
831 my $stor = dbic_internal_try { $self->schema->storage }
833 $self->{_columns_info_loaded}++;
835 # try for the case of storage without table
837 my $info = $stor->columns_info_for( $self->from );
839 { (lc $_) => $info->{$_} }
843 foreach my $col ( keys %$colinfo ) {
845 %{ $colinfo->{$col} },
846 %{ $info->{$col} || $lc_info->{lc $col} || {} }
856 if (my $inf = $colinfo->{$_}) {
860 $self->throw_exception( sprintf (
861 "No such column '%s' on source '%s'",
863 $self->source_name || $self->name || 'Unknown source...?',
869 # the shallow copy is crucial - there are exists() checks within
877 =head2 remove_columns
881 =item Arguments: @colnames
883 =item Return Value: not defined
887 $source->remove_columns(qw/col1 col2 col3/);
889 Removes the given list of columns by name, from the result source.
891 B<Warning>: Removing a column that is also used in the sources primary
892 key, or in one of the sources unique constraints, B<will> result in a
893 broken result source.
899 =item Arguments: $colname
901 =item Return Value: not defined
905 $source->remove_column('col');
907 Remove a single column by name from the result source, similar to
910 B<Warning>: Removing a column that is also used in the sources primary
911 key, or in one of the sources unique constraints, B<will> result in a
912 broken result source.
917 my ($self, @to_remove) = @_;
919 local $self->{__in_rsrc_setter_callstack} = 1
920 unless $self->{__in_rsrc_setter_callstack};
922 my $columns = $self->_columns
927 delete $columns->{$_};
931 $self->_ordered_columns([ grep { not $to_remove{$_} } @{$self->_ordered_columns} ]);
934 sub remove_column :DBIC_method_is_indirect_sugar {
935 DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
936 shift->remove_columns(@_)
939 =head2 set_primary_key
943 =item Arguments: @cols
945 =item Return Value: not defined
949 Defines one or more columns as primary key for this source. Must be
950 called after L</add_columns>.
952 Additionally, defines a L<unique constraint|/add_unique_constraint>
955 Note: you normally do want to define a primary key on your sources
956 B<even if the underlying database table does not have a primary key>.
958 L<DBIx::Class::Manual::Intro/The Significance and Importance of Primary Keys>
963 sub set_primary_key {
964 my ($self, @cols) = @_;
966 local $self->{__in_rsrc_setter_callstack} = 1
967 unless $self->{__in_rsrc_setter_callstack};
969 my $colinfo = $self->columns_info(\@cols);
970 for my $col (@cols) {
971 carp_unique(sprintf (
972 "Primary key of source '%s' includes the column '%s' which has its "
973 . "'is_nullable' attribute set to true. This is a mistake and will cause "
974 . 'various Result-object operations to fail',
975 $self->source_name || $self->name || 'Unknown source...?',
977 )) if $colinfo->{$col}{is_nullable};
980 $self->_primaries(\@cols);
982 $self->add_unique_constraint(primary => \@cols);
985 =head2 primary_columns
989 =item Arguments: none
991 =item Return Value: Ordered list of primary column names
995 Read-only accessor which returns the list of primary keys, supplied by
1000 sub primary_columns {
1001 return @{shift->_primaries||[]};
1004 # a helper method that will automatically die with a descriptive message if
1005 # no pk is defined on the source in question. For internal use to save
1006 # on if @pks... boilerplate
1007 sub _pri_cols_or_die {
1009 my @pcols = $self->primary_columns
1010 or $self->throw_exception (sprintf(
1011 "Operation requires a primary key to be declared on '%s' via set_primary_key",
1012 # source_name is set only after schema-registration
1013 $self->source_name || $self->result_class || $self->name || 'Unknown source...?',
1018 # same as above but mandating single-column PK (used by relationship condition
1020 sub _single_pri_col_or_die {
1022 my ($pri, @too_many) = $self->_pri_cols_or_die;
1024 $self->throw_exception( sprintf(
1025 "Operation requires a single-column primary key declared on '%s'",
1026 $self->source_name || $self->result_class || $self->name || 'Unknown source...?',
1034 Manually define the correct sequence for your table, to avoid the overhead
1035 associated with looking up the sequence automatically. The supplied sequence
1036 will be applied to the L</column_info> of each L<primary_key|/set_primary_key>
1040 =item Arguments: $sequence_name
1042 =item Return Value: not defined
1049 my ($self,$seq) = @_;
1051 local $self->{__in_rsrc_setter_callstack} = 1
1052 unless $self->{__in_rsrc_setter_callstack};
1054 my @pks = $self->primary_columns
1057 $_->{sequence} = $seq
1058 for values %{ $self->columns_info (\@pks) };
1062 =head2 add_unique_constraint
1066 =item Arguments: $name?, \@colnames
1068 =item Return Value: not defined
1072 Declare a unique constraint on this source. Call once for each unique
1075 # For UNIQUE (column1, column2)
1076 __PACKAGE__->add_unique_constraint(
1077 constraint_name => [ qw/column1 column2/ ],
1080 Alternatively, you can specify only the columns:
1082 __PACKAGE__->add_unique_constraint([ qw/column1 column2/ ]);
1084 This will result in a unique constraint named
1085 C<table_column1_column2>, where C<table> is replaced with the table
1088 Unique constraints are used, for example, when you pass the constraint
1089 name as the C<key> attribute to L<DBIx::Class::ResultSet/find>. Then
1090 only columns in the constraint are searched.
1092 Throws an error if any of the given column names do not yet exist on
1097 sub add_unique_constraint {
1100 local $self->{__in_rsrc_setter_callstack} = 1
1101 unless $self->{__in_rsrc_setter_callstack};
1104 $self->throw_exception(
1105 'add_unique_constraint() does not accept multiple constraints, use '
1106 . 'add_unique_constraints() instead'
1111 if (ref $cols ne 'ARRAY') {
1112 $self->throw_exception (
1113 'Expecting an arrayref of constraint columns, got ' . ($cols||'NOTHING')
1117 my $name = shift @_;
1119 $name ||= $self->name_unique_constraint($cols);
1121 foreach my $col (@$cols) {
1122 $self->throw_exception("No such column $col on table " . $self->name)
1123 unless $self->has_column($col);
1126 my %unique_constraints = $self->unique_constraints;
1127 $unique_constraints{$name} = $cols;
1128 $self->_unique_constraints(\%unique_constraints);
1131 =head2 add_unique_constraints
1135 =item Arguments: @constraints
1137 =item Return Value: not defined
1141 Declare multiple unique constraints on this source.
1143 __PACKAGE__->add_unique_constraints(
1144 constraint_name1 => [ qw/column1 column2/ ],
1145 constraint_name2 => [ qw/column2 column3/ ],
1148 Alternatively, you can specify only the columns:
1150 __PACKAGE__->add_unique_constraints(
1151 [ qw/column1 column2/ ],
1152 [ qw/column3 column4/ ]
1155 This will result in unique constraints named C<table_column1_column2> and
1156 C<table_column3_column4>, where C<table> is replaced with the table name.
1158 Throws an error if any of the given column names do not yet exist on
1161 See also L</add_unique_constraint>.
1165 sub add_unique_constraints :DBIC_method_is_indirect_sugar {
1166 DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
1169 my @constraints = @_;
1171 if ( !(@constraints % 2) && grep { ref $_ ne 'ARRAY' } @constraints ) {
1172 # with constraint name
1173 while (my ($name, $constraint) = splice @constraints, 0, 2) {
1174 $self->add_unique_constraint($name => $constraint);
1178 # no constraint name
1179 foreach my $constraint (@constraints) {
1180 $self->add_unique_constraint($constraint);
1185 =head2 name_unique_constraint
1189 =item Arguments: \@colnames
1191 =item Return Value: Constraint name
1195 $source->table('mytable');
1196 $source->name_unique_constraint(['col1', 'col2']);
1200 Return a name for a unique constraint containing the specified
1201 columns. The name is created by joining the table name and each column
1202 name, using an underscore character.
1204 For example, a constraint on a table named C<cd> containing the columns
1205 C<artist> and C<title> would result in a constraint name of C<cd_artist_title>.
1207 This is used by L</add_unique_constraint> if you do not specify the
1208 optional constraint name.
1212 sub name_unique_constraint {
1213 my ($self, $cols) = @_;
1215 my $name = $self->name;
1216 $name = $$name if (ref $name eq 'SCALAR');
1217 $name =~ s/ ^ [^\.]+ \. //x; # strip possible schema qualifier
1219 return join '_', $name, @$cols;
1222 =head2 unique_constraints
1226 =item Arguments: none
1228 =item Return Value: Hash of unique constraint data
1232 $source->unique_constraints();
1234 Read-only accessor which returns a hash of unique constraints on this
1237 The hash is keyed by constraint name, and contains an arrayref of
1238 column names as values.
1242 sub unique_constraints {
1243 return %{shift->_unique_constraints||{}};
1246 =head2 unique_constraint_names
1250 =item Arguments: none
1252 =item Return Value: Unique constraint names
1256 $source->unique_constraint_names();
1258 Returns the list of unique constraint names defined on this source.
1262 sub unique_constraint_names {
1265 my %unique_constraints = $self->unique_constraints;
1267 return keys %unique_constraints;
1270 =head2 unique_constraint_columns
1274 =item Arguments: $constraintname
1276 =item Return Value: List of constraint columns
1280 $source->unique_constraint_columns('myconstraint');
1282 Returns the list of columns that make up the specified unique constraint.
1286 sub unique_constraint_columns {
1287 my ($self, $constraint_name) = @_;
1289 my %unique_constraints = $self->unique_constraints;
1291 $self->throw_exception(
1292 "Unknown unique constraint $constraint_name on '" . $self->name . "'"
1293 ) unless exists $unique_constraints{$constraint_name};
1295 return @{ $unique_constraints{$constraint_name} };
1298 =head2 sqlt_deploy_callback
1302 =item Arguments: $callback_name | \&callback_code
1304 =item Return Value: $callback_name | \&callback_code
1308 __PACKAGE__->result_source->sqlt_deploy_callback('mycallbackmethod');
1312 __PACKAGE__->result_source->sqlt_deploy_callback(sub {
1313 my ($source_instance, $sqlt_table) = @_;
1317 An accessor to set a callback to be called during deployment of
1318 the schema via L<DBIx::Class::Schema/create_ddl_dir> or
1319 L<DBIx::Class::Schema/deploy>.
1321 The callback can be set as either a code reference or the name of a
1322 method in the current result class.
1324 Defaults to L</default_sqlt_deploy_hook>.
1326 Your callback will be passed the $source object representing the
1327 ResultSource instance being deployed, and the
1328 L<SQL::Translator::Schema::Table> object being created from it. The
1329 callback can be used to manipulate the table object or add your own
1330 customised indexes. If you need to manipulate a non-table object, use
1331 the L<DBIx::Class::Schema/sqlt_deploy_hook>.
1333 See L<DBIx::Class::Manual::Cookbook/Adding Indexes And Functions To
1334 Your SQL> for examples.
1336 This sqlt deployment callback can only be used to manipulate
1337 SQL::Translator objects as they get turned into SQL. To execute
1338 post-deploy statements which SQL::Translator does not currently
1339 handle, override L<DBIx::Class::Schema/deploy> in your Schema class
1340 and call L<dbh_do|DBIx::Class::Storage::DBI/dbh_do>.
1342 =head2 default_sqlt_deploy_hook
1344 This is the default deploy hook implementation which checks if your
1345 current Result class has a C<sqlt_deploy_hook> method, and if present
1346 invokes it B<on the Result class directly>. This is to preserve the
1347 semantics of C<sqlt_deploy_hook> which was originally designed to expect
1348 the Result class name and the
1349 L<$sqlt_table instance|SQL::Translator::Schema::Table> of the table being
1354 sub default_sqlt_deploy_hook {
1357 my $class = $self->result_class;
1359 if ($class and $class->can('sqlt_deploy_hook')) {
1360 $class->sqlt_deploy_hook(@_);
1364 sub _invoke_sqlt_deploy_hook {
1366 if ( my $hook = $self->sqlt_deploy_callback) {
1375 =item Arguments: $classname
1377 =item Return Value: $classname
1381 use My::Schema::ResultClass::Inflator;
1384 use My::Schema::Artist;
1386 __PACKAGE__->result_class('My::Schema::ResultClass::Inflator');
1388 Set the default result class for this source. You can use this to create
1389 and use your own result inflator. See L<DBIx::Class::ResultSet/result_class>
1392 Please note that setting this to something like
1393 L<DBIx::Class::ResultClass::HashRefInflator> will make every result unblessed
1394 and make life more difficult. Inflators like those are better suited to
1395 temporary usage via L<DBIx::Class::ResultSet/result_class>.
1401 =item Arguments: none
1403 =item Return Value: L<$resultset|DBIx::Class::ResultSet>
1407 Returns a resultset for the given source. This will initially be created
1408 on demand by calling
1410 $self->resultset_class->new($self, $self->resultset_attributes)
1412 but is cached from then on unless resultset_class changes.
1414 =head2 resultset_class
1418 =item Arguments: $classname
1420 =item Return Value: $classname
1424 package My::Schema::ResultSet::Artist;
1425 use base 'DBIx::Class::ResultSet';
1428 # In the result class
1429 __PACKAGE__->resultset_class('My::Schema::ResultSet::Artist');
1432 $source->resultset_class('My::Schema::ResultSet::Artist');
1434 Set the class of the resultset. This is useful if you want to create your
1435 own resultset methods. Create your own class derived from
1436 L<DBIx::Class::ResultSet>, and set it here. If called with no arguments,
1437 this method returns the name of the existing resultset class, if one
1440 =head2 resultset_attributes
1444 =item Arguments: L<\%attrs|DBIx::Class::ResultSet/ATTRIBUTES>
1446 =item Return Value: L<\%attrs|DBIx::Class::ResultSet/ATTRIBUTES>
1450 # In the result class
1451 __PACKAGE__->resultset_attributes({ order_by => [ 'id' ] });
1454 $source->resultset_attributes({ order_by => [ 'id' ] });
1456 Store a collection of resultset attributes, that will be set on every
1457 L<DBIx::Class::ResultSet> produced from this result source.
1459 B<CAVEAT>: C<resultset_attributes> comes with its own set of issues and
1460 bugs! Notably the contents of the attributes are B<entirely static>, which
1461 greatly hinders composability (things like L<current_source_alias
1462 |DBIx::Class::ResultSet/current_source_alias> can not possibly be respected).
1463 While C<resultset_attributes> isn't deprecated per se, you are strongly urged
1464 to seek alternatives.
1466 Since relationships use attributes to link tables together, the "default"
1467 attributes you set may cause unpredictable and undesired behavior. Furthermore,
1468 the defaults B<cannot be turned off>, so you are stuck with them.
1470 In most cases, what you should actually be using are project-specific methods:
1472 package My::Schema::ResultSet::Artist;
1473 use base 'DBIx::Class::ResultSet';
1477 #__PACKAGE__->resultset_attributes({ prefetch => 'tracks' });
1480 sub with_tracks { shift->search({}, { prefetch => 'tracks' }) }
1483 $schema->resultset('Artist')->with_tracks->...
1485 This gives you the flexibility of not using it when you don't need it.
1487 For more complex situations, another solution would be to use a virtual view
1488 via L<DBIx::Class::ResultSource::View>.
1494 $self->throw_exception(
1495 'resultset does not take any arguments. If you want another resultset, '.
1496 'call it on the schema instead.'
1499 $self->resultset_class->new(
1502 ( dbic_internal_try { %{$self->schema->default_resultset_attributes} } ),
1503 %{$self->{resultset_attributes}},
1512 =item Arguments: none
1514 =item Result value: $name
1518 Returns the name of the result source, which will typically be the table
1519 name. This may be a scalar reference if the result source has a non-standard
1526 =item Arguments: $source_name
1528 =item Result value: $source_name
1532 Set an alternate name for the result source when it is loaded into a schema.
1533 This is useful if you want to refer to a result source by a name other than
1536 package ArchivedBooks;
1537 use base qw/DBIx::Class/;
1538 __PACKAGE__->table('books_archive');
1539 __PACKAGE__->source_name('Books');
1541 # from your schema...
1542 $schema->resultset('Books')->find(1);
1548 =item Arguments: none
1550 =item Return Value: FROM clause
1554 my $from_clause = $source->from();
1556 Returns an expression of the source to be supplied to storage to specify
1557 retrieval from this source. In the case of a database, the required FROM
1562 sub from { die 'Virtual method!' }
1566 Stores a hashref of per-source metadata. No specific key names
1567 have yet been standardized, the examples below are purely hypothetical
1568 and don't actually accomplish anything on their own:
1570 __PACKAGE__->source_info({
1571 "_tablespace" => 'fast_disk_array_3',
1572 "_engine" => 'InnoDB',
1579 =item Arguments: L<$schema?|DBIx::Class::Schema>
1581 =item Return Value: L<$schema|DBIx::Class::Schema>
1585 my $schema = $source->schema();
1587 Sets and/or returns the L<DBIx::Class::Schema> object to which this
1588 result source instance has been attached to.
1594 # invoke the mark-diverging logic
1595 $_[0]->set_rsrc_instance_specific_attribute( schema => $_[1] );
1598 $_[0]->get_rsrc_instance_specific_attribute( 'schema' ) || do {
1599 my $name = $_[0]->{source_name} || '_unnamed_';
1600 my $err = 'Unable to perform storage-dependent operations with a detached result source '
1601 . "(source '$name' is not associated with a schema).";
1603 $err .= ' You need to use $schema->thaw() or manually set'
1604 . ' $DBIx::Class::ResultSourceHandle::thaw_schema while thawing.'
1605 if $_[0]->{_detached_thaw};
1607 DBIx::Class::Exception->throw($err);
1616 =item Arguments: none
1618 =item Return Value: L<$storage|DBIx::Class::Storage>
1622 $source->storage->debug(1);
1624 Returns the L<storage handle|DBIx::Class::Storage> for the current schema.
1628 sub storage :DBIC_method_is_indirect_sugar {
1629 DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
1630 $_[0]->schema->storage
1633 =head2 add_relationship
1637 =item Arguments: $rel_name, $related_source_name, \%cond, \%attrs?
1639 =item Return Value: 1/true if it succeeded
1643 $source->add_relationship('rel_name', 'related_source', $cond, $attrs);
1645 L<DBIx::Class::Relationship> describes a series of methods which
1646 create pre-defined useful types of relationships. Look there first
1647 before using this method directly.
1649 The relationship name can be arbitrary, but must be unique for each
1650 relationship attached to this result source. 'related_source' should
1651 be the name with which the related result source was registered with
1652 the current schema. For example:
1654 $schema->source('Book')->add_relationship('reviews', 'Review', {
1655 'foreign.book_id' => 'self.id',
1658 The condition C<$cond> needs to be an L<SQL::Abstract>-style
1659 representation of the join between the tables. For example, if you're
1660 creating a relation from Author to Book,
1662 { 'foreign.author_id' => 'self.id' }
1664 will result in the JOIN clause
1666 author me JOIN book foreign ON foreign.author_id = me.id
1668 You can specify as many foreign => self mappings as necessary.
1670 Valid attributes are as follows:
1676 Explicitly specifies the type of join to use in the relationship. Any
1677 SQL join type is valid, e.g. C<LEFT> or C<RIGHT>. It will be placed in
1678 the SQL command immediately before C<JOIN>.
1682 An arrayref containing a list of accessors in the foreign class to proxy in
1683 the main class. If, for example, you do the following:
1685 CD->might_have(liner_notes => 'LinerNotes', undef, {
1686 proxy => [ qw/notes/ ],
1689 Then, assuming LinerNotes has an accessor named notes, you can do:
1691 my $cd = CD->find(1);
1692 # set notes -- LinerNotes object is created if it doesn't exist
1693 $cd->notes('Notes go here');
1697 Specifies the type of accessor that should be created for the
1698 relationship. Valid values are C<single> (for when there is only a single
1699 related object), C<multi> (when there can be many), and C<filter> (for
1700 when there is a single related object, but you also want the relationship
1701 accessor to double as a column accessor). For C<multi> accessors, an
1702 add_to_* method is also created, which calls C<create_related> for the
1707 Throws an exception if the condition is improperly supplied, or cannot
1712 sub add_relationship {
1713 my ($self, $rel, $f_source_name, $cond, $attrs) = @_;
1715 local $self->{__in_rsrc_setter_callstack} = 1
1716 unless $self->{__in_rsrc_setter_callstack};
1718 $self->throw_exception("Can't create relationship without join condition")
1722 # Check foreign and self are right in cond
1723 if ( (ref $cond ||'') eq 'HASH') {
1724 $_ =~ /^foreign\./ or $self->throw_exception("Malformed relationship condition key '$_': must be prefixed with 'foreign.'")
1727 $_ =~ /^self\./ or $self->throw_exception("Malformed relationship condition value '$_': must be prefixed with 'self.'")
1731 my %rels = %{ $self->_relationships };
1732 $rels{$rel} = { class => $f_source_name,
1733 source => $f_source_name,
1736 $self->_relationships(\%rels);
1741 =head2 relationships
1745 =item Arguments: none
1747 =item Return Value: L<@rel_names|DBIx::Class::Relationship>
1751 my @rel_names = $source->relationships();
1753 Returns all relationship names for this source.
1758 keys %{$_[0]->_relationships};
1761 =head2 relationship_info
1765 =item Arguments: L<$rel_name|DBIx::Class::Relationship>
1767 =item Return Value: L<\%rel_data|DBIx::Class::Relationship::Base/add_relationship>
1771 Returns a hash of relationship information for the specified relationship
1772 name. The keys/values are as specified for L<DBIx::Class::Relationship::Base/add_relationship>.
1776 sub relationship_info {
1777 #my ($self, $rel) = @_;
1778 return shift->_relationships->{+shift};
1781 =head2 has_relationship
1785 =item Arguments: L<$rel_name|DBIx::Class::Relationship>
1787 =item Return Value: 1/0 (true/false)
1791 Returns true if the source has a relationship of this name, false otherwise.
1795 sub has_relationship {
1796 #my ($self, $rel) = @_;
1797 return exists shift->_relationships->{+shift};
1800 =head2 reverse_relationship_info
1804 =item Arguments: L<$rel_name|DBIx::Class::Relationship>
1806 =item Return Value: L<\%rel_data|DBIx::Class::Relationship::Base/add_relationship>
1810 Looks through all the relationships on the source this relationship
1811 points to, looking for one whose condition is the reverse of the
1812 condition on this relationship.
1814 A common use of this is to find the name of the C<belongs_to> relation
1815 opposing a C<has_many> relation. For definition of these look in
1816 L<DBIx::Class::Relationship>.
1818 The returned hashref is keyed by the name of the opposing
1819 relationship, and contains its data in the same manner as
1820 L</relationship_info>.
1824 sub reverse_relationship_info {
1825 my ($self, $rel) = @_;
1827 my $rel_info = $self->relationship_info($rel)
1828 or $self->throw_exception("No such relationship '$rel'");
1832 return $ret unless ((ref $rel_info->{cond}) eq 'HASH');
1834 my $stripped_cond = $self->__strip_relcond ($rel_info->{cond});
1836 my $registered_source_name = $self->source_name;
1838 # this may be a partial schema or something else equally esoteric
1839 my $other_rsrc = $self->related_source($rel);
1841 # Get all the relationships for that source that related to this source
1842 # whose foreign column set are our self columns on $rel and whose self
1843 # columns are our foreign columns on $rel
1844 foreach my $other_rel ($other_rsrc->relationships) {
1846 # only consider stuff that points back to us
1847 # "us" here is tricky - if we are in a schema registration, we want
1848 # to use the source_names, otherwise we will use the actual classes
1850 # the schema may be partial
1851 my $roundtrip_rsrc = dbic_internal_try { $other_rsrc->related_source($other_rel) }
1854 if ($registered_source_name) {
1855 next if $registered_source_name ne ($roundtrip_rsrc->source_name || '')
1858 next if $self->result_class ne $roundtrip_rsrc->result_class;
1861 my $other_rel_info = $other_rsrc->relationship_info($other_rel);
1863 # this can happen when we have a self-referential class
1864 next if $other_rel_info eq $rel_info;
1866 next unless ref $other_rel_info->{cond} eq 'HASH';
1867 my $other_stripped_cond = $self->__strip_relcond($other_rel_info->{cond});
1869 $ret->{$other_rel} = $other_rel_info if (
1870 $self->_compare_relationship_keys (
1871 [ keys %$stripped_cond ], [ values %$other_stripped_cond ]
1874 $self->_compare_relationship_keys (
1875 [ values %$stripped_cond ], [ keys %$other_stripped_cond ]
1883 # all this does is removes the foreign/self prefix from a condition
1884 sub __strip_relcond {
1887 { map { /^ (?:foreign|self) \. (\w+) $/x } ($_, $_[1]{$_}) }
1892 sub compare_relationship_keys {
1893 carp 'compare_relationship_keys is a private method, stop calling it';
1895 $self->_compare_relationship_keys (@_);
1898 # Returns true if both sets of keynames are the same, false otherwise.
1899 sub _compare_relationship_keys {
1900 # my ($self, $keys1, $keys2) = @_;
1902 join ("\x00", sort @{$_[1]})
1904 join ("\x00", sort @{$_[2]})
1908 # optionally takes either an arrayref of column names, or a hashref of already
1909 # retrieved colinfos
1910 # returns an arrayref of column names of the shortest unique constraint
1911 # (matching some of the input if any), giving preference to the PK
1912 sub _identifying_column_set {
1913 my ($self, $cols) = @_;
1915 my %unique = $self->unique_constraints;
1916 my $colinfos = ref $cols eq 'HASH' ? $cols : $self->columns_info($cols||());
1918 # always prefer the PK first, and then shortest constraints first
1920 for my $set (delete $unique{primary}, sort { @$a <=> @$b } (values %unique) ) {
1921 next unless $set && @$set;
1924 next USET unless ($colinfos->{$_} && !$colinfos->{$_}{is_nullable} );
1927 # copy so we can mangle it at will
1934 sub _minimal_valueset_satisfying_constraint {
1936 my $args = { ref $_[0] eq 'HASH' ? %{ $_[0] } : @_ };
1938 $args->{columns_info} ||= $self->columns_info;
1940 my $vals = extract_equality_conditions(
1942 ($args->{carp_on_nulls} ? 'consider_nulls' : undef ),
1946 for my $col ($self->unique_constraint_columns($args->{constraint_name}) ) {
1947 if( ! exists $vals->{$col} or ( $vals->{$col}||'' ) eq UNRESOLVABLE_CONDITION ) {
1948 $cols->{missing}{$col} = undef;
1950 elsif( ! defined $vals->{$col} ) {
1951 $cols->{$args->{carp_on_nulls} ? 'undefined' : 'missing'}{$col} = undef;
1954 # we need to inject back the '=' as extract_equality_conditions()
1955 # will strip it from literals and values alike, resulting in an invalid
1956 # condition in the end
1957 $cols->{present}{$col} = { '=' => $vals->{$col} };
1960 $cols->{fc}{$col} = 1 if (
1961 ( ! $cols->{missing} or ! exists $cols->{missing}{$col} )
1963 keys %{ $args->{columns_info}{$col}{_filter_info} || {} }
1967 $self->throw_exception( sprintf ( "Unable to satisfy requested constraint '%s', missing values for column(s): %s",
1968 $args->{constraint_name},
1969 join (', ', map { "'$_'" } sort keys %{$cols->{missing}} ),
1970 ) ) if $cols->{missing};
1972 $self->throw_exception( sprintf (
1973 "Unable to satisfy requested constraint '%s', FilterColumn values not usable for column(s): %s",
1974 $args->{constraint_name},
1975 join (', ', map { "'$_'" } sort keys %{$cols->{fc}}),
1981 !$ENV{DBIC_NULLABLE_KEY_NOWARN}
1983 carp_unique ( sprintf (
1984 "NULL/undef values supplied for requested unique constraint '%s' (NULL "
1985 . 'values in column(s): %s). This is almost certainly not what you wanted, '
1986 . 'though you can set DBIC_NULLABLE_KEY_NOWARN to disable this warning.',
1987 $args->{constraint_name},
1988 join (', ', map { "'$_'" } sort keys %{$cols->{undefined}}),
1992 return { map { %{ $cols->{$_}||{} } } qw(present undefined) };
1995 # Returns the {from} structure used to express JOIN conditions
1997 my ($self, $join, $alias, $seen, $jpath, $parent_force_left) = @_;
1999 # we need a supplied one, because we do in-place modifications, no returns
2000 $self->throw_exception ('You must supply a seen hashref as the 3rd argument to _resolve_join')
2001 unless ref $seen eq 'HASH';
2003 $self->throw_exception ('You must supply a joinpath arrayref as the 4th argument to _resolve_join')
2004 unless ref $jpath eq 'ARRAY';
2006 $jpath = [@$jpath]; # copy
2008 if (not defined $join or not length $join) {
2011 elsif (ref $join eq 'ARRAY') {
2014 $self->_resolve_join($_, $alias, $seen, $jpath, $parent_force_left);
2017 elsif (ref $join eq 'HASH') {
2020 for my $rel (keys %$join) {
2022 my $rel_info = $self->relationship_info($rel)
2023 or $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
2025 my $force_left = $parent_force_left;
2026 $force_left ||= lc($rel_info->{attrs}{join_type}||'') eq 'left';
2028 # the actual seen value will be incremented by the recursion
2029 my $as = $self->schema->storage->relname_to_table_alias(
2030 $rel, ($seen->{$rel} && $seen->{$rel} + 1)
2034 $self->_resolve_join($rel, $alias, $seen, [@$jpath], $force_left),
2035 $self->related_source($rel)->_resolve_join(
2036 $join->{$rel}, $as, $seen, [@$jpath, { $rel => $as }], $force_left
2044 $self->throw_exception("No idea how to resolve join reftype ".ref $join);
2047 my $count = ++$seen->{$join};
2048 my $as = $self->schema->storage->relname_to_table_alias(
2049 $join, ($count > 1 && $count)
2052 my $rel_info = $self->relationship_info($join)
2053 or $self->throw_exception("No such relationship $join on " . $self->source_name);
2055 my $rel_src = $self->related_source($join);
2056 return [ { $as => $rel_src->from,
2058 -join_type => $parent_force_left
2060 : $rel_info->{attrs}{join_type}
2062 -join_path => [@$jpath, { $join => $as } ],
2064 ! $rel_info->{attrs}{accessor}
2066 $rel_info->{attrs}{accessor} eq 'single'
2068 $rel_info->{attrs}{accessor} eq 'filter'
2071 -relation_chain_depth => ( $seen->{-relation_chain_depth} || 0 ) + 1,
2073 $self->_resolve_relationship_condition(
2075 self_alias => $alias,
2076 foreign_alias => $as,
2083 carp 'pk_depends_on is a private method, stop calling it';
2085 $self->_pk_depends_on (@_);
2088 # Determines whether a relation is dependent on an object from this source
2089 # having already been inserted. Takes the name of the relationship and a
2090 # hashref of columns of the related object.
2091 sub _pk_depends_on {
2092 my ($self, $rel_name, $rel_data) = @_;
2094 my $relinfo = $self->relationship_info($rel_name);
2096 # don't assume things if the relationship direction is specified
2097 return $relinfo->{attrs}{is_foreign_key_constraint}
2098 if exists ($relinfo->{attrs}{is_foreign_key_constraint});
2100 my $cond = $relinfo->{cond};
2101 return 0 unless ref($cond) eq 'HASH';
2103 # map { foreign.foo => 'self.bar' } to { bar => 'foo' }
2104 my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond };
2106 # assume anything that references our PK probably is dependent on us
2107 # rather than vice versa, unless the far side is (a) defined or (b)
2109 my $rel_source = $self->related_source($rel_name);
2113 foreach my $p ($self->primary_columns) {
2115 exists $keyhash->{$p}
2117 ! defined( $rel_data->{$keyhash->{$p}} )
2119 ! ( $colinfos ||= $rel_source->columns_info )
2120 ->{$keyhash->{$p}}{is_auto_increment}
2127 sub resolve_condition {
2128 carp 'resolve_condition is a private method, stop calling it';
2129 shift->_resolve_condition (@_);
2132 sub _resolve_condition {
2133 # carp_unique sprintf
2134 # '_resolve_condition is a private method, and moreover is about to go '
2135 # . 'away. Please contact the development team at %s if you believe you '
2136 # . 'have a genuine use for this method, in order to discuss alternatives.',
2137 # DBIx::Class::_ENV_::HELP_URL,
2140 #######################
2141 ### API Design? What's that...? (a backwards compatible shim, kill me now)
2143 my ($self, $cond, @res_args, $rel_name);
2145 # we *SIMPLY DON'T KNOW YET* which arg is which, yay
2146 ($self, $cond, $res_args[0], $res_args[1], $rel_name) = @_;
2148 # assume that an undef is an object-like unset (set_from_related(undef))
2149 my @is_objlike = map { ! defined $_ or length ref $_ } (@res_args);
2151 # turn objlike into proper objects for saner code further down
2153 next unless $is_objlike[$_];
2155 if ( defined blessed $res_args[$_] ) {
2157 # but wait - there is more!!! WHAT THE FUCK?!?!?!?!
2158 if ($res_args[$_]->isa('DBIx::Class::ResultSet')) {
2159 carp('Passing a resultset for relationship resolution makes no sense - invoking __gremlins__');
2160 $is_objlike[$_] = 0;
2161 $res_args[$_] = '__gremlins__';
2164 elsif( $_ == 0 and $res_args[0]->isa( $__expected_result_class_isa ) ) {
2165 $res_args[0] = { $res_args[0]->get_columns };
2169 $res_args[$_] ||= {};
2171 # hate everywhere - have to pass in as a plain hash
2172 # pretending to be an object at least for now
2173 $self->throw_exception("Unsupported object-like structure encountered: $res_args[$_]")
2174 unless ref $res_args[$_] eq 'HASH';
2179 # where-is-waldo block guesses relname, then further down we override it if available
2181 $is_objlike[1] ? ( rel_name => $res_args[0], self_alias => $res_args[0], foreign_alias => 'me', self_result_object => $res_args[1] )
2182 : $is_objlike[0] ? ( rel_name => $res_args[1], self_alias => 'me', foreign_alias => $res_args[1], foreign_values => $res_args[0] )
2183 : ( rel_name => $res_args[0], self_alias => $res_args[1], foreign_alias => $res_args[0] )
2186 ( $rel_name ? ( rel_name => $rel_name ) : () ),
2189 # Allowing passing relconds different than the relationshup itself is cute,
2190 # but likely dangerous. Remove that from the (still unofficial) API of
2191 # _resolve_relationship_condition, and instead make it "hard on purpose"
2192 local $self->relationship_info( $args->{rel_name} )->{cond} = $cond if defined $cond;
2194 #######################
2196 # now it's fucking easy isn't it?!
2197 my $rc = $self->_resolve_relationship_condition( $args );
2200 ( $rc->{join_free_condition} || $rc->{condition} ),
2201 ! $rc->{join_free_condition},
2204 # _resolve_relationship_condition always returns qualified cols even in the
2205 # case of join_free_condition, but nothing downstream expects this
2206 if ($rc->{join_free_condition} and ref $res[0] eq 'HASH') {
2208 { ($_ =~ /\.(.+)/) => $res[0]{$_} }
2214 return wantarray ? @res : $res[0];
2217 # Keep this indefinitely. There is evidence of both CPAN and
2218 # darkpan using it, and there isn't much harm in an extra var
2220 our $UNRESOLVABLE_CONDITION = UNRESOLVABLE_CONDITION;
2221 # YES I KNOW THIS IS EVIL
2222 # it is there to save darkpan from themselves, since internally
2223 # we are moving to a constant
2224 Internals::SvREADONLY($UNRESOLVABLE_CONDITION => 1);
2226 # Resolves the passed condition to a concrete query fragment and extra
2229 ## self-explanatory API, modeled on the custom cond coderef:
2230 # rel_name => (scalar)
2231 # foreign_alias => (scalar)
2232 # foreign_values => (either not supplied or a hashref )
2233 # self_alias => (scalar)
2234 # self_result_object => (either not supplied or a result object)
2235 # require_join_free_condition => (boolean, throws on failure to construct a JF-cond)
2236 # infer_values_based_on => (either not supplied or a hashref, implies require_join_free_condition)
2239 # condition => (a valid *likely fully qualified* sqla cond structure)
2240 # identity_map => (a hashref of foreign-to-self *unqualified* column equality names)
2241 # join_free_condition => (a valid *fully qualified* sqla cond structure, maybe unset)
2242 # inferred_values => (in case of an available join_free condition, this is a hashref of
2243 # *unqualified* column/value *EQUALITY* pairs, representing an amalgamation
2244 # of the JF-cond parse and infer_values_based_on
2245 # always either complete or unset)
2247 sub _resolve_relationship_condition {
2250 my $args = { ref $_[0] eq 'HASH' ? %{ $_[0] } : @_ };
2252 for ( qw( rel_name self_alias foreign_alias ) ) {
2253 $self->throw_exception("Mandatory argument '$_' to _resolve_relationship_condition() is not a plain string")
2254 if !defined $args->{$_} or length ref $args->{$_};
2257 $self->throw_exception("Arguments 'self_alias' and 'foreign_alias' may not be identical")
2258 if $args->{self_alias} eq $args->{foreign_alias};
2261 my $exception_rel_id = "relationship '$args->{rel_name}' on source '@{[ $self->source_name ]}'";
2263 my $rel_info = $self->relationship_info($args->{rel_name})
2265 # or $self->throw_exception( "No such $exception_rel_id" );
2266 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");
2269 $exception_rel_id = "relationship '$rel_info->{_original_name}' on source '@{[ $self->source_name ]}'"
2270 if $rel_info and exists $rel_info->{_original_name};
2272 $self->throw_exception("No practical way to resolve $exception_rel_id between two data structures")
2273 if exists $args->{self_result_object} and exists $args->{foreign_values};
2275 $self->throw_exception( "Argument to infer_values_based_on must be a hash" )
2276 if exists $args->{infer_values_based_on} and ref $args->{infer_values_based_on} ne 'HASH';
2278 $args->{require_join_free_condition} ||= !!$args->{infer_values_based_on};
2280 $self->throw_exception( "Argument 'self_result_object' must be an object inheriting from '$__expected_result_class_isa'" )
2282 exists $args->{self_result_object}
2285 ! defined blessed $args->{self_result_object}
2287 ! $args->{self_result_object}->isa( $__expected_result_class_isa )
2292 my $rel_rsrc = $self->related_source($args->{rel_name});
2295 exists $args->{foreign_values}
2298 ref $args->{foreign_values} eq 'HASH'
2300 $self->throw_exception(
2301 "Argument 'foreign_values' must be a hash reference"
2305 keys %{$args->{foreign_values}}
2308 my ($col_idx, $rel_idx) = map
2309 { { map { $_ => 1 } $rel_rsrc->$_ } }
2310 qw( columns relationships )
2315 # re-build {foreign_values} excluding refs as follows
2316 # ( hot codepath: intentionally convoluted )
2318 $args->{foreign_values} = { map {
2322 $self->throw_exception(
2323 "The key '$_' supplied as part of 'foreign_values' during "
2324 . 'relationship resolution must be a column name, not a function'
2329 # skip if relationship ( means a multicreate stub was passed in )
2330 # skip if literal ( can't infer anything about it )
2331 # or plain throw if nonequiv yet not literal
2333 length ref $args->{foreign_values}{$_}
2338 is_literal_value($args->{foreign_values}{$_})
2343 ( $equivalencies ||= extract_equality_conditions( $args->{foreign_values}, 'consider nulls' ) )
2347 ($equivalencies->{$_}||'') eq UNRESOLVABLE_CONDITION
2350 $self->throw_exception(
2351 "Resolution of relationship '$args->{rel_name}' failed: "
2352 . "supplied value for foreign column '$_' is not a direct "
2353 . 'equivalence expression'
2358 : $col_idx->{$_} ? ( $_ => $args->{foreign_values}{$_} )
2359 : $self->throw_exception(
2360 "The key '$_' supplied as part of 'foreign_values' during "
2361 . 'relationship resolution is not a column on related source '
2362 . "'@{[ $rel_rsrc->source_name ]}'"
2365 } keys %{$args->{foreign_values}} };
2370 if (ref $rel_info->{cond} eq 'CODE') {
2373 rel_name => $args->{rel_name},
2374 self_resultsource => $self,
2375 self_alias => $args->{self_alias},
2376 foreign_alias => $args->{foreign_alias},
2378 { (exists $args->{$_}) ? ( $_ => $args->{$_} ) : () }
2379 qw( self_result_object foreign_values )
2383 # legacy - never remove these!!!
2384 $cref_args->{foreign_relname} = $cref_args->{rel_name};
2386 $cref_args->{self_rowobj} = $cref_args->{self_result_object}
2387 if exists $cref_args->{self_result_object};
2389 ($ret->{condition}, $ret->{join_free_condition}, my @extra) = $rel_info->{cond}->($cref_args);
2392 $self->throw_exception("A custom condition coderef can return at most 2 conditions, but $exception_rel_id returned extra values: @extra")
2395 if (my $jfc = $ret->{join_free_condition}) {
2397 $self->throw_exception (
2398 "The join-free condition returned for $exception_rel_id must be a hash reference"
2399 ) unless ref $jfc eq 'HASH';
2401 my ($joinfree_alias, $joinfree_source);
2402 if (defined $args->{self_result_object}) {
2403 $joinfree_alias = $args->{foreign_alias};
2404 $joinfree_source = $rel_rsrc;
2406 elsif (defined $args->{foreign_values}) {
2407 $joinfree_alias = $args->{self_alias};
2408 $joinfree_source = $self;
2411 # FIXME sanity check until things stabilize, remove at some point
2412 $self->throw_exception (
2413 "A join-free condition returned for $exception_rel_id without a result object to chain from"
2414 ) unless $joinfree_alias;
2416 my $fq_col_list = { map
2417 { ( "$joinfree_alias.$_" => 1 ) }
2418 $joinfree_source->columns
2421 exists $fq_col_list->{$_} or $self->throw_exception (
2422 "The join-free condition returned for $exception_rel_id may only "
2423 . 'contain keys that are fully qualified column names of the corresponding source '
2424 . "'$joinfree_alias' (instead it returned '$_')"
2430 $_->isa( $__expected_result_class_isa )
2432 $self->throw_exception (
2433 "The join-free condition returned for $exception_rel_id may not "
2434 . 'contain result objects as values - perhaps instead of invoking '
2435 . '->$something you meant to return ->get_column($something)'
2441 elsif (ref $rel_info->{cond} eq 'HASH') {
2443 # the condition is static - use parallel arrays
2444 # for a "pivot" depending on which side of the
2445 # rel did we get as an object
2446 my (@f_cols, @l_cols);
2447 for my $fc (keys %{ $rel_info->{cond} }) {
2448 my $lc = $rel_info->{cond}{$fc};
2450 # FIXME STRICTMODE should probably check these are valid columns
2451 $fc =~ s/^foreign\.// ||
2452 $self->throw_exception("Invalid rel cond key '$fc'");
2454 $lc =~ s/^self\.// ||
2455 $self->throw_exception("Invalid rel cond val '$lc'");
2461 # construct the crosstable condition and the identity map
2463 $ret->{condition}{"$args->{foreign_alias}.$f_cols[$_]"} = { -ident => "$args->{self_alias}.$l_cols[$_]" };
2464 $ret->{identity_map}{$l_cols[$_]} = $f_cols[$_];
2467 if ($args->{foreign_values}) {
2468 $ret->{join_free_condition}{"$args->{self_alias}.$l_cols[$_]"} = $args->{foreign_values}{$f_cols[$_]}
2471 elsif (defined $args->{self_result_object}) {
2473 for my $i (0..$#l_cols) {
2474 if ( $args->{self_result_object}->has_column_loaded($l_cols[$i]) ) {
2475 $ret->{join_free_condition}{"$args->{foreign_alias}.$f_cols[$i]"} = $args->{self_result_object}->get_column($l_cols[$i]);
2478 $self->throw_exception(sprintf
2479 "Unable to resolve relationship '%s' from object '%s': column '%s' not "
2480 . 'loaded from storage (or not passed to new() prior to insert()). You '
2481 . 'probably need to call ->discard_changes to get the server-side defaults '
2482 . 'from the database.',
2484 $args->{self_result_object},
2486 ) if $args->{self_result_object}->in_storage;
2488 # FIXME - temporarly force-override
2489 delete $args->{require_join_free_condition};
2490 $ret->{join_free_condition} = UNRESOLVABLE_CONDITION;
2496 elsif (ref $rel_info->{cond} eq 'ARRAY') {
2497 if (@{ $rel_info->{cond} } == 0) {
2499 condition => UNRESOLVABLE_CONDITION,
2500 join_free_condition => UNRESOLVABLE_CONDITION,
2504 my @subconds = map {
2505 local $rel_info->{cond} = $_;
2506 $self->_resolve_relationship_condition( $args );
2507 } @{ $rel_info->{cond} };
2509 if( @{ $rel_info->{cond} } == 1 ) {
2510 $ret = $subconds[0];
2513 for my $subcond ( @subconds ) {
2514 $self->throw_exception('Either all or none of the OR-condition members must resolve to a join-free condition')
2515 if ( $ret and ( $ret->{join_free_condition} xor $subcond->{join_free_condition} ) );
2517 # we are discarding inferred_values from individual 'OR' branches here
2518 # see @nonvalues checks below
2519 $subcond->{$_} and push @{$ret->{$_}}, $subcond->{$_} for (qw(condition join_free_condition));
2525 $self->throw_exception ("Can't handle condition $rel_info->{cond} for $exception_rel_id yet :(");
2529 # Explicit normalization pass
2530 # ( nobody really knows what a CODE can return )
2531 # Explicitly leave U_C alone - it would be normalized
2532 # to an { -and => [ U_C ] }
2535 $ret->{$_} ne UNRESOLVABLE_CONDITION
2537 $ret->{$_} = normalize_sqla_condition($ret->{$_})
2538 for qw(condition join_free_condition);
2542 $args->{require_join_free_condition}
2544 ( ! $ret->{join_free_condition} or $ret->{join_free_condition} eq UNRESOLVABLE_CONDITION )
2546 $self->throw_exception(
2547 ucfirst sprintf "$exception_rel_id does not resolve to a %sjoin-free condition fragment",
2548 exists $args->{foreign_values}
2549 ? "'foreign_values'-based reversed-"
2554 # we got something back - sanity check and infer values if we can
2557 $ret->{join_free_condition}
2559 $ret->{join_free_condition} ne UNRESOLVABLE_CONDITION
2562 my $jfc_eqs = extract_equality_conditions(
2563 $ret->{join_free_condition},
2567 for( keys %{ $ret->{join_free_condition} } ) {
2569 push @nonvalues, { $_ => $ret->{join_free_condition}{$_} };
2572 # a join_free_condoition is fully qualified by definition
2573 my ($col) = $_ =~ /\.(.+)/ or carp_unique(
2574 'Internal error - extract_equality_conditions() returned a '
2575 . "non-fully-qualified key '$_'. *Please* file a bugreport "
2576 . "including your definition of $exception_rel_id"
2579 if (exists $jfc_eqs->{$_} and ($jfc_eqs->{$_}||'') ne UNRESOLVABLE_CONDITION) {
2580 $ret->{inferred_values}{$col} = $jfc_eqs->{$_};
2582 elsif ( !$args->{infer_values_based_on} or ! exists $args->{infer_values_based_on}{$col} ) {
2583 push @nonvalues, { $_ => $ret->{join_free_condition}{$_} };
2589 delete $ret->{inferred_values} if @nonvalues;
2592 # did the user explicitly ask
2593 if ($args->{infer_values_based_on}) {
2595 $self->throw_exception(sprintf (
2596 "Unable to complete value inferrence - $exception_rel_id results in expression(s) instead of definitive values: %s",
2598 # FIXME - used for diag only, but still icky
2599 my $sqlm = $self->schema->storage->sql_maker;
2600 local $sqlm->{quote_char};
2601 local $sqlm->{_dequalify_idents} = 1;
2602 ($sqlm->_recurse_where({ -and => \@nonvalues }))[0]
2607 $ret->{inferred_values} ||= {};
2609 $ret->{inferred_values}{$_} = $args->{infer_values_based_on}{$_}
2610 for keys %{$args->{infer_values_based_on}};
2613 # add the identities based on the main condition
2614 # (may already be there, since easy to calculate on the fly in the HASH case)
2615 if ( ! $ret->{identity_map} ) {
2617 my $col_eqs = extract_equality_conditions($ret->{condition});
2620 for my $lhs (keys %$col_eqs) {
2622 next if $col_eqs->{$lhs} eq UNRESOLVABLE_CONDITION;
2624 # there is no way to know who is right and who is left in a cref
2625 # therefore a full blown resolution call, and figure out the
2626 # direction a bit further below
2627 $colinfos ||= fromspec_columns_info([
2628 { -alias => $args->{self_alias}, -rsrc => $self },
2629 { -alias => $args->{foreign_alias}, -rsrc => $rel_rsrc },
2632 next unless $colinfos->{$lhs}; # someone is engaging in witchcraft
2634 if ( my $rhs_ref = is_literal_value( $col_eqs->{$lhs} ) ) {
2637 $colinfos->{$rhs_ref->[0]}
2639 $colinfos->{$lhs}{-source_alias} ne $colinfos->{$rhs_ref->[0]}{-source_alias}
2641 ( $colinfos->{$lhs}{-source_alias} eq $args->{self_alias} )
2642 ? ( $ret->{identity_map}{$colinfos->{$lhs}{-colname}} = $colinfos->{$rhs_ref->[0]}{-colname} )
2643 : ( $ret->{identity_map}{$colinfos->{$rhs_ref->[0]}{-colname}} = $colinfos->{$lhs}{-colname} )
2648 $col_eqs->{$lhs} =~ /^ ( \Q$args->{self_alias}\E \. .+ ) /x
2650 ($colinfos->{$1}||{})->{-result_source} == $rel_rsrc
2652 my ($lcol, $rcol) = map
2653 { $colinfos->{$_}{-colname} }
2657 "The $exception_rel_id specifies equality of column '$lcol' and the "
2658 . "*VALUE* '$rcol' (you did not use the { -ident => ... } operator)"
2664 # FIXME - temporary, to fool the idiotic check in SQLMaker::_join_condition
2665 $ret->{condition} = { -and => [ $ret->{condition} ] } unless (
2666 $ret->{condition} eq UNRESOLVABLE_CONDITION
2669 ref $ret->{condition} eq 'HASH'
2671 grep { $_ =~ /^-/ } keys %{$ret->{condition}}
2678 =head2 related_source
2682 =item Arguments: $rel_name
2684 =item Return Value: $source
2688 Returns the result source object for the given relationship.
2692 sub related_source {
2693 my ($self, $rel) = @_;
2694 if( !$self->has_relationship( $rel ) ) {
2695 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
2698 # if we are not registered with a schema - just use the prototype
2699 # however if we do have a schema - ask for the source by name (and
2700 # throw in the process if all fails)
2701 if (my $schema = dbic_internal_try { $self->schema }) {
2702 $schema->source($self->relationship_info($rel)->{source});
2705 my $class = $self->relationship_info($rel)->{class};
2706 $self->ensure_class_loaded($class);
2707 $class->result_source;
2711 =head2 related_class
2715 =item Arguments: $rel_name
2717 =item Return Value: $classname
2721 Returns the class name for objects in the given relationship.
2726 my ($self, $rel) = @_;
2727 if( !$self->has_relationship( $rel ) ) {
2728 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
2730 return $self->schema->class($self->relationship_info($rel)->{source});
2737 =item Arguments: none
2739 =item Return Value: L<$source_handle|DBIx::Class::ResultSourceHandle>
2743 Obtain a new L<result source handle instance|DBIx::Class::ResultSourceHandle>
2744 for this source. Used as a serializable pointer to this resultsource, as it is not
2745 easy (nor advisable) to serialize CODErefs which may very well be present in e.g.
2746 relationship definitions.
2751 require DBIx::Class::ResultSourceHandle;
2752 return DBIx::Class::ResultSourceHandle->new({
2753 source_moniker => $_[0]->source_name,
2755 # so that a detached thaw can be re-frozen
2756 $_[0]->{_detached_thaw}
2757 ? ( _detached_source => $_[0] )
2758 : ( schema => $_[0]->schema )
2763 my $global_phase_destroy;
2765 ### NO detected_reinvoked_destructor check
2766 ### This code very much relies on being called multuple times
2768 return if $global_phase_destroy ||= in_global_destruction;
2774 # Under no circumstances shall $_[0] be stored anywhere else (like copied to
2775 # a lexical variable, or shifted, or anything else). Doing so will mess up
2776 # the refcount of this particular result source, and will allow the $schema
2777 # we are trying to save to reattach back to the source we are destroying.
2778 # The relevant code checking refcounts is in ::Schema::DESTROY()
2780 # if we are not a schema instance holder - we don't matter
2782 ! ref $_[0]->{schema}
2784 isweak $_[0]->{schema}
2787 # weaken our schema hold forcing the schema to find somewhere else to live
2788 # during global destruction (if we have not yet bailed out) this will throw
2789 # which will serve as a signal to not try doing anything else
2790 # however beware - on older perls the exception seems randomly untrappable
2791 # due to some weird race condition during thread joining :(((
2792 local $SIG{__DIE__} if $SIG{__DIE__};
2793 local $@ if DBIx::Class::_ENV_::UNSTABLE_DOLLARAT;
2795 weaken $_[0]->{schema};
2797 # if schema is still there reintroduce ourselves with strong refs back to us
2798 if ($_[0]->{schema}) {
2799 my $srcregs = $_[0]->{schema}->source_registrations;
2801 defined $srcregs->{$_}
2803 $srcregs->{$_} == $_[0]
2805 $srcregs->{$_} = $_[0]
2813 $global_phase_destroy = 1;
2816 # Dummy NEXTSTATE ensuring the all temporaries on the stack are garbage
2817 # collected before leaving this scope. Depending on the code above, this
2818 # may very well be just a preventive measure guarding future modifications
2822 sub STORABLE_freeze { Storable::nfreeze($_[0]->handle) }
2825 my ($self, $cloning, $ice) = @_;
2826 %$self = %{ (Storable::thaw($ice))->resolve };
2829 =head2 throw_exception
2831 See L<DBIx::Class::Schema/"throw_exception">.
2835 sub throw_exception {
2839 ? $self->{schema}->throw_exception(@_)
2840 : DBIx::Class::Exception->throw(@_)
2844 =head2 column_info_from_storage
2848 =item Arguments: 1/0 (default: 0)
2850 =item Return Value: 1/0
2854 __PACKAGE__->column_info_from_storage(1);
2856 Enables the on-demand automatic loading of the above column
2857 metadata from storage as necessary. This is *deprecated*, and
2858 should not be used. It will be removed before 1.0.
2860 =head1 FURTHER QUESTIONS?
2862 Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
2864 =head1 COPYRIGHT AND LICENSE
2866 This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
2867 by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
2868 redistribute it and/or modify it under the same terms as the
2869 L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.