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 1     1   7 use strict;
  1         2  
  1         31  
4 1     1   5 use warnings;
  1         2  
  1         22  
5              
6 1     1   456 use Call::Context ();
  1         397  
  1         20  
7              
8 1     1   6 use Protocol::DBus::Marshal ();
  1         2  
  1         15  
9 1     1   5 use Protocol::DBus::Pack ();
  1         2  
  1         59  
10              
11             # This just gets us to the length of the headers array.
12             use constant {
13 1         449 _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 1     1   15 };
  1         3  
57              
58             my ($_is_big_endian, $prot_version);
59              
60             sub parse_simple {
61 8     8 0 15 my ($buf_sr) = @_;
62              
63 8         30 Call::Context::must_be_list();
64              
65 8 50       100 if (length($$buf_sr) >= _MIN_HEADER_LENGTH()) {
66 8         35 ($_is_big_endian, $prot_version) = unpack 'axxC', $$buf_sr;
67              
68 8 50       24 if (1 != $prot_version) {
69 0         0 die "Protocol version must be 1, not “$prot_version”!";
70             }
71              
72 8 50       29 $_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 8 50       27 my $array_length = unpack(
75             '@12 ' . ($_is_big_endian ? 'N' : 'V'),
76             $$buf_sr,
77             );
78              
79 8 50       21 if (length($$buf_sr) >= (_MIN_HEADER_LENGTH + $array_length)) {
80              
81             # We never care about the header signatures.
82 8         15 local $Protocol::DBus::Marshal::PRESERVE_VARIANT_SIGNATURES = 0;
83              
84 8 50       55 my ($content, $length) = Protocol::DBus::Marshal->can(
85             $_is_big_endian ? 'unmarshal_be' : 'unmarshal_le'
86             )->($buf_sr, 0, SIGNATURE());
87              
88 8         24 Protocol::DBus::Pack::align( $length, 8 );
89              
90 8         35 return( $content, $length, $_is_big_endian );
91             }
92             }
93              
94 0           return;
95             }
96              
97             1;