process results from the CPAN

Acrux


=head1 ATTRIBUTES

This class implements the following attributes

=head2 data

    my $data = $provider->data;
    $provider = $provider->data({foo => 'bar'});

Data structure to be processed

=head1 METHODS

This class implements the following methods

=head2 add

    $provider->add("data", "and another data", ...);

Add data to digest calculate.

lib/Acrux/FileLock.pm view on Meta::CPAN

    die $fl->error if $fl->error;
    die "Already running" if $fl->check;

    # . . . do stuff . . .

=head1 DESCRIPTION

The Lock File simple interface

This package manages a lock files. It will create a lock file,
query the process within to discover if it's still running, and remove
the lock file. This module based on L<Lock::File>, L<File::TinyLock>,
L<JIP::LockFile>, L<LockFile::Simple> and L<Acrux::FilePid>.

=head1 METHODS

This module implements the following methods

=head2 new

    my $fl = Acrux::FileLock->new(

lib/Acrux/FileLock.pm view on Meta::CPAN

This method checks whether the lock is currently considered active.

Returns C<1> if the lock is active or C<0> if the lock is free.
The return value is always boolean and does not contain the PID of the
lock owner.

Before checking the lock state, this method reads the owner information
from the lock file and updates the C<own> and C<uid> attributes when the
file contains valid owner data. These values represent the metadata
stored in the lock file at the time of the call and must not be
considered proof that the corresponding process currently owns the
lock.

When C<flock> mode is enabled, the lock state is determined exclusively
by the system file lock. The C<own> and C<uid> attributes are still
updated from the lock file, but they do not participate in determining
the lock state.

In the regular mode, the owner PID and UID are additionally used to
determine whether the lock is still valid. A stale lock file is removed
automatically when possible.

lib/Acrux/FileLock.pm view on Meta::CPAN

    $fl = $fl->own(123);
    my $owner_did = $fl->own;

Accessor and mutator for the PID associated with the lock owner.

When C<check> reads a lock file containing valid owner information, this
attribute is updated with the PID stored in the file.

The value represents the owner PID recorded in the lock file at the time
of the last C<check> call. It is metadata and is not, by itself, a
guarantee that the corresponding process currently owns the lock.

After a successful C<lock>, the attribute contains the PID associated
with the newly acquired lock.

In C<flock> mode, the operating system does not provide the PID of the
process holding the system lock. Therefore, when inspecting a foreign
lock, C<own> represents only the PID recorded in the lock file.

=head2 pid

    my $pid = $fl->pid;

Returns the PID associated with this lock object.

By default, this is the PID of the current process (C<$$>). The value is
used when creating the lock file and is stored as the owner PID in the
lock file

The PID may be specified explicitly when creating the object:

    my $fl = Acrux::FileLock->new(pid => 123);

This can be useful when the object is used to represent a lock owned by
another process

=head2 uid

    $fl = $fl->uid(1000);
    my $owner_uid = $fl->uid;

Accessor and mutator for the numeric user ID associated with the lock
owner.

When C<check> reads a lock file containing valid owner information, this
attribute is updated with the UID stored in the file.

The value represents the owner UID recorded in the lock file at the time
of the last C<check> call. It is metadata and is not, by itself, a
guarantee that the corresponding process currently owns the lock.

After a successful C<lock>, the attribute contains the UID associated
with the newly acquired lock.

In C<flock> mode, the operating system does not provide the UID of the
process holding the system lock. Therefore, when inspecting a foreign
lock, C<uid> represents only the UID recorded in the lock file.

=head2 unlock

    $self = $self->unlock;

This method performs unlocking the lock file and removes it

=head1 HISTORY

lib/Acrux/FileLock.pm view on Meta::CPAN

        # Oops! Process already exists
        $self->_debug(sprintf("Found valid existing lock file for PID=%d", $self->own));
        return 1;
    }

    # Process for owner PID not exists. Check owner UID
    else {
        # Owner UID is current user?
        if ($self->uid && $self->uid != $>) {
            $self->_debug("The owner of the lock file owns NOT current user");
            # Check process by by /proc/PID (for linux only!)
            if (-d File::Spec->catfile("/proc", $self->own)) {
                $self->_debug(sprintf("Found valid existing lock file for PID=%d (by /proc/%d)", $self->own, $self->own));
                return 1;
            }
        }

        # Try unlink the not my lock file
        unless (unlink $self->file) {
            $self->_debug(sprintf("Can't remove stale lock file \"%s\": %s", $self->file, $!));
            return 1;

lib/Acrux/FilePid.pm view on Meta::CPAN

    my $fp = Acrux::FilePid->new (
        file => '/some/file.pid',
        auto => 1,
    );
    die "Already running" if $fp->running;
    # . . .

=head1 DESCRIPTION

This software manages a pid file for you. It will create a pid file,
query the process within to discover if it's still running, and remove
the pid file.

=head2 new

    my $fp = Acrux::FilePid->new;

    my $fp = Acrux::FilePid->new(
        file => '/var/run/daemon.pid',
    );

lib/Acrux/FilePid.pm view on Meta::CPAN


Removes the pid file from disk. Returns true on success, false on
failure.

=head2 running

    my $pid = $fp->running;
    die "Service already running: $pid" if $pid;

Checks to see if the pricess identified in the pid file is still
running. If the process is still running, the pid is returned. Otherwise
C<undef> is returned.

=head2 save

    $fp->save;

Writes the pid file to disk, inserting the pid inside the file.
On success, the object is returned. On failure, C<undef> is
returned.

lib/Acrux/Pointer.pm view on Meta::CPAN


=head1 ATTRIBUTES

This class implements the following attributes

=head2 data

    my $data = $pointer->data;
    $pointer = $pointer->data({foo => 'bar'});

Data structure to be processed

=head1 METHODS

This class implements the following methods

=head2 contains

    my $bool = $pointer->contains('/foo/1');

Check if L</"data"> contains a value that can be identified with the given pointer

lib/Acrux/Util.pm view on Meta::CPAN


=item mode

This numeric argument sets the default mode of opening files to write.
By default this argument to C<(O_WRONLY | O_CREAT)>.
Please DO NOT set this argument unless really necessary!

=item perms

This argument sets the permissions of newly-created files.
This value is modified by your process's umask and defaults to 0666 (same as sysopen)

=back

See also L</slurp> to reading data from file

=head2 spurt

See L</spew>

=head2 strf

lib/Acrux/Util.pm view on Meta::CPAN

}

# Text utils
sub trim {
    my $val = shift;
    return unless defined $val;
    $val =~ s|^\s+||s; # trim left
    $val =~ s|\s+$||s; # trim right
    return $val;
}
sub dformat { # Simple templating processor
    my $f = shift;
    my $d = @_ ? @_ > 1 ? {@_} : {%{$_[0]}} : {};
    $f =~ s/\[([A-Z0-9_\-.]+?)\]/(defined($d->{$1}) ? $d->{$1} : "[$1]")/eg;
    return $f;
}
sub strf { # Yet another simple templating processor
    my $s = shift // '';
    my $h = @_ ? @_ > 1 ? {@_} : {%{$_[0]}} : {};
    return '' unless length $s;
    $h->{'%'} //= '%'; # by default '%' eq '%''

    $s =~ s/
            (?:
              %\{(\w+)\}       # short name like %{name}
              |
              %([%a-zA-Z])     # single character specifier like %d

t/05-filepid.t view on Meta::CPAN

#
#########################################################################
use strict;
use Test::More;

use_ok qw/Acrux::FilePid/;

# Regular mode
{
    my $fp = Acrux::FilePid->new(file => "test05.pid");
    is $fp->pid, $$, "$$ current process by default";
    ok $fp->save, "$$ writing file";
    is $fp->running, $$, "$$ we are running";
    ok $fp->remove, "$$ deleted file";
    #note explain $fp;
}

# Autoremove mode
{
    my $fp = Acrux::FilePid->new(file => "test05.tmp", autoremove => 1);
    ok $fp->save, "$$ writing file";

t/05-filepid.t view on Meta::CPAN

}

# Fork mode
my $file = 'child05.tmp';
unlink $file if -e $file;
if (my $child = fork) { # Parent PID
    sleep 1;
    my $p = Acrux::FilePid->new(file => $file, autoremove => 1);
    note sprintf "Parent PID: %s; Parent Owner: %s", $p->pid, $p->owner;
    $p->save unless $p->running;
    ok $p->running, 'child process is running';
    #note explain $p;
    waitpid $child, 0;
    done_testing;
} else { # child process
    my $p = Acrux::FilePid->new(file => $file, autoremove => 1); # hope for the best
    unless ($p->running) {
       $p->save;
       note sprintf "Start child process (Child PID: %s; Child Owner: %s)", $p->pid, $p->owner;
       sleep 3;
       note sprintf "Finish child process (Child PID: %s; Child Owner: %s)", $p->pid, $p->owner;
    }
    #note 'parent is running' if $p->running;
}

__END__

prove -lv t/05-filepid.t

t/13-filelock.t view on Meta::CPAN

use Acrux::FileLock;

use constant DEBUG => !!($ENV{ACRUX_FILELOCK_DEBUG} || 0);
use constant FLOCK => !!($ENV{ACRUX_FILELOCK_FLOCK} || 0);

my $file = "test13.lock";
note "Current PID=$$";

subtest "Base call" => sub {
    my $l = Acrux::FileLock->new(file => $file, debug => DEBUG, flock => FLOCK);
    is $l->pid, $$, "$$ current process by default";

    # Lock
    ok !$l->lock->error, "$$ lock file" or diag $l->error;

    # Check
    ok $l->check, "$$ is locked";

    # Get owner uid
    if (my $owner_uid = $l->uid) {
        is $owner_uid, $>, "$$ owner uid" and note "owner uid = $owner_uid";

t/13-filelock.t view on Meta::CPAN


    # Check
    ok $l->check, "$$ is locked";

    # Lock again
    ok !$l->lock->error, "$$ lock file again" or diag $l->error;
};

subtest "Fork mode" => sub {

    # Parent process
    if (my $child = fork) {
        sleep 1;
        my $l = Acrux::FileLock->new(file => $file, auto => 1, flock => FLOCK);
        note sprintf "Parent PID: %s; Parent Owner PID: %s", $l->pid, $l->own;

        # Check
        ok $l->check, "$$ is locked";

        waitpid $child, 0;
        return;
    }

    # Child process
    else {
        my $l = Acrux::FileLock->new(file => $file, auto => 1, flock => FLOCK);
        unless ($l->check) {
           note sprintf "Start child process (Child PID: %s; Child Owner PID: %s)", $l->pid, $l->uid;
           sleep 3;
           note sprintf "Finish child process (Child PID: %s; Child Owner PID: %s)", $l->pid, $l->uid;
        }
        exit;
    }

};


done_testing;

1;

( run in 1.277 second using v1.01-cache-2.11-cpan-a49fcb8fa48 )