summaryrefslogtreecommitdiffstats
path: root/perl-install/dbus_object.pm
blob: dc9df0d54c6c891effb8add669c8c4b37c918b9d (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
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;