Attempting to redefine IO::Tee::PRINT for thread safety

Question

Thanks to some help, I've started attempting to get thread-safe logging working for my script - however, I don't seem to have it working correctly:

use Fcntl ':flock';

no warnings 'redefine';
sub IO::Tee::PRINT
{
    my $self = shift;
    my $ret = 1;
    foreach my $fh (@$self) {
        flock($fh, LOCK_EX);
        print "\n\t\ttestA\n";  #<-- added for testing
        undef $ret unless print $fh @_;
        flock($fh, LOCK_UN);
        print "\t\ttestB\n";    #<-- added for testing
    }
    return $ret;
}

my $Info_tee = IO::Tee->new(\*STDOUT, ">$ENV{DOM}\\build.log");

When I get to the threaded section of my script:

print $Info_tee "\n------------------------------------------------------\n";
print $Info_tee "\n\t\t*** Performing Action: \'$cmd\' on $comp ***";

My output to STDOUT (4 threads) is:

                testA
                testA

------------------------------------------------------
                testB

                testA

------------------------------------------------------
                testB

------------------------------------------------------
                testB

                testA

                testA

------------------------------------------------------
                testB

.. and then the script locks up. What am I doing wrong?

Edit: I've created a simple example of my issue here -- I noticed that if you remove the queue from the script, everything seems to work as designed.

Answer 1

The easy way

Just use an explicit mutex around your shared resource. That's clear, concise, and easy:

use threads;
use threads::shared;

my $mutex : shared; # will synchronize access to our shared IO::Tee resource

async {
  ...
  { lock $mutex; print $shared_resource "I did something"; }
  ...
}

Note, your synchronization will need to be a mutex or some other threading construct. flock and friends were designed for interprocess locking, and generally don't have desirable multithreaded semantics.

The harder way

The alternative approach you seem to want, viz., to redefine or to extend IO::Tee to support an implicit mutex, is inobvious, verbose, and more challenging.

Why? IO::Tee objects carry state and were not designed for multithreaded use. (That is, simply synchronizing PRINT/PRINTF calls may not be enough.) Each object is really two objects tie()d together, one a GLOB and one ARRAY slotted in that glob. Globs can't be shared under perl threads, and arrayrefs are cleared when shared. It's not intractable, of course, but the amount of work seems disproportionately large to simply using an explicit mutex to control thread access to a shared resource.

Answer 2

You're unclear as usual.

---

If the problem you're having is that the script locks up, it's not from anything you posted.

---

If the problem you posted is that stuff is being printed after the lock has been released, it's because you need to flush the buffers before releasing the lock.

STDOUT->flush();
$fh->flush();

---

If the problem is that you're getting the following, it's because you don't hold the lock long enough (as you've previously been told).

------------------------------------------------------
------------------------------------------------------
*** Performing Action: 'action' on comp1 ***
*** Performing Action: 'action' on comp2 ***

Answer 3

You could avoid reinveting the wheel. There are many logging modules that are supports this out-of-the-box.

One example is Log4perl: perl: Will Log::Log4perl work in a multi-threaded environment?

http://search.cpan.org/dist/Log-Log4perl/lib/Log/Log4perl/FAQ.pm#How_can_I_run_Log%3a%3aLog4perl_under_mod_perl?

Regards