File Coverage

blib/lib/Net/SIP/Blocker.pm
Criterion Covered Total %
statement 35 35 100.0
branch 8 14 57.1
condition 2 3 66.6
subroutine 7 7 100.0
pod 2 2 100.0
total 54 61 88.5


line stmt bran cond sub pod time code
1             ###########################################################################
2             # package Net::SIP::Blocker
3             ###########################################################################
4              
5 5     5   3662 use strict;
  5         10  
  5         125  
6 5     5   22 use warnings;
  5         10  
  5         178  
7              
8              
9             package Net::SIP::Blocker;
10              
11 5     5   22 use fields qw( dispatcher block );
  5         7  
  5         26  
12 5     5   325 use Carp 'croak';
  5         8  
  5         203  
13 5     5   26 use Net::SIP::Debug;
  5         10  
  5         42  
14              
15              
16             ###########################################################################
17             # creates new Blocker object
18             # Args: ($class,%args)
19             # %args
20             # block: \%hash where the blocked method is the key and its value
21             # is a number with three digits with optional message
22             # e.g. { 'SUBSCRIBE' => 405 }
23             # dispatcher: the Net::SIP::Dispatcher object
24             # Returns: $self
25             ###########################################################################
26             sub new {
27 2     2 1 116 my ($class,%args) = @_;
28 2         8 my $self = fields::new( $class );
29              
30             my $map = delete $args{block}
31 2 50       170 or croak("no mapping between method and code");
32 2         37 while (my ($method,$code) = each %$map) {
33 2         5 $method = uc($method);
34 2 50       54 ($code, my $msg) = $code =~m{^(\d\d\d)(?:\s+(.+))?$} or
35             croak("block code for $method must be DDD [text]");
36 2 50       17 $self->{block}{$method} = defined($msg) ? [$code,$msg]:[$code];
37             }
38              
39             $self->{dispatcher} = delete $args{dispatcher}
40 2 50       8 or croak('no dispatcher given');
41              
42 2         7 return $self;
43             }
44              
45              
46             ###########################################################################
47             # Blocks methods not wanted and sends a response back over the same leg
48             # with the Error-Message of the block_code
49             # Args: ($self,$packet,$leg,$from)
50             # args as usual for sub receive
51             # Returns: block_code | NONE
52             ###########################################################################
53             sub receive {
54 2     2 1 5 my Net::SIP::Blocker $self = shift;
55 2         4 my ($packet,$leg,$from) = @_;
56              
57 2 50       75 $packet->is_request or return;
58              
59 2         8 my $method = $packet->method;
60 2 100 66     25 if ( $method eq 'ACK' and my $block = $self->{block}{INVITE} ) {
61 1         16 $self->{dispatcher}->cancel_delivery($packet->tid);
62 1         4 return $block->[0];
63             }
64              
65 1 50       4 my $block = $self->{block}{$method} or return;
66              
67 1         102 DEBUG( 10,"block $method with code @$block" );
68             $self->{dispatcher}->deliver(
69 1         19 $packet->create_response(@$block),
70             leg => $leg,
71             dst_addr => $from
72             );
73 1         5 return $block->[0]
74             }
75              
76             1;