File Coverage

blib/lib/Net/Async/UWSGI/Server.pm
Criterion Covered Total %
statement 77 86 89.5
branch 10 18 55.5
condition 0 5 0.0
subroutine 23 26 88.4
pod 8 8 100.0
total 118 143 82.5


line stmt bran cond sub pod time code
1             package Net::Async::UWSGI::Server;
2             $Net::Async::UWSGI::Server::VERSION = '0.006';
3 2     2   35309 use strict;
  2         4  
  2         65  
4 2     2   9 use warnings;
  2         3  
  2         92  
5              
6 2     2   917 use parent qw(IO::Async::Notifier);
  2         542  
  2         9  
7              
8             =head1 NAME
9              
10             Net::Async::UWSGI::Server - server implementation for UWSGI
11              
12             =head1 VERSION
13              
14             version 0.006
15              
16             =head1 SYNOPSIS
17              
18             =head1 DESCRIPTION
19              
20             =cut
21              
22 2     2   30421 use curry;
  2         353  
  2         55  
23 2     2   859 use curry::weak;
  2         52  
  2         50  
24              
25 2     2   995 use IO::Async::Listener;
  2         86136  
  2         66  
26              
27 2     2   1135 use Mixin::Event::Dispatch::Bus;
  2         11625  
  2         55  
28 2     2   844 use Net::Async::UWSGI::Server::Connection;
  2         4  
  2         81  
29              
30 2     2   9 use Scalar::Util qw(weaken);
  2         3  
  2         92  
31 2     2   7 use URI;
  2         3  
  2         33  
32 2     2   8 use URI::QueryParam;
  2         1  
  2         33  
33 2     2   9 use JSON::MaybeXS;
  2         2  
  2         98  
34 2     2   11 use Encode qw(encode);
  2         3  
  2         82  
35 2     2   11 use Future;
  2         2  
  2         58  
36 2     2   1099 use HTTP::Response;
  2         36475  
  2         72  
37              
38 2     2   13 use Protocol::UWSGI qw(:server);
  2         3  
  2         1256  
39              
40             =head1 METHODS
41              
42             =cut
43              
44             =head2 path
45              
46             =cut
47              
48 5     5 1 88 sub path { shift->{path} }
49              
50             =head2 backlog
51              
52             =cut
53              
54 1     1 1 4 sub backlog { shift->{backlog} }
55              
56             =head2 mode
57              
58             =cut
59              
60 1     1 1 4 sub mode { shift->{mode} }
61              
62             =head2 configure
63              
64             =cut
65              
66             sub configure {
67 2     2 1 9854 my ($self, %args) = @_;
68 2         7 for(qw(path backlog mode on_request)) {
69 8 100       25 $self->{$_} = delete $args{$_} if exists $args{$_};
70             }
71 2         20 $self->SUPER::configure(%args);
72             }
73              
74             =head2 _add_to_loop
75              
76             =cut
77              
78             sub _add_to_loop {
79 2     2   487 my ($self, $loop) = @_;
80 2         6 delete $self->{listening};
81 2         8 $self->listening;
82             ()
83 1         2 }
84              
85             =head2 listening
86              
87             =cut
88              
89             sub listening {
90 2     2 1 5 my ($self) = @_;
91 2 50       8 return $self->{listening} if exists $self->{listening};
92              
93 2 100       7 defined(my $path = $self->path) or die "No path provided";
94 1 50 0     11 unlink $path or die "Unable to remove existing $path socket - $!" if -S $path;
95              
96 1         3 my $f = $self->loop->new_future->set_label('listener startup');
97 1         943 $self->{listening} = $f;
98 1         10 my $listener = IO::Async::Listener->new(
99             on_accept => $self->curry::incoming_socket,
100             );
101              
102 1         90 $self->add_child($listener);
103             $listener->listen(
104             addr => {
105             family => 'unix',
106             socktype => 'stream',
107             path => $self->path,
108             },
109              
110             on_listen => $self->curry::on_listen_start($f),
111             # on_stream => $self->curry::incoming_stream,
112              
113             on_listen_error => sub {
114 0     0   0 $f->fail(listen => "Cannot listen - $_[1]\n");
115             },
116 1         105 );
117 1         83 $f
118             }
119              
120             =head2 on_listen_start
121              
122             =cut
123              
124             sub on_listen_start {
125 1     1 1 749 my ($self, $f, $listener) = @_;
126              
127 1         3 my $sock = $listener->read_handle;
128              
129             # Make sure the socket is accessible
130 1 50       5 if(my $mode = $self->mode) {
131             # Allow octal-as-string
132 1 50       6 $mode = oct $mode if substr($mode, 0, 1) eq '0';
133 1         3 $self->debug_printf("chmod %s to %04o", $self->path, $mode);
134 1 50       4 chmod $mode, $self->path or $f->fail(listen => 'unable to chmod socket - ' . $!);
135             }
136              
137             # Support custom backlog (default 1 is usually too low)
138 1 50       3 if(my $backlog = $self->backlog) {
139 0         0 $self->debug_printf("Set listen queue on %s to %d", $self->path, $backlog);
140 0 0       0 $sock->listen($backlog) or die $!;
141             }
142              
143 1         4 $f->done($listener);
144             }
145              
146             =head2 incoming_socket
147              
148             Called when we have an incoming socket. Usually indicates a new request.
149              
150             =cut
151              
152             sub incoming_socket {
153 0     0 1   my ($self, $listener, $socket) = @_;
154 0           $self->debug_printf("Incoming socket - %s, total now ", $socket, 0+$self->children);
155              
156 0           $socket->blocking(0);
157 0           my $stream = Net::Async::UWSGI::Server::Connection->new(
158             handle => $socket,
159             bus => $self->bus,
160             on_request => $self->{on_request},
161             autoflush => 1,
162             );
163 0           $self->add_child($stream);
164             }
165              
166             =head2 bus
167              
168             The event bus. See L.
169              
170             =cut
171              
172 0   0 0 1   sub bus { shift->{bus} ||= Mixin::Event::Dispatch::Bus->new }
173              
174             1;
175              
176             __END__