CPAN::Groonga

package Anyevent::JSONRPC::Utils;

use base qw(Exporter);
our @EXPORT_OK = qw(
    delegate
    do_moose
    do_exporter
);

sub delegate {
    my $object = shift;
    
    croak("delegate needs a blessed object as parameter") unless blessed $object;

    if ( $object->isa("AnyEvent::JSONRPC::Client") ) {
        # Any call is proxied to the client

        return sub {
            my $cv   = shift;
            my $call = $cv->call;

            my $result = $object->call ( $call->method => $call );

            eval { $cv->result( $result->recv ); 1 } or $cv->error( $@ );
        }
    }

    # Any call is asumed to be a method call

    return sub {
        my $cv     = shift;
        my $method = $cv->call->method;

        my @result;
        eval { 
            @result = $self->$method( @_ ); 1 
        } or do {
            my $error = $@;

            if ( blessed $error or ref $error eq "HASH") {
                $cv->error( $error ) if blessed $error or ref $error eq "HASH";
            } else {
                $cv->error( { code => -32603, message => "Internal error", data => $error 
            }
        };

        $cv->result( @result );        
    }
}

my %protected = (
    meta => 1,
    dump => 1,
    does => 1,
    new  => 1,
);

sub do_moose {
    my $object = shift;

    croak("do_moose needs a moose object as parameter")
        unless blessed $object and $object->isa("Moose::Object");

    my $delegator = delegate($object);

    return map  { $_ => $delegator } 
           grep { !$protected{$_} and !/^_/ and !/^[A-Z]*$/ }  $object->meta->get_all_method_names;
}

1;

__END__

=head1 NAME

AnyEvent::JSONRPC::Utils - Helper functions for use with AnyEvent::JSONRPC

=head1 SYNOPSIS

    # XXX being either TCP or HTTP
    my $server = AnyEvent::JSONRPC::XXX::Server->new();

    # Delegate methods to an object:
    my $object = Foo->new();
    $server->reg_cb(
        method1 => delegate($object),
    );

    # Delegate methods to another json-rpc server
    my $client = AnyEvent::JSONRPC::XXX::Client->new();
    $server->reg_cb(
        method2 => delegate($client),
    );

    # Delegate all methods from moose object
    my $object = Bar->new();
    $server->reg_cb(
        do_moose($object),
    );


=head1 DESCRIPTION

This module provides a couple of helper functions for creating JSON-RPC
servers. This is kind of experimental at the moment.

=head1 FUNCTIONS

=over 4

=item C<delegate <$objectE<gt>>

This function returns a generic subroutine usable for registering method
calls. The same subroutine can be used for registering multiple methods
delegated to the same object.

If C<$object> is a L<AnyEvent::JSONRPC> client method calls will be proxied
through this client, otherwise it is assumed to be method calls on the object.

=item C<do_moose <$objectE<gt>>

This function returns a complete delegation of methods to a Moose object. Some
methods are considered protected and should be explicitly registered if
needed. This includes all method names starting with an underscore, all
methodnames consisting of only capital letters, and the following methods
generated by Moose: C<new>, C<meta>, C<dump>, and C<does>.

=back

=head1 AUTHOR

Peter Makholm <peter@makholm.net>

=head1 COPYRIGHT AND LICENSE

Copyright (c) 2010 by Peter Makholm.

This program is free software; you can redistribute
it and/or modify it under the same terms as Perl itself.

The full text of the license can be found in the
LICENSE file included with this module.

=cut