File Coverage

blib/lib/FCGI/Client/RecordFactory.pm
Criterion Covered Total %
statement 9 47 19.1
branch 0 8 0.0
condition 0 2 0.0
subroutine 3 9 33.3
pod 4 5 80.0
total 16 71 22.5


line stmt bran cond sub pod time code
1             package FCGI::Client::RecordFactory;
2 1     1   8 use strict;
  1         3  
  1         33  
3 1     1   7 use warnings;
  1         2  
  1         34  
4 1     1   6 use FCGI::Client::Constant;
  1         3  
  1         9  
5              
6             sub create_request {
7 0     0 1   my ($self, $reqid, $env, $content) = @_;
8 0           my $factory = __PACKAGE__;
9 0           my $flags = 0;
10 0 0         return join('',
11             $factory->build_begin_request($reqid, FCGI_RESPONDER, $flags),
12             $factory->build_params($reqid, %$env),
13             $factory->build_params($reqid),
14             ($content ? $factory->build_stdin($reqid, $content) : ''),
15             $factory->build_stdin($reqid, ''),
16             );
17             }
18              
19             # generate generic record
20             sub build_base {
21 0     0 0   my ($class, $type, $request_id, $content) = @_;
22             # 0 unsigned char version;
23             # 1 unsigned char type;
24             # 2 unsigned char requestIdB1; <= (B1<<8)+B0, network byte order
25             # 3 unsigned char requestIdB0;
26             # 4 unsigned char contentLengthB1;
27             # 5 unsigned char contentLengthB0;
28             # 6 unsigned char paddingLength;
29             # 7 unsigned char reserved;
30             # unsigned char contentData[contentLength];
31             # unsigned char paddingData[paddingLength];
32             #
33             # n => An unsigned short (16−bit) in "network" (big−endian) order.
34             # C => An unsigned char (octet) value.
35             my $build_record = sub {
36 0     0     my $in = $_[0];
37 0           pack('CCnnCC',
38             FCGI_VERSION_1,
39             $type,
40             $request_id,
41             length($in),
42             0,
43             0,
44             ) . $in
45 0           };
46 0 0         if (length($content) > 0) {
47 0           my $buf = '';
48 0           while( length( $content ) > 65535 ) {
49 0           $buf .= $build_record->( substr( $content, 0, 65535 ) );
50 0           $content = substr( $content, 65535 );
51             }
52 0           $buf .= $build_record->($content);
53 0           return $buf;
54             } else {
55 0           return $build_record->('');
56             }
57             }
58              
59             # generate FCGI_BEGIN_REQUEST record
60             sub build_begin_request {
61 0     0 1   my ($class, $request_id, $role, $flags) = @_;
62             # typedef struct {
63             # unsigned char roleB1;
64             # unsigned char roleB0;
65             # unsigned char flags;
66             # unsigned char reserved[5];
67             # } FCGI_BeginRequestBody;
68 0           my $content = pack(
69             'nCCCCCC',
70             $role,
71             $flags,
72             0,0,0,0,0
73             );
74 0           $class->build_base(FCGI_BEGIN_REQUEST, $request_id, $content);
75             }
76              
77             # generate FCGI_PARAMS record
78             # 0x80000000 means: The high-order bit of the first byte of a length indicates the length's encoding. A high-order zero implies a one-byte encoding, a one a four-byte encoding.
79             sub build_params {
80 0     0 1   my ($class, $request_id, %params) = @_;
81 0           my $content = '';
82 0           while (my ($k, $v) = each %params) {
83 0           my $klen = length($k);
84 0           my $vlen = length($v);
85 0 0         if ($klen < 127) {
86 0           $content .= pack('C', $klen); # C: An unsigned char (octet) value.
87             } else {
88 0           $klen = $klen | 0x80000000;
89 0           $content .= pack('N', $klen); # N: An unsigned quad value.
90             }
91 0 0         if ($vlen < 127) {
92 0           $content .= pack('C', $vlen);
93             } else {
94 0           $vlen = $vlen | 0x80000000;
95 0           $content .= pack('N', $vlen);
96             }
97 0           $content .= $k;
98 0           $content .= $v;
99             }
100 0           $class->build_base(FCGI_PARAMS, $request_id, $content);
101             }
102              
103             # generate FCGI_STDIN record
104             sub build_stdin {
105 0     0 1   my ($class, $request_id, $content) = @_;
106 0   0       $content ||= '';
107 0           $class->build_base(FCGI_STDIN, $request_id, $content);
108             }
109              
110             1;
111             __END__