diff options
Diffstat (limited to 'atc-therm-receiver')
| -rw-r--r-- | atc-therm-receiver/test.pl | 186 |
1 files changed, 186 insertions, 0 deletions
diff --git a/atc-therm-receiver/test.pl b/atc-therm-receiver/test.pl new file mode 100644 index 0000000..fb03ec8 --- /dev/null +++ b/atc-therm-receiver/test.pl @@ -0,0 +1,186 @@ +#!/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(); + |