[libnet-dbus-perl] 31/335: Changed example programs to match python examples

Intrigeri intrigeri at moszumanska.debian.org
Sat Mar 21 01:07:15 UTC 2015


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 0b7b2d1b6b3a5fd47ba2a476ea72e4fc7236f3fd
Author: Daniel P. Berrange <dan at berrange.com>
Date:   Tue Nov 23 23:27:08 2004 +0000

    Changed example programs to match python examples
---
 examples/{client.pl => binding-client.pl} |  0
 examples/{server.pl => binding-server.pl} |  0
 examples/echo.pl                          | 24 -------------------
 examples/example-client.pl                | 13 +++++++++++
 examples/example-service.pl               | 39 +++++++++++++++++++++++++++++++
 examples/example-signal-emitter.pl        | 37 +++++++++++++++++++++++++++++
 examples/example-signal-receiver.pl       | 25 ++++++++++++++++++++
 examples/hello.pl                         | 13 -----------
 8 files changed, 114 insertions(+), 37 deletions(-)

diff --git a/examples/client.pl b/examples/binding-client.pl
similarity index 100%
rename from examples/client.pl
rename to examples/binding-client.pl
diff --git a/examples/server.pl b/examples/binding-server.pl
similarity index 100%
rename from examples/server.pl
rename to examples/binding-server.pl
diff --git a/examples/echo.pl b/examples/echo.pl
deleted file mode 100644
index e1d2336..0000000
--- a/examples/echo.pl
+++ /dev/null
@@ -1,24 +0,0 @@
-#/usr/bin/perl
-
-use Net::DBus;
-
-my $bus = Net::DBus->new($Net::DBus::TYPE_SESSION);
-
-my $service = $bus->get_service("org.example.MyService",
-				$bus);
-
-my $object = $service->get_object("/org/example/MyObject",
-				  "org.example.MyObject");
-
-
-use Data::Dumper;
-
-print "Echoed ", join("\n", Dumper($object->Echo(dstring ("Earth"),
-						 dboolean (1),
-						 dbyte (24),
-						 dint32(["1","0","1","1","1","0","1"]),
-						 "Some random stuff",
-						 dstring("More random stff"),
-						 dint32 (-24532),
-						 duint32 (32442)))), "\n";
-
diff --git a/examples/example-client.pl b/examples/example-client.pl
new file mode 100644
index 0000000..a9fc08b
--- /dev/null
+++ b/examples/example-client.pl
@@ -0,0 +1,13 @@
+#/usr/bin/perl
+
+use Net::DBus;
+
+my $bus = Net::DBus->session();
+
+my $service = $bus->get_service("org.designfu.SampleService");
+my $object = $service->get_object("/SomeObject",
+				  "org.designfu.SampleInterface");
+
+my $reply = $object->HelloWorld("Hello from example-client.pl!");
+
+print "[", join(",", @{$reply}), "]\n";
diff --git a/examples/example-service.pl b/examples/example-service.pl
new file mode 100644
index 0000000..c11b811
--- /dev/null
+++ b/examples/example-service.pl
@@ -0,0 +1,39 @@
+#!/usr/bin/perl
+
+use Carp qw(confess cluck);
+use Net::DBus;
+use Net::DBus::Service;
+use Net::DBus::Reactor;
+
+my $bus = Net::DBus->session();
+my $service = Net::DBus::Service->new("org.designfu.SampleService", 
+				      $bus);
+
+my $object = SomeObject->new($service);
+
+my $reactor = Net::DBus::Reactor->new();
+$reactor->manage($bus->{connection});
+$reactor->run();
+
+package SomeObject;
+
+use base qw(Net::DBus::Object);
+
+sub new {
+    my $class = shift;
+    my $self = $class->SUPER::new("/SomeObject",
+				  ["HelloWorld"],
+				  @_);
+    
+    bless $self, $class;
+    
+    return $self;
+}
+
+sub HelloWorld {
+    my $self = shift;
+    my $message = shift;
+    print $message, "\n";
+    return ["Hello", "from example-service.pl"];
+}
+
diff --git a/examples/example-signal-emitter.pl b/examples/example-signal-emitter.pl
new file mode 100644
index 0000000..723a27a
--- /dev/null
+++ b/examples/example-signal-emitter.pl
@@ -0,0 +1,37 @@
+#!/usr/bin/perl -w
+
+use Net::DBus;
+use Net::DBus::Reactor;
+use Net::DBus::Service;
+use Net::DBus::Object;
+
+my $bus = Net::DBus->session();
+my $service = Net::DBus::Service->new("org.designfu.TestService", 
+				      $bus);
+my $object = TestObject->new($service);
+
+my $reactor = Net::DBus::Reactor->new();
+$reactor->manage($bus->{connection});
+$reactor->run();
+
+package TestObject;
+
+use base qw(Net::DBus::Object);
+
+sub new {
+    my $class = shift;
+    my $self = $class->SUPER::new("/object",
+				  ["emitHelloSignal"],
+				  @_);
+    
+    bless $self, $class;
+    
+    return $self;
+}
+
+sub emitHelloSignal {
+    my $self = shift;
+    $self->emit_signal("org.designfu.TestService", 
+		       "hello");
+}
+
diff --git a/examples/example-signal-receiver.pl b/examples/example-signal-receiver.pl
new file mode 100644
index 0000000..5f89e07
--- /dev/null
+++ b/examples/example-signal-receiver.pl
@@ -0,0 +1,25 @@
+#!/usr/bin/perl -w
+
+use Net::DBus;
+use Net::DBus::Reactor;
+
+my $bus = Net::DBus->session();
+
+my $service = $bus->get_service("org.designfu.TestService");
+my $object  = $service->get_object("/object", 
+				   "org.designfu.TestService");
+
+sub hello_signal_handler {
+    my ($interface, $signal_name, $service_name, $path, $message) = @_;
+    printf "Received signal '%s.%s' from object '%s%s'\n", 
+      $interface, $signal_name, $service_name, $path;
+}
+
+$object->connect_to_signal("hello", \&hello_signal_handler);
+
+# Tell the remote object to emit the signal
+$object->emitHelloSignal();
+
+my $reactor = Net::DBus::Reactor->new();
+$reactor->manage($bus->{connection});
+$reactor->run();
diff --git a/examples/hello.pl b/examples/hello.pl
deleted file mode 100644
index 7893a3c..0000000
--- a/examples/hello.pl
+++ /dev/null
@@ -1,13 +0,0 @@
-#/usr/bin/perl
-
-use Net::DBus;
-
-my $bus = Net::DBus->new($Net::DBus::TYPE_SESSION);
-
-my $service = $bus->get_service("org.example.MyService",
-				$bus);
-
-my $object = $service->get_object("/org/example/MyObject",
-				  "org.example.MyObject");
-
-print "Reply ", join("\n", $object->HelloWorld("Earth")), "\n";

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



More information about the Pkg-perl-cvs-commits mailing list