File Coverage

blib/lib/Monitoring/Livestatus/INET.pm
Criterion Covered Total %
statement 43 56 76.7
branch 9 18 50.0
condition 1 3 33.3
subroutine 8 10 80.0
pod 1 1 100.0
total 62 88 70.4


line stmt bran cond sub pod time code
1             package Monitoring::Livestatus::INET;
2 5     5   29726 use parent 'Monitoring::Livestatus';
  5         427  
  5         38  
3              
4 5     5   286 use strict;
  5         5  
  5         101  
5 5     5   19 use warnings;
  5         9  
  5         127  
6 5     5   444 use IO::Socket::INET ();
  5         14742  
  5         97  
7 5     5   17 use Socket qw(IPPROTO_TCP TCP_NODELAY);
  5         7  
  5         781  
8 5     5   21 use Carp qw/confess croak/;
  5         7  
  5         1815  
9              
10             =head1 NAME
11              
12             Monitoring::Livestatus::INET - connector with tcp sockets
13              
14             =head1 SYNOPSIS
15              
16             use Monitoring::Livestatus;
17             my $nl = Monitoring::Livestatus::INET->new( 'localhost:9999' );
18             my $hosts = $nl->selectall_arrayref("GET hosts");
19              
20             =head1 CONSTRUCTOR
21              
22             =head2 new ( [ARGS] )
23              
24             Creates an C object. C takes at least the server.
25             Arguments are the same as in C.
26             If the constructor is only passed a single argument, it is assumed to
27             be a the C specification. Use either socker OR server.
28              
29             =cut
30              
31             sub new {
32 5     5 1 766 my($class, @args) = @_;
33 5 100       13 unshift(@args, "peer") if scalar @args == 1;
34 5         14 my(%options) = @args;
35 5 100       14 $options{'name'} = $options{'peer'} unless defined $options{'name'};
36              
37 5         10 $options{'backend'} = $class;
38 5         31 my $self = Monitoring::Livestatus->new(%options);
39 5         9 bless $self, $class;
40 5 50       24 confess('not a scalar') if ref $self->{'peer'} ne '';
41              
42 5         14 return $self;
43             }
44              
45              
46             ########################################
47              
48             =head1 METHODS
49              
50             =cut
51              
52             sub _open {
53 1     1   1 my $self = shift;
54 1         2 my $sock;
55              
56 1         6 my $remaining = alarm($self->{'connect_timeout'});
57 1         3 eval {
58 1     0   11 local $SIG{'ALRM'} = sub { die("connection timeout"); };
  0         0  
59             $sock = IO::Socket::INET->new(
60             PeerAddr => $self->{'peer'},
61             Type => IO::Socket::INET::SOCK_STREAM,
62 1         16 Timeout => $self->{'connect_timeout'},
63             );
64 1 50 33     2756 if(!defined $sock || !$sock->connected()) {
65 1         6 my $msg = "failed to connect to $self->{'peer'}: $!";
66 1 50       3 if($self->{'errors_are_fatal'}) {
67 1         227 croak($msg);
68             }
69 0         0 $Monitoring::Livestatus::ErrorCode = 500;
70 0         0 $Monitoring::Livestatus::ErrorMessage = $msg;
71 0         0 alarm(0);
72 0         0 return;
73             }
74              
75 0         0 setsockopt($sock, IPPROTO_TCP, TCP_NODELAY, 1);
76              
77             };
78 1         116 alarm(0);
79 1 50       5 alarm($remaining) if $remaining;
80              
81 1 50       5 if($@) {
82 1         2 $Monitoring::Livestatus::ErrorCode = 500;
83 1         1 $Monitoring::Livestatus::ErrorMessage = $@;
84 1         3 return;
85             }
86              
87 0 0         if(defined $self->{'query_timeout'}) {
88             # set timeout
89 0           $sock->timeout($self->{'query_timeout'});
90             }
91              
92 0           return($sock);
93             }
94              
95              
96             ########################################
97              
98             sub _close {
99 0     0     my $self = shift;
100 0           my $sock = shift;
101 0 0         return unless defined $sock;
102 0           return close($sock);
103             }
104              
105              
106             1;
107              
108             =head1 AUTHOR
109              
110             Sven Nierlein, 2009-present,
111              
112             =head1 COPYRIGHT AND LICENSE
113              
114             Copyright (C) by Sven Nierlein
115              
116             This library is free software; you can redistribute it and/or modify
117             it under the same terms as Perl itself.
118              
119             =cut
120              
121             __END__