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   14 use strict;
  3         3  
  3         106  
4 3     3   15 use warnings;
  3         4  
  3         110  
5              
6 3     3   923 use Pod::Webserver::Connection;
  3         5  
  3         159  
7              
8             our $VERSION = '3.10';
9              
10 3     3   1390 use Socket qw(PF_INET SOCK_STREAM SOMAXCONN inet_aton sockaddr_in);
  3         8076  
  3         1689  
11              
12             # ------------------------------------------------
13              
14             sub accept {
15 1     1 0 6525 my $self = shift;
16 1         14 my $sock = $self->{__sock};
17              
18 1         11 my $rin = '';
19 1         22 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         9 do {
26 1 50       131677 if (select ($rin, undef, undef, $self->{Timeout})) {
27             # Ready for reading;
28              
29 1         9 my $got = do {local *GOT; \*GOT};
  1         9  
  1         11  
30             #$! = "";
31 1 50       49 accept $got, $sock or die "Error: accept failed: $!\n";
32 1         34 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 2 my $class = shift;
44 1         4 my $self = {@_};
45 1   50     8 $self->{LocalHost} ||= 'localhost';
46              
47             # Anonymous file handles the 5.004 way:
48 1         1 my $sock = do {local *SOCK; \*SOCK};
  1         3  
  1         3  
49              
50 1 50       646 my $proto = getprotobyname('tcp') or die "Error in getprotobyname: $!\n";
51 1 50       51 socket($sock, PF_INET, SOCK_STREAM, $proto) or die "Can't create socket: $!\n";
52 1 50       212 my $host = inet_aton($self->{LocalHost})
53             or die "Can't resolve hostname '$self->{LocalHost}'\n";
54 1         10 my $sin = sockaddr_in($self->{LocalPort}, $host);
55 1 50       26 bind $sock, $sin
56             or die "Couldn't bind to $self->{LocalHost}:$self->{LocalPort}: $!\n";
57 1 50       14 listen $sock, SOMAXCONN or die "Couldn't listen on socket: $!\n";
58              
59 1         2 $self->{__sock} = $sock;
60              
61 1         17 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;