=begin meta_information

=encoding utf8

	License:		BSD-2-Clause
	Program-version:	<see below>
	Description:		Libriary for IPC and token based
				lock mechanism.
	Contact:		Dominik Bernhardt - domasprogrammer@gmail.com or https://github.com/DomAsProgrammer

=end meta_information

=begin license

	Transport data between applications (IPC) via Storable library
	Copyright © 2025 Dominik Bernhardt

	Redistribution and use in source and binary
	forms, with or without modification, are permitted
	provided that the following conditions are met:

	1. Redistributions of source code must retain the
	above copyright notice, this list of conditions and the
	following disclaimer.

	2. Redistributions in binary form must reproduce
	the above copyright notice, this list of conditions and
	the following disclaimer in the documentation and/or
	other materials provided with the distribution.

	THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT
	HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR
	IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
	IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
	PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
	COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY
	DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
	CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
	PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
	DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
	CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
	CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
	OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
	SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
	DAMAGE.

=end license

=begin version_history

	v0.1 Beta
	I often had problems installing IPC::Shareable on dif-
	ferent platforms.
	So I built this library runable with only (Enterprise
	Linux) default Perl installation.

	v0.2 Beta
	Missing control added

	v0.2.1 Beta
	Extended how_to

	v1
	Bugfixes and release

	v1.1
	Now protects content of the file, only accessible by
	owner.

	v1.2
	Better target name handling.
	Enable user to use a second argument for manipulating
	chmod.

	v1.3
	Solved DESTROY bug

	v1.4
	Proper error message on missing lock file.
	Speed improvement by NOT sleeping

	v1.4.1
	Just some prettier output.

	v1.5
	Renamed

	v1.5.1
	Fewer output

	v1.6
	Read/write permission check.

	v1.6.1
	Read/write permission bug solved.
	Better working DESTROY function.

	v1.6.2
	False coded bol_AllowMultiple corrected.

	v1.6.3
	Code quality increased.
	Added dependency: boolean and Try

	v1.6.3.1
	Added coments

	v2.00
	Significant changes!
	Renamed
	Now working with a FIFO array, but nothing should change
	for the lib user.

	v2.01
	Some bugfixes.

	v2.02
	Implemented Carp and Exporter.
	Declared version.

	v2.03
	Used END block to properly end the program.

	v2.04
	Switched to Perl v5.40.0, removed Try and replaced by
	feature q{try}

	v2.05
	Perl v5.40.0 also supports boolean values nativly.
	Removed boolean and used builtin's true and false.

	v2.06
	Bugfix of lock_retrieve() on scrambled files.

	v2.07
	Detection and warning of orphan lock files.

	v2.08
	New terminology
	Compatibility layer

	v2.09
	Removed compatibility layer

	v2.10
	New dependency for FreeBSD: /run as tmpfs in testing
	Full fledged pod.

	v2.10.01
	Bugfix: Dynamic lock file target mode is now case
	sensetive agian.

	v2.11
	Bugfixes

	v2.12
	Cares about lock file's permissions in detail.

	v2.13
	Better handling if TokenUnlock() was called if TokenLock() was never called before.
	Improved manual.

	v3
	Verion number change to integer.
	Public release on MetaCPAN.

=end version_history

=begin comment

 use IPC::LockTicket;

 my $object	= IPC::LockTicket->New(qq{name}, <chmod num>);	# For SPEED:	Creates a shared handle within
								# /dev/shm (allowed symbols: m{^[a-z0-9]+$}i)
								# name like name

 my $object	= IPC::LockTicket->New(qq{/absolute/path.file}, <chmod num>)
								# For STORAGE:	Creates a shared handle at the
								# given path (must be a file name)

 $bol_succcess	= $object->MainLock(1);				# For MULTIPLE usage: allows calling MainLock()
								# multiple times on same file to allow IPC even
								# if it's not from a fork (applies only on same
								# name or file) i.e. it's not failing on
								# MainLock() if file exists

 $bol_succcess	= $object->MainLock();				# Creates shm/lock-file or if existing and
								# MULTIPLE is active for file and new object
								# it implements the PID

 $bol_succcess	= $object->TokenLock();			# Get a ticket to queue up - blocks until it's
								# our turn

 $bol_succcess	= $object->SetCustomData($reference);		# Save any data as reference - be aware this
								# decreases speed and you fastly run out of
								# space

 $reference	= $object->GetCustomData();			# Load custom data block

 $bol_succcess	= $object->TokenUnlock();			# We're done and next one's turn is now

 $bol_succcess	= $object->MainUnlock();			# Removes PID from lock file on MULTIPLE. If
								# no more PIDs are within the lockfile it re-
								# moves the lock file as well.
								# Hint: The user of the library must take
								# care when to MainUnlock() e.g. wait until
								# all child processes died.

=end comment

=begin comment

	V A R I A B L E  N A M I N G

	str	string
	 L sql	sql code
	 L cmd	command string
	 L ver	version number
	 L bin	binary data, also base64
	 L hex  hex coded data
	 L uri	path or url

	int	integer number
	 L cnt	counter
	 L oct  octal number
	 L pid	process id number
	 L tsp	seconds since period

	flt	floating point number

	bol	boolean

	mxd	unkown data (mixed)

	ref	reference
	 L rxp	regular expression
	 L are	array reference
	 L dsc	file discriptor (type glob)
	 L sub	anonymous subfunction	- DO NO LONGER USE, since Perl v5.26 functions can be declared lexically non-anonymous!
	 L har	hash array reference
	  L tbl	table (a hash array with PK as key OR a multidimensional array AND hash arrays as values)
	  L obj	object (very often)

=end comment


=cut

=head1 NAME

IPC::LockTicket - Use Storable library to IPC token to prevent parallel access to any resources. Including your custom data to transfer asynchronously.

=head1 SYNOPSIS

 use strict;
 use warnings;
 use IPC::LockTicket;

 my $object	= IPC::LockTicket->New(@options);

 my $object	= IPC::LockTicket->New(qq{name}, 0666);
   # ...or
 my $object	= IPC::LockTicket->New(qq{/absolute/path.file}, 0600)

 # This fails if the IPC file exists already
 $bol_succcess	= $object->MainLock();

 $bol_succcess	= $object->SetCustomData($reference);

 # fork() and do within Child1:
 # Child1 represents best practice.

 $bol_succcess	= $object->TokenLock(); # Blocks unless lock is aquired.

 $reference	= $object->GetCustomData();
 # Do something with $reference
 $bol_succcess	= $object->SetCustomData($reference);

 $bol_succcess	= $object->TokenUnlock(); # Other children can only use the
   # updated version, but were blocked until this point. Best practice is
   # keeping the Time between TokenLock() and TokenUnlock() as short as
   # possible.

 # Within a different Child2:
 $reference	= $object->GetCustomData(); # This is safe, but right after this
   # call the data might change, because it is not controlled through any mechanism.
   # This is useful if one just needs to get the current state, but doesn't rely on
   # persistence.

 # Within another different ChildN:
 $bol_succcess	= $object->SetCustomData($reference); # This is safe, too, but
   # it might lead to data loss through overwriting existing data.

 # At the end the parent does:
 $bol_succcess	= $object->MainUnlock();

 # Hand over a true value if multiple parents shall use the same IPC file:
 $bol_succcess	= $object->MainLock(1);

=head1 DESCRIPTION

IPC::LockTicket allows one to get a simple token/ticket locking mechanism, like C<flock()> does, but FIFO sorted.
It also makes it easy to transport small amount of data between processes.

The data you want to transfer must be saved as an anonymous reference, and returns as such.

The data is not transferred in real time, but only on request. While you might store whole objects if you need the most recent of them, lock the store, load it, change it and store it again before you unlock it again.

In theory, you can store as much data as your disk can hold, but be aware: this will slow down the lock mechanism. Use multiple files in this case: One only holds data (full path), the other is just for locking (dynamic path).


=cut

=head1 IPC::LockTicket Class METHODS

=head3 C<New>

 my $object	= IPC::LockTicket->new($str_Name, $oct_Permission) or die;

Creates a new IPC::LockTicket object, which is returned. Returns C<undef> on failure. Expects one or two arguments. First the name, optionally secondly the permission as an octal number.

=over 2

=item name

String just matching C<m{^[-_a-z0-9]+$}i> for dynamic naming or a full path to a file.
Mandatory.

=item permission

Access rights that the lock file will have.
For example, if just a collision protection shall be implemented, it might be the best to set it to 0666, so collisions can be prevented over the whole system for every user.
Expects an octal number, like L<chmod(1)>.
Defaults to C<0600>.

=back


=cut

=head3 C<DESTROY>

 my $bol_Success	= $object->DESTROY();

Destroys the object so it removes lock files or PIDs from lock files. Automatically called on C<undef($object)>, C<die>, C<exit>, and when C<$object> leaves the scope.

B<Not> called if another module C<croak()>s or if the application fails through an exception at runtime.

Z<>

If not called, the next C<MainLock()> will clear the orphan file, but it is not clear that the content was written properly. If the file is empty or cannot be read, it will not be cleared, but C<MainLock()> will fail. See L<C<MainLock>> for further details.


=cut

=head3 C<MainLock>

 my $bol_Success	= $object->MainLock();
 my $bol_Success	= $object->MainLock(1);

Checks if a lock file exists and creates it if not. Fails if file exists and process stored within is alive.
If a C<true> value is supplied, locking is non-exclusive but shared. If the file exists and was also created non-exclusively, locking is successful. This way the lock file is shared with several processes, requesting non-exclusive mode.
If C<false> is returned from C<MainLock> no lock file was created/claimed.
Meaning:

 ____________________________________________________________________________________________________________________________________
 | Call mode        | MainLock() | MainLock() | MainLock() | MainLock()   | MainLock(1) | MainLock(1) | MainLock(1)  | MainLock(1)  |
 | Lock file        | empty*     | shared     | exclusive  | non-existent | empty*      | shared      | exclusive    | non-existent |
 | MainLock returns | false      | false      | false      | true         | false       | true        | false        | true         |
 ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯

*= empty or any other non-Storable data.


=cut

=head3 C<MainUnlock>

 $object->MainUnlock();

Removes lock. The lock file is deleted if this is the last process accessing it.
Returns only a true value.

If it is a shared lock and not the last process accessing it, only the PID entries are removed from the lock file.


=cut

=head3 C<TokenLock>

 $object->TokenLock();

Can only be called after C<MainLock> and before C<MainUnlock> otherwise C<die>s.
Requests exclusive lock, i.e., any C<TokenLock> is blocking until C<TokenUnlock> was called, or the locking process is dead. Process checks are done to prevent infinite locks through broken children or parents, but this is not proper usage. Don't just C<exit>, but call C<TokenUnlock> and C<MainUnlock> in appropriate sequence before ending processes!
Returns a true value or blocks.


=cut

=head3 C<TokenUnlock>

 $object->TokenUnlock();

Can only be called after C<MainLock> and before C<MainUnlock> otherwise C<die>s.
Removes the token from the lock file so any other request of C<TokenLock> can be satisfied.
Returns false if unlock is done while not holding the lock.
Otherwise, it returns true.


=cut

=head3 C<SetCustomData>

 $object->TokenLock();
 $object->SetCustomData($reference);
 $object->TokenUnlock();

Writes a custom data reference in a reserved area. See L<CAVEATS> and L<GOOD PRACTICE> for further details.
Should be preceded by C<TokenLock()> and followed by C<TokenUnlock()>.
Returns only a true value or C<die>s.


=cut

=head3 C<GetCustomData>

 $ref_Data	= $object->GetCustomData();

Load the reference, formerly saved by C<SetCustomData>.
Returns C<undef> either it was never set or an error occurred.


=cut

=head1 LOCKING

Locking works like a traffic light: Only if honoured, it can do its magic. L<C<flock()>|https://perldoc.perl.org/functions/flock> works the same way: only if all members honour the lock, it can be guaranteed to work properly.
There are several methods implemented to prevent infinite locks through unexpectedly died processes.
But the core of this is the token handling itself, providing a FIFO locking mechanism. The first process which called C<TokenLock> is the first that will gain the lock. The last process, called C<TokenLock> has to wait until the second to last called C<TokenUnlock>.
C<TokenLock> is blocking. Until the former processes either call C<TokenUnlock> or unexpectedly died.

=head1 CAVEATS

Using C<SetCustomData> can lead to problems. For example, if a huge array is stored, the memory can exceed. However, even worse is: the more data is stored within, the slower the locking mechanism gets, because it has to write all the data every time it checks or changes the lock file.
Refer to L<GOOD PRACTICE> how to prevent this.

=head1 GOOD PRACTICE

=head3 Transferring huge amounts of data between processes

 # Parent
 my $obj_Lock	= IPC::LockTicket->New('MyApp');
 my $obj_IPC	= IPC::LockTicket->New('/var/tmp/MyApp/storage.ipc');
 $obj_Lock->MainLock(1);
 $obj_IPC->MainLock(1);
 ...

 # Child 1 has much data to transfer
 $obj_Lock->TokenLock();
 $obj_IPC->SetCustomData($referenceToHugeHashArray);
 $obj_Lock->TokenUnlock();
 ...

 # Child 2 shall work on the data
 $obj_Lock->TokenLock();
 my $referenceToHugeHashArray = $obj_IPC->GetCustomData();
 $obj_IPC->SetCustomData(undef);	# Clear storage to prevent working on the same elements several times...
 $obj_Lock->TokenUnlock();		# ...and unlock fastly.

 if ( defined($referenceToHugeHashArray) ) {
	# Do something with the data...
	exit(0);
	}
 else {
	# Data was emptied or no data were saved yet.
	exit(0);
	}

Use dynamic naming for locking mechanisms only. This way, C<IPC::LockTicket> tries to find the best location to store the file on its own while you keep the file small.
For use of custom data transfer between processes, use full path notation and store on a slower, but huge partition.
This way the lock mechanism can keep its speed, but you can transfer huge data as well.
Maybe it is a better idea to use something like a database instead of a lock file for those situations. To consider this: the data is stored as a blob from L<Storable>. This works well if you write once and clear the data afterwards. But it will re-write the whole file every time C<SetCustomData> is called. This is inefficient if only a new hash pair shall be added and can make your app awfully slow. Better would be to prevent parallel database table access through IPC::LockTicket, so no redundant work happens, while databases are optimized to handle small amounts of data. Consider S<C<Child 2>> reading the whole table, then truncating it. After that S<C<Child 1>> might again write something new into the table.

=head3 Shared locks

It is possible to run C<MainLock(1)> within the children, but this is bad practice and strongly discouraged! Shared locks shall only be shared between the main processes (parents) while children only use the C<TokenLock> and C<TokenUnlock> methods.
The lock objects created through C<New('name')> can be copied though C<fork>ing.
But C<New> sets what is understood as the I<parent> PID to the calling process. C<MainLock> and C<MainUnlock> expect to be run within the I<parent> process.
C<TokenLock> is more optimized for speed than C<MainLock> is.

=head1 AUTHOR

Dominik Bernhardt, domasprogrammer@gmail.com

=head1 CREDITS

Thanks for the hard time, much to learn and ideas I got through:

=over 2

=item L<Storable|https://metacpan.org/pod/Storable>

=item L<IPC::Shareable|https://metacpan.org/pod/IPC::Shareable>

=item L<C<flock()>|https://perldoc.perl.org/functions/flock>

=back

=head1 SEE ALSO

L<perl(1)>, L<Storable|https://metacpan.org/pod/Storable>


=cut

