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) 2017 Ashish Gulhati
5             #
6             # $Id$
7              
8             package IPC::Queue::Duplex::Job;
9              
10 3     3   1230 use Time::HiRes qw(usleep);
  3         3218  
  3         13  
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 263 my ($self, $result) = @_;
19 9         34 my $filefin = $self->{File}; $filefin =~ s/\.wrk/.fin/;
  9         62  
20 9         617 open (RESULT, ">$self->{File}");
21 9         93 print RESULT "$result\n";
22 9         301 close RESULT;
23 9         739 rename $self->{File}, $filefin;
24             }
25              
26             sub response {
27 9     9 1 7442 my $self = shift;
28 9         33 my $filefin = my $fileiqd = $self->{File}; $filefin =~ s/\.job/.fin/; $fileiqd =~ s/\.job/.iqd/;
  9         57  
  9         40  
29 9         431 while (!-f $filefin) {
30 1         10661 usleep 10000;
31             }
32 9         759 open (RESPONSE, $filefin);
33 9         208 my $response = ;
34 9         104 close $filefin;
35 9 50       44 if ($response) {
36 9         5314 unlink $filefin; unlink $fileiqd;
  9         586  
37 9         41 chomp $response;
38 9         67 return $response;
39             }
40             else {
41 0         0 print STDERR "DEBUG: $filefin\n";
42             }
43             }
44              
45             sub delete {
46 1     1 1 108 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.003 $
58             $Date: Sat May 6 17:13:44 PDT 2017 $
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) 2017 Ashish Gulhati.
142              
143             This program is free software; you can redistribute it and/or modify it
144             under the terms of the Artistic License 2.0.
145              
146             See L for the full
147             license terms.