File Coverage

blib/lib/Gearman/ResponseParser/Taskset.pm
Criterion Covered Total %
statement 26 28 92.8
branch 2 2 100.0
condition 2 3 66.6
subroutine 8 9 88.8
pod 2 3 66.6
total 40 45 88.8


line stmt bran cond sub pod time code
1             package Gearman::ResponseParser::Taskset;
2 7     7   23 use version;
  7         9  
  7         30  
3             $Gearman::ResponseParser::Taskset::VERSION = qv("2.001_001");
4              
5 7     7   458 use strict;
  7         7  
  7         112  
6 7     7   19 use warnings;
  7         7  
  7         144  
7              
8 7     7   23 use base "Gearman::ResponseParser";
  7         7  
  7         2363  
9 7     7   31 use Carp ();
  7         8  
  7         79  
10 7     7   21 use Scalar::Util ();
  7         7  
  7         884  
11              
12             =head1 NAME
13              
14             Gearman::ResponseParser::Taskset - gearmand response parser implementation
15              
16             =head1 DESCRIPTION
17              
18              
19             derived from L
20              
21             =head1 METHODS
22              
23             =cut
24              
25             sub new {
26 2     2 0 489 my ($class, %opts) = @_;
27 2         2 my $ts = delete $opts{taskset};
28 2 100 66     31 (Scalar::Util::blessed($ts) && $ts->isa("Gearman::Taskset"))
29             || Carp::croak
30             "provided taskset argument is not a Gearman::Taskset reference";
31              
32 1         8 my $self = $class->SUPER::new(%opts);
33 1         2 $self->{_taskset} = $ts;
34 1         2 return $self;
35             } ## end sub new
36              
37             =head2 on_packet($packet, $parser)
38              
39             provide C<$packet> to L process_packet
40              
41             =cut
42              
43             sub on_packet {
44 0     0 1 0 my ($self, $packet, $parser) = @_;
45 0         0 $self->{_taskset}->process_packet($packet, $parser->source);
46             }
47              
48             =head2 on_error($msg)
49              
50             die C<$msg>
51              
52             =cut
53              
54             sub on_error {
55 1     1 1 251 my ($self, $errmsg) = @_;
56 1         7 die "ERROR: $errmsg\n";
57             }
58              
59             1;