[libnet-dbus-perl] 304/335: Add an example for proxy objects

[Intrigeri]

This is an automated email from the git hooks/post-receive script.

intrigeri pushed a commit to branch experimental
in repository libnet-dbus-perl.

commit 7639b74d1ee245718d29b614f81a89d71752bfcf
Author: Daniel P. Berrange <dan at berrange.com>
Date:   Sun Nov 6 14:21:55 2011 +0000

    Add an example for proxy objects
---
 examples/example-proxy-service.pl | 80 +++++++++++++++++++++++++++++++++++++++
 1 file changed, 80 insertions(+)

diff --git a/examples/example-proxy-service.pl b/examples/example-proxy-service.pl
new file mode 100644
index 0000000..5a9203e
--- /dev/null
+++ b/examples/example-proxy-service.pl
@@ -0,0 +1,80 @@
+#!/usr/bin/perl
+
+use warnings;
+use strict;
+
+use Carp qw(confess cluck);
+use Net::DBus;
+use Net::DBus::Service;
+use Net::DBus::Reactor;
+
+#...  continued at botom
+
+
+package SomeObject;
+
+use Class::MethodMaker [ scalar => [ qw(name email salary) ]];
+
+sub new {
+    my $class = shift;
+    my $self = {};
+
+    bless $self, $class;
+    
+    return $self;
+}
+
+sub HelloWorld {
+    my $self = shift;
+    my $message = shift;
+    print "Do hello world\n";
+    print $message, "\n";
+    return ["Hello", " from example-service.pl"];
+}
+
+sub GetDict {
+    my $self = shift;
+    print "Do get dict\n";
+    return {"first" => "Hello Dict", "second" => " from example-service.pl"};
+}
+
+sub GetTuple {
+    my $self = shift;
+    print "Do get tuple\n";
+    return ["Hello Tuple", " from example-service.pl"];
+}
+
+package SomeObject::DBus;
+
+use base qw(Net::DBus::ProxyObject);
+use Net::DBus::Exporter qw(org.designfu.SampleInterface);
+
+dbus_property("name", "string");
+dbus_property("email", "string", "read");
+dbus_property("salary", "int32", "write");
+
+sub new {
+    my $class = shift;
+    my $service = shift;
+    my $impl = shift;
+    my $self = $class->SUPER::new($service, "/SomeObject", $impl);
+    bless $self, $class;
+    
+    return $self;
+}
+
+dbus_method("HelloWorld", ["string"], [["array", "string"]], { param_names => ["message"], return_names => ["reply"] });
+dbus_method("GetDict", [], [["dict", "string", "string"]]);
+dbus_method("GetTuple", [], [["struct", "string", "string"]]);
+
+
+package main;
+
+my $bus = Net::DBus->session();
+my $object = SomeObject->new();
+my $service = $bus->export_service("org.designfu.SampleService");
+my $proxy = SomeObject::DBus->new($service, $object);
+
+$object->email('joe at example.com');
+
+Net::DBus::Reactor->main->run();

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libnet-dbus-perl.git