File Coverage

blib/lib/Net/SIP/NATHelper/Client.pm
Criterion Covered Total %
statement 18 44 40.9
branch 0 8 0.0
condition 0 4 0.0
subroutine 6 13 46.1
pod 2 5 40.0
total 26 74 35.1


line stmt bran cond sub pod time code
1 4     4   1486 use strict;
  4         8  
  4         100  
2 4     4   16 use warnings;
  4         7  
  4         153  
3              
4             ############################################################################
5             #
6             # Net::SIP::NATHelper::Client
7             # proxy for Net::SIP::NAT::Helper to communicate over sockets
8             # with Net::SIP::NATHelper::Server
9             # used in connection with bin/nathelper.pl
10             #
11             ############################################################################
12              
13             package Net::SIP::NATHelper::Client;
14              
15 4     4   20 use Net::SIP::Debug;
  4         7  
  4         43  
16 4     4   21 use Net::SIP::Util qw(invoke_callback INETSOCK);
  4         9  
  4         182  
17 4     4   19 use IO::Socket;
  4         7  
  4         38  
18 4     4   1684 use Storable qw(nfreeze thaw);
  4         8  
  4         1571  
19              
20             sub new {
21 0     0 1   my ($class,$socket) = @_;
22 0 0         my $create_socket = $socket =~m{/}
23             ? [ \&__create_unix_socket, $socket ]
24             : [ \&__create_tcp_socket, $socket ]
25             ;
26 0           my $self = bless { create_socket => $create_socket },$class;
27 0           return $self;
28             }
29              
30             sub allocate_sockets {
31 0     0 0   my Net::SIP::NATHelper::Client $self = shift;
32 0           return $self->rpc( 'allocate',@_ );
33             }
34              
35             sub activate_session {
36 0     0 0   my Net::SIP::NATHelper::Client $self = shift;
37 0           return $self->rpc( 'activate',@_ );
38             }
39              
40             sub close_session {
41 0     0 0   my Net::SIP::NATHelper::Client $self = shift;
42 0           return $self->rpc( 'close',@_ );
43             }
44              
45             sub rpc {
46 0     0 1   my Net::SIP::NATHelper::Client $self = shift;
47 0           my ($method,@arg) = @_;
48 0   0       my $sock = invoke_callback( $self->{create_socket} ) || die $!;
49 0           $sock->autoflush;
50 0           my $packet = pack( "N/a*", nfreeze([$method,@arg]));
51 0           print $sock $packet;
52 0 0         read( $sock, my $len,4 ) || die $!;
53 0           $len = unpack( "N",$len );
54 0 0         die if $len>32768;
55 0 0         die $! unless $len == read( $sock, $packet, $len );
56 0   0       my $ref = eval { thaw($packet) } || die $@;
57 0           return $$ref;
58             }
59              
60             sub __create_unix_socket {
61 0     0     my $socket = shift;
62 0           return IO::Socket::UNIX->new(
63             Type => SOCK_STREAM,
64             Peer => $socket
65             );
66             }
67              
68             sub __create_tcp_socket {
69 0     0     my $socket = shift;
70 0           return INETSOCK( $socket );
71             }
72              
73             1;