File Coverage

blib/lib/FCGI/Client/Connection.pm
Criterion Covered Total %
statement 21 78 26.9
branch 0 26 0.0
condition 0 5 0.0
subroutine 7 14 50.0
pod 1 1 100.0
total 29 124 23.3


line stmt bran cond sub pod time code
1             package FCGI::Client::Connection;
2 1     1   2629 use Any::Moose;
  1         100591  
  1         7  
3 1     1   3875 use FCGI::Client::Constant;
  1         3  
  1         6  
4 1     1   1152 use Time::HiRes qw(time);
  1         2209  
  1         7  
5 1     1   229 use List::Util qw(max);
  1         3  
  1         142  
6 1     1   1043 use POSIX qw(EAGAIN);
  1         8269  
  1         7  
7 1     1   23187 use FCGI::Client::Record;
  1         105  
  1         41  
8 1     1   1670 use FCGI::Client::RecordFactory;
  1         5  
  1         1066  
9              
10             has sock => (
11             is => 'ro',
12             required => 1,
13             );
14              
15             has timeout => (
16             is => 'rw',
17             isa => 'Int',
18             default => 10,
19             );
20              
21             sub request {
22 0     0 1   my ($self, $env, $content) = @_;
23 0           local $SIG{PIPE} = "IGNORE";
24             {
25 0     0     local $SIG{ALRM} = sub { Carp::confess('REQUEST_TIME_OUT') };
  0            
  0            
26 0   0       my $orig_alarm = alarm($self->timeout) || 0;
27 0           $self->_send_request($env, $content);
28 0           my @res = $self->_receive_response($self->sock);
29 0           alarm($orig_alarm);
30 0           return @res;
31             }
32             }
33              
34             sub _receive_response {
35 0     0     my ($self, $sock) = @_;
36 0           my ($stdout, $stderr);
37 0           while (my $res = $self->_read_record($self)) {
38 0           my $type = $res->type;
39 0 0         if ($type == FCGI_STDOUT) {
    0          
    0          
40 0           $stdout .= $res->content;
41             } elsif ($type == FCGI_STDERR) {
42 0           $stderr .= $res->content;
43             } elsif ($type == FCGI_END_REQUEST) {
44 0           my $appstatus = unpack('N', $res->content);
45 0           $sock->close();
46 0           return ($stdout, $stderr, $appstatus);
47             } else {
48 0           die "unknown response type: " . $res->type;
49             }
50             }
51 0           die 'connection breaked from server process?';
52             }
53             sub _send_request {
54 0     0     my ($self, $env, $content) = @_;
55 0           my $reqid = 1;
56 0           $self->sock->print(FCGI::Client::RecordFactory->create_request($reqid, $env, $content));
57             }
58              
59             sub _read_record {
60 0     0     my ($self) = @_;
61 0           my $header_raw = '';
62 0           while (length($header_raw) != FCGI_HEADER_LEN) {
63 0 0         $self->_read_timeout(\$header_raw, FCGI_HEADER_LEN-length($header_raw), length($header_raw)) or return;
64             }
65 0           my $header = FCGI::Client::RecordHeader->new(raw => $header_raw);
66 0           my $content_length = $header->content_length;
67 0           my $content = '';
68 0 0         if ($content_length != 0) {
69 0           while (length($content) != $content_length) {
70 0 0         $self->_read_timeout(\$content, $content_length-length($content), length($content)) or return;
71             }
72             }
73 0           my $padding_length = $header->padding_length;
74 0           my $padding = '';
75 0 0         if ($padding_length != 0) {
76 0           while (length($padding) != $padding_length) {
77 0 0         $self->_read_timeout(\$padding, $padding_length, 0) or return;
78             }
79             }
80 0           return FCGI::Client::Record->new(
81             header => $header,
82             content => $content,
83             );
84             }
85              
86             # returns 1 if socket is ready, undef on timeout
87             sub _wait_socket {
88 0     0     my ( $self, $sock, $is_write, $wait_until ) = @_;
89 0           do {
90 0           my $vec = '';
91 0           vec( $vec, $sock->fileno, 1 ) = 1;
92 0 0         if (
    0          
    0          
93             select(
94             $is_write ? undef : $vec,
95             $is_write ? $vec : undef,
96             undef,
97             max( $wait_until - time, 0 )
98             ) > 0
99             )
100             {
101 0           return 1;
102             }
103             } while ( time < $wait_until );
104 0           return;
105             }
106              
107             # returns (positive) number of bytes read, or undef if the socket is to be closed
108             sub _read_timeout {
109 0     0     my ( $self, $buf, $len, $off, ) = @_;
110 0           my $sock = $self->sock;
111 0           my $timeout = $self->timeout;
112 0           my $wait_until = time + $timeout;
113 0           while ( $self->_wait_socket( $sock, undef, $wait_until ) ) {
114 0 0 0       if ( my $ret = $sock->sysread( $$buf, $len, $off ) ) {
    0          
115 0           return $ret;
116             }
117             elsif ( !( !defined($ret) && $! == EAGAIN ) ) {
118 0           last;
119             }
120             }
121 0           return;
122             }
123              
124             1;
125             __END__