summaryrefslogtreecommitdiffstats
path: root/perl-install/dbus_object.pm
diff options
context:
space:
mode:
Diffstat (limited to 'perl-install/dbus_object.pm')
-rw-r--r--perl-install/dbus_object.pm72
1 files changed, 72 insertions, 0 deletions
diff --git a/perl-install/dbus_object.pm b/perl-install/dbus_object.pm
new file mode 100644
index 000000000..dc9df0d54
--- /dev/null
+++ b/perl-install/dbus_object.pm
@@ -0,0 +1,72 @@
+package dbus_object;
+
+sub system_bus {
+ my %params = @_;
+ #- use nomainloop => 1 to disable Net::DBus::Reactor main loop
+ require Net::DBus;
+ Net::DBus->system(%params);
+}
+
+sub new {
+ my ($type, $bus, $service, $path, $interface) = @_;
+ my $o = {
+ bus => $bus,
+ service => $service,
+ path => $path,
+ interface => $interface,
+ };
+ attach_object($o);
+ bless $o, $type;
+}
+
+sub attach_object {
+ my ($o) = @_;
+ my $service = $o->{bus}->get_service($o->{service});
+ $o->{object} = $service->get_object($o->{path}, $o->{interface});
+}
+
+sub call_method {
+ my ($o, $method, @args) = @_;
+ $o->{object}->$method(@args);
+}
+
+sub safe_call_method {
+ my ($o, $method, @args) = @_;
+ my @ret;
+ eval {
+ @ret = $o->call_method($method, @args);
+ };
+ if ($@) {
+ print STDERR "($method) exception: $@\n";
+ $o->{bus}{connection}->dispatch;
+ return;
+ }
+ @ret;
+}
+
+sub set_gtk2_watch {
+ my ($o) = @_;
+ set_gtk2_watch_helper($o->{bus});
+}
+
+sub set_gtk2_watch_helper {
+ my ($bus) = @_;
+ $bus->{connection}->set_watch_callbacks(sub {
+ my ($con, $watch) = @_;
+ my $flags = $watch->get_flags;
+ require Net::DBus::Binding::Watch;
+ require Gtk2::Helper;
+ if ($flags & &Net::DBus::Binding::Watch::READABLE) {
+ Gtk2::Helper->add_watch($watch->get_fileno, 'in', sub {
+ $watch->handle(&Net::DBus::Binding::Watch::READABLE);
+ $con->dispatch;
+ 1;
+ });
+ }
+ #- do nothing for WRITABLE watch, we dispatch when needed
+ }, undef, undef); #- do nothing when watch is disabled or toggled yet
+
+ $bus->{connection}->dispatch;
+}
+
+1;