File Coverage

blib/lib/Net/Stomp/MooseHelpers/TracerRole.pm
Criterion Covered Total %
statement 59 62 95.1
branch 7 10 70.0
condition 6 8 75.0
subroutine 14 15 93.3
pod n/a
total 86 95 90.5


line stmt bran cond sub pod time code
1             package Net::Stomp::MooseHelpers::TracerRole;
2             $Net::Stomp::MooseHelpers::TracerRole::VERSION = '3.0';
3             {
4             $Net::Stomp::MooseHelpers::TracerRole::DIST = 'Net-Stomp-MooseHelpers';
5             }
6 1     1   566 use Moose::Role;
  1         2  
  1         6  
7 1     1   4323 use MooseX::Types::Path::Class;
  1         2  
  1         13  
8 1     1   1305 use Net::Stomp::MooseHelpers::Types qw(Permissions OctalPermissions);
  1         2599  
  1         7  
9 1     1   3648 use Time::HiRes ();
  1         1249  
  1         25  
10 1     1   6 use File::Temp ();
  1         2  
  1         17  
11 1     1   4 use Try::Tiny;
  1         3  
  1         85  
12 1     1   7 use List::Util 1.33 'none';
  1         18  
  1         56  
13 1     1   6 use namespace::autoclean;
  1         1  
  1         9  
14              
15             # ABSTRACT: role to dump Net::Stomp frames to disk
16              
17              
18             has trace_basedir => (
19             is => 'rw',
20             isa => 'Path::Class::Dir',
21             coerce => 1,
22             );
23              
24              
25             has trace => (
26             is => 'rw',
27             isa => 'Bool',
28             default => 0,
29             );
30              
31              
32             has trace_permissions => (
33             is => 'rw',
34             isa => Permissions,
35             default => '0600',
36             coerce => 1,
37             );
38              
39              
40             has trace_directory_permissions => (
41             is => 'rw',
42             isa => Permissions,
43             default => '0700',
44             coerce => 1,
45             );
46              
47              
48              
49             has trace_types => (
50             is => 'rw',
51             isa => 'ArrayRef[Str]',
52             default => sub {+['SEND','MESSAGE']},
53             );
54              
55              
56             sub _dirname_from_destination {
57 5     5   125 my ($self,$destination) = @_;
58              
59 5 100       21 return '' unless defined $destination;
60              
61 3         7 my $ret = $destination;
62 3         8 $ret =~ s{^(queue|topic)/}{/$1/};
63 3         17 $ret =~ s/\W+/_/g;
64 3         12 return $ret;
65             }
66              
67              
68             sub _filename_from_frame {
69 5     5   15 my ($self,$frame,$direction) = @_;
70              
71 5         48 my $base = sprintf '%0.5f',Time::HiRes::time();
72             my $dir = $self->trace_basedir->subdir(
73             $self->_dirname_from_destination($frame->headers->{destination})
74 5         102 );
75 5         306 $dir->mkpath({mode => $self->trace_directory_permissions});
76              
77 5         506 return File::Temp::tempfile("${base}-${direction}-XXXX",
78             DIR => $dir->stringify);
79             }
80              
81             sub _temp_trace_file {
82 5     5   12 my ($self,$frame,$direction) = @_;
83              
84 5         74 my $base = sprintf '%0.5f',Time::HiRes::time();
85 5         72 my $dir = $self->trace_basedir->subdir('tmp');
86 5         421 $dir->mkpath({mode => $self->trace_directory_permissions});
87              
88 5         750 return File::Temp::tempfile("${base}-temp-XXXX",
89             DIR => $dir->stringify);
90             }
91              
92             sub _save_frame {
93 7     7   18 my ($self,$frame,$direction) = @_;
94              
95 7 50       207 return unless $self->trace;
96 7 50       18 return unless $frame;
97 7         134 return if $self->trace_types and @{$self->trace_types} and
98 7 100 66 3   159 none { lc($frame->command) eq lc($_) } @{$self->trace_types};
  3   100     74  
  3         62  
99 5   50     43 $direction||='';
100              
101 5 50       90 if (!$self->trace_basedir) {
102 0         0 warn "trace_basedir not set, but tracing requested, ignoring\n";
103 0         0 return;
104             }
105              
106 5         72 my ($tmp_fh,$tmp_filename) = $self->_temp_trace_file;
107 5         1596 binmode $tmp_fh;
108 5         27 syswrite $tmp_fh,$frame->as_string;
109             try {
110 5     5   389 chmod $self->trace_permissions & (~umask),$tmp_fh;
111             }
112             catch {
113 0     0   0 chmod $self->trace_permissions & (~umask),$tmp_filename;
114 5         602 };
115 5         320 close $tmp_fh;
116              
117 5         28 my ($fh,$filename) = $self->_filename_from_frame($frame,$direction);
118 5         1329 close $fh;
119 5         478 rename $tmp_filename,$filename;
120              
121 5         46 return;
122             }
123              
124             1;
125              
126             __END__
127              
128             =pod
129              
130             =encoding UTF-8
131              
132             =head1 NAME
133              
134             Net::Stomp::MooseHelpers::TracerRole - role to dump Net::Stomp frames to disk
135              
136             =head1 VERSION
137              
138             version 3.0
139              
140             =head1 DESCRIPTION
141              
142             This role is not to be used directly, look at
143             L<Net::Stomp::MooseHelpers::TraceStomp> and
144             L<Net::Stomp::MooseHelpers::TraceOnly>.
145              
146             This role provides attributes and methods to write to disk every
147             outgoing and incoming STOMP frame.
148              
149             The frames are written as they are "on the wire" (no encoding
150             conversion happens), one file per frame. Each frame is written into a
151             directory under L</trace_basedir> with a name derived from the frame
152             destination.
153              
154             =head1 ATTRIBUTES
155              
156             =head2 C<trace_basedir>
157              
158             The directory under which frames will be dumped. Accepts strings and
159             L<Path::Class::Dir> objects. If it's not specified and you enable
160             L</trace>, every frame will generate a warning.
161              
162             =head2 C<trace>
163              
164             Boolean attribute to enable or disable tracing / dumping of frames. If
165             you enable tracing but don't set L</trace_basedir>, every frame will
166             generate a warning.
167              
168             =head2 C<trace_permissions>
169              
170             The permissions (as in L<perlfunc/chmod>) to set the dumped files
171             to. Accepts integers and strings with base-8 representation (see
172             L<Net::Stomp::MooseHelpers::Types/Permissions> and
173             L<Net::Stomp::MooseHelpers::Types/OctalPermissions>). The actual
174             permissions applied will also depend on the L<umask>.
175              
176             =head2 C<trace_directory_permissions>
177              
178             The permissions (as in L<perlfunc/chmod>) to set the directories for
179             dumped files to. Accepts integers and strings with base-8
180             representation (see L<Net::Stomp::MooseHelpers::Types/Permissions> and
181             L<Net::Stomp::MooseHelpers::Types/OctalPermissions>). The actual
182             permissions applied will also depend on the L<umask>.
183              
184             =head2 C<trace_types>
185              
186             Arrayref of frame types to dump (strings, compared
187             case-insensitively). Defaults to C<['SEND','MESSAGE']>. If set to an
188             empty array, all frame types will be dumped (this was the behaviour is
189             previous versions).
190              
191             =head1 METHODS
192              
193             =head2 C<_dirname_from_destination>
194              
195             Generate a directory name from a frame destination. By default,
196             replaces every sequence of non-word characters with C<'_'>.
197              
198             =head2 C<_filename_from_frame>
199              
200             Returns a filehandle / filename pair for the file to write the frame
201             into. Avoids duplicates by using L<Time::HiRes>'s C<time> as a
202             starting filename, and L<File::Temp>.
203              
204             =head1 AUTHOR
205              
206             Gianni Ceccarelli <gianni.ceccarelli@net-a-porter.com>
207              
208             =head1 COPYRIGHT AND LICENSE
209              
210             This software is copyright (c) 2014 by Net-a-porter.com.
211              
212             This is free software; you can redistribute it and/or modify it under
213             the same terms as the Perl 5 programming language system itself.
214              
215             =cut