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   443 use strict;
  6         12  
  6         176  
4 6     6   35 use warnings;
  6         14  
  6         151  
5              
6 6     6   30 use Socket;
  6         13  
  6         4092  
7              
8             sub create_socket {
9 2     2 0 33 my ($addr_obj) = @_;
10              
11 2 50       59 if ($addr_obj->transport() eq 'unix') {
12 2         28 my $path = $addr_obj->attribute('abstract');
13              
14 2 50       49 if ($path) {
15 0         0 substr($path, 0, 0, "\0");
16             }
17             else {
18 2 50       19 $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       153 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       153 connect $s, Socket::pack_sockaddr_un($path) or do {
28 1         44 die "connect($path): $!";
29             };
30              
31 1         9 return $s;
32             }
33              
34             # TODO: Handle TCP addresses.
35              
36 0           die( "Unrecognized path: " . $addr_obj->to_string() );
37             }
38              
39             1;