| Subject: | Returning objects from PlServer |
Hi,
We are using your module very happly. Thank you. Below you can find some methods over ridden which makes 'returning objects which lives on the server side' possible.
It should not effect the current interface. Just adds bit more functionalty. You might want to have a look at it , when you have a little extra time.
Regards,
Ziya Suzen
#### SERVER ####
# Overriden methods for returning objects back to the Client
sub NewHandle ($$$@) {
my($self, $handle, $method, @args) = @_;
my(undef, $object) = $self->CallMethod($handle, $method, @args);
die "Constructor $method didn't return a true value" unless $object;
('', $self->StoreHandle($object))
}
sub CallMethod ($$$@) {
my($self, $handle, $method, @args) = @_;
my($ref, $object);
my $call_by_instance;
{
my $lock = lock($Net::Daemon::RegExpLock)
if $Net::Daemon::RegExpLock && $self->{'mode'} eq 'threads';
$call_by_instance = ($handle =~ /=\w+\(0x/);
}
if ($call_by_instance) {
$self->Debug("CallMethod: Call by instance");
# Looks like a call by instance
$object = $self->UseHandle($handle);
$ref = ref($object);
}
else {
$self->Debug("CallMethod: Call by class");
# Call by class
$ref = $object = $handle;
}
if ($self->{'methods'}) {
my $class = $self->{'methods'}->{$ref};
if (!$class || !$class->{$method}) {
die "Not permitted for method $method of class $ref";
}
$self->Debug("CallMethod: Class: $class");
if ($class->{$method} eq 'object') {
$self->Debug("CallMethod: Method returns object.");
my $returned_object = $object->$method(@args);
return ('object', $self->StoreHandle($returned_object))
}
if ($class->{$method} eq 'array_of_objects') {
$self->Debug("CallMethod: Method returns array of objects.");
my @returned_objects = $object->$method(@args);
my @array_of_objects;
foreach my $returned_object (@returned_objects) {
push @array_of_objects, $self->StoreHandle($returned_object);
}
return ('array_of_objects', @array_of_objects);
}
}
$self->Debug("CallMethod: Runnig Object:$object Method:$method");
('', $object->$method(@args));
}
#### CLIENT ####
use base ('RPC::PlClient');
sub Call ($@) {
my $self = shift;
$self->RPC::PlServer::Comm::Write([@_]);
my $msg = $self->RPC::PlServer::Comm::Read();
my $return_type = shift @$msg if ref($msg) eq 'ARRAY';
if ($return_type eq 'object') {
my($object) = @$msg;
$object =~ /^((?:\w+|\:\:)+)=(\w+)/;
return RPC::PlClient::Object->new($1, $self, $object);
}
if ($return_type eq 'array_of_objects') {
my @return_objects;
foreach my $object (@$msg) {
$object =~ /^((?:\w+|\:\:)+)=(\w+)/;
push @return_objects,
RPC::PlClient::Object->new($1, $self, $object);
}
return @return_objects;
}
die "Unexpected EOF while waiting for server reply" unless defined($msg);
die "Server returned error: $$msg" if ref($msg) eq 'SCALAR';
die "Expected server to return an array ref" unless ref($msg) eq 'ARRAY';
@$msg;
}
### EXAMPLE CONF FILE ###
.........
#'debug' => 1,
'mode' => 'fork', # Recommended for Unix
'methods' =>
{
# General Interface
'RIPE::NCC::RegProxy::Server' =>
{
'Call' => 1,
'ClientObject' => 1,
'CallMethod' => 1,
'NewHandle' => 1
},
'My::Module' =>
{
'new' => 1,
'a_method' => 1,
'return_objects' => 'array_of_objects',
'return_one_object' => 'object',
.......