From cddf386defea9fcb3900b7b46337b4cc96df6668 Mon Sep 17 00:00:00 2001 From: Olivier Blin Date: Wed, 13 Jul 2005 03:45:04 +0000 Subject: initial import --- perl-install/dbus_object.pm | 71 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 71 insertions(+) create mode 100644 perl-install/dbus_object.pm (limited to 'perl-install/dbus_object.pm') diff --git a/perl-install/dbus_object.pm b/perl-install/dbus_object.pm new file mode 100644 index 000000000..445fc73ba --- /dev/null +++ b/perl-install/dbus_object.pm @@ -0,0 +1,71 @@ +package dbus_object; + +sub system_bus() { + require Net::DBus; + Net::DBus->system; +} + +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 dispatch { + my ($o) = @_; + $o->{bus}{connection}->dispatch; +} + +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->dispatch; + return; + } + @ret; +} + +sub set_gtk2_watch { + my ($o) = @_; + + $o->{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 + + $o->dispatch; +} + +1; -- cgit v1.2.1