view release on metacpan or  search on metacpan

DBus.pm  view on Meta::CPAN

=head2 EXAMPLE

Here is a simple example. Both work with AnyEvent::DBus and do the same
thing, but only the second is actually non-blocking.

Example 1: list registered named, blocking version.

   use AnyEvent::DBus;

   my $conn = Net::DBus->find;
   my $bus  = $conn->get_bus_object;

   for my $name (@{ $bus->ListNames }) {
      print "  $name\n";
   }

Example 1: list registered named, somewhat non-blocking version.

   use AnyEvent;
   use AnyEvent::DBus;
   use Net::DBus::Annotation qw(:call);

   my $conn = Net::DBus->find; # always blocks :/
   my $bus  = $conn->get_bus_object;

   my $quit = AE::cv;

   # the trick here is to prepend dbus_call_async to any method
   # arguments and then to call the set_notify method on the
   # returned Net::DBus::AsyncReply object

   $bus->ListNames (dbus_call_async)->set_notify (sub {
      for my $name (@{ $_[0]->get_result }) {
         print "  $name\n";
      }
      $quit->send;
   });

   $quit->recv;

=cut

package AnyEvent::DBus;

use common::sense;

use AnyEvent ();
use Net::DBus ();
use Net::DBus::Binding::Watch ();

our $VERSION = '0.31';

# yup, Net::DBus checks by using exists on %INC...
$INC{'Net/DBus/Reactor.pm'} = undef;

# claim we are the main reactor mainloop
*Net::DBus::Reactor::main = sub { __PACKAGE__ };

our $I = 0;
our %O; # watchers and timers, unfortunately, dbus only supports attaching integers...

sub watch_off {
   delete $O{$_[1]->get_data};
}

sub io_toggle {
   my ($con, $w) = @_;

   my $id = $w->get_data;
   my $f  = $w->get_flags;
   my $fd = $w->get_fileno;
   my $on = $w->is_enabled;

   $f & Net::DBus::Binding::Watch::READABLE ()
      and
         $O{$id}[0] = $on && AE::io $fd, 0, sub {
            $w->handle (Net::DBus::Binding::Watch::READABLE ());
            $con->dispatch;
         };

   $f & Net::DBus::Binding::Watch::WRITABLE ()
      and
         $O{$id}[1] = $on && AE::io $fd, 1, sub {
            $w->handle (Net::DBus::Binding::Watch::WRITABLE ());
            $con->dispatch;
         };
}

sub io_on {
   my ($con, $w) = @_;

   my $id = ++$I;
   $w->set_data ($id);

   &io_toggle;
}

sub timeout_toggle {
   my ($con, $w) = @_;

   my $id = $w->get_data;
   my $i  = $w->get_interval * 0.001;

   $O{$id} = $w->is_enabled && AE::timer $i, $i, sub {
      $w->handle;
      $con->dispatch;
   };
}

sub timeout_on {
   my ($con, $w) = @_;
   my $id = ++$I;
   $w->set_data ($id);
   
   &timeout_toggle;
}

sub manage {
   my (undef, $con) = @_;