Filename | /usr/local/lib/site_perl/Mutex/Flock.pm |
Statements | Executed 15 statements in 511µs |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 23µs | 140µs | BEGIN@71 | Mutex::Flock::
1 | 1 | 1 | 11µs | 14µs | BEGIN@2 | Mutex::Flock::
1 | 1 | 1 | 10µs | 14µs | BEGIN@3 | Mutex::Flock::
1 | 1 | 1 | 8µs | 97µs | BEGIN@72 | Mutex::Flock::
1 | 1 | 1 | 7µs | 41µs | BEGIN@70 | Mutex::Flock::
1 | 1 | 1 | 6µs | 23µs | BEGIN@80 | Mutex::Flock::
1 | 1 | 1 | 3µs | 3µs | BEGIN@79 | Mutex::Flock::
1 | 1 | 1 | 2µs | 2µs | END | Mutex::Flock::
0 | 0 | 0 | 0s | 0s | DESTROY | Mutex::Flock::
0 | 0 | 0 | 0s | 0s | lock | Mutex::Flock::
0 | 0 | 0 | 0s | 0s | new | Mutex::Flock::
0 | 0 | 0 | 0s | 0s | reopen | Mutex::Flock::
0 | 0 | 0 | 0s | 0s | unlock | Mutex::Flock::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Mutex::Flock; | ||||
2 | 2 | 21µs | 2 | 18µs | # spent 14µs (11+3) within Mutex::Flock::BEGIN@2 which was called:
# once (11µs+3µs) by Log::Writer::Handle::BEGIN@121 at line 2 # spent 14µs making 1 call to Mutex::Flock::BEGIN@2
# spent 3µs making 1 call to strict::import |
3 | 2 | 53µs | 2 | 19µs | # spent 14µs (10+5) within Mutex::Flock::BEGIN@3 which was called:
# once (10µs+5µs) by Log::Writer::Handle::BEGIN@121 at line 3 # spent 14µs making 1 call to Mutex::Flock::BEGIN@3
# spent 5µs making 1 call to warnings::import |
4 | |||||
5 | ################################################################################ | ||||
6 | # | ||||
7 | # DOCUMENTATION SECTION | ||||
8 | # | ||||
9 | ################################################################################ | ||||
10 | |||||
11 | =head1 NAME | ||||
12 | |||||
13 | Mutex::Flock - OO implementation of the exclusive lock | ||||
14 | |||||
15 | =head1 SYNOPSIS | ||||
16 | |||||
17 | use Mutex::Flock; | ||||
18 | |||||
19 | my $lock = new Mutex::Flock('./spool/test.lock'); | ||||
20 | |||||
21 | $lock->lock(); | ||||
22 | $lock->unlock(); | ||||
23 | |||||
24 | $lock->reopen(); | ||||
25 | |||||
26 | =head1 DESCRIPTION | ||||
27 | |||||
28 | Object oriented implementation of exclusive locks based on the flock() | ||||
29 | primitive. | ||||
30 | |||||
31 | =head1 USAGE | ||||
32 | |||||
33 | =head1 BUGS | ||||
34 | |||||
35 | =head1 SUPPORT | ||||
36 | |||||
37 | =head1 AUTHOR | ||||
38 | |||||
39 | Jan Mach | ||||
40 | Cesnet, z.s.p.o | ||||
41 | jan.mach@cesnet.cz | ||||
42 | http://www.cesnet.cz | ||||
43 | |||||
44 | =head1 COPYRIGHT | ||||
45 | |||||
46 | This program is free software; you can redistribute | ||||
47 | it and/or modify it under the same terms as Perl itself. | ||||
48 | |||||
49 | The full text of the license can be found in the | ||||
50 | LICENSE file included with this module. | ||||
51 | |||||
52 | |||||
53 | =head1 SEE ALSO | ||||
54 | |||||
55 | perl(1). | ||||
56 | |||||
57 | =head1 FUNCTION REFERENCE | ||||
58 | |||||
59 | =over 4 | ||||
60 | |||||
61 | =cut | ||||
62 | |||||
63 | ################################################################################ | ||||
64 | # | ||||
65 | # INITIALIZATION AND CLEANUP SECTION | ||||
66 | # | ||||
67 | ################################################################################ | ||||
68 | |||||
69 | #-- Perl core modules ---------------------------------------------------------# | ||||
70 | 2 | 22µs | 2 | 75µs | # spent 41µs (7+34) within Mutex::Flock::BEGIN@70 which was called:
# once (7µs+34µs) by Log::Writer::Handle::BEGIN@121 at line 70 # spent 41µs making 1 call to Mutex::Flock::BEGIN@70
# spent 34µs making 1 call to Exporter::import |
71 | 2 | 27µs | 2 | 256µs | # spent 140µs (23+117) within Mutex::Flock::BEGIN@71 which was called:
# once (23µs+117µs) by Log::Writer::Handle::BEGIN@121 at line 71 # spent 140µs making 1 call to Mutex::Flock::BEGIN@71
# spent 117µs making 1 call to Exporter::import |
72 | 2 | 32µs | 2 | 185µs | # spent 97µs (8+89) within Mutex::Flock::BEGIN@72 which was called:
# once (8µs+89µs) by Log::Writer::Handle::BEGIN@121 at line 72 # spent 97µs making 1 call to Mutex::Flock::BEGIN@72
# spent 89µs making 1 call to Exporter::import |
73 | |||||
74 | #-- Perl CPAN modules ---------------------------------------------------------# | ||||
75 | |||||
76 | #-- Custom application modules ------------------------------------------------# | ||||
77 | |||||
78 | #-- Module initializations ----------------------------------------------------# | ||||
79 | # spent 3µs within Mutex::Flock::BEGIN@79 which was called:
# once (3µs+0s) by Log::Writer::Handle::BEGIN@121 at line 82 | ||||
80 | 2 | 23µs | 2 | 40µs | # spent 23µs (6+17) within Mutex::Flock::BEGIN@80 which was called:
# once (6µs+17µs) by Log::Writer::Handle::BEGIN@121 at line 80 # spent 23µs making 1 call to Mutex::Flock::BEGIN@80
# spent 17µs making 1 call to vars::import |
81 | 1 | 3µs | $VERSION = '0.01'; | ||
82 | 1 | 325µs | 1 | 3µs | } # spent 3µs making 1 call to Mutex::Flock::BEGIN@79 |
83 | |||||
84 | |||||
85 | #-- Module clean-up code (global destructor) ----------------------------------# | ||||
86 | 1 | 2µs | # spent 2µs within Mutex::Flock::END which was called:
# once (2µs+0s) by main::RUNTIME at line 0 of mentat.storage.mongo.pl | ||
87 | |||||
88 | } | ||||
89 | |||||
90 | ################################################################################ | ||||
91 | # | ||||
92 | # CONSTANTS AND GLOBAL VARIABLES DEFINITION SECTION | ||||
93 | # | ||||
94 | ################################################################################ | ||||
95 | |||||
96 | #-- Constants -----------------------------------------------------------------# | ||||
97 | |||||
98 | #-- Static public class variables (our) ---------------------------------------# | ||||
99 | |||||
100 | #-- Static protected class variables (my) -------------------------------------# | ||||
101 | |||||
102 | ################################################################################ | ||||
103 | # | ||||
104 | # IMPLEMENTATION SECTION | ||||
105 | # | ||||
106 | ################################################################################ | ||||
107 | |||||
108 | =item new() [PUBLIC, STATIC] | ||||
109 | |||||
110 | Usage : my $lock = Mutex::Flock->new('./spool/test.lock'); | ||||
111 | Purpose : Create new exclusive lock | ||||
112 | Returns : Create new instance of exclusive lock | ||||
113 | Arguments : string $lock_file_name - name of the lock file | ||||
114 | Throws : Croaks, if invoked on object or invalid arguments given | ||||
115 | Comments : Internally uses reopen() method | ||||
116 | See Also : reopen() method | ||||
117 | |||||
118 | =cut | ||||
119 | |||||
120 | sub new | ||||
121 | { | ||||
122 | my $class = shift; | ||||
123 | croak ((caller(0))[3] . ": class method invoked on object") if ref $class; | ||||
124 | my ($lock_file_name,) = @_; | ||||
125 | croak ((caller(0))[3] . ": invalid arguments") unless $lock_file_name; | ||||
126 | |||||
127 | my $self = bless ({}, $class); | ||||
128 | $self->{LOCK_FILE_NAME} = $lock_file_name; | ||||
129 | $self->reopen(); | ||||
130 | return $self; | ||||
131 | } | ||||
132 | |||||
133 | =item DESTROY [PUBLIC] | ||||
134 | |||||
135 | Usage : | ||||
136 | Purpose : Close opened lock file handle | ||||
137 | Returns : | ||||
138 | Arguments : | ||||
139 | Throws : | ||||
140 | Comments : | ||||
141 | See Also : | ||||
142 | |||||
143 | =cut | ||||
144 | |||||
145 | sub DESTROY { | ||||
146 | my $self = shift; | ||||
147 | close($self->{LOCK_HANDLE}) if $self->{LOCK_HANDLE}; | ||||
148 | } | ||||
149 | |||||
150 | =item reopen() [PUBLIC] | ||||
151 | |||||
152 | Usage : $lock->reopen(); | ||||
153 | Purpose : Reopen the lock file | ||||
154 | Returns : Nothing | ||||
155 | Arguments : None | ||||
156 | Throws : Croaks, if invoked on class | ||||
157 | Comments : | ||||
158 | See Also : | ||||
159 | |||||
160 | =cut | ||||
161 | |||||
162 | sub reopen() { | ||||
163 | my $self = shift; | ||||
164 | croak ((caller(0))[3] . ": instance method invoked on class") unless ref $self; | ||||
165 | $self->{LOCK_HANDLE} = IO::File->new($self->{LOCK_FILE_NAME},'w') or die "Can't open lock file '$self->{LOCK_FILE_NAME}': $!\n"; | ||||
166 | } | ||||
167 | |||||
168 | =item lock() [PUBLIC] | ||||
169 | |||||
170 | Usage : $lock->lock(); | ||||
171 | Purpose : Lock the exclusive lock | ||||
172 | Returns : Nothing | ||||
173 | Arguments : None | ||||
174 | Throws : Croaks, if invoked on class | ||||
175 | Comments : | ||||
176 | See Also : | ||||
177 | |||||
178 | =cut | ||||
179 | |||||
180 | sub lock() { | ||||
181 | my $self = shift; | ||||
182 | croak ((caller(0))[3] . ": instance method invoked on class") unless ref $self; | ||||
183 | flock($self->{LOCK_HANDLE}, LOCK_EX) or die "Can't lock lock file '$self->{LOCK_FILE_NAME}': $!\n"; | ||||
184 | } | ||||
185 | |||||
186 | =item unlock() [PROTECTED] | ||||
187 | |||||
188 | Usage : $lock->unlock(); | ||||
189 | Purpose : Unlock the exclusive lock | ||||
190 | Returns : Nothing | ||||
191 | Arguments : None | ||||
192 | Throws : Croaks, if invoked on class | ||||
193 | Comments : | ||||
194 | See Also : | ||||
195 | |||||
196 | =cut | ||||
197 | |||||
198 | sub unlock() { | ||||
199 | my $self = shift; | ||||
200 | croak ((caller(0))[3] . ": instance method invoked on class") unless ref $self; | ||||
201 | flock($self->{LOCK_HANDLE}, LOCK_UN) or die "Can't unlock lock file '$self->{LOCK_FILE_NAME}': $!\n"; | ||||
202 | } | ||||
203 | |||||
204 | =pod | ||||
205 | |||||
206 | =back | ||||
207 | |||||
208 | =cut | ||||
209 | |||||
210 | 1 | 2µs | 1; |