summaryrefslogtreecommitdiffstats
path: root/perl-install/dbus_object.pm
blob: 445fc73baea1e8a1be28e5407034b25cd9425554 (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
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;