File Coverage

blib/lib/IPC/ScoreBoard.pm

Criterion	Covered	Total	%
statement	63	69	91.3
branch	10	20	50.0
condition	4	18	22.2
subroutine	13	13	100.0
pod	3	3	100.0
total	93	123	75.6

package IPC::ScoreBoard;

use 5.008008;
use strict;
use warnings;
use File::Map qw/:map/;
use Carp;

our $VERSION = '0.05';

require XSLoader;
XSLoader::load('IPC::ScoreBoard', $VERSION);

use constant {
  IVLEN=>length(pack "J", 0),
  MAGIC=>'PCSB',
};

# a slot is always a set of IVs.
# hence, $slotsize is given in units of IVLEN bytes.

sub anon {
  my ($class, $how_many, $slotsize, $score_extra);
  if( @_>3 or $_[0]!~/^\d/ ) {
    ($class, $how_many, $slotsize, $score_extra)=@_;
    $class=ref($class) || $class;
  } else {
    ($how_many, $slotsize, $score_extra)=@_;
    $class=__PACKAGE__;
  }

  use integer;
  $score_extra=0 unless defined $score_extra;

  my $slsz=$slotsize*IVLEN;
  map_anonymous my $scoreboard, (4+$how_many*$slotsize+$score_extra)*IVLEN;
  substr $scoreboard, 0, length(MAGIC), MAGIC;
  substr $scoreboard, IVLEN, 3*IVLEN,
    pack "J3", $how_many, $slotsize, $score_extra;

  return bless \$scoreboard, $class;
}

sub named {
  my ($class, $filename, $how_many, $slotsize, $score_extra);
  if( @_>4 or $_[1]!~/^\d/ ) {
    ($class, $filename, $how_many, $slotsize, $score_extra)=@_;
    $class=ref($class) || $class;
  } else {
    ($filename, $how_many, $slotsize, $score_extra)=@_;
    $class=__PACKAGE__;
  }

  use integer;
  $score_extra=0 unless defined $score_extra;

  open my $fh, '+>', $filename or croak "Cannot open $filename: $!";

  syswrite $fh, "\0" x((4+$how_many*$slotsize+$score_extra)*IVLEN);
  map_handle my $scoreboard, $fh, '+<';
  substr $scoreboard, 0, length(MAGIC), MAGIC;
  substr $scoreboard, IVLEN, 3*IVLEN,
    pack "J3", $how_many, $slotsize, $score_extra;

  return bless \$scoreboard, $class;
}

sub open {
  my ($class, $filename);
  if( @_>1 ) {
    ($class, $filename)=@_;
    $class=ref($class) || $class;
  } else {
    ($filename)=@_;
    $class=__PACKAGE__;
  }

  open my $fh, '+<', $filename or croak "Cannot open $filename: $!";
  map_handle my $scoreboard, $fh, '+<';

  croak "Invalid magic number in $filename"
    unless substr($scoreboard, 0, length(MAGIC)) eq MAGIC;

  return bless(\$scoreboard, $class), unpack 'x'.IVLEN.'J3', $scoreboard;
}

my $import_done;
sub import {
  return if @_>=2 and $_[1] eq ':noshortcuts';
  # create shortcuts
  return if $import_done;
  $import_done=1;
  no strict 'refs';
  for my $n (qw/anon named open get set incr decr sum get_all sum_all
		get_extra set_extra incr_extra decr_extra get_all_extra
		nslots slotsize nextra have_atomics offset_of/) {
    *{'SB::'.$n}=\&{$n};
  }
}

1;
__END__