File Coverage

blib/lib/DBGp/Client/Listener.pm
Criterion Covered Total %
statement 10 12 83.3
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 14 16 87.5


line stmt bran cond sub pod time code
1             package DBGp::Client::Listener;
2              
3 1     1   1034 use strict;
  1         1  
  1         21  
4 1     1   4 use warnings;
  1         1  
  1         21  
5              
6             =head1 NAME
7              
8             DBGp::Client::Listener - wait for incoming DBGp connections
9              
10             =head1 SYNOPSIS
11              
12             $listener = DBGp::Client::Listener->new(
13             port => 9000,
14             );
15             $listener->listen;
16              
17             $connection = $listener->accept;
18              
19             # use the methods in the DBGp::Client::Connection object
20              
21             =head1 DESCRIPTION
22              
23             The main entry point for L: listens for incoming
24             debugger connections and returns a L object.
25              
26             =head1 METHODS
27              
28             =cut
29              
30 1     1   410 use IO::Socket;
  1         13652  
  1         3  
31              
32 1     1   372 use DBGp::Client::Connection;
  0            
  0            
33              
34             =head2 new
35              
36             my $listener = DBGp::Client::Listener->new(%opts);
37              
38             Possible options are C to specify a TCP port, and C to
39             specify the path for an Unix-domain socket.
40              
41             =cut
42              
43             sub new {
44             my ($class, %args) = @_;
45             my $self = bless {
46             port => $args{port},
47             path => $args{path},
48             socket => undef,
49             }, $class;
50              
51             die "Specify either 'port' or 'path'" unless $self->{port} || $self->{path};
52              
53             return $self;
54             }
55              
56             =head2 listen
57              
58             $listener->listen;
59              
60             Starts listening on the endpoint specified to the constructor;
61             Cs if there is an error.
62              
63             =cut
64              
65             sub listen {
66             my ($self) = @_;
67              
68             if ($self->{port}) {
69             $self->{socket} = IO::Socket::INET->new(
70             Listen => 1,
71             LocalAddr => '127.0.0.1',
72             LocalPort => $self->{port},
73             Proto => 'tcp',
74             ReuseAddr => 1,
75             ReusePort => 1,
76             );
77             } elsif ($self->{path}) {
78             if (-S $self->{path}) {
79             unlink $self->{path} or die "Unable to unlink stale socket: $!";
80             }
81              
82             $self->{socket} = IO::Socket::UNIX->new(
83             Listen => 1,
84             Local => $self->{path},
85             );
86             }
87              
88             die "Unable to start listening: $!" unless $self->{socket};
89             }
90              
91             =head2 accept
92              
93             my $connection = $listener->accept;
94              
95             Waits for an incoming debugger connection and returns a
96             fully-initialized L object; it calls
97             L on the connection object to
98             read and parse the initialization message.
99              
100             =cut
101              
102             sub accept {
103             my ($self) = @_;
104             my $sock = $self->{socket}->accept;
105              
106             return undef if !$sock;
107              
108             my $conn = DBGp::Client::Connection->new(socket => $sock);
109              
110             $conn->parse_init;
111              
112             return $conn;
113             }
114              
115             1;
116              
117             __END__