File Coverage

blib/lib/Net/Stomp/MooseHelpers/TraceStomp.pm
Criterion Covered Total %
statement 12 12 100.0
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 16 16 100.0


line stmt bran cond sub pod time code
1             package Net::Stomp::MooseHelpers::TraceStomp;
2             $Net::Stomp::MooseHelpers::TraceStomp::VERSION = '3.0';
3             {
4             $Net::Stomp::MooseHelpers::TraceStomp::DIST = 'Net-Stomp-MooseHelpers';
5             }
6 1     1   339 use Moose::Role;
  1         4166  
  1         4  
7 1     1   4651 use Moose::Util 'apply_all_roles';
  1         2  
  1         4  
8 1     1   179 use namespace::autoclean;
  1         3  
  1         7  
9              
10             # ABSTRACT: role to wrap the Net::Stomp connection in tracing code
11              
12             with 'Net::Stomp::MooseHelpers::TracerRole';
13              
14              
15             around '_build_connection' => sub {
16             my ($orig,$self,@etc) = @_;
17              
18             my $conn = $self->$orig(@etc);
19             apply_all_roles($conn,'Net::Stomp::MooseHelpers::TraceStomp::ConnWrapper');
20             $conn->_tracing_object($self);
21             return $conn;
22             };
23              
24             {
25             package Net::Stomp::MooseHelpers::TraceStomp::ConnWrapper;
26             $Net::Stomp::MooseHelpers::TraceStomp::ConnWrapper::VERSION = '3.0';
27             {
28             $Net::Stomp::MooseHelpers::TraceStomp::ConnWrapper::DIST = 'Net-Stomp-MooseHelpers';
29             }
30 1     1   170 use Moose::Role;
  1         2  
  1         5  
31              
32             has _tracing_object => ( is => 'rw' );
33              
34             before send_frame => sub {
35             my ($self,$frame,@etc) = @_;
36              
37             if (my $o=$self->_tracing_object) {
38             $o->_save_frame($frame,'send');
39             }
40              
41             return;
42             };
43              
44             around receive_frame => sub {
45             my ($orig,$self,@etc) = @_;
46              
47             my $frame = $self->$orig(@etc);
48              
49             if (my $o=$self->_tracing_object) {
50             $o->_save_frame($frame,'recv');
51             }
52              
53             return $frame;
54             };
55             }
56              
57             1;
58              
59             __END__
60              
61             =pod
62              
63             =encoding UTF-8
64              
65             =head1 NAME
66              
67             Net::Stomp::MooseHelpers::TraceStomp - role to wrap the Net::Stomp connection in tracing code
68              
69             =head1 VERSION
70              
71             version 3.0
72              
73             =head1 SYNOPSIS
74              
75             package MyThing;
76             use Moose;with 'Net::Stomp::MooseHelpers::CanConnect';
77             with 'Net::Stomp::MooseHelpers::TraceStomp';
78              
79             $self->trace_basedir('/tmp/stomp_dumpdir');
80             $self->trace(1);
81              
82             =head1 DESCRIPTION
83              
84             This module wraps the connection object provided by
85             L<Net::Stomp::MooseHelpers::CanConnect> and writes to disk every
86             outgoing and incoming frame.
87              
88             The frames are written as they are "on the wire" (no encoding
89             conversion happens), one file per frame. Each frame is written into a
90             directory under L</trace_basedir> with a name derived from the frame
91             destination.
92              
93             =head1 ATTRIBUTES
94              
95             =head2 C<trace_basedir>
96              
97             The directory under which frames will be dumped. Accepts strings and
98             L<Path::Class::Dir> objects. If it's not specified and you enable
99             L</trace>, every frame will generate a warning.
100              
101             =head2 C<trace>
102              
103             Boolean attribute to enable or disable tracing / dumping of frames. If
104             you enable tracing but don't set L</trace_basedir>, every frame will
105             generate a warning.
106              
107             =head1 AUTHOR
108              
109             Gianni Ceccarelli <gianni.ceccarelli@net-a-porter.com>
110              
111             =head1 COPYRIGHT AND LICENSE
112              
113             This software is copyright (c) 2014 by Net-a-porter.com.
114              
115             This is free software; you can redistribute it and/or modify it under
116             the same terms as the Perl 5 programming language system itself.
117              
118             =cut