File Coverage

testlib
Criterion Covered Total %
statement 11 24 45.8
branch 1 8 12.5
condition 1 4 25.0
subroutine 3 7 42.8
pod n/a
total 16 43 37.2


line stmt bran cond sub pod time code
1              
2             # make sure we can do sockets
3 6     6   4890 use IO::Socket ();
  6         96104  
  6         134  
4 6     6   2996 use Data::Dumper ();
  6         33755  
  6         1386  
5              
6             # some local lexicals
7             my $text;
8              
9             # satisy -require-
10             1;
11              
12             #------------------------------------------------------------------------
13             # anyport
14             #
15             # Return a free port for listening
16             #
17             # IN: 1 servername or IP address (defaults to "localhost")
18             # OUT: 1 random port number
19              
20             sub anyport {
21              
22             # attempt to obtain a port to work on
23 8     8   16543 my $port = '';
24 8 50 50     384 if (my $socket = IO::Socket::INET->new(
25             Listen => 5,
26             LocalAddr => (shift || '127.0.0.1'),
27             ) ) {
28 8         4322 $port = $socket->sockport;
29             }
30              
31             # make sure the system's freed up the port
32 8         8002900 sleep 1;
33 8         503 return $port;
34             } #anyport
35              
36             #------------------------------------------------------------------------
37             # ft
38             #
39             # Helper sub for doing tests inside a forked process
40             #
41             # a. called without parameter in void context: initialize
42             # b. called with parameter in void context: add test result + comment
43             # c. called without parameter in scalar context: return result
44              
45             sub ft {
46              
47             # completed, return what we got
48 0 0   0     if ( defined wantarray ) {
    0          
49 0           return $text;
50             }
51              
52             # we're getting a test, return its result
53             elsif (@_) {
54 0   0       $text .= ($_[0] || '')."#$_[1]\n";
55             }
56              
57             # we're initializing
58             else {
59 0           $text = '';
60             }
61             } #ft
62              
63             #------------------------------------------------------------------------
64             # pft
65             #
66             # Process forked test results
67             #
68             # IN: 1 filename to read
69              
70             sub pft {
71              
72             # open the file
73 0 0   0     open my $handle, $_[0] or die "Could not open '$_[0]': $!";
74              
75             # process all lines
76 0           chomp,&ok( split "#" ) while <$handle>;
77              
78             # deny all further knowledge
79 0           close $handle;
80 0           unlink $_[0];
81             } #pft
82              
83             #------------------------------------------------------------------------
84             # slurp
85             #
86             # Slurp the contents of a file
87             #
88             # IN: 1 filename
89             # OUT: 1 contents of file
90              
91 0     0     sub slurp { open my $handle,$_[0]; local $/; <$handle> } #slurp
  0            
  0            
92              
93             #------------------------------------------------------------------------
94             # splat
95             #
96             # Splat contents to a file
97             #
98             # IN: 1 filename
99             # 2 contents of file
100              
101 0     0     sub splat { open my $handle,">$_[0]"; print $handle $_[1] } #splat
  0