File Coverage

blib/lib/Mail/MtPolicyd/Client.pm
Criterion Covered Total %
statement 12 34 35.2
branch 0 12 0.0
condition 0 3 0.0
subroutine 4 8 50.0
pod 1 1 100.0
total 17 58 29.3


line stmt bran cond sub pod time code
1             package Mail::MtPolicyd::Client;
2              
3 2     2   1067960 use Moose;
  2         8  
  2         26  
4              
5             our $VERSION = '1.23'; # VERSION
6             # ABSTRACT: a policyd client class
7              
8              
9 2     2   15638 use IO::Socket::UNIX;
  2         6  
  2         33  
10 2     2   1769 use IO::Socket::INET;
  2         5  
  2         22  
11              
12 2     2   4235 use Mail::MtPolicyd::Client::Response;
  2         7  
  2         817  
13              
14             has 'socket_path' => ( is => 'rw', isa => 'Maybe[Str]' );
15             has 'host' => ( is => 'rw', isa => 'Str', default => 'localhost:12345' );
16             has 'keepalive' => ( is => 'rw', isa => 'Bool', default => 0 );
17              
18             has '_fh' => ( is => 'rw', isa => 'Maybe[IO::Handle]' );
19              
20             sub _connect {
21 0     0     my $self = shift;
22 0           my $fh;
23 0 0         if( defined $self->socket_path ) {
24 0 0         $fh = IO::Socket::UNIX->new(
25             Peer => $self->socket_path,
26             autoflush => 0,
27             ) or die('could not connect to socket: '.$!);
28             } else {
29 0 0         $fh = IO::Socket::INET->new(
30             PeerAddr => $self->host,
31             Proto => 'tcp',
32             autoflush => 0,
33             ) or die('could not connect to host: '.$!);
34             }
35 0           $self->_fh( $fh );
36             }
37              
38             sub _disconnect {
39 0     0     my $self = shift;
40              
41 0           $self->_fh->close;
42 0           $self->_fh( undef );
43             }
44              
45             sub _is_connected {
46 0     0     my $self = shift;
47 0 0         if( defined $self->_fh ) {
48 0           return(1);
49             }
50 0           return(0);
51             }
52              
53             sub request {
54 0     0 1   my ( $self, $request ) = @_;
55              
56 0 0         if( ! $self->_is_connected ) {
57 0           $self->_connect;
58             }
59              
60 0           $self->_fh->print( $request->as_string );
61 0           $self->_fh->flush;
62              
63 0           my $response = Mail::MtPolicyd::Client::Response->new_from_fh( $self->_fh );
64              
65             # close connection we're not doing keepalive
66             # or if the server already closed connection (server side keepalive off)
67 0 0 0       if( ! $self->keepalive || $self->_fh->eof ) {
68 0           $self->_disconnect;
69             }
70              
71 0           return $response;
72             }
73              
74             1;
75              
76             __END__
77              
78             =pod
79              
80             =encoding UTF-8
81              
82             =head1 NAME
83              
84             Mail::MtPolicyd::Client - a policyd client class
85              
86             =head1 VERSION
87              
88             version 1.23
89              
90             =head1 DESCRIPTION
91              
92             Client class to query a policyd server.
93              
94             =head2 SYNOPSIS
95              
96             use Mail::MtPolicyd::Client;
97             use Mail::MtPolicyd::Client::Request;
98              
99             my $client = Mail::MtPolicyd::Client->new(
100             host => 'localhost:12345',
101             keepalive => 1,
102             );
103              
104             my $request = Mail::MtPolicyd::Client::Request->new(
105             'client_address' => '192.168.0.1',
106             );
107              
108             my $response = $client->request( $request );
109             print $response->as_string;
110              
111             =head2 METHODS
112              
113             =over
114              
115             =item request ( $request )
116              
117             Will send a Mail::MtPolicyd::Client::Request to the remote host
118             and return a Mail::MtPolicyd::Client::Response.
119              
120             =back
121              
122             =head2 ATTRIBUTES
123              
124             =over
125              
126             =item socket_path (default: undef)
127              
128             Path of a socket of the policyd server.
129              
130             If defined this socket will be used instead of a tcp connection.
131              
132             =item host (default: localhost:12345)
133              
134             Remote address/port of the policyd server.
135              
136             =item keepalive (default: 0)
137              
138             Keep connection open for multiple requests.
139              
140             =back
141              
142             =head1 AUTHOR
143              
144             Markus Benning <ich@markusbenning.de>
145              
146             =head1 COPYRIGHT AND LICENSE
147              
148             This software is Copyright (c) 2014 by Markus Benning <ich@markusbenning.de>.
149              
150             This is free software, licensed under:
151              
152             The GNU General Public License, Version 2, June 1991
153              
154             =cut