File Coverage

blib/lib/Protocol/DBus/Parser/UnixFDs.pm
Criterion Covered Total %
statement 17 19 89.4
branch 3 6 50.0
condition n/a
subroutine 3 3 100.0
pod 0 1 0.0
total 23 29 79.3


line stmt bran cond sub pod time code
1             package Protocol::DBus::Parser::UnixFDs;
2              
3 1     1   631 use strict;
  1         2  
  1         24  
4 1     1   5 use warnings;
  1         1  
  1         170  
5              
6             sub extract_from_msghdr {
7 1     1 0 1791 my ($msg) = @_;
8              
9 1         3 my @all_control = $msg->cmsghdr();
10              
11 1         9 my @fhs;
12              
13 1         3 while (@all_control) {
14 1         2 my ($level, $type, $data) = splice @all_control, 0, 3;
15 1 50       3 if ($level != Socket::SOL_SOCKET()) {
16 0         0 die "Unknown control message level: $level";
17             }
18              
19 1 50       4 if ($type != Socket::SCM_RIGHTS()) {
20 0         0 die "Unknown control message type: $type";
21             }
22              
23 1         5 for my $fd ( unpack 'I!*', $data ) {
24              
25             # The mode is immaterial except to
26             # avoid Perl complaining about STDOUT
27             # being reopened as read or something.
28             # The kernel should not care.
29 2 50       35 open my $fh, '+<&=', $fd or die "open() to reuse FD $fd: $!";
30              
31             # Would it be worthwhile to fcntl()
32             # here to determine what the actual
33             # access mode is and re-open() with
34             # that mode?
35              
36 2         8 push @fhs, $fh;
37             }
38             }
39              
40 1         4 return @fhs;
41             }
42              
43             1;