view release on metacpan or  search on metacpan

lib/File/Flock/Subprocess.pm  view on Meta::CPAN

use Data::Structure::Util qw(unbless);

# shared
my $dir;
my $socket;
my $av0;
my $debug;

BEGIN { $debug = 0; }

# proxy server
my $connections;
my $parent_pid;
my $timer;
my $ioe_parent;
my $counter = '0001';
my %locks;

# client side
my $child;
my %lock_pids;		# filename -> pid
my %lock_proxies;	# pid -> proxy
my %lock_count;		# pid -> count
my $last_pid;

sub new
{
	my ($pkg, $file, $shared, $nonblocking) = @_;
	&lock($file, $shared, $nonblocking) or return undef;
	return bless [$file], __PACKAGE__;
}

sub DESTROY
{
	my ($this) = @_;
	unlock($this->[0]);
}

sub encode
{
	local($_);
	for $_ (@_) {
		### assert: defined $_
		s/\\/\\\\/g;
		s/\n/\\n/g;
		s/\t/\\t/g;
	}
}

sub decode
{
	local($_);
	for $_ (@_) {
		### assert: defined $_
		s/\\t/\t/g;
		s/\\n/\n/g;
		s/\\\\/\\/g;
	}
}

sub update_proxy_connections
{
use Carp qw(longmess);
	print STDERR longmess("last_pid undefined") unless defined $last_pid;
	return if $last_pid == $$;
	### UPDATING PROXY CONNECTIONS: "$$ IS NOT $last_pid"
	$last_pid = $$;
	for my $pid (keys %lock_proxies) {
		my $proxy = IO::Socket::UNIX->new(
			Peer	=> "$socket.$pid",
			Type	=> SOCK_STREAM,
		) or carp "Could not open connection to lockserver $socket.$pid: $!";

		### CLOSING OLD $$
		$lock_proxies{$pid}->close();
		$lock_proxies{$pid} = $proxy;
	}
	### DONE UPDATING: $$
}

sub request
{
	my ($request, $file) = @_;
	my $av0 = $0;
	local($0) = $av0;
	$0 = "$av0 - lock proxy request $request";
	my $ts_before = time;
	### REQUEST: "$$ $request"

	my $proxy = $lock_proxies{$lock_pids{$file}} or die;

	$proxy->print("$$ $request\n")
		or croak "print to lock proxy: $!";
	for(;;) {
		my $ok = $proxy->getline();
		chomp($ok);
		### RESPONSE: $ok
		if ($ts_before) {
			my $diff = time - $ts_before;
		}
		if ($ok =~ /^ERROR:(.*)/) {
			my $error = $1;
			decode($error);
			### ................. $error
			$error =~ s/\n.*//s;
			### ..... $error
			croak $error;
		} elsif ($ok =~ /^RESULT=(\d+)/) {
			### RESULT: $$.$1
			return $1;
		} else {
			die "unexpected response from lock proxy: $ok";
		}
	}
}

sub lock
{
	my ($file, $shared, $nonblocking) = @_;

	update_proxy_connections();