Update: Added flush method for completeness.
I've been saving the following demonstration for release day. Currently, I'm wrapping up MCE::Shared 1.827.
Well, here is a fast logger class which may be shared for concurrent capability. Calling localtime or gmtime per each log entry is expensive. This uses
the old time-stamp value until one second has elapsed.
use strict;
use warnings;
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Logger class. Requires MCE::Shared 1.827+.
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
package My::Logger;
use Time::HiRes qw( time );
# construction
sub new {
my ( $class, %self ) = @_;
open $self{fh}, ">>", $self{path} or return '';
binmode $self{fh};
$self{stamp} = localtime; # or gmtime
$self{time } = time;
bless \%self, $class;
}
# $ob->log("message");
sub log {
my ( $self, $stamp ) = ( shift );
if ( time - $self->{time} > 1.0 ) {
$self->{stamp} = $stamp = localtime; # or gmtime
$self->{time } = time;
}
else {
$stamp = $self->{stamp};
}
print {$self->{fh}} "$stamp --- @_\n";
}
# $ob->autoflush(0);
# $ob->autoflush(1);
sub autoflush {
my ( $self, $flag ) = @_;
if ( defined fileno($self->{fh}) ) {
$flag ? select(( select($self->{fh}), $| = 1 )[0])
: select(( select($self->{fh}), $| = 0 )[0]);
return 1;
}
return;
}
# $ob->binmode($layer);
# $ob->binmode();
sub binmode {
my ( $self, $layer ) = @_;
if ( defined fileno($self->{fh}) ) {
CORE::binmode $self->{fh}, $layer // ':raw';
return 1;
}
return;
}
# $ob->close()
sub close {
my ( $self ) = @_;
if ( defined fileno($self->{fh}) ) {
close $self->{'fh'};
}
return;
}
# $ob->flush();
sub flush {
my ( $self ) = @_;
if ( defined fileno($self->{fh}) ) {
my $old_fh = select $self->{fh};
my $old_af = $|; $| = 1; $| = $old_af;
select $old_fh;
return 1;
}
return;
}
1;
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Main script.
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
package main;
use MCE::Hobo;
use MCE::Shared 1.827;
my $file = "log.txt"; unlink $file;
my $pid = $$;
my $ob = MCE::Shared->share( { module => 'My::Logger' }, path => $file
+ )
or die "open error '$file': $!";
# $ob->autoflush(1); # optional, flush write immediately
sub work {
my $id = shift;
for ( 1 .. 250_000 ) {
$ob->log("Hello from $id: $_");
}
}
MCE::Hobo->create('work', $_) for 1 .. 4;
MCE::Hobo->waitall;
# Threads and multi-process safety for closing the handle.
sub CLONE { $pid = 0; }
END { $ob->close if $ob && $pid == $$; }
MCE::Shared 1.827 will be released sometime this month along with MCE 1.830.
Regards, Mario.