quote_sub perlstring serialize
dbic_internal_try
detected_reinvoked_destructor scope_guard
+ mkdir_p
);
use namespace::clean;
weaken (
$seek_and_destroy{ refaddr($_[0]) } = $_[0]
);
+
+ # Dummy NEXTSTATE ensuring the all temporaries on the stack are garbage
+ # collected before leaving this scope. Depending on the code above, this
+ # may very well be just a preventive measure guarding future modifications
+ undef;
}
END {
# disarm the handle if not native to this process (see comment on top)
$_->_verify_pid for @instances;
}
+
+ # Dummy NEXTSTATE ensuring the all temporaries on the stack are garbage
+ # collected before leaving this scope. Depending on the code above, this
+ # may very well be just a preventive measure guarding future modifications
+ undef;
}
sub CLONE {
# properly renumber existing refs
$_->_arm_global_destructor
}
+
+ # Dummy NEXTSTATE ensuring the all temporaries on the stack are garbage
+ # collected before leaving this scope. Depending on the code above, this
+ # may very well be just a preventive measure guarding future modifications
+ undef;
}
}
$_[0]->_dbh(undef);
# not calling ->disconnect here - we are being destroyed - nothing to reset
- # this op is necessary, since the very last perl runtime statement
- # triggers a global destruction shootout, and the $SIG localization
- # may very well be destroyed before perl actually gets to do the
- # $dbh undef
- 1;
+ # Dummy NEXTSTATE ensuring the all temporaries on the stack are garbage
+ # collected before leaving this scope. Depending on the code above, this
+ # may very well be just a preventive measure guarding future modifications
+ undef;
}
# handle pid changes correctly - do not destroy parent's connection
$_[0]->disconnect;
}
- return;
+ # Dummy NEXTSTATE ensuring the all temporaries on the stack are garbage
+ # collected before leaving this scope. Depending on the code above, this
+ # may very well be just a preventive measure guarding future modifications
+ undef;
}
=head2 connect_info
my $g = scope_guard {
- {
- local $@ if DBIx::Class::_ENV_::UNSTABLE_DOLLARAT;
- eval { $self->_dbh->disconnect };
- }
+ defined( $self->_dbh )
+ and dbic_internal_try { $self->_dbh->disconnect };
$self->_dbh(undef);
$self->_dbh_details({});
#$self->_sql_maker(undef); # this may also end up being different
};
- # FIXME FIXME FIXME
- # Something is wrong with CAG - it seems to delay GC in PP mode
- # If the below if() is changed to:
- #
- # if( $self->_dbh ) {
- #
- # The the following will reproducibly warn as the weakref in a $txn_guard
- # is *NOT* deallocated by the time the $txn_guard destructor runs at
- # https://github.com/dbsrgits/dbix-class/blob/84efb6d7/lib/DBIx/Class/Storage/TxnScopeGuard.pm#L82
- #
- # perl -Ilib -e '
- # BEGIN { warn $ENV{CAG_USE_XS} = ( time % 2 ) };
- # use DBIx::Class::Schema;
- # my $s = DBIx::Class::Schema->connect("dbi:SQLite::memory:");
- # my $g = $s->txn_scope_guard;
- # $s->storage->disconnect
- # '
- if( $self->{_dbh} ) { # do not use accessor - see above
+ if( $self->_dbh ) {
$self->_do_connection_actions(disconnect_call_ => $_) for (
( $self->on_disconnect_call || () ),
# stops the "implicit rollback on disconnect" warning
$self->_exec_txn_rollback unless $self->_dbh_autocommit;
}
+
+ # Dummy NEXTSTATE ensuring the all temporaries on the stack are garbage
+ # collected before leaving this scope. Depending on the code above, this
+ # may very well be just a preventive measure guarding future modifications
+ undef;
}
=head2 with_deferred_fk_checks
sub create_ddl_dir {
my ($self, $schema, $databases, $version, $dir, $preversion, $sqltargs) = @_;
- unless ($dir) {
+ require DBIx::Class::Optional::Dependencies;
+ if (my $missing = DBIx::Class::Optional::Dependencies->req_missing_for ('deploy')) {
+ $self->throw_exception("Can't create a ddl file without $missing");
+ }
+
+ if (!$dir) {
carp "No directory given, using ./\n";
$dir = './';
- } else {
- -d $dir
- or
- (require File::Path and File::Path::mkpath (["$dir"])) # mkpath does not like objects (i.e. Path::Class::Dir)
- or
- $self->throw_exception(
- "Failed to create '$dir': " . ($! || $@ || 'error unknown')
- );
}
-
- $self->throw_exception ("Directory '$dir' does not exist\n") unless(-d $dir);
+ else {
+ mkdir_p( $dir ) unless -d $dir;
+ }
$databases ||= ['MySQL', 'SQLite', 'PostgreSQL'];
$databases = [ $databases ] if(ref($databases) ne 'ARRAY');
%{$sqltargs || {}}
};
- if (my $missing = DBIx::Class::Optional::Dependencies->req_missing_for ('deploy')) {
- $self->throw_exception("Can't create a ddl file without $missing");
- }
-
my $sqlt = SQL::Translator->new( $sqltargs );
$sqlt->parser('SQL::Translator::Parser::DBIx::Class');
return join('', @rows);
}
+ require DBIx::Class::Optional::Dependencies;
if (my $missing = DBIx::Class::Optional::Dependencies->req_missing_for ('deploy') ) {
$self->throw_exception("Can't deploy without a pregenerated 'ddl_dir' directory or $missing");
}