File Coverage

blib/lib/Test/SharedObject.pm

Criterion	Covered	Total	%
statement	43	43	100.0
branch	2	2	100.0
condition			n/a
subroutine	13	13	100.0
pod	4	4	100.0
total	62	62	100.0

package Test::SharedObject;
use 5.008001;
use strict;
use warnings;

our $VERSION = "0.01";

use Storable qw/store_fd fd_retrieve/;
use File::Temp qw/tempfile/;
use Test::SharedObject::Lock;

sub new {
    my ($class, $data) = @_;

    my ($fh, $file) = tempfile(EXLOCK => 0);
    my $self = bless {
        file => $file,
        ppid => $$,
    } => $class;

    seek $fh, 0, 0;
    truncate $fh, 0;
    store_fd \$data, $fh;
    close $fh;

    return $self;
}

sub txn {
    my ($self, $code) = @_;
    my $lock = Test::SharedObject::Lock->new($self);

    my $fh   = $lock->fh;
    my $ref  = fd_retrieve $fh;
    my $data = $code->($$ref);

    seek $fh, 0, 0;
    truncate $fh, 0;
    store_fd \$data, $fh;

    return $data; ## unlock
}

sub set {
    my ($self, $data) = @_;
    return $self->txn(sub { $data });
}

sub _identity { $_[0] }
sub get {
    my $self = shift;
    return $self->txn(\&_identity);
}

sub DESTROY {
    my $self = shift;
    unlink $self->{file} if $$ == $self->{ppid};
}

1;
__END__