File Coverage

blib/lib/Net/Stomp/MooseHelpers/ReadTrace.pm
Criterion Covered Total %
statement 61 63 96.8
branch 10 18 55.5
condition n/a
subroutine 13 13 100.0
pod 6 6 100.0
total 90 100 90.0


line stmt bran cond sub pod time code
1             package Net::Stomp::MooseHelpers::ReadTrace;
2             $Net::Stomp::MooseHelpers::ReadTrace::VERSION = '2.9';
3             {
4             $Net::Stomp::MooseHelpers::ReadTrace::DIST = 'Net-Stomp-MooseHelpers';
5             }
6 1     1   40126 use Moose;
  1         334115  
  1         6  
7 1     1   6392 use MooseX::Types::Path::Class;
  1         78069  
  1         5  
8 1     1   1204 use Net::Stomp::Frame;
  1         3195  
  1         6  
9 1     1   29 use Path::Class;
  1         2  
  1         46  
10 1     1   3 use Carp;
  1         1  
  1         46  
11             require Net::Stomp::MooseHelpers::TraceStomp;
12 1     1   4 use namespace::autoclean;
  1         1  
  1         7  
13              
14             # ABSTRACT: class to read the output of L<Net::Stomp::MooseHelpers::TraceStomp>
15              
16              
17             has trace_basedir => (
18             is => 'rw',
19             isa => 'Path::Class::Dir',
20             coerce => 1,
21             required => 1,
22             );
23              
24              
25             sub read_frame_from_filename {
26 5     5 1 8 my ($self,$filename) = @_;
27              
28 5         17 my $fh=file($filename)->openr;
29 5         1071 binmode $fh;
30 5         15 return $self->read_frame_from_fh($fh);
31             }
32              
33              
34             sub read_frame_from_fh {
35 5     5 1 7 my ($self,$fh) = @_;
36              
37 5         19 local $/="\x0A";
38 5         78 my $command=<$fh>;
39 5 50       11 return unless $command;
40 5         12 chomp $command;
41 5         6 my %headers;
42 5         11 while (defined(my $header_line=<$fh>)) {
43 17         14 chomp $header_line;
44 17 100       25 last if $header_line eq '';
45              
46 12         24 my ($key,$value) = split ':',$header_line,2;
47 12         32 $headers{$key}=$value;
48             }
49              
50 5         12 local $/=undef;
51              
52 5         36 my $body=<$fh>;
53              
54 5 50       9 return unless $body;
55 5 50       29 return unless $body =~ s{\x00$}{}; # 0 marks the end of the frame
56              
57 5         47 return Net::Stomp::Frame->new({
58             command => $command,
59             headers => \%headers,
60             body => $body,
61             });
62             }
63              
64              
65             sub trace_subdir_for_destination {
66 5     5 1 99 my ($self,$destination) = @_;
67              
68 5 50       13 if (@_==1) {
69 5         232 return $self->trace_basedir;
70             }
71              
72 0 0       0 confess "You must pass a defined, non-empty destination"
73             if !length($destination);
74              
75 0         0 return $self->trace_basedir->subdir(
76             Net::Stomp::MooseHelpers::TracerRole->
77             _dirname_from_destination($destination)
78             );
79             }
80              
81              
82             sub sorted_filenames {
83 3     3 1 4 my $self=shift;
84              
85 3         6 my $dir = $self->trace_subdir_for_destination(@_);
86              
87 3 50       13 return unless -e $dir;
88              
89 3         103 my @files;
90             $dir->recurse(
91             callback=>sub{
92 14     14   2692 my ($f) = @_;
93 14 100       23 return if $f->is_dir;
94 5 50       22 return unless $f->basename =~ /^\d+\.\d+-\w+-/;
95 5         42 push @files,$f;
96             },
97 3         23 );
98 3         34 @files = sort { $a->basename cmp $b->basename } @files;
  3         11  
99              
100 3         11 return @files;
101             }
102              
103              
104             sub clear_destination {
105 2     2 1 20841 my $self=shift;
106              
107 2         8 my $dir = $self->trace_subdir_for_destination(@_);
108              
109 2         14 $dir->rmtree({keep_root=>1});$dir->mkpath;
  2         1308  
110              
111 2         97 return;
112             }
113              
114              
115             sub sorted_frames {
116 3     3 1 6 my $self=shift;
117              
118 5         69 return map {
119 3         10 $self->read_frame_from_filename($_)
120             } $self->sorted_filenames(@_);
121             }
122              
123             1;
124              
125             __END__
126              
127             =pod
128              
129             =encoding UTF-8
130              
131             =head1 NAME
132              
133             Net::Stomp::MooseHelpers::ReadTrace - class to read the output of L<Net::Stomp::MooseHelpers::TraceStomp>
134              
135             =head1 VERSION
136              
137             version 2.9
138              
139             =head1 SYNOPSIS
140              
141             my $reader = Net::Stomp::MooseHelpers::ReadTrace->new({
142             trace_basedir => '/tmp/mq',
143             });
144              
145             my @frames = $reader->sorted_frames('/queue/somewhere');
146              
147             =head1 DESCRIPTION
148              
149             L<Net::Stomp::MooseHelpers::TraceStomp> and
150             L<Net::Stomp::MooseHelpers::TraceOnly> write STOMP frames to
151             disk. This class helps you read them back.
152              
153             =head1 ATTRIBUTES
154              
155             =head2 C<trace_basedir>
156              
157             The directory from which frames will be read. Accepts strings and
158             L<Path::Class::Dir> objects.
159              
160             =head1 METHODS
161              
162             =head2 C<read_frame_from_filename>
163              
164             my $stomp_frame = $reader->read_frame_from_filename('/a/path');
165              
166             Given a filename (I<unrelated> to L</trace_basedir>), returns a
167             L<Net::Stomp::Frame> object parsed from it, using
168             L</read_frame_from_fh>.
169              
170             =head2 C<read_frame_from_fh>
171              
172             my $stomp_frame = $reader->read_frame_from_fh($fh);
173              
174             Given a filehandle (C<binmode> it first!), returns a
175             L<Net::Stomp::Frame> object parsed from it. If the filehandle contains
176             more than one frame, reads the first one and leaves the read position
177             just after it.
178              
179             If the file was not a dumped STOMP frame, this function will probably
180             return nothing; if it looked enough like a STOMP frame, you'll get
181             back whatever could be parsed.
182              
183             =head2 C<trace_subdir_for_destination>
184              
185             my $dir = $reader->trace_subdir_for_destination($destination);
186              
187             Returns a L<Path::Class::Dir> object pointing at the (possibly
188             non-existent) directory used to store frames for the given
189             destination.
190              
191             C<< ->trace_subdir_for_destination() >> is the same as C<<
192             ->trace_basedir >>.
193              
194             Passing an explicit C<undef> or an empty string will throw an
195             exception, see L</sorted_filenames> and L</clear_destination> for the
196             reason.
197              
198             =head2 C<sorted_filenames>
199              
200             my @names = $reader->sorted_filenames();
201             my @names = $reader->sorted_filenames($destination);
202              
203             Given a destination (C</queue/something> or similar), returns all
204             frame dump filenames found under the corresponding dump directory
205             under L</trace_basedir>, sorted by filename (that is, by timestamp).
206              
207             If you don't specify a destination, all filenames from all
208             destinations will be returned. Passing an explicit C<undef> or an
209             empty string will throw an exception, to save you when you try doing
210             things like:
211              
212             my $dest = get_something_from_config;
213             my @names = $reader->sorted_filenames($dest);
214              
215             and end up getting way more items than you thought.
216              
217             =head2 C<clear_destination>
218              
219             $reader->clear_destination();
220             $reader->clear_destination($destination);
221              
222             Given a destination (C</queue/something> or similar), removes all
223             stored frames for it.
224              
225             If you don't specify a destination, all frames for all destinations
226             will be removed. Passing an explicit C<undef> or an empty string will
227             throw an exception, to save you when you try doing things like:
228              
229             my $dest = get_something_from_config;
230             $reader->clear_destination($dest);
231              
232             and end up deleting way more than you thought.
233              
234             =head2 C<sorted_frames>
235              
236             my @frames = $reader->sorted_frames();
237             my @frames = $reader->sorted_frames($destination);
238              
239             Same as L</sorted_filenames>, but returns the parsed frames instead of
240             the filenames.
241              
242             =head1 AUTHOR
243              
244             Gianni Ceccarelli <gianni.ceccarelli@net-a-porter.com>
245              
246             =head1 COPYRIGHT AND LICENSE
247              
248             This software is copyright (c) 2014 by Net-a-porter.com.
249              
250             This is free software; you can redistribute it and/or modify it under
251             the same terms as the Perl 5 programming language system itself.
252              
253             =cut