package XAS::Lib::RPC::JSON::Server;

our $VERSION = '0.02';

use POE;
use Try::Tiny;

use XAS::Class
  version   => $VERSION,
  base      => 'XAS::Lib::Net::Server',
  codec     => 'JSON',
  constants => 'HASH ARRAY :jsonrpc',
  messages => {
      'rpc_method'  => "the rpc method \"%s\" is unknown",
      'rpc_version' => "this server supports only json-rpc version 2.0",
      'rpc_format'  => "this json-rpc format is not supported",
      'rpc_batch'   => "the usage of json-rpc batch mode is not supported",
      'rpc_notify'  => "the usage of json-rpc notifications is not supported",
      'nologger'    => 'no Logger defined',
  },
;

my $errors = {
    '-32700' => 'Parse Error',
    '-32600' => 'Invalid Request',
    '-32601' => 'Method not Found',
    '-32602' => 'Invalid Params',
    '-32603' => 'Internal Error',
    '-32099' => 'Server Error',
    '-32001' => 'App Error',
};

use Data::Dumper;

# ----------------------------------------------------------------------
# Public Methods
# ----------------------------------------------------------------------

sub process {
    my ($self, $message, $wheel) = @_;

    my $result;
    my $packet;
    my $output;
    my $request;
    my @packets;

    $request = decode($message);

    if (ref($request) eq ARRAY) {

        foreach my $r (@$request) {

            try {

                $result = $self->_process_request($r);
                $packet = $self->_rpc_result($r->{id}, $result);

            } catch {

                my $ex = $_;

                $packet = $self->_exception_handler($ex, $r->{id});

            };

            push(@packets, $packet);

        }

        $output = encode(@packets);

    } else {

        try {

            $result = $self->_process_request($request);
            $packet = $self->_rpc_result($request->{id}, $result);

        } catch {

            my $ex = $_;

	        $packet = $self->_exception_handler($ex, $request->{id});

        };

        $output = encode($packet);

    }

    return $output;

}

sub log {
    my ($self, $level, $message) = @_;

    my $logger = $self->logger;

    $poe_kernel->post($logger, $level, $message);

}

# ----------------------------------------------------------------------
# Private Methods
# ----------------------------------------------------------------------

sub _exception_handler {
    my ($self, $ex, $id) = @_;

    my $packet;
    my $ref = ref($ex);

    if ($ref) {

        if ($ex->isa('XAS::Exception')) {

            my $type = $ex->type;
            my $info = $ex->info;

            if ($type eq ('xas.lib.rpc.json.server.rpc_method')) {

                $packet = $self->_rpc_error($id, RPC_ERR_METHOD, $info);

            } elsif ($type eq ('xas.lib.rpc.json.server.rpc_version')) {

                $packet = $self->_rpc_error($id, RPC_ERR_REQ, $info);

            } elsif ($type eq ('xas.lib.rpc.json.server.rpc_format')) {

                $packet = $self->_rpc_error($id, RPC_ERR_PARSE, $info);

            } elsif ($type eq ('xas.lib.rpc.json.server.rpc_notify')) {

                $packet = $self->_rpc_error($id, RPC_ERR_INTERNAL, $info);

            } else {

                my $msg = $type . ' - ' . $info;
                $packet = $self->_rpc_error($id, RPC_ERR_APP, $msg);

            }

        } else {

            $packet = $self->_rpc_error($id, RPC_ERR_SERVER, "Server error");

        }

    } else {

        my $msg = sprintf("%s", $ex);
        $packet = $self->_rpc_error($id, RPC_ERR_APP, $msg);

    }

    return $packet;

}

sub _process_request {
    my ($self, $request) = @_;

    my $method;
    my $output;

    if (ref($request) ne HASH) {

        $self->throw_msg(
            'xas.lib.rpc.json.server.format', 
            'rpc_format'
        );

    }

    if ($request->{jsonrpc} ne RPC_JSON) {

        $self->throw_msg(
            'xas.lib.rpc.json.server.rpc_version', 
            'rpc_version'
        );

    }

    unless (defined($request->{id})) {

        $self->throw_msg(
            'xas.lib.rpc.json.server.nonotifications', 
            'rpc_nonotify'
        );

    }

    $method = 'do_' . $request->{method};

    if ($self->can($method)) {

        $output = $self->$method($request->{params});

    } else {

        $self->throw_msg(
            'xas.lib.rpc.json.server.rpc_method', 
            'rpc_method', 
            $request->{method}
        );

    }

    return $output;

}

sub _rpc_error {
    my ($self, $id, $code, $message) = @_;

    my $response = {
        jsonrpc => RPC_JSON,
        id      => $id,
        error   => {
            code    => $code,
            message => $errors->{$code},
            data    => $message
        }
    };

    return $response;

}

sub _rpc_result {
    my ($self, $id, $result) = @_;

    my $response = {
        jsonrpc => RPC_JSON,
        id      => $id,
        result  => $result
    };

    return $response;

}

1;

__END__

=head1 NAME

XAS::Lib::RPC::JSON::Server - A JSON RPC interface for the XAS environment

=head1 SYNOPSIS

 my $server = XAS::Lib::RPC::JSON::Server->new(
     -alias   => 'server',
     -port    => '9505',
     -address => 'localhost',
     -logger  => 'logger'
 );

=head1 DESCRIPTION

This modules implements a simple JSON RPC v2.0 server. It needs to be extended
to be usefull. This runs as a POE session. It doesn't support "Notification" 
calls.

=head1 METHODS

=head2 new

This initializes the module and starts listening for requests. There are
five parameters that can be passed. They are the following:

=over 4

=item B<-alias>

The name of the POE session.

=item B<-port>

The IP port to listen on (default 9505).

=item B<-address>

The address to bind to (default 127.0.0.1).

=item B<-logger>

The name of the logger session.

=back

=head2 process($packet, $wheel)

This method will attempt to parse the JSON RPC packet and call the correct RPC
method. While returning the correct response to the client.

=over 4

=item B<$packet>

The packet received from the socket.

=item B<$wheel>

The current POE wheel.

=back

=head2 log($level, $message)

This method will send log message to the logger session.

=over 4

=item B<$level>

The log level.

=item B<$message>

The message to log.

=back

=head1 SEE ALSO

 XAS::Base
 XAS::Class
 XAS::Constants
 XAS::Exception
 XAS::System
 XAS::Utils

 XAS::Apps::Base::Alerts
 XAS::Apps::Base::Collector
 XAS::Apps::Base::ExtractData
 XAS::Apps::Base::ExtractGlobals
 XAS::Apps::Base::RemoveData
 XAS::Apps::Database::Schema
 XAS::Apps::Templates::Daemon
 XAS::Apps::Templates::Generic
 XAS::Apps::Test::Echo::Client
 XAS::Apps::Test::Echo::Server
 XAS::Apps::Test::RPC::Client
 XAS::Apps::Test::RPC::Methods
 XAS::Apps::Test::RPC::Server

 XAS::Collector::Alert
 XAS::Collector::Base
 XAS::Collector::Connector
 XAS::Collector::Factory

 XAS::Lib::App
 XAS::Lib::App::Daemon
 XAS::Lib::App::Daemon::POE
 XAS::Lib::Connector
 XAS::Lib::Counter
 XAS::Lib::Daemon::Logger
 XAS::Lib::Daemon::Logging
 XAS::Lib::Gearman::Admin
 XAS::Lib::Gearman::Admin::Status
 XAS::Lib::Gearman::Admin::Worker
 XAS::Lib::Gearman::Client
 XAS::Lib::Gearman::Client::Status
 XAS::Lib::Gearman::Worker
 XAS::Lib::Net::Client
 XAS::LIb::Net::Server
 XAS::Lib::RPC::JSON::Client
 XAS::Lib::RPC::JSON::Server
 XAS::Lib::Session
 XAS::Lib::Spool

 XAS::Model::Database
 XAS::Model::Database::Alert
 XAS::Model::Database::Counter
 XAS::Model::DBM

 XAS::Monitor::Base
 XAS::Monitor::Database
 XAS::Monitor::Database::Alert

 XAS::Scheduler::Base

 XAS::System::Alert
 XAS::System::Email
 XAS::System::Environment
 XAS::System::Logger

=head1 AUTHOR

Kevin L. Esteb, E<lt>kevin@kesteb.usE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2012 by Kevin L. Esteb

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.8 or,
at your option, any later version of Perl 5 you may have available.

=cut
