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 =cut
  35
  36 __PACKAGE__->config( serializer => 'YAML' );
  37
  38 sub begin : Private {
  39     my ($self, $c) = @_;
  40
  41     # Deserialize the request message
  42         my $message;
  43     my $serializer = $self->config->{serializer};
  44     my $s = Data::Serializer->new( serializer => $serializer );
  45     eval {
  46         my $body = $c->request->body;
  47         open my $IN, "$body" or die "can't open temp file $body";
  48         $message = $s->raw_deserialize(do { local $/; <$IN> });
  49     };
  50     if ($@) {
  51         # can't reply - reply_to is embedded in the message
  52         $c->error("exception in deserialize: $@");
  53     }
  54     else {
  55         $c->stash->{request} = $message;
  56     }
  57 }
  58
  59 sub end : Private {
  60     my ($self, $c) = @_;
  61
  62     # Engine will send our reply based on the value of this header.
  63     $c->response->headers->header( 'X-Reply-Address' => $c->stash->{request}->{reply_to} );
  64
  65     # The wire response
  66     my $output;
  67
  68     # Load a serializer
  69     my $serializer = $self->config->{serializer};
  70     my $s = Data::Serializer->new( serializer => $serializer );
  71
  72     # Custom error handler - steal errors from catalyst and dump them into
  73     # the stash, to get them serialized out as the reply.
  74      if (scalar @{$c->error}) {
  75          my $error = join "\n", @{$c->error};
  76          $c->stash->{response} = { status => 'ERROR', error => $error };
  77         $output = $s->serialize( $c->stash->{response} );
  78         $c->clear_errors;
  79         $c->response->status(400);
  80      }
  81
  82     # Serialize the response
  83     eval {
  84         $output = $s->raw_serialize( $c->stash->{response} );
  85     };
  86     if ($@) {
  87          my $error = "exception in serialize: $@";
  88          $c->stash->{response} = { status => 'ERROR', error => $error };
  89          $output = $s->serialize( $c->stash->{response} );
  90         $c->response->status(400);
  91     }
  92
  93     $c->response->output( $output );
  94 }
  95
  96 sub default : Private {
  97     my ($self, $c) = @_;
  98
  99     # Forward the request to the appropriate action, based on the
 100     # message type.
 101     my $action = $c->stash->{request}->{type};
 102     if (defined $action) {
 103         $c->forward($action, [$c->stash->{request}]);
 104     }
 105     else {
 106          $c->error('no message type specified');
 107     }
 108 }
 109
 110 __PACKAGE__->meta->make_immutable;
 111