File Coverage

blib/lib/PeekPoke/FFI.pm

Criterion	Covered	Total	%
statement	30	30	100.0
branch	2	2	100.0
condition	6	7	85.7
subroutine	9	9	100.0
pod	3	3	100.0
total	50	51	98.0

package PeekPoke::FFI;

use strict;
use warnings;
use 5.008001;
use FFI::Platypus 1.00;
use base qw( Exporter );

our @EXPORT_OK = qw( peek poke );

# ABSTRACT: Perl extension for reading and writing to arbitrary memory locations
our $VERSION = '0.02'; # VERSION


my $ffi = FFI::Platypus->new( api => 1, lib => [undef], lang => 'C' );


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

  my $base = $opts{base} || 0;
  my $type = $opts{type} || 'uint8';
  my $size = $ffi->sizeof($type);
  my $memcpy = $ffi->function( memcpy => [ 'opaque', "${type}[1]", 'size_t' ] => 'opaque' );

  bless {
    base   => $base,
    type   => $type,
    size   => $size,
    memcpy => $memcpy,
  }, $class;

}

my $default;

sub _self
{
  my $args = shift;
  if(ref $args->[0])
  {
    return shift @$args;
  }
  else
  {
    return $default ||= __PACKAGE__->new;
  }
}


sub peek
{
  my $self = _self(\@_);
  my($offset) = @_;
  $ffi->cast('opaque' => $self->{type} . '[1]', $self->{base} + ($offset * $self->{size}))->[0];
}


sub poke
{
  my $self = _self(\@_);
  my($offset, $value) = @_;
  $self->{memcpy}->call($self->{base} + ($offset * $self->{size}), [$value], $self->{size});
}

1;

__END__