CouchDB::ExternalProcess - Make creating Perl-based external processs for CouchDB

  package MyProcess;
  use base qw/CouchDB::ExternalProcess/;

  sub _before {
      my ($self, $request) = @_;
      # Do something with the hashref $request
      return $request;
  }

  sub hello_world :Action {
      my ($self, $req) = @_;
      my $response = {
          body => "Hello, " . $req->{query}->{greeting_target} . "!"
      };
      return $response;
  }

  sub _after {
      my ($self,$response) = @_;
      # Do something with the hashref $response
      return $response;
  }

  [external]
  my_process = perl -MMyProcess -e 'MyProcess->new->run'

  [httpd_db_handlers]
  _my_process = {couch_httpd_external, handle_external_req, <<"my_process">>}

  http://myserver/databaseName/_my_process/hello_world/?greeting_target=Sally

  Hello, Sally!

  {
      code => 500,
      json => {
          error => $error
      }
  }

  sub foo :Action :Description("Foo!") :Args("Some data") {
    # ... 
  }

  sub bar :Action
          :Description("Get your Bar on!")
          :Args({name => "Name of something", color => "RGB Color Value"}) 
  {
    # ... 
  }

  {
    "foo": {
        "description": "Foo!",
        "args": "Some data"
    },
    "bar": }
        "description": "Get your Bar on!",
        "args": "Some data"
    }
  }

    Mike Walker
    CPAN ID: FANSIPANS
    mike-cpan-couchdb-externalprocess@napkindrawing.com
    http://napkindrawing.com/

	The BSD License

package CouchDB::ExternalProcess;

use strict;
use warnings;

use Attribute::Handlers;
use JSON::Any;

BEGIN {
    use Exporter ();
    use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
    $VERSION     = '0.02';
    @ISA         = qw(Exporter);
    #Give a hoot don't pollute, do not export more than needed by default
    @EXPORT      = qw();
    @EXPORT_OK   = qw();
    %EXPORT_TAGS = ();
}

my %actions = (
    _meta => \&_meta
);
my %metadata;

sub new
{
    my ($class, %parameters) = @_;

    my $self = bless ({}, ref ($class) || $class);

    $self->jsonParser(JSON::Any->new);

    return $self;
}

sub run {
    my $self = shift;
    my %opts = @_;

    my $in_fh = $opts{in_fh} || *STDIN;
    my $out_fh = $opts{out_fh} || *STDOUT;

    $SIG{__DIE__} = sub {
        close($in_fh);
        close($out_fh);
        $self->_destroy();
        print STDERR "Error In ExternalProcess '".(ref $self)."': @_";
        exit();
    };

    $self->_init;

    $| = 1;
    while(my $reqJson = <$in_fh>) {
        my $output = $self->_process($reqJson);
        print $out_fh $output . $/;
    }

    close($in_fh);
    close($out_fh);

    $self->_destroy;
}

sub jsonParser {
    my ($self, $jp) = @_;
    $self->{jsonParser} = $jp if $jp;
    return $self->{jsonParser};
}

sub _init {
}

sub _destroy {
}

sub _before {
    return $_[1];
}

sub _after {
    return $_[1];
}

sub _error {
    my ($self, $error) = @_;
    return {
        code => 500,
        json => {
            error => $error
        }
    }
}

sub _extract_action_name {
    my ($self,$req) = @_;
    return $req->{path}->[2];
}

sub _meta {
    return {
        json => \%metadata,
    };
}

sub _process {
    my ($self, $reqJson) = @_;

    my $req = $self->jsonParser->jsonToObj($reqJson);
    my $response = {};

    # TODO: Strip first component off and use that as name?
    my $actionName = $self->_extract_action_name($req);

    eval {
        # Do we have the requested action ...
        if(!defined($actionName) || !defined($actions{$actionName})) {
            die("The specified action is not defined\n");
        }

        # Run _before
        $req = $self->_before($req);

        # Run the action
        $response = $actions{$actionName}->($self, $req);

        # Run _after
        $response = $self->_after($response);
    };

    if($@) {
        chomp($@);
        my $error = $@;
        eval {
            $response = $self->_error($error);
        };
        if($@) {
            $response->{code} = 500;
            $response->{json}->{error} = [ $error, $@ ];
        }
    }

    return $self->jsonParser->objToJson($response);
}

sub Action :ATTR {
    my $args = attrArgs(@_);
    my $subName = *{$args->{symbol}}{NAME};

    my @reservedNames = qw/
        _meta _init _error _destroy _before _after _process new run
    /;

    if(grep { $_ eq $subName} @reservedNames) {
        die("'$subName' is a reserved method name and cannot be used as an action name");
    }

    $actions{ $subName } = $args->{referent};
}

sub Description :ATTR {
    my $args = attrArgs(@_);
    die(":Description attribute must specify a string describing the method")
        unless $args->{data};
    my $subName = *{$args->{symbol}}{NAME};
    $metadata{ $subName } ||= {};
    $metadata{ $subName }->{description} = $args->{data};
}

sub Args :ATTR {
    my $args = attrArgs(@_);
    die(":Args attribute must specify a list of arguments the method accepts")
        unless $args->{data};
    my $subName = *{$args->{symbol}}{NAME};
    $metadata{ $subName } ||= {};
    $metadata{ $subName }->{args} = $args->{data};
}

sub attrArgs {
    my %args;
    @args{qw/ package symbol referent attr data phase filename linenum /} = @_;
    return \%args;
}

#################### main pod documentation end ###################


1;
# The preceding line will help the module return a true value