File Coverage

blib/lib/Net/SIP/NATHelper/Local.pm
Criterion Covered Total %
statement 18 54 33.3
branch 0 12 0.0
condition 0 2 0.0
subroutine 6 13 46.1
pod 5 5 100.0
total 29 86 33.7


line stmt bran cond sub pod time code
1 4     4   1806 use strict;
  4         10  
  4         121  
2 4     4   22 use warnings;
  4         7  
  4         156  
3              
4             ############################################################################
5             #
6             # Net::SIP::NATHelper::Local
7             # wrapper around Net::SIP::NATHelper::Base to integrate into local mainloop
8             #
9             ############################################################################
10              
11             package Net::SIP::NATHelper::Local;
12 4     4   22 use Net::SIP::Debug;
  4         9  
  4         48  
13 4     4   1741 use Net::SIP::NATHelper::Base;
  4         14  
  4         196  
14 4     4   26 use Net::SIP::Dispatcher::Eventloop;
  4         9  
  4         222  
15 4     4   25 use fields qw( helper loop callbacks );
  4         8  
  4         19  
16              
17             sub new {
18 0     0 1   my ($class,$loop) = @_;
19 0           my $self = fields::new($class);
20 0           my $helper = Net::SIP::NATHelper::Base->new;
21 0           %$self = ( loop => $loop, helper => $helper, callbacks => [] );
22 0     0     $loop->add_timer( 1, [ sub { shift->expire },$self ], 1, 'nat_expire' );
  0            
23 0           return $self;
24             }
25              
26             sub expire {
27 0     0 1   my Net::SIP::NATHelper::Local $self = shift;
28 0           my @expired = $self->{helper}->expire(@_);
29 0 0         @expired && $self->_update_callbacks;
30 0           return int(@expired);
31             }
32              
33             sub allocate_sockets {
34 0     0 1   my Net::SIP::NATHelper::Local $self = shift;
35 0   0       my $media = $self->{helper}->allocate_sockets(@_) || return;
36             #$self->_update_callbacks;
37 0           return $media;
38             }
39              
40             sub activate_session {
41 0     0 1   my Net::SIP::NATHelper::Local $self = shift;
42 0 0         my ($info,$duplicate) = $self->{helper}->activate_session(@_)
43             or return;
44 0           $self->_update_callbacks;
45 0 0         return $duplicate ? -1:1;
46             }
47              
48             sub close_session {
49 0     0 1   my Net::SIP::NATHelper::Local $self = shift;
50 0 0         my @info = $self->{helper}->close_session(@_) or return;
51 0           $self->_update_callbacks;
52 0           return scalar(@info);
53             }
54              
55             sub _update_callbacks {
56 0     0     my Net::SIP::NATHelper::Local $self = shift;
57 0           my $cb_old = $self->{callbacks};
58 0           my @cb_new = $self->{helper}->callbacks;
59 0           $self->{callbacks} = \@cb_new;
60              
61             # hash by cbid for old callbacks
62 0 0         my %old = map { $_->[2] => $_ } @{ $cb_old || [] };
  0            
  0            
63              
64 0           my $loop = $self->{loop};
65 0           foreach my $cb ( @cb_new ) {
66 0           my ($socket,$callback,$id) = @$cb;
67 0 0         if ( delete $old{ $id } ) {
68             # unchanged
69             } else {
70             # new callback
71 0           $loop->addFD($socket, EV_READ, $callback)
72             }
73             }
74             # delete unused callbacks
75 0           map { $loop->delFD( $_->[0] ) } values %old;
  0            
76             }
77              
78             1;