File Coverage

blib/lib/Protocol/DBus/WriteMsg.pm
Criterion Covered Total %
statement 28 35 80.0
branch 3 10 30.0
condition 2 3 66.6
subroutine 9 9 100.0
pod 0 1 0.0
total 42 58 72.4


line stmt bran cond sub pod time code
1             package Protocol::DBus::WriteMsg;
2              
3 5     5   35 use strict;
  5         7  
  5         145  
4 5     5   26 use warnings;
  5         11  
  5         114  
5              
6 5     5   26 use Socket ();
  5         10  
  5         65  
7              
8 5     5   1573 use Protocol::DBus::Socket ();
  5         14  
  5         121  
9              
10 5     5   30 use parent qw( IO::Framed::Write );
  5         10  
  5         43  
11              
12             my %fh_fds;
13              
14             sub DESTROY {
15 2     2   8345 my ($self) = @_;
16              
17 2         10 my $fh = delete $fh_fds{ $self->get_write_fh() };
18              
19 2 50       59 $self->SUPER::DESTROY() if IO::Framed::Write->can('DESTROY');
20              
21 2         101 return;
22             }
23              
24             sub enqueue_message {
25 3     3 0 10 my ($self, $buf_sr, $fds_ar) = @_;
26              
27 3 50 66     6 push @{ $fh_fds{$self->get_write_fh()} }, ($fds_ar && @$fds_ar) ? $fds_ar : undef;
  3         37  
28              
29             $self->write(
30             $$buf_sr,
31             sub {
32              
33             # We’re done with the message, so we remove the FDs entry,
34             # which by here should be undef.
35 3     3   168 shift @{ $fh_fds{$self->get_write_fh()} };
  3         12  
36             },
37 3         94 );
38              
39 3         55 return $self;
40             }
41              
42             # Receives ($fh, $buf)
43             sub WRITE {
44              
45             # Only use sendmsg if we actually need to.
46 3 50   3   82 if (my $fds_ar = $fh_fds{ $_[0] }[0]) {
47 0 0       0 die 'Socket::MsgHdr is not loaded!' if !Socket::MsgHdr->can('new');
48              
49 0         0 my $msg = Socket::MsgHdr->new( buf => $_[1] );
50              
51 0         0 $msg->cmsghdr(
52             Socket::SOL_SOCKET(), Socket::SCM_RIGHTS(),
53             pack( 'I!*', @$fds_ar ),
54             );
55              
56 0         0 my $bytes = Protocol::DBus::Socket::sendmsg_nosignal( $_[0], $msg, 0 );
57              
58             # NOTE: This assumes that, on an incomplete write, the ancillary
59             # data (i.e., the FDs) will have been sent, and there is no need
60             # to resend. That appears to be the case on Linux and MacOS, but
61             # I can’t find any actual documentation to that effect.
62 0 0       0 if ($bytes) {
63 0         0 undef $fh_fds{ $_[0] }[0];
64             }
65              
66 0         0 return $bytes;
67             }
68              
69 3         30 return Protocol::DBus::Socket::send_nosignal( $_[0], $_[1], 0 );
70             }
71              
72             1;