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          my $error = join "\n", @{$c->error};
  90          $c->stash->{response} = { status => 'ERROR', error => $error };
  91         $output = $s->serialize( $c->stash->{response} );
  92         $c->clear_errors;
  93         $c->response->status(400);
  94      }
  95
  96     # Serialize the response
  97     eval {
  98         $output = $s->raw_serialize( $c->stash->{response} );
  99     };
 100     if ($@) {
 101          my $error = "exception in serialize: $@";
 102          $c->stash->{response} = { status => 'ERROR', error => $error };
 103          $output = $s->serialize( $c->stash->{response} );
 104         $c->response->status(400);
 105     }
 106
 107     $c->response->output( $output );
 108 }
 109
 110 sub default : Private {
 111     my ($self, $c) = @_;
 112
 113     # Forward the request to the appropriate action, based on the
 114     # message type.
 115     my $action = $c->stash->{request}->{type};
 116     if (defined $action) {
 117         $c->forward($action, [$c->stash->{request}]);
 118     }
 119     else {
 120          $c->error('no message type specified');
 121     }
 122 }
 123
 124 __PACKAGE__->meta->make_immutable;
 125