[libnet-dbus-perl] 100/335: Added example use of properties

Intrigeri intrigeri at moszumanska.debian.org
Sat Mar 21 01:07:32 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 c8cacf258c5f8728d7551594e2078f0ec9b56a34
Author: Daniel P. Berrange <dan at berrange.com>
Date:   Fri Sep 9 14:16:04 2005 +0000

    Added example use of properties
---
 examples/example-client.pl  | 10 ++++++++--
 examples/example-service.pl |  6 ++++++
 2 files changed, 14 insertions(+), 2 deletions(-)

diff --git a/examples/example-client.pl b/examples/example-client.pl
index c24c963..d671a63 100644
--- a/examples/example-client.pl
+++ b/examples/example-client.pl
@@ -1,9 +1,9 @@
 #/usr/bin/perl
 
 use Net::DBus;
-use Carp qw(cluck carp);
+use Carp qw(cluck carp confess);
 #$SIG{__WARN__} = sub { cluck $_[0] };
-#$SIG{__DIE__} = sub { carp $_[0] };
+#$SIG{__DIE__} = sub { confess "[". $_[0] ."]"};
 
 my $bus = Net::DBus->find();
 
@@ -21,3 +21,9 @@ print "(", join(", ", map { "'$_'" } @{$tuple}), ")\n";
 my $dict = $object->GetDict();
 
 print "{", join(", ", map { "'$_': '" . $dict->{$_} . "'"} keys %{$dict}), "}\n";
+
+$object->name("John Doe");
+$object->age(21);
+$object->email('john.doe at example.com');
+
+print $object->name, " ", $object->age, " ", $object->email, "\n";
diff --git a/examples/example-service.pl b/examples/example-service.pl
index cd391d2..04efacc 100644
--- a/examples/example-service.pl
+++ b/examples/example-service.pl
@@ -13,6 +13,12 @@ package SomeObject;
 use base qw(Net::DBus::Object);
 use Net::DBus::Exporter qw(org.designfu.SampleInterface);
 
+use Class::MethodMaker [ scalar => [ qw(name email age) ]];
+
+dbus_property("name", "string");
+dbus_property("email", "string", "read");
+dbus_property("age", "int32", "write");
+
 sub new {
     my $class = shift;
     my $service = shift;

-- 
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