File Coverage

blib/lib/Protocol/DBus/Connect.pm
Criterion Covered Total %
statement 18 22 81.8
branch 6 10 60.0
condition n/a
subroutine 4 4 100.0
pod 0 1 0.0
total 28 37 75.6


line stmt bran cond sub pod time code
1             package Protocol::DBus::Connect;
2              
3 6     6   407 use strict;
  6         11  
  6         173  
4 6     6   30 use warnings;
  6         11  
  6         139  
5              
6 6     6   28 use Socket;
  6         12  
  6         4126  
7              
8             sub create_socket {
9 2     2 0 58 my ($addr_obj) = @_;
10              
11 2 50       41 if ($addr_obj->transport() eq 'unix') {
12 2         17 my $path = $addr_obj->attribute('abstract');
13              
14 2 50       13 if ($path) {
15 0         0 substr($path, 0, 0, "\0");
16             }
17             else {
18 2 50       18 $path = $addr_obj->attribute('path') or do {
19 0         0 die( "No “path” nor “abstract”: " . $addr_obj->to_string() );
20             };
21             }
22              
23 2 50       134 socket my $s, Socket::AF_UNIX(), Socket::SOCK_STREAM(), 0 or do {
24 0         0 die "socket(AF_UNIX, SOCK_STREAM): $!";
25             };
26              
27 2 100       121 connect $s, Socket::pack_sockaddr_un($path) or do {
28 1         46 die "connect($path): $!";
29             };
30              
31 1         6 return $s;
32             }
33              
34             # TODO: Handle TCP addresses.
35              
36 0           die( "Unrecognized path: " . $addr_obj->to_string() );
37             }
38              
39             1;