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 == $$; }
[download]

MCE::Shared 1.827 will be released sometime this month along with MCE 1.830.

Regards, Mario.

---

---

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

• How do I compose an effective node title?
• How do I post a question effectively?
• Markup in the Monastery

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		&
	<		&lt;
	>		&gt;
	[		&#91;
	]		&#93;

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.