File Coverage

blib/lib/POE/Event/Message/UniqueID.pm

Criterion	Covered	Total	%
statement	48	60	80.0
branch	11	24	45.8
condition	3	7	42.8
subroutine	10	10	100.0
pod	1	4	25.0
total	73	105	69.5

# -*- Perl -*-
#
# File:  POE/Event/Message/UniqueID.pm
# Desc:  Generate a guaranteed unique message identifier
# Date:  Mon Oct 10 10:10:59 2005
# Stat:  Prototype, Experimental
#
package POE::Event::Message::UniqueID;
use 5.006;
use strict;
use warnings;

our $PACK    = __PACKAGE__;
our $VERSION = '0.03';
### @ISA     = qw( );

use POSIX;
use Time::HiRes;	# comment this line to use CORE::time() and rand()
			# uncomment to use gettimeofday() -- the better choice
my($host,$pid);
my($time,$ident,@prior) = ("","",());
my($secs,$msecs,$rand)  = (0,0,0);
my($errs,$mesg,$count)  = (0,"",0);

sub import
{   my($class,@args) = @_;
    $class->buildIdentityGenerator( @args );   # How will we create IDs today?
}

*generate         = \&genUniqueIdent;
*generateUniqueID = \&genUniqueIdent;

sub buildIdentityGenerator
{   my($class,$debug) = @_;

    $host = eval { (POSIX::uname)[1] };
    $pid  = $$;

    print "-" x 55 ."\n"  if $debug;

    if ( exists $INC{'Time/HiRes.pm'} ) {
	print "Will use Time::HiRes::time() to generate IDs\n"  if $debug;

	eval('sub genUniqueIdent {
	          ($secs,$msecs) = Time::HiRes::gettimeofday();
	          ( $host ."-". unpack("H*", pack("N*", $secs,$msecs,$pid)) );
	      }
	');

    } else {
	print "Will use CORE::time() and rand() to generate IDs\n"   if $debug;
	print "(note that there is a slight chance of duplicates)\n" if $debug;

	eval('sub genUniqueIdent {
		  my $limit = 1000000;    # good distribution for uniqueness?
		  ($time,$rand) = ( CORE::time(), rand($limit) );
		  ( $host ."-". unpack("H*", pack("N*", $time,$rand,$pid)) );
	      }
	');
    }
    return;
}

my $dupErrCount;
sub dupErrCount { $dupErrCount };

sub verifyGenerateUniqueID
{   my($class,$debug,$max) = @_;

    $debug ||= 0;
    $max   ||= 1000;

    if ($debug) {
	print "-" x 55 ."\n";
	print "Generating $max IDs to verify uniqueness...\n";
	print "  host = $host\n";
	print "   pid = $pid\n";
	print "  time = ". time() ."\n";
    }

    foreach (1..$max) {

	$ident = genUniqueIdent();       # This is a generated subroutine

	if ( grep(/^$ident$/, @prior) ) {
	    ($errs,$mesg)  = ($errs +1, "duplicate ID!");
	    print " ident = $ident   $mesg\n";
	} else {
	    ($mesg)  = ("unique ID!");
	    push @prior, $ident;
	    if ($count) {
		print " ident = $ident   $mesg\n"      if $debug > 1;
	    } else {
		print " ident = $ident   (example)\n"  if $debug > 1;
	    }
	}
	$count++;
    }
    $dupErrCount = $errs;

    print "-" x 55 ."\n";
    print "IDs Generated: $count   Duplicates: $errs\n";

    if ( $errs and exists $INC{'Time/HiRes.pm'} ) {
	print "OUCH: the unique ID generator needs some work!!\n";
    } elsif ( $errs ) {
	print "Oops: Try using 'Time::HiRes' for better results!\n";
    }
    print "-" x 55 ."\n";
    return;
}
#_________________________
1; # Required by require()

__END__