File Coverage

lib/IPC/SRLock/Base.pm

Criterion	Covered	Total	%
statement	54	54	100.0
branch	5	6	100.0
condition	7	9	100.0
subroutine	13	13	100.0
pod	1	1	100.0
total	80	83	100.0

package IPC::SRLock::Base;

use namespace::autoclean;

use Date::Format           qw( time2str );
use English                qw( -no_match_vars );
use File::DataClass::Types qw( Bool LoadableClass NonEmptySimpleStr
                               Num Object PositiveInt );
use IPC::SRLock::Utils     qw( Unspecified hash_from merge_attributes throw );
use Time::Elapsed          qw( elapsed );
use Time::HiRes            qw( usleep );
use Moo;

# Public attributes
has 'debug'       => is => 'ro',   isa => Bool, default => 0;

has 'log'         => is => 'lazy', isa => Object,
   builder        => sub { $_[ 0 ]->_null_class->new };

has 'name'        => is => 'ro',   isa => NonEmptySimpleStr, required => 1;

has 'nap_time'    => is => 'ro',   isa => Num, default => 0.1;

has 'patience'    => is => 'ro',   isa => PositiveInt, default => 0;

has 'time_out'    => is => 'ro',   isa => PositiveInt, default => 300;

# Private attributes
has '_null_class' => is => 'lazy', isa => LoadableClass,
   default        => 'Class::Null', init_arg => undef;

# Construction
around 'BUILDARGS' => sub {
   my ($orig, $self, @args) = @_; my $attr = $orig->( $self, @args );

   my $builder = $attr->{builder} or return $attr;

   merge_attributes $attr, $builder, [ 'debug', 'log' ];

   return $attr;
};

# Private methods
sub _get_args {
   my $self = shift; my $args = hash_from @_;

   $args->{k}  or throw Unspecified, [ 'key' ]; $args->{k} .= q();
   $args->{p} //= $PID; # uncoverable condition false
   $args->{t} //= $self->time_out; # uncoverable condition false

   return $args;
}

sub _sleep_or_timeout {
   my ($self, $start, $now, $key) = @_;

   $self->patience and $now > $start + $self->patience
      and throw 'Lock [_1] timed out', [ $key ];
   usleep( 1_000_000 * $self->nap_time );
   return 1;
}

sub _timeout_error {
   my ($self, $key, $pid, $when, $after) = @_;

   return "Timed out ${key} set by ${pid} on "
        . time2str( '%Y-%m-%d at %H:%M', $when )." after ${after} seconds\n";
}

# Public methods
sub get_table {
   my $self  = shift;
   my $count = 0;
   my $data  = { align  => { id    => 'left',
                             pid   => 'right',
                             stime => 'right',
                             tleft => 'right'},
                 count  => $count,
                 fields => [ qw( id pid stime tleft ) ],
                 hclass => { id    => 'most' },
                 labels => { id    => 'Key',
                             pid   => 'PID',
                             stime => 'Lock Time',
                             tleft => 'Time Left' },
                 values => [] };

   for my $lock (@{ $self->list }) {
      my $fields = {};

      $fields->{id   } = $lock->{key};
      $fields->{pid  } = $lock->{pid};
      $fields->{stime} = time2str( '%Y-%m-%d %H:%M:%S', $lock->{stime} );

      my $tleft = $lock->{stime} + $lock->{timeout} - time;

      # uncoverable branch false
      $fields->{tleft} = $tleft > 0 ? elapsed( $tleft ) : 'Expired';
      push @{ $data->{values} }, $fields; $count++;
   }

   $data->{count} = $count;
   return $data;
}

1;

__END__