use DBIx::Class::Exception;
use DBIx::Class::Carp;
+use Devel::GlobalDestruction;
use Try::Tiny;
use List::Util 'first';
use Scalar::Util qw/blessed weaken isweak/;
use base qw/DBIx::Class/;
-__PACKAGE__->mk_group_accessors('simple' => qw/_ordered_columns
- _columns _primaries _unique_constraints name resultset_attributes
- from _relationships column_info_from_storage source_info
- source_name sqlt_deploy_callback/);
+__PACKAGE__->mk_group_accessors(simple => qw/
+ source_name name source_info
+ _ordered_columns _columns _primaries _unique_constraints
+ _relationships resultset_attributes
+ column_info_from_storage
+/);
-__PACKAGE__->mk_group_accessors('component_class' => qw/resultset_class
- result_class/);
+__PACKAGE__->mk_group_accessors(component_class => qw/
+ resultset_class
+ result_class
+/);
+
+__PACKAGE__->mk_classdata( sqlt_deploy_callback => 'default_sqlt_deploy_hook' );
=head1 NAME
$new->{_relationships} = { %{$new->{_relationships}||{}} };
$new->{name} ||= "!!NAME NOT SET!!";
$new->{_columns_info_loaded} ||= 0;
- $new->{sqlt_deploy_callback} ||= "default_sqlt_deploy_hook";
return $new;
}
=over
-=item Arguments: $callback
+=item Arguments: $callback_name | \&callback_code
+
+=item Return value: $callback_name | \&callback_code
=back
__PACKAGE__->sqlt_deploy_callback('mycallbackmethod');
+ or
+
+ __PACKAGE__->sqlt_deploy_callback(sub {
+ my ($source_instance, $sqlt_table) = @_;
+ ...
+ } );
+
An accessor to set a callback to be called during deployment of
the schema via L<DBIx::Class::Schema/create_ddl_dir> or
L<DBIx::Class::Schema/deploy>.
The callback can be set as either a code reference or the name of a
method in the current result class.
-If not set, the L</default_sqlt_deploy_hook> is called.
+Defaults to L</default_sqlt_deploy_hook>.
Your callback will be passed the $source object representing the
ResultSource instance being deployed, and the
=head2 default_sqlt_deploy_hook
-=over
-
-=item Arguments: $source, $sqlt_table
-
-=item Return value: undefined
-
-=back
-
-This is the sensible default for L</sqlt_deploy_callback>.
-
-If a method named C<sqlt_deploy_hook> exists in your Result class, it
-will be called and passed the current C<$source> and the
-C<$sqlt_table> being deployed.
+This is the default deploy hook implementation which checks if your
+current Result class has a C<sqlt_deploy_hook> method, and if present
+invokes it B<on the Result class directly>. This is to preserve the
+semantics of C<sqlt_deploy_hook> which was originally designed to expect
+the Result class name and the
+L<$sqlt_table instance|SQL::Translator::Schema::Table> of the table being
+deployed.
=cut
);
}
+=head2 name
+
+=over 4
+
+=item Arguments: None
+
+=item Result value: $name
+
+=back
+
+Returns the name of the result source, which will typically be the table
+name. This may be a scalar reference if the result source has a non-standard
+name.
+
=head2 source_name
=over 4
retrieval from this source. In the case of a database, the required FROM
clause contents.
+=cut
+
+sub from { die 'Virtual method!' }
+
=head2 schema
=over 4
;
}
+# optionally takes either an arrayref of column names, or a hashref of already
+# retrieved colinfos
+# returns an arrayref of column names of the shortest unique constraint
+# (matching some of the input if any), giving preference to the PK
+sub _identifying_column_set {
+ my ($self, $cols) = @_;
+
+ my %unique = $self->unique_constraints;
+ my $colinfos = ref $cols eq 'HASH' ? $cols : $self->columns_info($cols||());
+
+ # always prefer the PK first, and then shortest constraints first
+ USET:
+ for my $set (delete $unique{primary}, sort { @$a <=> @$b } (values %unique) ) {
+ next unless $set && @$set;
+
+ for (@$set) {
+ next USET unless ($colinfos->{$_} && !$colinfos->{$_}{is_nullable} );
+ }
+
+ # copy so we can mangle it at will
+ return [ @$set ];
+ }
+
+ return undef;
+}
+
# Returns the {from} structure used to express JOIN conditions
sub _resolve_join {
my ($self, $join, $alias, $seen, $jpath, $parent_force_left) = @_;
$jpath = [@$jpath]; # copy
- if (not defined $join) {
+ if (not defined $join or not length $join) {
return ();
}
elsif (ref $join eq 'ARRAY') {
-alias => $as,
-relation_chain_depth => $seen->{-relation_chain_depth} || 0,
},
- $self->_resolve_condition($rel_info->{cond}, $as, $alias, $join)
+ scalar $self->_resolve_condition($rel_info->{cond}, $as, $alias, $join)
];
}
}
# FIXME sanity check until things stabilize, remove at some point
$self->throw_exception (
- "A join-free condition returned for relationship '$relname' whithout a row-object to chain from"
+ "A join-free condition returned for relationship '$relname' without a row-object to chain from"
) unless $obj_rel;
# FIXME another sanity check
# array of column names for each of those relationships. Column names are
# prefixed relative to the current source, in accordance with where they appear
# in the supplied relationships.
-
sub _resolve_prefetch {
my ($self, $pre, $alias, $alias_map, $order, $collapse, $pref_path) = @_;
$pref_path ||= [];
- if (not defined $pre) {
+ if (not defined $pre or not length $pre) {
return ();
}
elsif( ref $pre eq 'ARRAY' ) {
});
}
-{
- my $global_phase_destroy;
-
- # SpeedyCGI runs END blocks every cycle but keeps object instances
- # hence we have to disable the globaldestroy hatch, and rely on the
- # eval trap below (which appears to work, but is risky done so late)
- END { $global_phase_destroy = 1 unless $CGI::SpeedyCGI::i_am_speedy }
-
- sub DESTROY {
- return if $global_phase_destroy;
+my $global_phase_destroy;
+sub DESTROY {
+ return if $global_phase_destroy ||= in_global_destruction;
######
# !!! ACHTUNG !!!!
# we are trying to save to reattach back to the source we are destroying.
# The relevant code checking refcounts is in ::Schema::DESTROY()
- # if we are not a schema instance holder - we don't matter
- return if(
- ! ref $_[0]->{schema}
- or
- isweak $_[0]->{schema}
- );
-
- # weaken our schema hold forcing the schema to find somewhere else to live
- # during global destruction (if we have not yet bailed out) this will throw
- # which will serve as a signal to not try doing anything else
- local $@;
- eval {
- weaken $_[0]->{schema};
- 1;
- } or do {
- $global_phase_destroy = 1;
- return;
- };
+ # if we are not a schema instance holder - we don't matter
+ return if(
+ ! ref $_[0]->{schema}
+ or
+ isweak $_[0]->{schema}
+ );
+ # weaken our schema hold forcing the schema to find somewhere else to live
+ # during global destruction (if we have not yet bailed out) this will throw
+ # which will serve as a signal to not try doing anything else
+ # however beware - on older perls the exception seems randomly untrappable
+ # due to some weird race condition during thread joining :(((
+ local $@;
+ eval {
+ weaken $_[0]->{schema};
# if schema is still there reintroduce ourselves with strong refs back to us
if ($_[0]->{schema}) {
$srcregs->{$_} = $_[0] if $srcregs->{$_} == $_[0];
}
}
- }
+
+ 1;
+ } or do {
+ $global_phase_destroy = 1;
+ };
+
+ return;
}
sub STORABLE_freeze { Storable::nfreeze($_[0]->handle) }
should not be used. It will be removed before 1.0.
-=head1 AUTHORS
+=head1 AUTHOR AND CONTRIBUTORS
-Matt S. Trout <mst@shadowcatsystems.co.uk>
+See L<AUTHOR|DBIx::Class/AUTHOR> and L<CONTRIBUTORS|DBIx::Class/CONTRIBUTORS> in DBIx::Class
=head1 LICENSE
projects / dbsrgits/DBIx-Class.git / blobdiff