lib/Catalyst/Controller/MessageDriven.pm

   1 package Catalyst::Controller::MessageDriven;
   2 use Moose;
   3 use Data::Serializer;
   4 use namespace::autoclean;
   5
   6 BEGIN { extends 'Catalyst::Controller' }
   7
   8 =head1 NAME
   9
  10 Catalyst::Controller::MessageDriven
  11
  12 =head1 SYNOPSIS
  13
  14   package MyApp::Controller::Queue;
  15   use Moose;
  16   BEGIN { extends 'Catalyst::Controller::MessageDriven' }
  17
  18   sub some_action : Local {
  19       my ($self, $c, $message) = @_;
  20
  21       # Handle message
  22
  23       # Reply with a minimal response message
  24       my $response = { type => 'testaction_response' };
  25       $c->stash->{response} = $response;
  26   }
  27
  28 =head1 DESCRIPTION
  29
  30 A Catalyst controller base class for use with Catalyst::Engine::Stomp,
  31 which handles YAML-serialized messages. A top-level "type" key in the
  32 YAML determines the action dispatched to.
  33
  34 =head1 METHODS
  35
  36 =head2 begin
  37
  38 Deserializes the request into C<< $c->stash->{request} >>
  39
  40 =head2 default
  41
  42 Dispatches to method named by the key C<< $c->stash->{request}->{type} >>
  43
  44 =head2 end
  45
  46 Serializes the response from C<< $c->stash->{response} >>
  47
  48 =cut
  49
  50 __PACKAGE__->config( serializer => 'YAML' );
  51
  52 sub begin : Private {
  53     my ($self, $c) = @_;
  54
  55     # Deserialize the request message
  56         my $message;
  57     my $serializer = $self->config->{serializer};
  58     my $s = Data::Serializer->new( serializer => $serializer );
  59     eval {
  60         my $body = $c->request->body;
  61         open my $IN, "$body" or die "can't open temp file $body";
  62         $message = $s->raw_deserialize(do { local $/; <$IN> });
  63     };
  64     if ($@) {
  65         # can't reply - reply_to is embedded in the message
  66         $c->error("exception in deserialize: $@");
  67     }
  68     else {
  69         $c->stash->{request} = $message;
  70     }
  71 }
  72
  73 sub end : Private {
  74     my ($self, $c) = @_;
  75
  76     # Engine will send our reply based on the value of this header.
  77     $c->response->headers->header( 'X-Reply-Address' => $c->stash->{request}->{reply_to} );
  78
  79     # The wire response
  80     my $output;
  81
  82     # Load a serializer
  83     my $serializer = $self->config->{serializer};
  84     my $s = Data::Serializer->new( serializer => $serializer );
  85
  86     # Custom error handler - steal errors from catalyst and dump them into
  87     # the stash, to get them serialized out as the reply.
  88      if (scalar @{$c->error}) {
  89         $c->log->error($_) for @{$c->error}; # Log errors in Catalyst
  90         my $error = join "\n", @{$c->error};
  91         $c->stash->{response} = { status => 'ERROR', error => $error };
  92         $output = $s->serialize( $c->stash->{response} );
  93         $c->clear_errors;
  94         $c->response->status(400);
  95      }
  96
  97     # Serialize the response
  98     eval {
  99         $output = $s->raw_serialize( $c->stash->{response} );
 100     };
 101     if ($@) {
 102          my $error = "exception in serialize: $@";
 103          $c->stash->{response} = { status => 'ERROR', error => $error };
 104          $output = $s->serialize( $c->stash->{response} );
 105         $c->response->status(400);
 106     }
 107
 108     $c->response->output( $output );
 109 }
 110
 111 sub default : Private {
 112     my ($self, $c) = @_;
 113
 114     # Forward the request to the appropriate action, based on the
 115     # message type.
 116     my $action = $c->stash->{request}->{type};
 117     if (defined $action) {
 118         $c->forward($action, [$c->stash->{request}]);
 119     }
 120     else {
 121          $c->error('no message type specified');
 122     }
 123 }
 124
 125 __PACKAGE__->meta->make_immutable;
 126