File Coverage

blib/lib/Protocol/DBus/Signature.pm
Criterion Covered Total %
statement 29 29 100.0
branch 11 12 91.6
condition 2 3 66.6
subroutine 4 4 100.0
pod 0 2 0.0
total 46 50 92.0


line stmt bran cond sub pod time code
1             package Protocol::DBus::Signature;
2              
3 3     3   684 use strict;
  3         6  
  3         85  
4 3     3   15 use warnings;
  3         5  
  3         929  
5              
6             # Returns a list of single complete types (SCTs).
7              
8             sub split {
9 102     102 0 164 my ($sig) = @_;
10              
11 102         137 my @scts;
12              
13 102         186 while (length($sig)) {
14 128         204 my $next_sct_len = Protocol::DBus::Signature::get_sct_length($sig, 0);
15 128         370 push @scts, substr( $sig, 0, $next_sct_len, q<> );
16             }
17              
18 102         279 return @scts;
19             }
20              
21             # Returns the length of the single complete type at $sct_offset.
22              
23             sub get_sct_length {
24 334     334 0 3140 my ($sig, $sct_offset) = @_;
25              
26 334         447 my $start = $sct_offset;
27              
28 334         509 my $next = substr($sig, $sct_offset, 1);
29              
30 334 100       642 if ($next eq 'a') {
31              
32             # “{ }” only happens after “a”
33 40         75 my $next_2nd = substr($sig, 1 + $sct_offset, 1);
34 40 100       84 if ($next_2nd eq '{') {
35              
36             # 4 for the “a”, “{”, key type, and “}”.
37             # We assume that the signature is well-formed.
38 19         52 return 4 + get_sct_length($sig, 3 + $sct_offset);
39             }
40              
41 21         52 return 1 + get_sct_length($sig, 1 + $sct_offset);
42             }
43              
44 294 100       507 if ($next eq '(') {
45 48         62 while (1) {
46 142         186 $sct_offset++;
47              
48 142 50       246 last if $sct_offset >= length($sig);
49              
50 142         217 my $next_in_struct = substr($sig, $sct_offset, 1);
51              
52 142 100 66     467 if ($next_in_struct eq '(' || $next_in_struct eq 'a') {
    100          
53 10         32 $sct_offset += get_sct_length($sig, $sct_offset) - 1;
54             }
55             elsif ($next_in_struct eq ')') {
56 48         79 last;
57             }
58             }
59             }
60              
61 294         695 return 1 + ($sct_offset - $start);
62             }
63              
64             1;