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   3633 use strict;
  5         15  
  5         218  
6 5     5   29 use warnings;
  5         10  
  5         204  
7              
8              
9             package Net::SIP::Blocker;
10              
11 5     5   27 use fields qw( dispatcher block );
  5         12  
  5         30  
12 5     5   373 use Carp 'croak';
  5         10  
  5         237  
13 5     5   27 use Net::SIP::Debug;
  5         38  
  5         35  
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 145 my ($class,%args) = @_;
28 2         10 my $self = fields::new( $class );
29              
30             my $map = delete $args{block}
31 2 50       228 or croak("no mapping between method and code");
32 2         11 while (my ($method,$code) = each %$map) {
33 2         8 $method = uc($method);
34 2 50       75 ($code, my $msg) = $code =~m{^(\d\d\d)(?:\s+(.+))?$} or
35             croak("block code for $method must be DDD [text]");
36 2 50       19 $self->{block}{$method} = defined($msg) ? [$code,$msg]:[$code];
37             }
38              
39             $self->{dispatcher} = delete $args{dispatcher}
40 2 50       16 or croak('no dispatcher given');
41              
42 2         9 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         3 my ($packet,$leg,$from) = @_;
56              
57 2 50       5 $packet->is_request or return;
58              
59 2         6 my $method = $packet->method;
60 2 100 66     11 if ( $method eq 'ACK' and my $block = $self->{block}{INVITE} ) {
61 1         19 $self->{dispatcher}->cancel_delivery($packet->tid);
62 1         4 return $block->[0];
63             }
64              
65 1 50       13 my $block = $self->{block}{$method} or return;
66              
67 1         11 DEBUG( 10,"block $method with code @$block" );
68             $self->{dispatcher}->deliver(
69 1         26 $packet->create_response(@$block),
70             leg => $leg,
71             dst_addr => $from
72             );
73 1         5 return $block->[0]
74             }
75              
76             1;