File Coverage

blib/lib/Pod/Webserver/Daemon.pm
Criterion Covered Total %
statement 38 41 92.6
branch 7 14 50.0
condition 1 2 50.0
subroutine 6 7 85.7
pod 0 3 0.0
total 52 67 77.6


line stmt bran cond sub pod time code
1             package Pod::Webserver::Daemon;
2              
3 3     3   16 use strict;
  3         8  
  3         235  
4 3     3   18 use warnings;
  3         6  
  3         131  
5              
6 3     3   1556 use Pod::Webserver::Connection;
  3         7  
  3         140  
7              
8             our $VERSION = '3.09';
9              
10 3     3   2430 use Socket qw(PF_INET SOCK_STREAM SOMAXCONN inet_aton sockaddr_in);
  3         10622  
  3         2616  
11              
12             # ------------------------------------------------
13              
14             sub accept {
15 1     1 0 13316 my $self = shift;
16 1         25 my $sock = $self->{__sock};
17              
18 1         18 my $rin = '';
19 1         28 vec($rin, fileno($sock), 1) = 1;
20              
21             # Sadly getting a valid returned time from select is not portable
22              
23 1         16 my $end = $self->{Timeout} + time;
24              
25 1         19 do {
26 1 50       168387 if (select ($rin, undef, undef, $self->{Timeout})) {
27             # Ready for reading;
28              
29 1         12 my $got = do {local *GOT; \*GOT};
  1         23  
  1         23  
30             #$! = "";
31 1 50       148 accept $got, $sock or die "Error: accept failed: $!\n";
32 1         59 return Pod::Webserver::Connection->new($got);
33             }
34             } while (time < $end);
35              
36 0         0 return undef;
37              
38             } # End of accept.
39              
40             # ------------------------------------------------
41              
42             sub new {
43 1     1 0 3 my $class = shift;
44 1         5 my $self = {@_};
45 1   50     11 $self->{LocalHost} ||= 'localhost';
46              
47             # Anonymous file handles the 5.004 way:
48 1         2 my $sock = do {local *SOCK; \*SOCK};
  1         3  
  1         3  
49              
50 1 50       2979 my $proto = getprotobyname('tcp') or die "Error in getprotobyname: $!\n";
51 1 50       68 socket($sock, PF_INET, SOCK_STREAM, $proto) or die "Can't create socket: $!\n";
52 1 50       779 my $host = inet_aton($self->{LocalHost})
53             or die "Can't resolve hostname '$self->{LocalHost}'\n";
54 1         22 my $sin = sockaddr_in($self->{LocalPort}, $host);
55 1 50       31 bind $sock, $sin
56             or die "Couldn't bind to $self->{LocalHost}:$self->{LocalPort}: $!\n";
57 1 50       18 listen $sock, SOMAXCONN or die "Couldn't listen on socket: $!\n";
58              
59 1         4 $self->{__sock} = $sock;
60              
61 1         34 return bless $self, $class;
62              
63             } # End of accept.
64              
65             # ------------------------------------------------
66              
67             sub url {
68 0     0 0   my $self = shift;
69              
70 0           return "http://$self->{LocalHost}:$self->{LocalPort}/";
71              
72             } # End of url.
73              
74             # ------------------------------------------------
75              
76             1;