Warnings on exit when DBI handle is global variable and there is assignment from subroutine

[vvv2542]

perl 5.40 prints warnings on exit when DBI handle is global variable and there is assignment from subroutine.

Module:
DBI 1.647

Description
The code below prints warnings on exit:

#!/usr/bin/env perl

use strict;
use warnings;
use DBI;

my $dbh = DBI->connect("dbi:Pg:dbname=db1", "user1", "password");
print "DONE\n";
exit 0;

sub sub1 {
    $dbh = "";
}

Result:

DONE
DBI dr handle 0x35f181.6477a42be8 cleared whilst still active during global destruction.
DBI dr handle 0x35f187a42be8 has 1 uncleared child handles during global destruction.
    dbih_clearcom (drh 0x35f187a42be8, com 0x35f1870ac000, imp DBD::Pg::dr):
       FLAGS 0x100215: COMSET Active Warn PrintWarn AutoCommit
       PARENT undef
       KIDS 1 (1 Active)

The script completed without warnings with perl 5.36 and the same version of DBI. Not tested with 5.38.
No warnings if remove $dbh assignment in sub1() which never called.

Steps to Reproduce
Execute the script with perl 5.40.

Expected behavior
No warnings.

Perl configuration

Summary of my perl5 (revision 5 version 40 subversion 2) configuration:

  Platform:
    osname=freebsd
    osvers=14.2-release-p3
    archname=amd64-freebsd-thread-multi
    uname='freebsd 142amd64-default-job-01 14.2-release-p3 freebsd 14.2-release-p3 amd64 '
    config_args='-Darchlib=/usr/local/lib/perl5/5.40/mach -Dcc=cc -Dcf_by=mat -Dcf_email=mat@FreeBSD.org -Dcf_time=Sun Apr 13 13:07:13 UTC 2025 -Dinc_version_list=none -Dlibperl=libperl.so.5.40.2 -Dman1dir=/usr/local/lib/perl5/5.40/perl/man/man1 -Dman3dir=/usr/local/lib/perl5/5.40/perl/man/man3 -Dprefix=/usr/local -Dprivlib=/usr/local/lib/perl5/5.40 -Dscriptdir=/usr/local/bin -Dsitearch=/usr/local/lib/perl5/site_perl/mach/5.40 -Dsitelib=/usr/local/lib/perl5/site_perl -Dsiteman1dir=/usr/local/lib/perl5/site_perl/man/man1 -Dsiteman3dir=/usr/local/lib/perl5/site_perl/man/man3 -Dusenm=n -Duseshrplib -sde -Ui_iconv -Ui_malloc -Uinstallusrbinperl -Alddlflags=-L/wrkdirs/usr/ports/lang/perl5.40/work/perl-5.40.2 -L/usr/local/lib/perl5/5.40/mach/CORE -lperl -Dshrpldflags=$(LDDLFLAGS:N-L/wrkdirs/usr/ports/lang/perl5.40/work/perl-5.40.2:N-L/usr/local/lib/perl5/5.40/mach/CORE:N-lperl) -Wl,-soname,$(LIBPERL:R) -Doptimize=-O2 -pipe  -fstack-protector-strong -fno-strict-aliasing  -Dusedtrace -Ui_gdbm -Dusemultiplicity=y -Duse64bitint -Dusemymalloc=n -Dusethreads=y'
    hint=recommended
    useposix=true
    d_sigaction=define
    useithreads=define
    usemultiplicity=define
    use64bitint=define
    use64bitall=define
    uselongdouble=undef
    usemymalloc=n
    default_inc_excludes_dot=define
  Compiler:
    cc='cc'
    ccflags ='-DHAS_FPSETMASK -DHAS_FLOATINGPOINT_H -DNO_POSIX_2008_LOCALE -fno-strict-aliasing -pipe -fstack-protector-strong -I/usr/local/include'
    optimize='-O2 -pipe -fstack-protector-strong -fno-strict-aliasing '
    cppflags='-DHAS_FPSETMASK -DHAS_FLOATINGPOINT_H -DNO_POSIX_2008_LOCALE -fno-strict-aliasing -pipe -fstack-protector-strong -I/usr/local/include'
    ccversion=''
    gccversion='FreeBSD Clang 18.1.6 (https://github.com/llvm/llvm-project.git llvmorg-18.1.6-0-g1118c2e05e67)'
    gccosandvers=''
    intsize=4
    longsize=8
    ptrsize=8
    doublesize=8
    byteorder=12345678
    doublekind=3
    d_longlong=define
    longlongsize=8
    d_longdbl=define
    longdblsize=16
    longdblkind=3
    ivtype='long'
    ivsize=8
    nvtype='double'
    nvsize=8
    Off_t='off_t'
    lseeksize=8
    alignbytes=8
    prototype=define
  Linker and Libraries:
    ld='cc'
    ldflags ='-pthread -Wl,-E  -fstack-protector-strong -L/usr/local/lib'
    libpth=/usr/lib /usr/local/lib /usr/lib/clang/18/lib
    libs=-ldl -lm -lcrypt -lutil
    perllibs=-ldl -lm -lcrypt -lutil
    libc=
    so=so
    useshrplib=true
    libperl=libperl.so.5.40.2
    gnulibc_version=''
  Dynamic Linking:
    dlsrc=dl_dlopen.xs
    dlext=so
    d_dlsymun=undef
    ccdlflags='  -Wl,-R/usr/local/lib/perl5/5.40/mach/CORE'
    cccdlflags='-DPIC -fPIC'
    lddlflags='-shared  -L/usr/local/lib/perl5/5.40/mach/CORE -lperl -L/usr/local/lib -fstack-protector-strong'


Characteristics of this binary (from libperl):
  Compile-time options:
    HAS_LONG_DOUBLE
    HAS_STRTOLD
    HAS_TIMES
    MULTIPLICITY
    PERLIO_LAYERS
    PERL_COPY_ON_WRITE
    PERL_DONT_CREATE_GVSV
    PERL_HASH_FUNC_SIPHASH13
    PERL_HASH_USE_SBOX32
    PERL_MALLOC_WRAP
    PERL_OP_PARENT
    PERL_PRESERVE_IVUV
    PERL_USE_SAFE_PUTENV
    USE_64_BIT_ALL
    USE_64_BIT_INT
    USE_ITHREADS
    USE_LARGE_FILES
    USE_LOCALE
    USE_LOCALE_COLLATE
    USE_LOCALE_CTYPE
    USE_LOCALE_NUMERIC
    USE_LOCALE_TIME
    USE_PERLIO
    USE_PERL_ATOF
    USE_REENTRANT_API
  Built under freebsd
  @INC:
    /usr/local/lib/perl5/site_perl/mach/5.40# perl -V output goes here

    /usr/local/lib/perl5/site_perl
    /usr/local/lib/perl5/5.40/mach
    /usr/local/lib/perl5/5.40

[karenetheridge]

This is a problem with DBI, which apparently needs to take more care to close down its connections in the right order during global destruction.

[vvv2542]

Why the same DBI version with perl 5.36 doesn't print the warning?
Why sub1() that do nothing and has no references in code causes the warning?

[Tux]

@karenetheridge suggestions on improvement welcome!
I know however from other DBD's that having structures that share connections are sometimes (very) hard to free. e.g. if freeing needs to wait for a database sync to disconnect

[iabyn]

On Mon, May 19, 2025 at 05:06:56AM -0700, vvv2542 wrote: The code below prints warnings on exit: ``` perl #!/usr/bin/env perl use strict; use warnings; use DBI; my $dbh = DBI->connect("dbi:Pg:dbname=db1", "user1", "password"); print "DONE\n"; exit 0; sub sub1 { $dbh = ""; }

Note that, by referring to $dbh within the sub, you're creating a closure. This can delay or alter the point at which $dbh is destroyed. Whether this is then showing up an issue with DBI, or with perl, or is simply a "don't do this", I can't say off-hand.

…

-- This is a great day for France! -- Nixon at Charles De Gaulle's funeral

[dlangille]

I've encountered a similar situation in my own code when moving from 5.38 to 5.40

What is interesting is that the errors are not reproducible. So far, I've been unable to reproduce the error by running the work load again. Not sure why yet.

Two nodes, running the same code, against similar databases, won't necessarily encounter the error when doing the same set of work. Again, not sure why. Given the data and work, if one node hits the error, everything running that same code should as well.

[dlangille]

Why the same DBI version with perl 5.36 doesn't print the warning? Why sub1() that do nothing and has no references in code causes the warning?

My testing on FreeBSD 14.2 with PostgreSQL 16 gives the same error

[23:53 dev-ingress01 dvl ~/scripts] % perl perl5-issue-23306
DONE
DBI dr handle 0x13b121641a68 cleared whilst still active during global destruction.
    dbih_clearcom (drh 0x13b121641a68, com 0x13b120cb12c0, imp DBD::Pg::dr):
       FLAGS 0x100215: COMSET Active Warn PrintWarn AutoCommit 
       PARENT undef
       KIDS 0 (1 Active)
[23:53 dev-ingress01 dvl ~/scripts] % 

If I remove sub1 the error does not appear or comment out the $dbh = ""; line, the error does not appear.

[karenetheridge]

During global destruction, the order in which resources are freed can be pretty random, so depending on the order in which things can happen, something can expect something to still exist which surprisingly does not.

Is there some graceful disconnecting or teardowns that you can do in an END{} block, or in the destructor for a particular object?

[vvv2542]

I my case adding END{} solves the problem. But I don't understand why in different scripts helps $dbh->disconnect, or $dbh=undef, or both. The solution for a particular script is unpredictable. But the problem is always reproducible.

[dlangille]

What is this END{}? Am I doing it wrong?

[11:31 dev-ingress01 dvl ~/scripts] % perl perl5-issue-23306

DONE
DBI dr handle 0x3ab457c41ac8 cleared whilst still active during global destruction.
    dbih_clearcom (drh 0x3ab457c41ac8, com 0x3ab4572b12c0, imp DBD::Pg::dr):
       FLAGS 0x100215: COMSET Active Warn PrintWarn AutoCommit 
       PARENT undef
       KIDS 0 (1 Active)

[11:31 dev-ingress01 dvl ~/scripts] % cat perl5-issue-23306

#!/usr/bin/env perl

use strict;
use warnings;
use DBI;



#require FreshPorts::config;
my $dbh = DBI->connect("dbi:Pg:dbname=freshports.dev;host=pg03.example.org", "redacted", 'redacted);

print "DONE\n";
exit 0;

sub sub1 {
    $dbh = "";
}

END{}

[vvv2542]

Try

END {
    $dbh->disconnect;
    $dbh = undef;
}

[dlangille]

That resolves my test issue. In my case, I think it's a race condition, since the same test does not fail on all hosts every time.

[Leont]

END {
    $dbh->disconnect;
    $dbh = undef;
}

I would recommend changing that to $dbh->disconnect if $dbh, if you end the script before $dbh is connected you'll get a weird and confusing error otherwise.

I think it's a race condition, since the same test does not fail on all hosts every time.

No it's not a race condition, it's just unorderedness like @karenetheridge explained.