File Coverage

blib/lib/Protocol/DBus/Message/Header.pm
Criterion Covered Total %
statement 30 32 93.7
branch 7 14 50.0
condition n/a
subroutine 7 7 100.0
pod 0 1 0.0
total 44 54 81.4


line stmt bran cond sub pod time code
1             package Protocol::DBus::Message::Header;
2              
3 6     6   40 use strict;
  6         12  
  6         210  
4 6     6   30 use warnings;
  6         16  
  6         138  
5              
6 6     6   383 use Call::Context ();
  6         305  
  6         95  
7              
8 6     6   27 use Protocol::DBus::Marshal ();
  6         12  
  6         117  
9 6     6   33 use Protocol::DBus::Pack ();
  6         7  
  6         442  
10              
11             # This just gets us to the length of the headers array.
12             use constant {
13 6         2049 _MIN_HEADER_LENGTH => 16,
14              
15             # The spec says to parse as array of pairs, but a dict makes
16             # more sense and is compatible. (The spec doesn’t proscribe
17             # duplicate headers, but the reference implementation does.)
18             SIGNATURE => 'yyyyuua{yv}',
19              
20             MESSAGE_TYPE => {
21             METHOD_CALL => 1,
22             METHOD_RETURN => 2,
23             ERROR => 3,
24             SIGNAL => 4,
25             },
26              
27             FLAG => {
28             NO_REPLY_EXPECTED => 1,
29             NO_AUTO_START => 2,
30             ALLOW_INTERACTIVE_AUTHORIZATION => 4,
31             },
32              
33             FIELD => {
34             PATH => 1,
35             INTERFACE => 2,
36             MEMBER => 3,
37             ERROR_NAME => 4,
38             REPLY_SERIAL => 5,
39             DESTINATION => 6,
40             SENDER => 7,
41             SIGNATURE => 8,
42             UNIX_FDS => 9,
43             },
44              
45             FIELD_SIGNATURE => {
46             PATH => 'o',
47             INTERFACE => 's',
48             MEMBER => 's',
49             ERROR_NAME => 's',
50             REPLY_SERIAL => 'u',
51             DESTINATION => 's',
52             SENDER => 's',
53             SIGNATURE => 'g',
54             UNIX_FDS => 'u',
55             },
56 6     6   31 };
  6         12  
57              
58             my ($_is_big_endian, $prot_version);
59              
60             sub parse_simple {
61 14     14 0 34 my ($buf_sr) = @_;
62              
63 14         68 Call::Context::must_be_list();
64              
65 14 50       221 if (length($$buf_sr) >= _MIN_HEADER_LENGTH()) {
66 14         61 ($_is_big_endian, $prot_version) = unpack 'axxC', $$buf_sr;
67              
68 14 50       45 if (1 != $prot_version) {
69 0         0 die "Protocol version must be 1, not “$prot_version”!";
70             }
71              
72 14 50       47 $_is_big_endian = ($_is_big_endian eq 'B') ? 1 : ($_is_big_endian eq 'l') ? 0 : die "Invalid endian byte: “$_is_big_endian”!";
    50          
73              
74 14 50       49 my $array_length = unpack(
75             '@12 ' . ($_is_big_endian ? 'N' : 'V'),
76             $$buf_sr,
77             );
78              
79 14 50       37 if (length($$buf_sr) >= (_MIN_HEADER_LENGTH + $array_length)) {
80              
81             # We never care about the header signatures.
82 14         44 local $Protocol::DBus::Marshal::PRESERVE_VARIANT_SIGNATURES = 0;
83              
84 14 50       143 my ($content, $length) = Protocol::DBus::Marshal->can(
85             $_is_big_endian ? 'unmarshal_be' : 'unmarshal_le'
86             )->($buf_sr, 0, SIGNATURE());
87              
88 14         44 Protocol::DBus::Pack::align( $length, 8 );
89              
90 14         60 return( $content, $length, $_is_big_endian );
91             }
92             }
93              
94 0           return;
95             }
96              
97             1;