File Coverage

blib/lib/Protocol/DBus/Pack.pm
Criterion Covered Total %
statement 29 29 100.0
branch 4 4 100.0
condition n/a
subroutine 8 8 100.0
pod 0 2 0.0
total 41 43 95.3


line stmt bran cond sub pod time code
1             package Protocol::DBus::Pack;
2              
3 2     2   12 use strict;
  2         4  
  2         55  
4 2     2   11 use warnings;
  2         3  
  2         89  
5              
6 2         170 use constant NUMERIC => {
7             y => 'C', # uint8
8             b => 'L', # boolean (uint32)
9             n => 's', # int16
10             q => 'S', # uint16
11             i => 'l', # int32
12             u => 'L', # uint32
13             x => 'q', # int64
14             t => 'Q', # uint64
15             d => 'd', # double float (?)
16             h => 'L', # unix fd, uint32
17 2     2   12 };
  2         3  
18              
19 2         270 use constant STRING => {
20             s => 'L/a x',
21             o => 'L/a x',
22             g => 'C/a x',
23 2     2   15 };
  2         3  
24              
25             use constant WIDTH => {
26 20         72 (map { $_ => length pack NUMERIC()->{$_} } keys %{ NUMERIC() }),
  2         9  
27 2         3 (map { $_ => length pack STRING()->{$_} } keys %{ STRING() }),
  6         244  
  2         7  
28 2     2   14 };
  2         4  
29              
30             use constant ALIGNMENT => {
31 2         9 %{ WIDTH() },
32 2         4 map { $_ => length pack( substr( STRING()->{$_}, 0, 1 ) ) } keys %{ STRING() },
  6         371  
  2         7  
33 2     2   14 };
  2         4  
34              
35             # Increments the 1st arg in-place to align on a boundary of the 2nd arg.
36             # ex. align( 7, 8 ) will change the $_[0] to be 8.
37             sub align {
38 270 100   270 0 594 if ($_[0] % $_[1]) {
39 49         101 $_[0] += ($_[1] - ($_[0] % $_[1]));
40             }
41             }
42              
43             sub align_str {
44 121 100   121 0 298 if (my $mod = length($_[0]) % $_[1]) {
45 17         47 $_[0] .= "\0" x ($_[1] - $mod);
46             }
47             }
48              
49             1;