File Coverage

lib/Class/Usul/Lock.pm
Criterion Covered Total %
statement 33 33 100.0
branch 1 2 50.0
condition n/a
subroutine 10 10 100.0
pod 3 3 100.0
total 47 48 97.9


line stmt bran cond sub pod time code
1             package Class::Usul::Lock;
2              
3 1     1   1303 use namespace::autoclean;
  1         14220  
  1         4  
4              
5 1     1   396 use Class::Usul::Constants qw( COMMA OK );
  1         3  
  1         8  
6 1     1   1089 use Class::Usul::Functions qw( emit );
  1         4  
  1         9  
7 1     1   1436 use Class::Usul::Time qw( time2str );
  1         3  
  1         50  
8 1     1   419 use Class::Usul::Types qw( Int Str );
  1         4  
  1         12  
9 1     1   1220 use Moo;
  1         2  
  1         9  
10 1     1   767 use Class::Usul::Options;
  1         3  
  1         6  
11              
12             extends q(Class::Usul::Programs);
13              
14             option 'lock_key' => is => 'ro', isa => Str, format => 's',
15             documentation => 'Key used to set/reset a lock',
16             short => 'k';
17              
18             option 'lock_pid' => is => 'ro', isa => Int, format => 'i',
19             documentation => 'Process id associated with a lock. Defaults to $$',
20             short => 'p';
21              
22             option 'lock_timeout' => is => 'ro', isa => Int, format => 'i',
23             documentation => 'Timeout in secounds before a lock is declared stale',
24             short => 't';
25              
26             sub list : method {
27 2     2 1 2303 my $self = shift;
28              
29 2 50       3 for my $ref (@{ $self->lock->list || [] }) {
  2         45  
30 1         2232 my $stime = time2str '%Y-%m-%d %H:%M:%S', $ref->{stime};
31              
32 1         186 emit join COMMA, $ref->{key}, $ref->{pid}, $stime, $ref->{timeout};
33             }
34              
35 2         2109 return OK;
36             }
37              
38             sub reset : method {
39 1     1 1 1596 my $self = shift; $self->lock->reset( k => $self->lock_key ); return OK;
  1         29  
  1         3319  
40             }
41              
42             sub set : method {
43 1     1 1 8 my $self = shift;
44              
45 1         22 $self->lock->set( k => $self->lock_key,
46             p => $self->lock_pid,
47             t => $self->lock_timeout );
48 1         17 return OK;
49             }
50              
51             1;
52              
53             __END__
54              
55             =pod
56              
57             =encoding utf-8
58              
59             =head1 Name
60              
61             Class::Usul::Lock - Command line access to the L<IPC::SRLock> methods
62              
63             =head1 Synopsis
64              
65             use Class::Usul::Lock;
66              
67             my $app = Class::Usul::Lock->new_with_options( appclass => 'YourApp' );
68              
69             $app->quiet( 1 );
70              
71             exit $app->run;
72              
73             =head1 Description
74              
75             Command line access to the L<IPC::SRLock> methods
76              
77             =head1 Configuration and Environment
78              
79             Defines the following attributes;
80              
81             =over 3
82              
83             =item lock_key
84              
85             String which is the key used to set/reset a lock. Set from the command line
86             with the C<k> switch
87              
88             =item lock_pid
89              
90             Integer which is the process id associated with a lock. Defaults to
91             C<$PID>. Set from the command line with the C<p> switch
92              
93             =item lock_timeout
94              
95             Integer which is the timeout in seconds before a lock is declared
96             stale. Defaults to five minutes. Set from the command line with the
97             C<t> switch
98              
99             =back
100              
101             =head1 Subroutines/Methods
102              
103             =head2 list - Lists the locks in the lock table
104              
105             Output is comma separated
106              
107             =head2 reset - Resets the specified lock
108              
109             Resets the lock keyed by the C<lock_key> attribute
110              
111             =head2 set - Sets the specified lock
112              
113             Set the lock keyed by the I<lock_key> attribute. Optionally use the
114             C<lock_pid> and C<lock_timeout> attributes
115              
116             =head1 Diagnostics
117              
118             None
119              
120             =head1 Dependencies
121              
122             =over 3
123              
124             =item L<Class::Usul::Programs>
125              
126             =item L<Class::Usul::Time>
127              
128             =item L<Moo>
129              
130             =back
131              
132             =head1 Incompatibilities
133              
134             There are no known incompatibilities in this module
135              
136             =head1 Bugs and Limitations
137              
138             There are no known bugs in this module.
139             Please report problems to the address below.
140             Patches are welcome
141              
142             =head1 Acknowledgements
143              
144             Larry Wall - For the Perl programming language
145              
146             =head1 Author
147              
148             Peter Flanigan, C<< <pjfl@cpan.org> >>
149              
150             =head1 License and Copyright
151              
152             Copyright (c) 2017 Peter Flanigan. All rights reserved
153              
154             This program is free software; you can redistribute it and/or modify it
155             under the same terms as Perl itself. See L<perlartistic>
156              
157             This program is distributed in the hope that it will be useful,
158             but WITHOUT WARRANTY; without even the implied warranty of
159             MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE
160              
161             =cut
162              
163             # Local Variables:
164             # mode: perl
165             # tab-width: 3
166             # End: