path: root/atc-therm-receiver/test.pl

#!/usr/bin/env perl 
use v5.38;
use experimental qw(for_list try);
use Net::DBus;
use Net::DBus::Reactor;
use Net::DBus::Annotation qw(:call);
use Data::Dumper;
 
package Monitor {
    use v5.38;
    use Net::DBus qw(:typing);
    use Net::DBus::Exporter qw(org.bluez.AdvertisementMonitor1);
    use parent qw(Net::DBus::Object);
 
    dbus_method('Activate',[],[],'org.bluez.AdvertisementMonitor1');
    sub Activate($self) { say "activated" }
    dbus_method('Release',[],[],'org.bluez.AdvertisementMonitor1');
    sub Release($self) { say "released" }
 
    dbus_method('DeviceFound',['objectpath'],[],'org.bluez.AdvertisementMonitor1',{param_names=>['device']});
    sub DeviceFound($self,$dev) { say "found $dev" }
    dbus_method('DeviceLost',['objectpath'],[],'org.bluez.AdvertisementMonitor1',{param_names=>['device']});
    sub DeviceLost($self,$dev) { say "lost $dev" }
 
    dbus_property('Type','string','read','org.bluez.AdvertisementMonitor1');
    sub Type($self) { return 'or_patterns' }
 
    dbus_property('Patterns',['array',['struct','byte','byte',['array','byte']]],'read','org.bluez.AdvertisementMonitor1');
    sub Patterns($self) { return [dbus_struct([dbus_byte(0),dbus_byte(0x16),dbus_array([dbus_byte(0x1a),dbus_byte(0x18)])])] }
 
    sub get_props($self) {
        return {
            'org.freedesktop.DBus.Introspectable' => {},
            'org.bluez.AdvertisementMonitor1' => {
                'Type' => Monitor->Type,
                'Patterns' => Monitor->Patterns,
            },
        };
    }
}
 
package MonitorApp {
    use v5.38;
    use Net::DBus qw(:typing);
    use Net::DBus::Exporter qw(org.freedesktop.DBus.ObjectManager);
    use parent qw(Net::DBus::Object);
 
    dbus_signal('InterfacesAdded',['objectpath',['dict','string',['dict','string',['variant']]]]);
    dbus_signal('InterfacesRemoved',['objectpath',['array','string']]);
 
    dbus_method('GetManagedObjects',[],[['dict','objectpath',['dict','string',['dict','string',['variant']]]]]);
    sub GetManagedObjects($self) {
        say 'MonitorApp GetManagedObjects';
        return {
            '/net/thenautilus/monitor' => Monitor->get_props,
        };
    }
}
 
my $PATH='/org/bluez/hci0';
 
my $reactor = Net::DBus::Reactor->main();
my $bus = Net::DBus->system;
my $bluez = $bus->get_service('org.bluez');
my $bluez_root = $bluez->get_object('/');
my $adapter = $bluez->get_object($PATH);
 
sub maybe_handle_data($path,$interfaces) {
    my $dev = $interfaces->{'org.bluez.Device1'}
        or return;
 
    my $service_data = $dev->{ServiceData}
        or return;
 
    my ($key) = keys $service_data->%*
        or return;
 
    $key =~ /^0000181a-/ or return;
 
    my @data = $service_data->{$key}->@*;
    my $temp = ($data[7]*256 + $data[6])/100;
    my $hum = ($data[9]*256 + $data[8])/100;
    my $bat_v = ($data[11]*256 + $data[10])/1000;
    my $bat_pc = $data[12];
 
    say "$path Data = @data";
    say "  ",join(':',map { sprintf('%02x',$_) } @data);
    say "  $temp C - $hum %h - $bat_v V - $bat_pc %";
 
    return 1;
}
 
sub look_at_device($path,$interfaces) {
    maybe_handle_data($path,$interfaces)
        or return;
 
    my $new_obj = $bluez->get_object($path);
 
    # I don't know how to tell bluez to keep these objects around ☹ 
    $new_obj->Set('org.bluez.Device1','Trusted',Net::DBus::dbus_boolean(1));
 
    $new_obj->connect_to_signal(
        'PropertiesChanged',
        sub($interface,$props,@) {
            maybe_handle_data($path,{$interface=>$props})
                or return;
        }
    );
 
    my $timer;
    $timer = $reactor->add_timeout(
        5_000,
        sub {
            try {
                my $raw_data = $new_obj->Get(
                    'org.bluez.Device1',
                    'ServiceData'
                ) or die 'no data';
 
                maybe_handle_data($path,{'org.bluez.Device1',{ServiceData=>$raw_data}})
                    or die 'bad data';
            }
            catch ($e) {
                warn "$path - error - $e\n";
                $reactor->remove_timeout($timer);
            }
        }
    );
}
 
say 'connect_to_signal';
$bluez_root->connect_to_signal(
    'InterfacesAdded',
    sub ($path,$interfaces) {
        look_at_device($path,$interfaces);
    },
);
say 'GetManagedObjects';
my $objects = $bluez_root->GetManagedObjects();
for my ($path,$interfaces) ($objects->%*) {
    look_at_device($path,$interfaces);
}
 
# I don't think this is any use when listening to advertisements 
say 'SetDiscoveryFilter';
$adapter->SetDiscoveryFilter({
    Transport => 'le',
    Discoverable => Net::DBus::dbus_boolean(0),
#    Pattern => 'A4:C1:38:', 
    DuplicateData => Net::DBus::dbus_boolean(1),
});
 
# say 'StartDiscovery'; 
# $adapter->StartDiscovery(); 
 
say 'registering monitor';
my $session_bus = Net::DBus->session;
# we need to expose our monitors on the system bus, but we can't claim 
# ownership of any actual service there, so we build the anonymous 
# service and export objects through that, they'll be identified by the connection id 
my $monitor_service = $bus->export_service();
my $monitor_app = MonitorApp->new($monitor_service,'/net/thenautilus');
my $monitor = Monitor->new($monitor_app,'monitor');
 
my $hook;
$hook = $reactor->add_hook(
    sub {
        say 'actually register';
        $adapter->RegisterMonitor(dbus_call_async,'/net/thenautilus')->set_notify(
            sub($reply) {
                say 'RegisterMonitor reply';
                try {
                    say 'ok(',$reply->get_result,')';
                } catch ($e) {
                    warn "error: $e";
                }
            }
        );
        say 'registered';
        $reactor->remove_hook($hook);
    }
);
 
say 'run';
$reactor->run();