Digging down gets quite complex. dbme() doesn't do the tie itself, it merely determines a number of variable specs for the wanted kind of handle and calls an appropriate sub in the handle allocater module to supply it.

But there is something strange going on.

In the same module as dbme() is another sub metadbs() which with flag=1 returns a set of similar tied-hash-handles in a hash-of-refs for a standard set of db files, itself using dbme() for each handle in turn. The $copyfrom handle above is part of this set. When called with flag=0 right before the failing untie code above, metadbs() unties each of those handle-refs (including $copyfrom) and does not hang. And has been doing so in service to a number of topmost programs for a couple of years (apparently successfully).

use DBctrl qw(svhash);
sub dbme {
  my ($dbtry, $makeyn, $hm) = @_;   
  #....
  $duplicates = 0;    
  $bdbtype = 'HASH';    
  
  ($dbhand, $fail) = svhash($dbtry, $hm, 
                    $makeyn, $duplicates, $bdbtype);
  #.....
  return ($dbhand, $fail);    
}
[download]

and then digging deeper ... (difficult paste, sorry)

sub svhash {    
    ($db, $hm, $makedb, $duplicates, $bdbtype) = @_;
    $makedb ||= 0;        
    $duplicates ||= '';    
    $bdbtype ||= 'hash';    
    my %h;                
    ($dbhandx, $fail) = ("", "");
    $fail = _dbfix($db, $hm);        
    unless ($fail) {
    
        my $bdb = BerkeleyDB::Hash;
        if (lc($bdbtype) =~ /btree/) { $bdb = BerkeleyDB::Btree;}     
        my $fset = DB_CREATE;                  
        my $n = "0666";                    
        my $dups = DB_DUP | DB_DUPSORT;
        $BerkeleyDB::Error = '';                
        if ($duplicates) {                
            if ($makedb) {                
                tie %h, $bdb, -Filename => $db,      -Flags => $fset, 
+      -Mode => $n, -Property => $dups                             
                                                                      
+                                                                     
+        or $fail = 1; 
            } else {                                    
                tie %h, $bdb, -Filename => $db,  -Mode => $n, -Propert
+y => $dups            or $fail = 1; 
            }        
        } else {                
            if ($makedb) {                
                tie %h, $bdb, -Filename => $db,      -Flags => $fset, 
+      -Mode => $n                    or $fail = 1; 
            } else {                                    
                tie %h, $bdb, -Filename => $db,  -Mode => $n          
+                                           or $fail = 1; 
            }        
        }
        
        $fail = dbresult($fail, $BerkeleyDB::Error);            
        unless ($fail)    {$dbhandx = \%h;}
    }
    
    return ($dbhandx, $fail);

}
[download]

Is that sub really coded without strict and returning globals?:

sub svhash {    
    ($db, $hm, $makedb, $duplicates, $bdbtype) = @_;
    $makedb ||= 0;        
    $duplicates ||= '';    
    $bdbtype ||= 'hash';    
    my %h;                               
    ($dbhandx, $fail) = ("", ""); ##<<<<<<<<<<<<<
...
    return ($dbhandx, $fail);     ##<<<<<<<<<<<<<
}
[download]

---

Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.

"Science is about questioning the status quo. Questioning authority".

In the absence of evidence, opinion is indistinguishable from prejudice.

Not entirely, but well spotted.

I cannot recall full rationale for that old 'unusual' coding, but may have to revisit it all again ... but under complex test conditions since it sits at hub of mission critical stuff.

The return & other vars have module scope, probably to share with internal subs, and where the external subs have a standardised layout. I see svhash() only calls 1 internal and so may not need module scoping of vars so often!

package DB::DBctrl; 
#use strict;     
our @EXPORT_OK = qw(svhash svdb mvdbsub mvdbhead);# externals   
my ($dbhandx, $fail, etc, ...) = ("","", etc, ...);
sub svhash {    

  return ($dbhandx, $fail);    

}
[download]

I think I would have interspersed compilations to the test stage where final 'use strict'-miscompile only due to the ("BerkeleyDB::HASH" etc) barewords it couldn't handle. But the exact ramifications escape me at the moment.

However, even module scope for a returned ref is starting to give me the jitters ... thanks very much ...

sub svhash {      
...                                
    my ($dbhandx, $fail) = ("", ""); ##<<<<<<<<<<<<<
...
    return ($dbhandx, $fail);     ##<<<<<<<<<<<<<
}
[download]

Altering scope of $dbhandx to svhash() instead of parent module did not, unfortunately, solve the problem.

Potential nasty side effects of that mistake were never struck due to a higher level wrapper managing mutual exclusivity of processes that might clash. Lucky perhaps.