File Coverage

blib/lib/Math/Matlab/Pool.pm

Criterion	Covered	Total	%
statement	28	49	57.1
branch	3	22	13.6
condition	0	3	0.0
subroutine	8	11	72.7
pod	5	5	100.0
total	44	90	48.8

package Math::Matlab::Pool;

use strict;
use vars qw($VERSION $MEMBERS $SYNC_FILE);

BEGIN {
	$VERSION = sprintf "%d.%03d", q$Revision: 1.4 $ =~ /: (\d+)\.(\d+)/;
}

use Math::Matlab;
use base qw( Math::Matlab );

use Fcntl qw(:DEFAULT :flock);

##-----  assign defaults, unless already set externally  -----
$MEMBERS	= []						unless defined $MEMBERS;
$SYNC_FILE	= '/tmp/MatlabPool.lock'	unless defined $SYNC_FILE;

##-----  Public Class Methods  -----
sub new {
	my ($class, $href) = @_;
	my $self	= {
		members		=> defined($href->{members})	? $href->{members}		: $MEMBERS,
		sync_file	=> defined($href->{sync_file})	? $href->{sync_file}	: $SYNC_FILE,
		err_msg	=> '',
		result	=> ''
	};

	bless $self, $class;

	## create objects from config as necessary
	foreach my $i ( 0..$#{$self->members} ) {
		my $member = $self->members->[$i];
		next unless ref $member eq 'HASH';
		my $class = $member->{class};
		$self->members->[$i] = $class->new( $member->{args} );
	}

	return $self;
}

##-----  Public Object Methods  -----
sub execute {
	my ($self, $code, $rel_mwd) = @_;

	my $matlab = $self->members->[ $self->next_index ];

	if ($matlab->execute($code, $rel_mwd)) {
		$self->{'result'} = $matlab->fetch_raw_result;
		return 1;
	} else {
		$self->err_msg( $matlab->err_msg );
		return 0;
	}
}

sub next_index {
	my ($self) = @_;

	## the following code from p. 247 of Perl Cookbook
	sysopen(FH, $self->sync_file, O_RDWR|O_CREAT)
							or die "can't open syncfile: $!";
	flock(FH, LOCK_EX)		or die "can't lock syncfile: $!";
	## now we have the lock, let's do our stuff
	my $num =  || $#{$self->members};
	seek(FH, 0, 0)			or die "can't rewind syncfile: $!";
	truncate(FH, 0)			or die "can't truncate syncfile: $!";
	$num++;
	$num = 0	if $num > $#{$self->members};
	print FH $num, "\n"		or die "can't write syncfile: $!";
	close(FH)				or die "can't close syncfile: $!";

	return $num;
}

sub members {	my $self = shift; return $self->_getset('members',		@_); }
sub sync_file {	my $self = shift; return $self->_getset('sync_file',	@_); }

1;
__END__