File Coverage

blib/lib/Protocol/DBus/Path.pm
Criterion Covered Total %
statement 13 23 56.5
branch 0 6 0.0
condition 1 8 12.5
subroutine 5 6 83.3
pod 0 2 0.0
total 19 45 42.2


line stmt bran cond sub pod time code
1             package Protocol::DBus::Path;
2              
3 5     5   35 use strict;
  5         11  
  5         217  
4 5     5   28 use warnings;
  5         10  
  5         120  
5              
6 5     5   2020 use Protocol::DBus::Address ();
  5         11  
  5         116  
7              
8 5     5   32 use constant _DEFAULT_SYSTEM_MESSAGE_BUS => 'unix:path=/var/run/dbus/system_bus_socket';
  5         10  
  5         958  
9              
10             # NB: If this returns “autolaunch:”, then the system should use
11             # platform-specific methods of locating a running D-Bus session server,
12             # or starting one if a running instance cannot be found.
13             sub login_session_message_bus {
14 0     0 0 0 my $addr = $ENV{'DBUS_SESSION_BUS_ADDRESS'};
15              
16 0 0 0     0 if (!$addr && ($^O eq 'darwin')) {
17 0         0 my $path = $ENV{'DBUS_LAUNCHD_SESSION_BUS_SOCKET'};
18              
19             # OK, let’s *really* stretch …
20 0   0     0 $path ||= readpipe( "launchctl getenv DBUS_LAUNCHD_SESSION_BUS_SOCKET" );
21 0         0 chomp $path;
22              
23 0 0       0 if ($path) {
24 0         0 chomp $path;
25              
26 0         0 $addr = "unix:path=$path";
27             }
28             }
29              
30 0 0       0 die "Found no login session message bus address!" if !$addr;
31              
32 0         0 return Protocol::DBus::Address::parse($addr);
33             }
34              
35             sub system_message_bus {
36 1   50 1 0 10 return Protocol::DBus::Address::parse( $ENV{'DBUS_SYSTEM_BUS_ADDRESS'} || _DEFAULT_SYSTEM_MESSAGE_BUS() );
37             }
38              
39             1;