File Coverage

blib/lib/Protocol/DBus/Parser/UnixFDs.pm
Criterion Covered Total %
statement 6 19 31.5
branch 0 6 0.0
condition n/a
subroutine 2 3 66.6
pod 0 1 0.0
total 8 29 27.5


line stmt bran cond sub pod time code
1             package Protocol::DBus::Parser::UnixFDs;
2              
3 1     1   584 use strict;
  1         2  
  1         23  
4 1     1   4 use warnings;
  1         2  
  1         168  
5              
6             sub extract_from_msghdr {
7 0     0 0   my ($msg) = @_;
8              
9 0           my @all_control = $msg->cmsghdr();
10              
11 0           my @fhs;
12              
13 0           while (@all_control) {
14 0           my ($level, $type, $data) = splice @all_control, 0, 3;
15 0 0         if ($level != Socket::SOL_SOCKET()) {
16 0           die "Unknown control message level: $level";
17             }
18              
19 0 0         if ($type != Socket::SCM_RIGHTS()) {
20 0           die "Unknown control message type: $type";
21             }
22              
23 0           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 0 0         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 0           push @fhs, $fh;
37             }
38             }
39              
40 0           return @fhs;
41             }
42              
43             1;