Use Data::Serializer, instead of hardcoding YAML. Allow the type of serializer
[catagits/Catalyst-Engine-STOMP.git] / lib / Catalyst / Controller / MessageDriven.pm
CommitLineData
0a663589 1package Catalyst::Controller::MessageDriven;
2use Moose;
a5ae1e8c 3use Data::Serializer;
0a663589 4
5BEGIN { extends 'Catalyst::Controller' }
6
d78bb739 7=head1 NAME
8
9Catalyst::Controller::MessageDriven
10
11=head1 SYNOPSIS
12
13 package MyApp::Controller::Queue;
14 use Moose;
15 BEGIN { extends 'Catalyst::Controller::MessageDriven' }
16
17 sub some_action : Local {
bf8937b7 18 my ($self, $c, $message) = @_;
19
20 # Handle message
21
d78bb739 22 # Reply with a minimal response message
23 my $response = { type => 'testaction_response' };
24 $c->stash->{response} = $response;
25 }
26
27=head1 DESCRIPTION
28
29A Catalyst controller base class for use with Catalyst::Engine::Stomp,
30which handles YAML-serialized messages. A top-level "type" key in the
31YAML determines the action dispatched to.
32
33=cut
34
a5ae1e8c 35__PACKAGE__->config( serializer => 'YAML' );
36
bf8937b7 37sub begin : Private {
38 my ($self, $c) = @_;
39
40 # Deserialize the request message
bf8937b7 41 my $message;
a5ae1e8c 42 my $serializer = $self->config->{serializer};
43 my $s = Data::Serializer->new( serializer => $serializer );
bf8937b7 44 eval {
45 my $body = $c->request->body;
a5ae1e8c 46 open my $IN, "$body" or die "can't open temp file $body";
47 $message = $s->raw_deserialize(do { local $/; <$IN> });
bf8937b7 48 };
49 if ($@) {
50 # can't reply - reply_to is embedded in the message
51 $c->error("exception in deserialize: $@");
52 }
53 else {
54 $c->stash->{request} = $message;
55 }
56}
0a663589 57
bf8937b7 58sub end : Private {
0a663589 59 my ($self, $c) = @_;
60
61 # Engine will send our reply based on the value of this header.
bf8937b7 62 $c->response->headers->header( 'X-Reply-Address' => $c->stash->{request}->{reply_to} );
0a663589 63
64 # Custom error handler - steal errors from catalyst and dump them into
65 # the stash, to get them serialized out as the reply.
66 if (scalar @{$c->error}) {
67 my $error = join "\n", @{$c->error};
68 $c->stash->{response} = { status => 'ERROR', error => $error };
69 $c->error(0); # clear errors, so our response isn't clobbered
70 }
bf8937b7 71
72 # Serialize the response
73 my $output;
a5ae1e8c 74 my $serializer = $self->config->{serializer};
75 my $s = Data::Serializer->new( serializer => $serializer );
bf8937b7 76 eval {
a5ae1e8c 77 $output = $s->raw_serialize( $c->stash->{response} );
bf8937b7 78 };
79 if ($@) {
80 my $error = "exception in serialize: $@";
81 $c->error($error);
82 $c->stash->{response} = { status => 'ERROR', error => $error };
83 $output = Dump( $c->stash->{response} );
84 }
85
86 $c->response->output( $output );
0a663589 87}
88
89sub default : Private {
90 my ($self, $c) = @_;
bf8937b7 91
0a663589 92 # Forward the request to the appropriate action, based on the
93 # message type.
bf8937b7 94 my $action = $c->stash->{request}->{type};
95 $c->forward($action, [$c->stash->{request}]);
0a663589 96}
97
98__PACKAGE__->meta->make_immutable;
99
1001;