File Coverage

blib/lib/XAS/Lib/Pipe/Unix.pm
Criterion Covered Total %
statement 12 44 27.2
branch 0 10 0.0
condition n/a
subroutine 4 9 44.4
pod 0 1 0.0
total 16 64 25.0


line stmt bran cond sub pod time code
1             package XAS::Lib::Pipe::Unix;
2              
3             our $VERSION = '0.01';
4              
5 1     1   727 use POE;
  1         2  
  1         4  
6 1     1   197 use POE::Filter::Line;
  1         1  
  1         14  
7 1     1   2 use POE::Wheel::ReadWrite;
  1         1  
  1         29  
8              
9             use XAS::Class
10 1         7 debug => 0,
11             version => $VERSION,
12             base => 'XAS::Base',
13             utils => 'trim dotid',
14             mixins => 'init_pipe _pipe_connect _pipe_input _pipe_output _pipe_error'
15 1     1   3 ;
  1         1  
16              
17             #use Data::Dumper;
18              
19             # ----------------------------------------------------------------------
20             # Public Methods
21             # ----------------------------------------------------------------------
22              
23             # ----------------------------------------------------------------------
24             # Public Events
25             # ----------------------------------------------------------------------
26              
27             # ----------------------------------------------------------------------
28             # Private Events
29             # ----------------------------------------------------------------------
30              
31             sub _pipe_connect {
32 0     0     my ($self) = $_[OBJECT];
33              
34 0           my $alias = $self->alias;
35              
36 0           $self->log->debug("$alias: _pipe_connect()");
37              
38             # Start listening on the pipe.
39              
40 0           $self->{'pipe'} = POE::Wheel::ReadWrite->new(
41             Handle => $self->fifo->open('r+'),
42             Filter => $self->filter,
43             InputEvent => 'pipe_input',
44             ErrorEvent => 'pipe_error'
45             );
46              
47             }
48              
49             sub _pipe_input {
50 0     0     my ($self, $input) = @_[OBJECT,ARG0];
51              
52 0           my $alias = $self->alias;
53              
54 0           $self->log->debug("$alias: _pipe_input()");
55              
56 0           $poe_kernel->post($alias, 'process_input', $input);
57              
58             }
59              
60             sub _pipe_output {
61 0     0     my ($self, $output) = @_[OBJECT,ARG0];
62              
63 0           my @buffer;
64 0           my $alias = $self->alias;
65              
66 0           $self->log->debug("$alias: _pipe_output()");
67              
68 0 0         if (my $wheel = $self->pipe) {
69              
70 0           push(@buffer, $output);
71 0           $wheel->put(@buffer);
72              
73             } else {
74              
75 0           $self->log->error_msg('net_client_nowheel', $alias);
76              
77             }
78              
79             }
80              
81             sub _pipe_error {
82 0     0     my ($self, $syscall, $errnum, $errstr) = @_[OBJECT,ARG0 .. ARG2];
83              
84 0           my $alias = $self->alias;
85              
86 0           $self->log->debug("$alias: _pipe_error()");
87 0           $self->log->debug(sprintf("%s: syscall: %s, errnum: %s, errstr: %s", $alias, $syscall, $errnum, $errstr));
88              
89 0 0         if ($errnum == 0) {
90              
91             # EOF detected.
92              
93 0           $self->log->info_msg('net_client_disconnect', $alias, 'localhost', $self->fifo);
94              
95 0           $poe_kernel->post($alias, 'session_shutdown');
96              
97             } else {
98              
99 0           $poe_kernel->post($alias, 'process_error', $syscall, $errnum, $errstr);
100              
101             }
102              
103             }
104              
105             # ----------------------------------------------------------------------
106             # Private Methods
107             # ----------------------------------------------------------------------
108              
109             sub init_pipe {
110 0     0 0   my $self = shift;
111              
112 0           my $alias = $self->alias;
113 0           my $mkfifo = '/usr/bin/mkfifo -m 666 ';
114              
115 0 0         unless (-p $self->fifo->path) {
116              
117 0 0         system($mkfifo . $self->fifo) && $self->throw_msg(
118             dotid($self->class) . '.nofifo',
119             'net_client_nocreate_fifo',
120             $self->fifo, $!
121             );
122              
123 0           $self->log->info_msg('net_client_create_fifo', $alias, $self->fifo);
124            
125             }
126              
127 0 0         unless (defined($self->filter)) {
128              
129 0           $self->{'filter'} = POE::Filter::Line->new(
130             InputLiteral => $self->eol,
131             OutputLiteral => $self->eol
132             );
133              
134             }
135              
136             }
137              
138             1;
139              
140             __END__