view release on metacpan or  search on metacpan

lib/Event/RPC/Client.pm  view on Meta::CPAN

            my $request_method = $method;
            no strict 'refs';
            *$local_method = sub {
                my $oid_ref = shift;
                my $rc      = $self->send_request({
                    cmd    => 'exec',
                    oid    => ${$oid_ref},
                    method => $request_method,
                    params => \@_,
                });
                return unless $rc;
                $rc = $rc->{rc};

                foreach my $val ( @{$rc} ) {
                    if ( ref $val eq 'ARRAY' ) {
                        foreach my $list_elem ( @{$val} ) {
                            my ($class) = split( "=", "$list_elem", 2 );
                            $self->load_class($class)
                                unless $loaded_classes->{$class};
                            my $list_elem_copy = $list_elem;
                            $list_elem = \$list_elem_copy;
                            bless $list_elem,
                                ( $class_map->{$class} || $class );
                        }
                    }
                    elsif ( ref $val eq 'HASH' ) {
                        foreach my $hash_elem ( values %{$val} ) {
                            my ($class) = split( "=", "$hash_elem", 2 );
                            $self->load_class($class)
                                unless $loaded_classes->{$class};
                            my $hash_elem_copy = $hash_elem;
                            $hash_elem = \$hash_elem_copy;
                            bless $hash_elem,
                                ( $class_map->{$class} || $class );
                        }
                    }
                    elsif ( defined $val ) {
                        my ($class) = split( "=", "$val", 2 );
                        $self->load_class($class)
                            unless $loaded_classes->{$class};
                        my $val_copy = $val;
                        $val = \$val_copy;
                        bless $val, ( $class_map->{$class} || $class );
                    }
                }
                return @{$rc} if wantarray;
                return $rc->[0];
            };
        }
    }

    return $local_class;
}

sub send_request {
    my $self = shift;
    my ($request) = @_;

    my $message = $self->get_message_format->new( $self->get_sock );

    $message->write_blocked($request);

    my $rc = eval { $message->read_blocked };

    if ($@) {
        $self->error($@);
        return;
    }

    if ( not $rc->{ok} ) {
        $rc->{msg} .= "\n" if not $rc->{msg} =~ /\n$/;
        croak ("$rc->{msg} -- called via Event::RPC::Client");
    }

    return $rc;
}

1;

__END__

=encoding utf8

=head1 NAME

Event::RPC::Client - Client API to connect to Event::RPC Servers

=head1 SYNOPSIS

  use Event::RPC::Client;

  my $rpc_client = Event::RPC::Client->new (
    #-- Required arguments
    host => "localhost",    # or "unix/" for Unix Domain socket
    port => 5555,           # or path to Unix Domain socket

    #-- Optional arguments
    classes   => [ "Event::RPC::Test" ],
    class_map => { "Event::RPC::Test" => "My::Event::RPC::Test" },

    ssl         => 1,
    ssl_ca_file => "some/ca.crt",
    ssl_ca_path => "some/ca/dir",
    ssl_opts    => { SSL_verifycn_name => 'server-hostname' },

    timeout     => 10,

    auth_user => "fred",
    auth_pass => Event::RPC->crypt("fred",$password),

    insecure_msg_fmt_ok => 1,

    error_cb => sub {
      my ($client, $error) = @_;
      print "An RPC error occured: $error\n";
      $client->disconnect;
      exit;
    },
  );

  $rpc_client->set_max_packet_size(2*1024*1024*1024);
  $rpc_client->connect;