[libnet-dbus-perl] 308/335: Cache objects when casting to interfaces

[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 de685be5fb7a1e1c3858054b50ee16b648363cd3
Author: Pavel Strashkin <pavel.strashkin at gmail.com>
Date:   Mon Nov 14 20:24:00 2011 +0000

    Cache objects when casting to interfaces
    
    To avoid creating an unbounded number of Net::DBus::RemoteObject
    instances after casting to interfaces, cache the cast objects.
---
 lib/Net/DBus/RemoteObject.pm | 10 +++++++---
 1 file changed, 7 insertions(+), 3 deletions(-)

diff --git a/lib/Net/DBus/RemoteObject.pm b/lib/Net/DBus/RemoteObject.pm
index af7cf2e..dc08bc5 100644
--- a/lib/Net/DBus/RemoteObject.pm
+++ b/lib/Net/DBus/RemoteObject.pm
@@ -101,6 +101,7 @@ sub new {
     $self->{service} = shift;
     $self->{object_path}  = shift;
     $self->{interface} = @_ ? shift : undef;
+    $self->{interfaces} = {};
     $self->{introspected} = 0;
     $self->{signal_handlers} = {};
     $self->{signal_id} = 0;
@@ -130,9 +131,12 @@ sub as_interface {
     die "already cast to " . $self->{interface} . "'"
 	if $self->{interface};
 
-    return $self->new($self->{service},
-		      $self->{object_path},
-		      $interface);
+    unless (exists $self->{interfaces}->{$interface}) {
+	$self->{interfaces}->{$interface} = 
+	    $self->new($self->{service},
+		       $self->{object_path});
+    }
+    return $self->{interfaces}->{$interface};
 }
 
 =item my $service = $object->get_service

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