File Coverage

blib/lib/IPC/Queue/Duplex/Job.pm
Criterion Covered Total %
statement 25 28 89.2
branch 1 2 50.0
condition n/a
subroutine 4 5 80.0
pod 4 4 100.0
total 34 39 87.1


line stmt bran cond sub pod time code
1             # -*-cperl-*-
2             #
3             # IPC::Queue::Duplex::Job - An IPC::Queue::Duplex job
4             # Copyright (c) Ashish Gulhati
5             #
6             # $Id: lib/IPC/Queue/Duplex/Job.pm v1.009 Tue Oct 16 21:48:32 PDT 2018 $
7              
8             package IPC::Queue::Duplex::Job;
9              
10 3     3   1242 use Time::HiRes qw(usleep);
  3         3328  
  3         11  
11              
12             sub new {
13 0     0 1 0 my ($class, %args) = @_;
14 0         0 bless { %args }, $class;
15             }
16              
17             sub finish {
18 9     9 1 168 my ($self, $result) = @_;
19 9         23 my $filefin = $self->{File}; $filefin =~ s/\.wrk/.fin/;
  9         51  
20 9         508 open (RESULT, ">$self->{File}");
21 9         79 print RESULT "$result\n";
22 9         554 close RESULT;
23 9         444 rename $self->{File}, $filefin;
24             }
25              
26             sub response {
27 9     9 1 3914 my $self = shift;
28 9         35 my $filefin = my $fileiqd = $self->{File}; $filefin =~ s/\.job/.fin/; $fileiqd =~ s/\.job/.iqd/;
  9         38  
  9         26  
29 9         166 while (!-f $filefin) {
30 4         40463 usleep 10000;
31             }
32 9         2522 open (RESPONSE, $filefin);
33 9         140 my $response = ;
34 9         72 close $filefin;
35 9 50       24 if ($response) {
36 9         245 unlink $filefin; unlink $fileiqd;
  9         127  
37 9         25 chomp $response;
38 9         43 return $response;
39             }
40             else {
41 0         0 print STDERR "DEBUG: $filefin\n";
42             }
43             }
44              
45             sub delete {
46 1     1 1 96 unlink shift->{File};
47             }
48              
49             1; # End of IPC::Queue::Duplex
50              
51             =head1 NAME
52              
53             IPC::Queue::Duplex::Job - An IPC::Queue::Duplex job
54              
55             =head1 VERSION
56              
57             $Revision: 1.009 $
58             $Date: Tue Oct 16 21:48:32 PDT 2018 $
59              
60             =head1 SYNOPSIS
61              
62             (Enqueuer)
63              
64             use IPC::Queue::Duplex;
65              
66             my $client = new IPC::Queue::Duplex (Dir => $dir);
67             my $job = $client->add($jobstr);
68             my $response = $job->response;
69              
70             (Worker)
71              
72             use IPC::Queue::Duplex;
73              
74             my $server = new IPC::Queue::Duplex (Dir => $dir);
75             my $job = $server->get:
76             process_job($job);
77             $job->finish($result);
78              
79             =head1 METHODS
80              
81             =head2 new
82              
83             Not intended to be called directly. Use an IPC::Queue::Duplex object
84             to create jobs.
85              
86             =head2 finish
87              
88             A job worker calls this method with a single argument, a string
89             containing the result of the job. This marks the job finished and
90             returns the result to the requester.
91              
92             =head2 response
93              
94             A requester calls this method with no arguments after placing a job on
95             the queue. It returns the result of the job when it's available.
96              
97             =head2 delete
98              
99             Deletes this job from the queue. No arguments.
100              
101             =head1 AUTHOR
102              
103             Ashish Gulhati, C<< >>
104              
105             =head1 BUGS
106              
107             Please report any bugs or feature requests to C, or through
108             the web interface at L. I will be notified, and then you'll
109             automatically be notified of progress on your bug as I make changes.
110              
111             =head1 SUPPORT
112              
113             You can find documentation for this module with the perldoc command.
114              
115             perldoc IPC::Queue::Duplex::Job
116              
117             You can also look for information at:
118              
119             =over 4
120              
121             =item * RT: CPAN's request tracker
122              
123             L
124              
125             =item * AnnoCPAN: Annotated CPAN documentation
126              
127             L
128              
129             =item * CPAN Ratings
130              
131             L
132              
133             =item * Search CPAN
134              
135             L
136              
137             =back
138              
139             =head1 LICENSE AND COPYRIGHT
140              
141             Copyright (c) Ashish Gulhati.
142              
143             This software package is Open Software; you can use, redistribute,
144             and/or modify it under the terms of the Open Artistic License 2.0.
145              
146             Please see L for the full license
147             terms, and ensure that the license grant applies to you before using
148             or modifying this software. By using or modifying this software, you
149             indicate your agreement with the license terms.