summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--perl_checker.src/global_checks.ml3
1 files changed, 2 insertions, 1 deletions
diff --git a/perl_checker.src/global_checks.ml b/perl_checker.src/global_checks.ml
index 40042c1..9f47b6a 100644
--- a/perl_checker.src/global_checks.ml
+++ b/perl_checker.src/global_checks.ml
@@ -219,7 +219,8 @@ let check_variables vars t =
check_unused_local_variables vars' ;
Some vars
- | Call(Deref(I_func, Ident(None, func, func_pos)), Anonymous_sub(Block f, pos) :: l) when func = "grep" || func = "map" || func = "substInFile" || func = "map_index" || func = "each_index" || func = "partition" || func = "find_index" || func = "grep_index" ->
+ | Call(Deref(I_func, Ident(None, func, func_pos)), Anonymous_sub(Block f, pos) :: l)
+ when List.mem func [ "grep" ; "map" ; "substInFile" ; "map_index" ; "each_index" ; "partition" ; "find_index" ; "grep_index" ; "find" ; "any" ; "every" ] ->
let vars = List.fold_left check_variables_ vars l in
let vars' = { vars with my_vars = [] :: vars.my_vars ; our_vars = [(I_scalar, "_"), (pos, ref true)] :: vars.our_vars } in
let vars' = List.fold_left check_variables_ vars' f in
href='#n4'>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;