File Coverage

blib/lib/Eixo/Queue/SocketPairDriver.pm
Criterion Covered Total %
statement 35 38 92.1
branch 2 2 100.0
condition n/a
subroutine 11 12 91.6
pod 0 5 0.0
total 48 57 84.2


line stmt bran cond sub pod time code
1             package Eixo::Queue::SocketPairDriver;
2              
3 1     1   4 use strict;
  1         1  
  1         22  
4 1     1   3 use Eixo::Base::Clase;
  1         13  
  1         4  
5              
6 1     1   58 use Socket;
  1         1  
  1         361  
7 1     1   3 use IO::Handle;
  1         1  
  1         26  
8 1     1   6 use IO::Select;
  1         12  
  1         256  
9              
10             has(
11              
12             a=>undef,
13             b=>undef,
14              
15             t=>undef,
16             );
17              
18             sub DESTROY{
19              
20 3 100   3   1142 close $_[0]->{t} if($_[0]->{t});
21             }
22              
23             sub open{
24              
25 3     3 0 2 my ($a, $b);
26              
27 3         71 socketpair($a, $b, AF_UNIX, SOCK_STREAM, PF_UNSPEC);
28              
29 3         10 $a->autoflush(1);
30 3         77 $b->autoflush(1);
31            
32 3         54 return __PACKAGE__->new(
33              
34             a=>$a,
35              
36             b=>$b,
37              
38             );
39            
40             }
41              
42             sub send{
43 1000     1000 0 1124 my ($self, $message) = @_;
44            
45 1000         1352 my $s = $self->{t};
46              
47 1000         1104 chomp($message);
48              
49 1000         1150 $message .= "\n";
50              
51 1000         97747 print $s $message;
52              
53             }
54              
55             sub receive{
56 1000     1000 0 3229 my ($self) = @_;
57              
58 1000         933 my $s = $self->{t};
59              
60 1000         20274 my $ret = <$s>;
61              
62 1000         2085 $ret;
63             }
64              
65              
66             sub A{
67 2     2 0 8 my ($self) = @_;
68              
69 2         30 close $self->{b};
70              
71 2         21 $self->__prepare($self->a);
72             }
73              
74             sub B{
75 0     0 0 0 my ($self) = @_;
76              
77 0         0 close $self->{a};
78              
79 0         0 $self->__prepare($self->b);
80             }
81              
82             sub __prepare{
83 2     2   24 my ($self, $i) = @_;
84              
85 2         6 $self->{t} = $i;
86              
87             }
88              
89             1;