File Coverage

blib/lib/Monitoring/Livestatus/INET.pm
Criterion Covered Total %
statement 27 56 48.2
branch 5 18 27.7
condition 0 3 0.0
subroutine 7 10 70.0
pod 1 1 100.0
total 40 88 45.4


line stmt bran cond sub pod time code
1             package Monitoring::Livestatus::INET;
2 4     4   72999 use parent 'Monitoring::Livestatus';
  4         259  
  4         30  
3              
4 4     4   222 use strict;
  4         8  
  4         70  
5 4     4   14 use warnings;
  4         7  
  4         111  
6 4     4   1972 use IO::Socket::IP ();
  4         48060  
  4         141  
7 4     4   44 use Socket qw(IPPROTO_TCP TCP_NODELAY);
  4         8  
  4         197  
8 4     4   21 use Carp qw/confess croak/;
  4         21  
  4         1374  
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 4     4 1 667 my($class, @args) = @_;
33 4 100       16 unshift(@args, "peer") if scalar @args == 1;
34 4         11 my(%options) = @args;
35 4 100       17 $options{'name'} = $options{'peer'} unless defined $options{'name'};
36              
37 4         9 $options{'backend'} = $class;
38 4         23 my $self = Monitoring::Livestatus->new(%options);
39 4         10 bless $self, $class;
40 4 50       21 confess('not a scalar') if ref $self->{'peer'} ne '';
41              
42 4         18 return $self;
43             }
44              
45              
46             ########################################
47              
48             =head1 METHODS
49              
50             =cut
51              
52             sub _open {
53 0     0     my $self = shift;
54 0           my $sock;
55              
56 0           my $remaining = alarm($self->{'connect_timeout'});
57 0           eval {
58 0     0     local $SIG{'ALRM'} = sub { die("connection timeout"); };
  0            
59             $sock = IO::Socket::IP->new(
60             PeerAddr => $self->{'peer'},
61             Type => IO::Socket::IP::SOCK_STREAM,
62 0           Timeout => $self->{'connect_timeout'},
63             );
64 0 0 0       if(!defined $sock || !$sock->connected()) {
65 0           my $msg = "failed to connect to $self->{'peer'}: $!";
66 0 0         if($self->{'errors_are_fatal'}) {
67 0           croak($msg);
68             }
69 0           $Monitoring::Livestatus::ErrorCode = 500;
70 0           $Monitoring::Livestatus::ErrorMessage = $msg;
71 0           alarm(0);
72 0           return;
73             }
74              
75 0           setsockopt($sock, IPPROTO_TCP, TCP_NODELAY, 1);
76              
77             };
78 0           alarm(0);
79 0 0         alarm($remaining) if $remaining;
80              
81 0 0         if($@) {
82 0           $Monitoring::Livestatus::ErrorCode = 500;
83 0           $Monitoring::Livestatus::ErrorMessage = $@;
84 0           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__