package Task::MemManager;
$Task::MemManager::VERSION = '0.04';
use strict;
use warnings;

use Carp;
use Inline ( C => 'DATA', );
use Module::Find;
use Module::Runtime 'use_module';
use Scalar::Util;

Inline->init()
  ; ## prevents warning "One or more DATA sections were not processed by Inline"

*ident = \&Scalar::Util::refaddr
  ;  # alias of refaddr in Ch. 15 & 16 of "Perl Best Practices" (O'Reilly, 2005)

# ABSTRACT: A memory allocator for low level code in Perl.



# Properties of the Memory Manager class (inside out object attributes)
my %buffer;               # Memory buffer
my %size_of_buffer;       # Size of the buffer
my %size_of_element;      # Size of each element in the buffer
my %num_of_elements;      # Number of elements in the buffer
my %delayed_gc_for;       # Objects with delayed garbage collection
my %death_stub;           # Function to call upon object destruction
my %allocator_of;         # Allocator used to allocate the buffer
my %memory_region;        # Memory region assigned to the buffer
my %is_nonoverlapping;    # Is the memory region non-overlapping ?
my %creation_opts;        # Options used to create the object

# Private functions
my $consume_or_allocate_private_func;    # Avoids DRY when allocating/consuming

# Find implemented memory allocators under this namespace
my @alloc_modules = findsubmod 'Task::MemManager';

my @utility_modules;

# Load allocators and store their functions
my %allocator_function;
my @allocator_functions = qw(malloc free get_buffer_address);
my @optional_functions  = qw(consume);
TEST_MODULE: foreach my $module_name (@alloc_modules) {
    ( my $key = $module_name ) =~ s/Task::MemManager:://;
    my $alloc_module = use_module($module_name);    # Load the module
    my $number_of_functions =
      grep { $alloc_module->can($_) } @allocator_functions;
    if (    $number_of_functions > 0
        and $number_of_functions < @allocator_functions )
    {
        push @utility_modules, $module_name;
        carp "Module $alloc_module does not implement all required methods "
          . "(@allocator_functions)\n This module will not be used for "
          . "memory allocation";
        next TEST_MODULE;
    }    ## zero implemented functions is OK, it may be a utility module

    # Store the mandatory and optional functions of the allocator
    foreach my $function (@allocator_functions) {
        $allocator_function{$key}{$function} = $alloc_module->can($function);
    }
    foreach my $function (@optional_functions) {
        $allocator_function{$key}{$function} = (
              $alloc_module->can($function)
            ? $alloc_module->can($function)
            : sub {
                croak "$module_name does not implement $function";
            }
        );
    }
}

###############################################################################
# Usage       : my $buffer = Task::MemManager->new(10, 1, {allocator =>
#                'PerlAlloc'});
# Purpose     : Allocates a buffer using the specified allocator
# Returns     : A reference to the buffer
# Parameters  : $num_of_items     - Number of items in the buffer
#               $size_of_each_item - Size of each item in the buffer
#               $opts_ref         - Reference to a hash of options. These are:
#                allocator      - Name of the allocator to use
#                delayed_gc     - Should garbage collection be delayed ?
#                                 If it evaluates to non-false, it'll delay GC
#                init_value     - Value to initialize the buffer with
#                death_stub     - Function to call upon object destruction
#                  it will receive the object's properties and identifier
#                  as a hash reference if it is defined
# Throws      : Croaks if the buffer allocation fails, or if the allocator
#                does not exist
# Comments    : Default allocator is PerlAlloc, which uses Perl's string
#                functions,
#               Default init_value is undef ('zero' zeroes out memory, any
#                 byte value will initialize memory with that value)
#               Default delayed_gc is 0 (garbage collection is immediate)
# See Also    : n/a
sub new {
    my ( $self, $num_of_items, $size_of_each_item, $opts_ref ) = @_;
    my $init_value = $opts_ref->{init_value};
    $opts_ref->{delayed_gc} //= 0;

    return $self->$consume_or_allocate_private_func( $num_of_items,
        $size_of_each_item, $opts_ref, 'malloc',
        [ $num_of_items, $size_of_each_item, $init_value ] );
}

###############################################################################
# Usage       : my $buffer = Task::MemManager->consume($buffer,10,1,
#                {allocator => 'PerlAlloc'});
# Purpose     : Consumers a buffer created with the specified allocator
# Returns     : A reference to the buffer
# Parameters  : $external_buffer_ref - Reference to the external buffer
#               $num_of_items     - Number of items in the buffer
#               $size_of_each_item - Size of each item in the buffer
#               \$opts          - Reference to a hash of options. 
#                The ones that control the constructor are the following:
#                allocator      - Name of the allocator to use
#                delayed_gc     - Should garbage collection be delayed ?
#                                 If it evaluates to non-false, it'll delay GC
#                init_value     - Value to initialize the buffer with (ignored)
#                death_stub     - Function to call upon object destruction
#                                 it will receive the object's properties and 
#                                 identifier as a hash reference (if defined)
#               Additional options may be presented and the entire set of 
#               options will be passed to the malloc function of the 
#               allocator. 
# Throws      : Croaks if the buffer allocation fails, or if the allocator
#                does not provide a consume function
# Comments    : Default allocator is PerlAlloc, which uses Perl's string
#                functions,
#               Default init_value is undef ('zero' zeroes out memory, any
#                 byte value will initialize memory with that value)
#               Default delayed_gc is 1 (garbage collection is delayed)
# See Also    : n/a
sub consume {
    my ( $self, $external_buffer_ref, $num_of_items, $size_of_each_item,
        $opts_ref )
      = @_;
    $opts_ref->{delayed_gc} //= 1;
    return $self->$consume_or_allocate_private_func( $num_of_items,
        $size_of_each_item, $opts_ref, 'consume',
        [ $external_buffer_ref, $num_of_items * $size_of_each_item ] );

}

# Private function to avoid DRY when allocating or consuming a buffer
$consume_or_allocate_private_func = sub {
    my ( $self, $num_of_items, $size_of_each_item, $opts_ref, $func,
        $func_args_ref )
      = @_;

    # exit if the number of items or the number of bytes per item is not defined
    croak "Number of items and size of each item must be defined"
      unless defined $num_of_items and defined $size_of_each_item;

    # Various defaults here

    my $death_stub     = $opts_ref->{death_stub};
    my $allocator_name = $opts_ref->{allocator} // 'PerlAlloc';
    unless ( exists $allocator_function{$allocator_name} ) {
        croak "Allocator $allocator_name is not implemented";
    }
    my $allocator  = $allocator_function{$allocator_name}{$func};
    my $new_buffer = bless do {
        my $anon_scalar = $allocator->(@$func_args_ref,$opts_ref);
    }, $self;
    unless ($new_buffer) {
        croak "Failed to allocate buffer using $allocator_name";
    }
    my $buffer_identifier = ident $new_buffer;

    # Detect overlapping memory regions and kill the program if detected
    my $start_address =
      $allocator_function{$allocator_name}{get_buffer_address}
      ->( ${$new_buffer} )
      or croak "Failed to get buffer address";
    my $end_address = $start_address + $num_of_items * $size_of_each_item - 1;
    while ( my ( $existing_buffer_identifier, $regions_of_buffers ) =
        each %memory_region )
    {
        my ( $other_start, $other_end ) = $regions_of_buffers->@*;
        if ( ( $start_address >= $other_start and $start_address <= $other_end )
            or ( $end_address >= $other_start and $end_address <= $other_end ) )
        {
            # avoids double free in DESTROY - have the OS do the cleanup
            $is_nonoverlapping{$existing_buffer_identifier} = 0;
            $is_nonoverlapping{$buffer_identifier}          = 0;
            carp "Memory region overlap detected";
        }
    }

    # store the attributes of the buffer
    $buffer{$buffer_identifier}            = $start_address;
    $memory_region{$buffer_identifier}     = [ $start_address, $end_address ];
    $size_of_buffer{$buffer_identifier}    = $num_of_items * $size_of_each_item;
    $size_of_element{$buffer_identifier}   = $size_of_each_item;
    $num_of_elements{$buffer_identifier}   = $num_of_items;
    $allocator_of{$buffer_identifier}      = $allocator_name;
    $is_nonoverlapping{$buffer_identifier} = 1;
    $creation_opts{buffer_identifier}      = $opts_ref;
    if ( $opts_ref->{delayed_gc} ) {
        $delayed_gc_for{$buffer_identifier} = $new_buffer;
    }
    if ( $opts_ref->{death_stub} ) {
        $death_stub{$buffer_identifier} = $death_stub;
    }

    return $new_buffer;
};

sub DESTROY {
    my ($self) = @_;
    my $identifier = ident $self;

    # Call the death stub and delete the property if it exists
    if ( exists $death_stub{$identifier} ) {
        $death_stub{$identifier}->(
            {
                buffer_address  => $buffer{$identifier},
                buffer_size     => $size_of_buffer{$identifier},
                element_size    => $size_of_element{$identifier},
                num_of_elements => $num_of_elements{$identifier},
                identifier      => $identifier
            }
        );
        delete $death_stub{$identifier};
    }

    # Free the buffer and delete the properties
    $allocator_function{ $allocator_of{$identifier} }{free}
      ->( $buffer{$identifier} )
      if $is_nonoverlapping{$identifier};
    delete $allocator_of{$identifier};
    delete $buffer{$identifier};
    delete $size_of_buffer{$identifier};
    delete $size_of_element{$identifier};
    delete $num_of_elements{$identifier};
    delete $creation_opts{$identifier};
}
###############################################################################
# Usage       : Task::MemManager->extract_buffer_region(pos_start, pos_end);
#               Task::MemManager->extract_buffer_region(pos_start);
# Purpose     : Extract a region of the buffer
# Returns     : A Perl string (null terminated) containing the region
# Parameters  : $pos_start - The starting position of the region
#               $pos_end   - The ending position of the region
# Throws      : n/a
# Comments    : Returns undef if attempt to overrun buffer, or
#                if pos_start > pos_end,
#               if pos_end is missing, then it will be set to the end of the
#               buffer,
#               if pos_start is missing, then it will be set to the start of
#               the buffer,
# See Also    : n/a

sub extract_buffer_region {
    my ( $self, $pos_start, $pos_end ) = @_;
    my $buffer_identifier = ident $self;
    my $buffer_size       = $size_of_buffer{$buffer_identifier};
    $pos_start = $pos_start // 0;
    $pos_end   = $pos_end   // $buffer_size - 1;
    return _extact_buffer_region( $buffer{$buffer_identifier},
        $pos_start, $pos_end, $buffer_size );
}

###############################################################################
# Usage       : Task::MemManager->get_buffer();
# Purpose     : Obtains the memory address of the buffer (useful for C code)
# Returns     : The memory address of the buffer as an unsigned integer
# Parameters  : n/a
# Throws      : n/a
# Comments    : None

sub get_buffer {
    my ($self) = @_;
    return $buffer{ ident $self };
}

###############################################################################
# Usage       : Task::MemManager->get_buffer_size();
# Purpose     : Returns the size of the buffer
# Returns     : The size of the buffer in bytes
# Parameters  : n/a
# Throws      : n/a
# Comments    : None

sub get_buffer_size {
    my ($self) = @_;
    return $size_of_buffer{ ident $self };
}

###############################################################################
# Usage       : Task::MemManager->get_element_size();
# Purpose     : Returns the size of each element in the buffer
# Returns     : The size of each element in bytes
# Parameters  : n/a
# Throws      : n/a
# Comments    : None

sub get_element_size {
    my ($self) = @_;
    return $size_of_element{ ident $self };
}

###############################################################################
# Usage       : Task::MemManager->get_num_of_elements();
# Purpose     : Returns the number of elements in the buffer
# Returns     : The number of elements in the buffer
# Parameters  : n/a
# Throws      : n/a
# Comments    : None

sub get_num_of_elements {
    my ($self) = @_;
    return $num_of_elements{ ident $self };
}

###############################################################################
# Usage       : Task::MemManager->delayed_gc();
# Purpose     : Obtain a list of objects that have delayed garbage collection
# Returns     : A reference to an array of objects with delayed GC
# Parameters  : n/a
# Throws      : n/a
# Comments    : None

sub get_delayed_gc_objects {
    my @delayed_gc_objects = keys %delayed_gc_for;
    return \@delayed_gc_objects;
}

1;

=head1 NAME

Task::MemManager - A memory allocated and manager for low level code in Perl.

=head1 VERSION

version 0.04

=head1 SYNOPSIS

  use Task::MemManager;

  my $mem_manager = Task::MemManager->new(10, 1, { allocator => 'PerlAlloc' });

  my $buffer = $mem_manager->get_buffer();
  my $buffer_size = $mem_manager->get_buffer_size();
  my $element_size = $mem_manager->get_element_size();
  my $num_of_elements = $mem_manager->get_num_of_elements();

  my $region = $mem_manager->extract_buffer_region($pos_start, $pos_end);

  my $delayed_gc_objects = $mem_manager->get_delayed_gc_objects();



=head1 DESCRIPTION

Task::MemManager is a memory allocator and manager designed for low level code in Perl. 
It provides functionalities to allocate, manage, and manipulate memory buffers.
The allocators are stored in separate packages under the Task::MemManager namespace.
Each allocator B<should implement the following functions>: malloc, free, and get_buffer_address,
that allocate, free, and return the address of a buffer respectively.
B<Optional functions> that may be implemented include: 
  consume, which takes an external buffer and wraps it in a Task::MemManager object.
Packages that do not implement these functions will not be used for memory allocation purposes.
e.g. they may implement other functionalities for working with memory buffers.
The default allocator is PerlAlloc, which uses Perl's string functions to allocate memory.

=head1 METHODS

=head2 new
   Usage      : my $buffer = Task::MemManager->consume($buffer,10,1,
                {allocator => 'PerlAlloc'});
  Purpose     : Allocates a buffer using a specified allocator.
  Returns     : A reference to the buffer.
  Parameters  : 
    - $num_of_items: Number of items in the buffer.
    - $size_of_each_item: Size of each item in the buffer.
    - \%opts: Reference to a hash of options (with defaults under comments):
      - allocator: Name of the allocator to use.
      - delayed_gc: Should garbage collection be delayed?
      - init_value: Value to initialize the buffer with (byte, non UTF!).
      - death_stub: Function to call upon object destruction (if any).
      Additional options may be specified and the entire hash reference
      will be passed to the malloc function of the allocator.
  Throws      : Croaks if the buffer allocation fails.
  Comments    : Default allocator is PerlAlloc, which uses Perl's string functions.
                Default init_value is undef ('zero' zeroes out memory, 
                any other byte value will initialize memory with that value).
                Default delayed_gc is 0 (garbage collection is immediate).

=head2 consume
  Usage       : my $buffer = Task::MemManager->consume($buffer,10,1,
                {allocator => 'PerlAlloc'});
  Purpose     : Consumers a buffer created with the specified allocator
  Returns     : A reference to the buffer
  Parameters  : $external_buffer_ref - Reference to the external buffer
                $num_of_items     - Number of items in the buffer
                $size_of_each_item - Size of each item in the buffer
                \$opts          - Reference to a hash of options. 
                The ones that control the constructor are the following:
                allocator      - Name of the allocator to use
                delayed_gc     - Should garbage collection be delayed ?
                                  If it evaluates to non-false, it'll delay GC
                init_value     - Value to initialize the buffer with (ignored)
                death_stub     - Function to call upon object destruction
                                  it will receive the object's properties and 
                                  identifier as a hash reference (if defined)
                Additional options may be presented and the entire set of 
                options will be passed to the malloc function of the 
                allocator. 
  Throws      : Croaks if the buffer allocation fails, or if the allocator
                does not provide a consume function
  Comments    : Default allocator is PerlAlloc, which uses Perl's string
                functions,
                Default init_value is undef ('zero' zeroes out memory, any
                  byte value will initialize memory with that value)
                Default delayed_gc is 1 (garbage collection is delayed)
                
=head2 extract_buffer_region

  Usage       : my $region = Task::MemManager->extract_buffer_region($pos_start, $pos_end);
  Purpose     : Extracts a region of the buffer.
  Returns     : A Perl string (null terminated) containing the region.
  Parameters  : 
    - $pos_start: The starting position of the region.
    - $pos_end: The ending position of the region.
  Throws      : n/a
  Comments    : Returns undef if attempt to overrun buffer, or if $pos_start > $pos_end.

=head2 get_buffer

  Usage       : my $buffer = Task::MemManager->get_buffer();
  Purpose     : Returns the memory address of the buffer.
  Returns     : The memory address of the buffer as an unsigned integer.
  Parameters  : n/a
  Throws      : n/a
  Comments    : None.

=head2 get_buffer_size

  Usage       : my $buffer_size = Task::MemManager->get_buffer_size();
  Purpose     : Returns the size of the buffer.
  Returns     : The size of the buffer in bytes.
  Parameters  : n/a
  Throws      : n/a
  Comments    : None.

=head2 get_element_size

  Usage       : my $element_size = Task::MemManager->get_element_size();
  Purpose     : Returns the size of each element in the buffer.
  Returns     : The size of each element in bytes.
  Parameters  : n/a
  Throws      : n/a
  Comments    : None.

=head2 get_num_of_elements

  Usage       : my $num_of_elements = Task::MemManager->get_num_of_elements();
  Purpose     : Returns the number of elements in the buffer.
  Returns     : The number of elements in the buffer.
  Parameters  : n/a
  Throws      : n/a
  Comments    : None.

=head2 get_delayed_gc_objects

  Usage       : my $delayed_gc_objects = Task::MemManager->get_delayed_gc_objects();
  Purpose     : Obtains a list of objects that have delayed garbage collection.
  Returns     : A reference to an array of objects with delayed GC.
  Parameters  : n/a
  Throws      : n/a
  Comments    : None.

=head1 EXAMPLES

We will illustrate the use of these methods with multiple examples. These will
cover issues like the allocation of memory, the extraction of regions from the
buffer, constant (to the eyes of Perl) memory allocation, delayed garbage
collection, and the use of a death stub, which is a function that is called
upon object destruction and may be used to perform e.g. logging or cleanup , 
operations other than freeing the memory buffer itself. 
The examples are best run sequentially in a single Perl script.

=head2 Example 1: Allocating buffers and killing them 

  use Task::MemManager;
  ## uses the default allocator PerlAlloc
  my $memdeath = Task::MemManager->new(
      40, 1,
      {
          init_value => 'zero',
          death_stub => sub {
              my ($obj_ref) = @_;
              printf "Killing 0x%8x \n", $obj_ref->{identifier};
          },
      }
  );

  my $mem = Task::MemManager->new(
      20, 1,
      {
          init_value => 'A',
          death_stub => sub {
              my ($obj_ref) = @_;
              printf "Killing 0x%8x \n", $obj_ref->{identifier};
          },
          allocator => 'CMalloc',
      }
  );
  printf( "%10s object is %s\n", ' mem', $mem );
  $mem = Task::MemManager->new(
    20, 1,
    {
        init_value => 'A',
        death_stub => sub {
            my ($obj_ref) = @_;
            printf "Killing 0x%8x \n", $obj_ref->{identifier};
        },
        allocator => 'CMalloc',
    }
  );

Print the buffer objects

  printf( "%10s object is %s\n", ' memdeath', $memdeath );
  printf( "%10s object is %s\n", ' mem', $mem );

If you would like to kill a buffer immediately, you can undefine it:

  undef $memdeath;
 
Attempting to under (or in general modify a constant or a Readonly)
memory buffer will kill the script. Note that these buffers can be
modified outside of Perl (including the Perl API) but not inside
the main Perl script. Such buffers are useful for keeping a constant
(in space) buffer throughout the lifetime of the script. Attempt
to modify them from within Perl, will kill the script at *runtime*
uncovering the modification attempt.

  use Const::Fast; ## may also use Readonly mutatis mutandis
  const my $mem_cp2 => Task::MemManager->new(
      20, 1,
      {
          init_value => 'D',
          death_stub => sub {
              my ($obj_ref) = @_;
              printf "Killing 0x%8x \n", $obj_ref->{identifier};
          },
          allocator => 'CMalloc',
      }
  );
  undef $mem_cp2;  # This will kill the script


=head2 Example 2: Extracting and inspecting a region from the buffer

First we will define a subroutine that will print the extracted region
in a nicely formated hexadecimal format.

  sub print_hex_values {
      my ( $string, $bytes_per_line ) = @_;
      $bytes_per_line //= 8;    # Default to 8 bytes per line if not provided

      my @bytes = unpack( 'C*', $string );    # Unpack the string into a list of bytes

      for ( my $i = 0 ; $i < @bytes ; $i++ ) {
          printf( "%02X ", $bytes[$i] );   # Print each byte in hexadecimal format
          print "\n" 
            if ( ( $i + 1 ) % $bytes_per_line == 0 )
            ;    # Print a newline after every $bytes_per_line bytes
      }
      print "\n" 
        if ( @bytes % $bytes_per_line != 0 )
        ;        # Print a final newline if the last line wasn't complete
  }

Now let's extract the region and print it

  my $region = $mem->extract_buffer_region(5, 10);
  print_hex_values( $region, 8 );

=head2 Example 3: Shallow copying defers buffer deallocation

Making a shallow copy of the buffer:

  my $mem_cp = $mem;
  printf( "%10s object is %s\n", ' mem_cp', $mem_cp );
  printf "Buffer %10s with buffer address %s\n", 
    'Alpha', $mem->get_buffer();
  printf "Buffer %10s with buffer address %s\n", 
    'Alpha_copy', $mem_cp->get_buffer();

Killing the original buffer in Perl. Trying to access it after death 
will lead to an error (but we intercept it in the code below)

  undef $mem;
  say "mem : ", ( $mem ? $mem->get_buffer() : "does not exist anymore" );

The shallow copy continues to exist, and so does the buffer region:

  printf "Buffer %10s with buffer address %s\n", 
    'Alpha_copy', $mem_cp->get_buffer();
  print_hex_values( $mem_cp->extract_buffer_region, 10 );

=head2 Example 4: Object modification and object destruction

Attempting to modify an existing buffer object, e.g. by reassiging it to 
a new buffer object, will instantly free the old memory buffer, and allocate
a new buffer with new contents (this Example continues at the end of Example 3)

  $mem_cp = Task::MemManager->new(
      20, 1,
      {
          init_value => 'D',
          death_stub => sub {
              my ($obj_ref) = @_;
              printf "Killing 0x%8x \n", $obj_ref->{identifier};
          },
          allocator => 'CMalloc',
      }
  );
  printf( "%10s object is %s\n", ' mem_cp', $mem_cp );
  printf "Buffer %10s with buffer address %s\n", 
    'Alpha_copy after modification', $mem_cp->get_buffer();
  print_hex_values( $mem_cp->extract_buffer_region, 10 );

=head2 Example 5: Fine control over garbage collection

Delayed garbage collection is useful when you want to keep a buffer alive
for a while after it goes out of scope. This is useful when you want to
transfer ownership of the memory space to an interfacing code (e.g. C code),
and don't want Perl to free the memory buffer (e.g when a lexical variable
is reassigned to a new buffer object in a loop).  
In this example we will create two buffers, one without and one with delayed
garbage collection and will track when they die relative to the end of the
script. This example is entirely self-contained.

  use Task::MemManager;
  use strict;
  use warnings;

  $mem_cp = Task::MemManager->new(
      20, 1,
      {
          init_value => 'D',
          death_stub => sub {
              my ($obj_ref) = @_;
              printf "Killing 0x%8x \n", $obj_ref->{identifier};
          },
          allocator => 'PerlAlloc',
      }
  );
  $mem_cp2 = Task::MemManager->new(
      20, 1,
      {
          init_value => 'D',
          death_stub => sub {
              my ($obj_ref) = @_;
              printf "Killing 0x%8x \n", $obj_ref->{identifier};
          },
          delayed_gc => 1,
          allocator => 'CMalloc',
      }
  );

List the objects with delayed garbage collection

  my $delayed_gc_objects = Task::MemManager->get_delayed_gc_objects();
  printf "Objects with delayed GC : " 
    . ("0x%8x " x @$delayed_gc_objects) 
    . "\n", @$delayed_gc_objects;

Time the precise moment of death:

  say "Undefining an object with delayed GC does not kill it!";
  undef $mem_cp2;
  say "End of the program - see how Perl's destroying all "
    . "delayed GC objects along with the rest of the objects";

=head2 Example 6: Consuming buffers and preventing double free

In this example we will create a simple buffer using FFI::Platypus::Memory's
malloc,and then we will consume it using Task::MemManager::CMalloc.
We will then create 2 bonafide Perl scalars, and then we will consume them
using Task::MemManager::PerlAlloc. We will then try to consume one of the
two Perl scalars using the memory address of the respective buffer 
using Task::MemManager::CMalloc to show the detection of overlapping memory 
regions, which causes the program to croak. Ordinarly, one would anticipate 
problems during the program shutdown as the DESTROY function is called to deal 
with the Task::MemManager objects. This is prevented because we track the 
regions that are overlapping and do not free them in the destructor.
We rather let the operating system to deal with them, when the program is wiped
out of memory. Note that consuming of a raw memory address will lead to the
zeroing out of the Perl scalar holding the address to prevent double free. 
This example is entirely self-contained.

  # consume - PerlAlloc & CMalloc, checking for overlapping allocations
  use FFI::Platypus::Buffer; 
  use FFI::Platypus::Memory;
  my $consumable  = "\0" x 100;
  my $consumable2 = "\0" x 100;
  my $pointer = malloc 1024;
  # use FFI::Platypus::Buffer to obtain the memory address of the Perl scalar 
  my ($reconsumable, $consumable_length) =   scalar_to_buffer $consumable; 

  say "Memory address is $pointer";
  my $mem_pointer =Task::MemManager->consume(\$pointer, 100,1,
    {
        death_stub => sub {
              my ($obj_ref) = @_;
              printf "Killing the reconsumable 0x%8x \n", $obj_ref->{identifier};
        },
        allocator => 'CMalloc'
    }
  );
  say "Memory address is $pointer";

  my $mem_consumable = Task::MemManager->consume(\$consumable, 1000,1,
    {
        death_stub => sub {
              my ($obj_ref) = @_;
              printf "Killing the consumable 0x%8x \n", $obj_ref->{identifier};
        },
        allocator => 'PerlAlloc'
    }
  );

  my $mem_consumable2 = Task::MemManager->consume(\$consumable2, 100,1,
    {
        death_stub => sub {
              my ($obj_ref) = @_;
              printf "Killing the consumable 0x%8x \n", $obj_ref->{identifier};
        },
        allocator => 'PerlAlloc'
    }
  );

  undef $consumable2;
  # try to ingest the same area twice

  
  # CMalloc is incorrect, but free will never be called on the buffer
  my $mem_consumable3 = Task::MemManager->consume(\$reconsumable, 100,1,
    {
        death_stub => sub {
              my ($obj_ref) = @_;
              printf "Killing the consumable 0x%8x \n", $obj_ref->{identifier};
        },
        allocator => 'CMalloc'
    }
  );



=head1 DIAGNOSTICS

There are no diagnostics that one can use. The module will croak if the
allocation fails, so you don't have to worry about error handling. 

=head1 DEPENDENCIES

The module depends on the C<Inline::C> module to access the memory buffer 
of the Perl scalar using the PerlAPI. In addition it depends implicitly
on all the dependencies of the memory allocators it uses

=head1 TODO

Open to suggestions. A few foolish ideas of my own include: adding further 
allocators and providing facilities that will *trigger* the delayed garbage 
collection for a specific object, at specific time points in a script 
(emulating for example Go's garbage collector).

=head1 SEE ALSO

=over 4


=item * L<https://metacpan.org/pod/Inline::C>

Inline::C is a module that allows you to write Perl subroutines in C. 

=item * L<https://perldoc.perl.org/perlguts> 

Introduction to the Perl API.

=item * L<https://perldoc.perl.org/perlapi>

Autogenerated documentation for the perl public API.

=back

=head1 AUTHOR

Christos Argyropoulos, C<< <chrisarg at cpan.org> >>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2024 by Christos Argyropoulos.

This is free software; you can redistribute it and/or modify it under the
MIT license. The full text of the license can be found in the LICENSE file
See L<https://en.wikipedia.org/wiki/MIT_License> for more information.


=cut

__DATA__

__C__

#include <stdint.h>
#include <stdlib.h>
#include <string.h>
#include <stdio.h>

/**
 * @brief Copies a region of a buffer to a new buffer.
 *
 * @usage SV *buffer = _extact_buffer_region(buffer, pos_start, pos_end, buffer_size);
 *
 * @param buffer The buffer to extract the region from.
 * @param pos_start The starting position of the region.
 * @param pos_end The ending position of the region.
 * @param buffer_size The size of the buffer.
 *
 * @return A Perl scalar (nul terminated string) containing the region.
 *
 * @throws n/a
 *
 * @comments Returns undef if attempt to overrun buffer, assumes zero based indexing into the buffer.
 *
 * @todo Reverse the buffer if pos_start > pos_end.
 */

SV *_extact_buffer_region(size_t buffer, size_t pos_start, size_t pos_end,
                          size_t buffer_size) {

    // attempt to overrun buffer                      
    if (pos_end >= buffer_size) {
            return &PL_sv_undef;
    }
    // can't reverse the buffer (yet)
    if(pos_start > pos_end) {
        return &PL_sv_undef;
    }

    void*  buffer_ptr = (void *)(uintptr_t)buffer; 
    size_t region_size = pos_end - pos_start +1;
    buffer_ptr += pos_start;
    SV* new_buffer = newSV(0); // zero buffer

    // copy the region using Perl's API macros (Newx, Copy, sv_usepvn_flags)
    char *new_buffer_ptr;
    Newx(new_buffer_ptr, region_size + 1, char);
    Copy(buffer_ptr,new_buffer_ptr, region_size, char);
    new_buffer_ptr[region_size] = '\0';
    sv_usepvn_flags(new_buffer, new_buffer_ptr, region_size, SV_SMAGIC | SV_HAS_TRAILING_NUL);

    return new_buffer;
}
