File Coverage

blib/lib/XAS/Lib/Modules/Spool.pm
Criterion Covered Total %
statement 12 116 10.3
branch 0 18 0.0
condition n/a
subroutine 4 21 19.0
pod 7 7 100.0
total 23 162 14.2


line stmt bran cond sub pod time code
1             package XAS::Lib::Modules::Spool;
2              
3             our $VERSION = '0.03';
4              
5 1     1   754 use Try::Tiny;
  1         1  
  1         51  
6 1     1   4 use XAS::Factory;
  1         1  
  1         6  
7 1     1   53 use XAS::Constants 'LOCK_DRIVERS';
  1         1  
  1         17  
8              
9             use XAS::Class
10 1         13 debug => 0,
11             version => $VERSION,
12             base => 'XAS::Base',
13             mixin => 'XAS::Lib::Mixins::Handlers',
14             utils => ':validation dotid',
15             filesystem => 'Dir File',
16             accessors => 'lockmgr',
17             vars => {
18             PARAMS => {
19             -directory => { isa => 'Badger::Filesystem::Directory' },
20             -mask => { optional => 1, default => 0664 },
21             -lock => { optional => 1, default => undef },
22             -extension => { optional => 1, default => '.pkt' },
23             -seqfile => { optional => 1, default => '.SEQ' },
24             -driver => { optional => 1, default => 'Filesystem', regex => LOCK_DRIVERS },
25             }
26             }
27 1     1   115 ;
  1         2  
28              
29             #use Data::Dumper;
30              
31             # ------------------------------------------------------------------------
32             # Public Methods
33             # ------------------------------------------------------------------------
34              
35             sub read {
36 0     0 1   my $self = shift;
37 0           my ($filename) = validate_params(\@_, [
38             { isa => 'Badger::Filesystem::File' },
39             ]);
40              
41 0           my $packet;
42              
43 0 0         if ($self->lockmgr->lock($self->lock)) {
44              
45 0           $packet = $self->_read_packet($filename);
46 0           $self->lockmgr->unlock($self->lock);
47              
48             } else {
49              
50 0           $self->throw_msg(
51             dotid($self->class) . '.read.lock_error',
52             'lock_dir_error',
53             $self->directory->path
54             );
55              
56             }
57              
58 0           return $packet;
59              
60             }
61              
62             sub write {
63 0     0 1   my $self = shift;
64 0           my ($packet) = validate_params(\@_, [ 1 ]);
65              
66 0           my $seqnum;
67              
68 0 0         if ($self->lockmgr->lock($self->lock)) {
69              
70 0           $seqnum = $self->_sequence();
71              
72 0           $self->_write_packet($packet, $seqnum);
73 0           $self->lockmgr->unlock($self->lock);
74              
75             } else {
76              
77 0           $self->throw_msg(
78             dotid($self->class) . '.write.lock_error',
79             'lock_dir_error',
80             $self->directory->path
81             );
82              
83             }
84              
85 0           return 1;
86              
87             }
88              
89             sub scan {
90 0     0 1   my $self = shift;
91              
92 0           my @files;
93 0           my $regex = $self->extension;
94 0           my $pattern = qr/$regex/i;
95              
96 0 0         if ($self->lockmgr->lock($self->lock)) {
97              
98 0           @files = sort(grep( $_->path =~ $pattern, $self->directory->files() ));
99 0           $self->lockmgr->unlock($self->lock);
100              
101             } else {
102              
103 0           $self->throw_msg(
104             dotid($self->class) . '.scan.lock_error',
105             'lock_dir_error',
106             $self->directory->path
107             );
108              
109             }
110              
111 0           return @files;
112              
113             }
114              
115             sub delete {
116 0     0 1   my $self = shift;
117 0           my ($file) = validate_params(\@_, [
118             { isa => 'Badger::Filesystem::File' },
119             ]);
120              
121 0 0         if ($self->lockmgr->lock($self->lock)) {
122              
123 0           $file->delete;
124 0           $self->lockmgr->unlock($self->lock);
125              
126             } else {
127              
128 0           $self->throw_msg(
129             dotid($self->class) . '.delete.lock_error',
130             'lock_dir_error',
131             $self->directory->path
132             );
133              
134             }
135              
136             }
137              
138             sub count {
139 0     0 1   my $self = shift;
140              
141 0           my @files;
142             my $count;
143 0           my $regex = $self->extension;
144 0           my $pattern = qr/$regex/i;
145              
146 0 0         if ($self->lockmgr->lock($self->lock)) {
147              
148 0           @files = grep( $_->path =~ $pattern, $self->directory->files() );
149 0           $count = scalar(@files);
150              
151 0           $self->lockmgr->unlock($self->lock);
152              
153             } else {
154              
155 0           $self->throw_msg(
156             dotid($self->class) . '.count.lock_error',
157             'lock_dir_error',
158             $self->directory->path
159             );
160              
161             }
162              
163 0           return $count;
164              
165             }
166              
167             sub get {
168 0     0 1   my $self = shift;
169              
170 0           my @files;
171             my $filename;
172 0           my $pattern = qr/$self->extension/i;
173              
174 0 0         if ($self->lockmgr->lock($self->lock)) {
175              
176 0           @files = sort(grep( $_->path =~ /$pattern/, $self->directory->files() ));
177 0           $filename = $files[0];
178              
179 0           $self->lockmgr->unlock($self->lock);
180              
181             } else {
182              
183 0           $self->throw_msg(
184             dotid($self->class) . '.get.lock_error',
185             'lock_dir_error',
186             $self->directory->path
187             );
188              
189             }
190              
191 0           return $filename;
192              
193             }
194              
195             # ------------------------------------------------------------------------
196             # Private Methods
197             # ------------------------------------------------------------------------
198              
199             sub init {
200 0     0 1   my $class = shift;
201              
202 0           my $self = $class->SUPER::init(@_);
203              
204 0 0         unless (defined($self->{'lock'})) {
205              
206 0           $self->{'lock'} = Dir($self->env->locks, 'spool')->path;
207              
208             }
209              
210 0           $self->{'lockmgr'} = XAS::Factory->module('lockmgr');
211              
212 0           $self->lockmgr->add(
213             -key => $self->lock,
214             -driver => $self->driver,
215             );
216              
217 0           return $self;
218              
219             }
220              
221             sub _chmod {
222 0     0     my $self = shift;
223 0           my $file = shift;
224              
225 0           my $mask = $self->mask + 0;
226 0           my $cnt = chmod($mask, $file);
227              
228 0 0         if ($cnt < 1) {
229              
230 0           $self->throw_msg(
231             dotid($self->class) . '.chmod.invperms',
232             'invperms',
233             $file
234             );
235              
236             }
237              
238             }
239              
240             sub _sequence {
241 0     0     my $self = shift;
242              
243 0           my $fh;
244             my $seqnum;
245 0           my $file = File($self->directory, $self->seqfile);
246              
247             try {
248              
249 0 0   0     if ($file->exists) {
250              
251 0           $fh = $file->open("r+");
252 0           $seqnum = $fh->getline;
253 0           $seqnum++;
254 0           $fh->seek(0, 0);
255 0           $fh->print($seqnum);
256 0           $fh->close;
257              
258             } else {
259              
260 0           $fh = $file->open("w");
261 0           $fh->print("1");
262 0           $fh->close;
263              
264 0           $self->_chmod($file);
265              
266 0           $seqnum = 1;
267              
268             }
269              
270             } catch {
271              
272 0     0     my $ex = $_;
273              
274 0           $self->throw_msg(
275             dotid($self->class) . '.sequence',
276             'spooler_sequence',
277             $file
278             );
279              
280 0           };
281              
282 0           return $seqnum;
283              
284             }
285              
286             sub _write_packet {
287 0     0     my $self = shift;
288 0           my ($packet, $seqnum) = validate_params(\@_, [1,1]);
289              
290 0           my $fh;
291 0           my $file = File($self->directory, $seqnum . $self->extension);
292              
293             try {
294              
295 0     0     $fh = $file->open("w");
296 0           $fh->print($packet);
297 0           $fh->close;
298              
299 0           $self->_chmod($file->path);
300              
301             } catch {
302              
303 0     0     my $ex = $_;
304              
305 0           $self->throw_msg(
306             dotid($self->class) . '.write_packet',
307             'spooler_write_packet',
308             $file->path
309             );
310              
311 0           };
312              
313             }
314              
315             sub _read_packet {
316 0     0     my $self = shift;
317 0           my ($file) = validate_params(\@_, [
318             { isa => 'Badger::Filesystem::File' }
319             ]);
320              
321 0           my $fh;
322             my $packet;
323              
324             try {
325              
326 0     0     $fh = $file->open("r");
327 0           $packet = $fh->getline;
328 0           $fh->close;
329              
330             } catch {
331              
332 0     0     my $ex = $_;
333              
334 0           $self->throw_msg(
335             dotid($self->class) . '.read_packet',
336             'spooler_read_packet',
337             $file->path
338             );
339              
340 0           };
341              
342 0           return $packet;
343              
344             }
345              
346             1;
347              
348             __END__