Protocol-DBus

 view release on metacpan or  search on metacpan

examples/anyevent.pl  view on Meta::CPAN

#!/usr/bin/perl

#----------------------------------------
# Contributed by Erik Huelsmann (ehuels@gmail.com)
#
# NB: This predates Protocol::DBus::Client::AnyEvent. Use that instead.
#----------------------------------------

use strict;
use warnings;

use AnyEvent;
use Data::Dumper;
use Protocol::DBus;
use Protocol::DBus::Client;

my $dbus = $> ? Protocol::DBus::Client::login_session() : Protocol::DBus::Client::system();
$dbus->blocking(0);

my $authenticated = AnyEvent->condvar;
my $w;
$w = AnyEvent->io(fh => $dbus->fileno(), poll => 'rw',
      cb => sub {
         if ($dbus->initialize()) {
            $authenticated->send();
            undef $w;
         }
     });

$authenticated->recv;

my $waiter = AnyEvent->condvar;

$w = AnyEvent->io(fh => $dbus->fileno(), poll => 'r',
      cb => sub {
         my $msg = $dbus->get_message;
         $waiter->send($msg);
     });


print Dumper $waiter->recv;
$waiter = AnyEvent->condvar;

$dbus->send_call(
    member => 'CreateTransaction',
    path => '/org/freedesktop/PackageKit',
    destination => 'org.freedesktop.PackageKit',
    interface => 'org.freedesktop.PackageKit',
);

my $trans_path = shift @{$waiter->recv->get_body};
$waiter = AnyEvent->condvar;


$w = AnyEvent->io(fh => $dbus->fileno(), poll => 'r',
      cb => sub {
         my $msg = $dbus->get_message();
         print Dumper $msg->get_body();

         if ($msg->get_header('MEMBER') eq 'Finished') {
           $waiter->send;
         }
     });


$dbus->send_call(
    member => 'AddMatch',
    signature => 's',
    destination => 'org.freedesktop.DBus',
    interface => 'org.freedesktop.DBus',
    path => '/org/freedesktop/DBus',
    body => [
       "path='$trans_path'"
    ]
);

$dbus->send_call(
    member => 'GetPackages',
    signature => 't',
    path => $trans_path,
    destination => 'org.freedesktop.PackageKit',
    interface => 'org.freedesktop.PackageKit.Transaction',
    body => [ 4 ],
);

$waiter->recv;



( run in 2.368 seconds using v1.01-cache-2.11-cpan-39bf76dae61 )