package Data::Sync::Shared;
use strict;
use warnings;
our $VERSION = '0.08';

require XSLoader;
XSLoader::load('Data::Sync::Shared', $VERSION);

# ithreads: blessed shared-memory handles must never be cloned into a
# child thread -- the clone would double-free the handle on thread exit.
{ no strict 'refs'; *{"${_}::CLONE_SKIP"} = sub { 1 } for qw(
  Data::Sync::Shared::Semaphore
  Data::Sync::Shared::Barrier
  Data::Sync::Shared::RWLock
  Data::Sync::Shared::Condvar
  Data::Sync::Shared::Once
  Data::Sync::Shared::RWLock::Guard
  Data::Sync::Shared::Condvar::Guard
  Data::Sync::Shared::Semaphore::Guard
); }

# Guard objects -- auto-release on scope exit

package Data::Sync::Shared::RWLock::Guard {
    our $VERSION = '0.08';   # indexable package: PAUSE needs a version here too
    sub DESTROY {
        # Only the process that took the lock may release it: after fork the
        # child inherits the guard object, and its global destruction would
        # otherwise release a lock the PARENT still holds -- breaking mutual
        # exclusion for every other process.
        my $self = shift;
        $self->[0]->${\$self->[1]} if $self->[0] && $self->[2] == $$;
    }
}

sub Data::Sync::Shared::RWLock::rdlock_guard {
    my $self = shift;
    $self->rdlock(@_);
    bless [$self, 'rdunlock', $$], 'Data::Sync::Shared::RWLock::Guard';
}

sub Data::Sync::Shared::RWLock::wrlock_guard {
    my $self = shift;
    $self->wrlock(@_);
    bless [$self, 'wrunlock', $$], 'Data::Sync::Shared::RWLock::Guard';
}

package Data::Sync::Shared::Condvar::Guard {
    our $VERSION = '0.08';   # indexable package: PAUSE needs a version here too
    sub DESTROY {
        # Only the process that took the mutex may release it -- see the note
        # on RWLock::Guard::DESTROY.
        my $self = shift;
        $self->[0]->unlock if $self->[0] && $self->[1] == $$;
    }
}

sub Data::Sync::Shared::Condvar::lock_guard {
    my $self = shift;
    $self->lock;
    bless [$self, $$], 'Data::Sync::Shared::Condvar::Guard';
}

# Condvar wait_while -- loop until predicate returns false

sub Data::Sync::Shared::Condvar::wait_while {
    my ($self, $pred, $timeout) = @_;
    $timeout //= -1;
    return $pred->() ? 0 : 1 if $timeout == 0;
    my $deadline;
    if ($timeout > 0) {
        require Time::HiRes;
        $deadline = Time::HiRes::time() + $timeout;
    }
    while ($pred->()) {
        if (defined $deadline) {
            my $remaining = $deadline - Time::HiRes::time();
            return 0 if $remaining <= 0;
            $self->wait($remaining);
            # Fall through to re-check predicate even on timeout -- the
            # condition may have cleared just before our deadline expired.
        } else {
            $self->wait;
        }
    }
    return 1;
}

# Semaphore guard

sub Data::Sync::Shared::Semaphore::acquire_guard {
    my ($self, $n, $timeout) = @_;
    $n //= 1;
    if ($n == 1) {
        $self->acquire($timeout // -1) or return undef;
    } else {
        $self->acquire_n($n, $timeout // -1) or return undef;
    }
    bless [$self, $n, $$], 'Data::Sync::Shared::Semaphore::Guard';
}

package Data::Sync::Shared::Semaphore::Guard {
    our $VERSION = '0.08';   # indexable package: PAUSE needs a version here too
    sub DESTROY {
        # Only the process that took the permits may release them: a forked
        # child's global destruction would otherwise release permits it never
        # acquired, pushing the semaphore count above what is actually free.
        my $self = shift;
        $self->[0]->release($self->[1]) if $self->[0] && $self->[2] == $$;
    }
}

1;

__END__

=encoding utf-8

=head1 NAME

Data::Sync::Shared - Shared-memory synchronization primitives for Linux

=head1 SYNOPSIS

    use Data::Sync::Shared;

    # Semaphore -- bounded counter for resource limiting
    my $sem = Data::Sync::Shared::Semaphore->new('/tmp/sem.shm', 4);
    $sem->acquire;            # block until available
    $sem->acquire(1.5);       # with timeout
    $sem->try_acquire;        # non-blocking
    $sem->acquire_n(3);       # acquire N permits atomically
    $sem->release;
    $sem->release(2);         # release N permits
    my $n = $sem->drain;      # acquire all, return count
    {
        my $g = $sem->acquire_guard;   # auto-release on scope exit
    }

    # Barrier -- N processes rendezvous
    my $bar = Data::Sync::Shared::Barrier->new('/tmp/bar.shm', 3);
    my $leader = $bar->wait;       # block until all 3 arrive
    my $leader = $bar->wait(5.0);  # with timeout (-1=timeout)

    # RWLock -- reader-writer lock
    my $rw = Data::Sync::Shared::RWLock->new('/tmp/rw.shm');
    $rw->rdlock;  $rw->rdunlock;
    $rw->wrlock;  $rw->wrunlock;
    $rw->try_rdlock;  $rw->try_wrlock;
    $rw->downgrade;                # wrlock -> rdlock atomically
    {
        my $g = $rw->wrlock_guard;  # auto-release on scope exit
    }

    # Condvar -- condition variable with built-in mutex
    my $cv = Data::Sync::Shared::Condvar->new('/tmp/cv.shm');
    $cv->lock;
    $cv->try_lock;       # non-blocking
    $cv->wait;           # atomically unlock + wait + re-lock
    $cv->wait(2.0);      # with timeout
    $cv->signal;         # wake one waiter
    $cv->broadcast;      # wake all waiters
    $cv->wait_while(sub { !$ready }, 5.0);  # predicate loop
    $cv->unlock;

    # Once -- one-time initialization gate
    my $once = Data::Sync::Shared::Once->new('/tmp/once.shm');
    if ($once->enter) {          # or enter($timeout)
        do_init();
        $once->done;
    }

    # All primitives support anonymous (fork-inherited) mode:
    my $sem = Data::Sync::Shared::Semaphore->new(undef, 4);

    # And memfd mode (fd-passable):
    my $sem = Data::Sync::Shared::Semaphore->new_memfd("my_sem", 4);
    my $fd = $sem->memfd;

=head1 DESCRIPTION

Data::Sync::Shared provides five cross-process synchronization primitives
stored in file-backed shared memory (C<mmap(MAP_SHARED)>), using Linux
futex for efficient blocking.

B<Linux-only>. Requires 64-bit Perl.

=head2 Primitives

=over

=item L<Data::Sync::Shared::Semaphore> - bounded counter

CAS-based counting semaphore. C<acquire> decrements (blocks at 0),
C<release> increments (capped at max). Useful for cross-process resource
limiting (connection pools, worker slots).

=item L<Data::Sync::Shared::Barrier> - rendezvous point

N processes call C<wait>; all block until the last one arrives, then all
proceed. Returns true for one "leader" process. Generation counter tracks
how many times the barrier has tripped.

=item L<Data::Sync::Shared::RWLock> - reader-writer lock

Multiple concurrent readers or one exclusive writer. Readers use
C<rdlock>/C<rdunlock>, writers use C<wrlock>/C<wrunlock>. Non-blocking
C<try_rdlock>/C<try_wrlock> variants available.

=item L<Data::Sync::Shared::Condvar> - condition variable

Includes a built-in mutex. C<lock>/C<unlock> protect the predicate.
C<wait> atomically releases the mutex and sleeps; on wakeup it
re-acquires the mutex. C<signal> wakes one waiter, C<broadcast> wakes all.

=item L<Data::Sync::Shared::Once> - one-time init gate

C<enter> returns true for exactly one process (the initializer); all
others block until C<done> is called. If the initializer dies, waiters
detect the stale PID and a new initializer is elected.

=back

=head2 Features

=over

=item * File-backed mmap for cross-process sharing

=item * Futex-based blocking (no busy-spin, no pthread)

=item * PID-based stale lock recovery (dead process detection)

=item * Anonymous and memfd modes

=item * Timeouts on all blocking operations (except Condvar C<lock>, which
provides only a non-blocking C<try_lock>)

=item * eventfd integration for event-loop wakeup

=back

=head2 Crash Safety

All primitives encode the holder's PID in the lock word. If a process
dies while holding a lock, other processes detect the stale lock within
2 seconds via C<kill(pid, 0)> and automatically recover.

Reader-slot exhaustion (slotless readers): dead-process recovery attributes a
crashed lock holder's contribution through its reader-slot. The slot table holds
1024 entries (one per concurrent reader process). If more than that many reader
processes share one mapping at once, a reader that cannot claim a slot proceeds
"slotless" -- it still takes the read lock but leaves no per-process record. If
such a slotless reader is then killed while holding the read lock, its share of
the lock cannot be attributed to a dead process, so writer recovery cannot
reclaim it and writers may block until the mapping is recreated. Reaching this
needs more than 1024 concurrent reader processes on one mapping plus a crash in
the brief read-lock window; the dead-process slot reclaim keeps the table from
filling with stale entries, so in practice it is very unlikely.

=head2 Security

Backing files are created securely: the path is opened with
O_CREAT|O_EXCL|O_NOFOLLOW (a pre-existing symlink at the path is
rejected, and an existing regular file is attached rather than
truncated) and the new file is created mode 0600 (owner-only) by
default, so a segment is not world-writable unless you opt in. To
share a file with a peer group, pass an explicit octal mode as the
last argument to new():

    my $sem = Data::Sync::Shared::Semaphore->new($path, $max, $initial, 0660);
    my $rw  = Data::Sync::Shared::RWLock->new($path, 0660);

The mode is applied exactly via C<fchmod> after an C<O_EXCL> create, so
the caller's umask does not narrow it.
Offsets read back from an attached segment are bounds-checked before
use, so a poisoned reader-slot offset cannot steer a pointer outside
the mapping.

=head2 Guard Objects

All locking primitives provide scope-based guards that auto-release
on scope exit (including exceptions):

    {
        my $g = $rw->rdlock_guard;
        # ... read operations ...
    }  # rdunlock called automatically

    {
        my $g = $sem->acquire_guard(3);  # acquire 3 permits
        # ... use resource ...
    }  # release(3) called automatically

    {
        my $g = $cv->lock_guard;
        $cv->wait_while(sub { !$ready }, 5.0);
    }  # unlock called automatically

=head1 PRIMITIVES

=head2 Data::Sync::Shared::Semaphore

=head3 Constructors

    my $sem = Data::Sync::Shared::Semaphore->new($path, $max);
    my $sem = Data::Sync::Shared::Semaphore->new($path, $max, $initial);
    my $sem = Data::Sync::Shared::Semaphore->new(undef, $max);
    my $sem = Data::Sync::Shared::Semaphore->new_memfd($name, $max);
    my $sem = Data::Sync::Shared::Semaphore->new_memfd($name, $max, $initial);
    my $sem = Data::Sync::Shared::Semaphore->new_from_fd($fd);

C<$max> is the maximum permit count. C<$initial> defaults to C<$max>
(fully available); set to 0 to start with no available permits.

=head3 Operations

    my $ok  = $sem->acquire;              # block until available (infinite)
    my $ok  = $sem->acquire($timeout);    # block with timeout (seconds)
    my $ok  = $sem->try_acquire;          # non-blocking, false if unavailable
    my $ok  = $sem->acquire_n($n);        # acquire N permits atomically
    my $ok  = $sem->acquire_n($n, $timeout);
    my $ok  = $sem->try_acquire_n($n);    # non-blocking N-permit acquire
    $sem->release;                        # release one permit
    $sem->release($n);                    # release N permits (clamped at max)
    my $n   = $sem->drain;               # acquire all available, return count
    my $val = $sem->value;                # current available count
    my $max = $sem->max;                  # maximum permits

=head3 Guard

    my $g = $sem->acquire_guard;          # acquire 1, release on scope exit
    my $g = $sem->acquire_guard($n);      # acquire N
    my $g = $sem->acquire_guard($n, $timeout);  # with timeout, undef on fail

=head2 Data::Sync::Shared::Barrier

=head3 Constructors

    my $bar = Data::Sync::Shared::Barrier->new($path, $parties);
    my $bar = Data::Sync::Shared::Barrier->new(undef, $parties);
    my $bar = Data::Sync::Shared::Barrier->new_memfd($name, $parties);
    my $bar = Data::Sync::Shared::Barrier->new_from_fd($fd);

C<$parties> must be >= 2.

=head3 Operations

    my $r = $bar->wait;           # block until all parties arrive
    my $r = $bar->wait($timeout); # with timeout

Returns: 1 = leader (last to arrive), 0 = non-leader, -1 = timeout.
A zero timeout (C<< wait(0) >>) is a non-blocking probe: it returns C<-1> if the
party would have to block, B<without> breaking the barrier. On a positive
timeout that actually elapses the barrier is permanently broken: C<wait> returns
C<-1> for the timing-out party and all other waiters, and every subsequent
C<wait> also returns C<-1> until C<reset> is called. This matches POSIX
C<pthread_barrier_t> broken semantics.

    my $gen = $bar->generation;    # how many times barrier has tripped
    my $n   = $bar->arrived;       # currently arrived count
    my $n   = $bar->parties;       # party count
    $bar->is_broken;               # true if timeout broke the barrier
    $bar->reset;                   # clear broken state + bump generation

=head2 Data::Sync::Shared::RWLock

=head3 Constructors

    my $rw = Data::Sync::Shared::RWLock->new($path);
    my $rw = Data::Sync::Shared::RWLock->new(undef);
    my $rw = Data::Sync::Shared::RWLock->new_memfd($name);
    my $rw = Data::Sync::Shared::RWLock->new_from_fd($fd);

=head3 Operations

    $rw->rdlock;                   # block until read lock acquired
    $rw->rdlock($timeout);         # with timeout (croaks on timeout)
    $rw->wrlock;                   # block until write lock acquired
    $rw->wrlock($timeout);         # with timeout (croaks on timeout)
    my $ok = $rw->try_rdlock;      # non-blocking
    my $ok = $rw->try_wrlock;      # non-blocking
    my $ok = $rw->rdlock_timed($timeout);  # returns false on timeout
    my $ok = $rw->wrlock_timed($timeout);  # returns false on timeout
    $rw->rdunlock;
    $rw->wrunlock;
    $rw->downgrade;                # convert wrlock to rdlock atomically

=head3 Guards

    my $g = $rw->rdlock_guard;             # rdunlock on scope exit
    my $g = $rw->rdlock_guard($timeout);   # with timeout (croaks on fail)
    my $g = $rw->wrlock_guard;
    my $g = $rw->wrlock_guard($timeout);

=head2 Data::Sync::Shared::Condvar

=head3 Constructors

    my $cv = Data::Sync::Shared::Condvar->new($path);
    my $cv = Data::Sync::Shared::Condvar->new(undef);
    my $cv = Data::Sync::Shared::Condvar->new_memfd($name);
    my $cv = Data::Sync::Shared::Condvar->new_from_fd($fd);

=head3 Operations

    $cv->lock;                     # acquire built-in mutex
    $cv->unlock;                   # release built-in mutex
    my $ok = $cv->try_lock;        # non-blocking

    my $ok = $cv->wait;            # unlock, wait for signal, re-lock
    my $ok = $cv->wait($timeout);  # with timeout
    $cv->signal;                   # wake one waiter
    $cv->broadcast;                # wake all waiters

    my $ok = $cv->wait_while(\&pred);           # loop until pred returns false
    my $ok = $cv->wait_while(\&pred, $timeout); # with timeout

C<wait> must be called while holding the mutex. Returns 1 on
signal/broadcast, 0 on timeout. The mutex is always re-acquired
before C<wait> returns.

C<wait_while> calls C<wait> in a loop until the predicate coderef
returns false. Returns 1 if predicate became false, 0 on timeout.

=head3 Guard

    my $g = $cv->lock_guard;       # unlock on scope exit

=head2 Data::Sync::Shared::Once

=head3 Constructors

    my $once = Data::Sync::Shared::Once->new($path);
    my $once = Data::Sync::Shared::Once->new(undef);
    my $once = Data::Sync::Shared::Once->new_memfd($name);
    my $once = Data::Sync::Shared::Once->new_from_fd($fd);

=head3 Operations

    my $init = $once->enter;             # try + wait, infinite
    my $init = $once->enter($timeout);   # with timeout
    $once->done;                         # mark initialization complete
    my $ok  = $once->is_done;            # check without blocking
    $once->reset;                        # reset to uninitialized state

C<enter> returns true for exactly one process (the initializer).  All others
block until C<done> is called, then return false.  With a C<$timeout>, a waiter
that times out before initialization completes B<also> returns false: a false
return means "not the initializer", not necessarily "initialization complete",
so use C<is_done> to tell a finished gate from a timed-out wait.
If the initializer dies, stale PID detection elects a new one.

=head2 Common Methods

All primitives support:

    my $p  = $obj->path;           # backing file path (undef if anon)
    my $fd = $obj->memfd;          # memfd fd (-1 if file-backed/anon)
    $obj->sync;                    # msync -- flush to disk
    $obj->unlink;                  # remove backing file
    Class->unlink($path);          # class method form
    my $s  = $obj->stats;          # diagnostic hashref

Stats keys vary by type. All counters are approximate under concurrency.

B<Semaphore:> C<value>, C<max>, C<waiters>, C<mmap_size>, C<acquires>,
C<releases>, C<waits>, C<timeouts>, C<recoveries>.

B<Barrier:> C<parties>, C<arrived>, C<generation>, C<waiters>,
C<mmap_size>, C<waits>, C<releases>, C<timeouts>.

B<RWLock:> C<state> (C<"unlocked">, C<"read_locked">, C<"write_locked">),
C<readers>, C<waiters>, C<mmap_size>, C<acquires>, C<releases>,
C<recoveries>.

B<Condvar:> C<waiters>, C<signals>, C<mmap_size>, C<acquires>,
C<releases>, C<waits>, C<timeouts>, C<recoveries>.

B<Once:> C<state> (C<"init">, C<"running">, C<"done">), C<is_done>,
C<waiters>, C<mmap_size>, C<acquires>, C<releases>, C<waits>,
C<timeouts>, C<recoveries>.

=head3 eventfd Integration

    my $fd = $obj->eventfd;        # create eventfd, returns fd
    $obj->eventfd_set($fd);        # use existing fd (e.g. from fork)
    my $fd = $obj->fileno;         # current eventfd (-1 if none)
    $obj->notify;                  # signal eventfd
    my $n  = $obj->eventfd_consume;  # drain notification counter

Notification is opt-in. Use with L<EV> or other event loops.

=head1 CRASH SAFETY

An interrupted create is recovered too. A creator killed after the backing
file is sized but before its header is committed leaves a full-size, all-zero
file. C<new> re-initializes such a file automatically, but only when it is
exactly the size the requested geometry needs, is owned by your effective uid,
and is still entirely zero -- a file holding data is never re-initialized. If
the creator got as far as writing part of the header, the file cannot be told
apart from a corrupt one and C<new> croaks with C<incomplete sync file left by
an interrupted create; remove it and retry>. A file left behind by an
interrupted create never held data, so removing it is safe -- but a file whose
header was corrupted after the fact reaches the same croak, so confirm it is
an abandoned create before deleting anything you care about.

=head1 SECURITY

Backing files are created with mode C<0600> (owner-only) by default, so only
the creating user can open and attach them. To share a backing file across
users, pass an explicit octal file mode such as C<0660> as the last argument
to C<new> -- C<< Semaphore->new($path, $max, $initial, $mode) >>,
C<< Barrier->new($path, $parties, $mode) >>, C<< RWLock->new($path, $mode) >>,
C<< Condvar->new($path, $mode) >> and C<< Once->new($path, $mode) >>. The mode
is applied when the file is created, and when a file left behind by an
interrupted create is re-initialized (see L</CRASH SAFETY>); a file already in
use keeps its own permissions. The file is opened with C<O_NOFOLLOW>, so a
symlink planted at the path is refused, and created with C<O_EXCL>; the on-disk
header is validated when the file is attached. Any process you grant write
access to a shared mapping is trusted not to corrupt its contents while other
processes are using it -- a primitive whose header is rewritten underneath it
can leave waiters parked, which no amount of validation at attach time can
undo.

=head1 SEE ALSO

L<Data::Buffer::Shared> - typed shared array

L<Data::HashMap::Shared> - concurrent hash table

L<Data::Queue::Shared> - FIFO queue

L<Data::PubSub::Shared> - publish-subscribe ring

L<Data::ReqRep::Shared> - request-reply

L<Data::Pool::Shared> - fixed-size object pool

L<Data::Stack::Shared> - LIFO stack

L<Data::Deque::Shared> - double-ended queue

L<Data::Log::Shared> - append-only log (WAL)

L<Data::Heap::Shared> - priority queue

L<Data::Graph::Shared> - directed weighted graph

L<Data::BitSet::Shared> - shared bitset (lock-free per-bit ops)

L<Data::RingBuffer::Shared> - fixed-size overwriting ring buffer

=head1 AUTHOR

vividsnow

=head1 LICENSE

This is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.

=cut
