File Coverage

blib/lib/Protocol/DBus/WriteMsg.pm
Criterion Covered Total %
statement 29 36 80.5
branch 4 12 33.3
condition 2 3 66.6
subroutine 9 9 100.0
pod 0 1 0.0
total 44 61 72.1


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