File Coverage

blib/lib/Log/Log4perl/Appender/Chunk.pm
Criterion Covered Total %
statement 66 68 97.0
branch 14 16 87.5
condition n/a
subroutine 15 15 100.0
pod 2 2 100.0
total 97 101 96.0


line stmt bran cond sub pod time code
1             package Log::Log4perl::Appender::Chunk;
2             $Log::Log4perl::Appender::Chunk::VERSION = '0.010';
3 6     6   44012 use Moose;
  6         2390784  
  6         41  
4              
5 6     6   41152 use Carp;
  6         14  
  6         432  
6 6     6   34 use Class::Load;
  6         25  
  6         230  
7 6     6   7064 use Data::Dumper;
  6         102705  
  6         431  
8 6     6   154499 use Log::Log4perl::MDC;
  6         969  
  6         6083  
9              
10              
11             # State variables:
12              
13             # State can be:
14             # OFFCHUNK: No chunk is currently captured.
15             # INCHUNK: A chunk is currently captured in the buffer
16             # ENTERCHUNK: Entering a chunk from an OFFCHUNK state
17             # NEWCHUNK: Entering a NEW chunk from an INCHUNK state
18             # LEAVECHUNK: Leaving a chunk from an INCHUNK state
19             has 'state' => ( is => 'rw' , isa => 'Str', default => 'OFFCHUNK' );
20             has 'previous_chunk' => ( is => 'rw' , isa => 'Maybe[Str]' , default => undef , writer => '_set_previous_chunk' );
21             has 'messages_buffer' => ( is => 'rw' , isa => 'ArrayRef[Str]' , default => sub{ []; });
22              
23             # Settings:
24             has 'chunk_marker' => ( is => 'ro' , isa => 'Str', required => 1, default => 'chunk' );
25              
26             # Store:
27             has 'store' => ( is => 'ro', isa => 'Log::Log4perl::Appender::Chunk::Store',
28             required => 1, lazy_build => 1);
29             has 'store_class' => ( is => 'ro' , isa => 'Str' , default => 'Null' );
30             has 'store_args' => ( is => 'ro' , isa => 'HashRef' , default => sub{ {}; });
31              
32             has 'store_builder' => ( is => 'ro' , isa => 'CodeRef', required => 1, default => sub{
33             my ($self) = @_;
34             sub{
35             $self->_full_store_class()->new($self->store_args());
36             }
37             });
38              
39             sub _build_store{
40 4     4   10 my ($self) = @_;
41 4         174 return $self->store_builder()->();
42             }
43              
44             sub _full_store_class{
45 4     4   8 my ($self) = @_;
46 4         172 my $full_class = $self->store_class();
47 4 100       20 if( $full_class =~ /^\+/ ){
48 1         4 $full_class =~ s/^\+//;
49             }else{
50 3         10 $full_class = 'Log::Log4perl::Appender::Chunk::Store::'.$full_class;
51             }
52 4         24 Class::Load::load_class($full_class);
53 3         871 return $full_class;
54             }
55              
56              
57             sub log{
58 44     44 1 8690 my ($self, %params) = @_;
59              
60             ## Any log within this method will be discarded.
61 44 100       153 if( Log::Log4perl::MDC->get(__PACKAGE__.'-reentrance') ){
62 5         48 return;
63             }
64 39         402 Log::Log4perl::MDC->put(__PACKAGE__.'-reentrance', 1);
65              
66 39         1999 my $chunk = Log::Log4perl::MDC->get($self->chunk_marker());
67              
68             # Change the state according to the chunk param
69 39         300 $self->state( $self->_compute_state($chunk) );
70              
71             # Act according to the state.
72 39         1549 my $m_name = '_on_'.$self->state();
73              
74 39         130 $self->$m_name(\%params);
75              
76 39         1970 $self->_set_previous_chunk($chunk);
77 39         143 Log::Log4perl::MDC->put(__PACKAGE__.'-reentrance', undef);
78             }
79              
80             sub _on_OFFCHUNK{
81 6     6   14 my ($self, $params) = @_;
82             # Chunk is Off, nothing much to do.
83             }
84              
85             sub _on_ENTERCHUNK{
86 8     8   43 my ($self,$params) = @_;
87             # Push the message in the buffer.
88 8         12 push @{$self->messages_buffer()} , $params->{message};
  8         379  
89             }
90              
91             sub _on_INCHUNK{
92 17     17   31 my ($self, $params) = @_;
93             # Push the message in the buffer.
94 17         20 push @{$self->messages_buffer()} , $params->{message};
  17         768  
95             }
96              
97             sub _on_NEWCHUNK{
98 5     5   11 my ($self, $params) = @_;
99             # Leave the chunk
100 5         13 $self->_on_LEAVECHUNK($params);
101             # And we are entering the new one.
102 5         71 $self->_on_INCHUNK($params);
103             }
104              
105             sub _on_LEAVECHUNK{
106 13     13   24 my ($self) = @_;
107              
108             # The new message should not be pushed on the buffer,
109             # As we left a chunk for no chunk.
110              
111             # Flush the buffer in one big message.
112 13         21 my $big_message = join('',@{$self->{messages_buffer}});
  13         36  
113 13         627 $self->messages_buffer( [] );
114              
115             # The chunk ID is in the previous chunk. This should NEVER be null
116 13         547 my $chunk_id = $self->previous_chunk();
117 13 50       42 unless( defined $chunk_id ){
118 0         0 confess("Undefined previous chunk. This should never happen. Dont know where to put the big message:$big_message");
119             }
120 13         511 $self->store->store($chunk_id, $big_message);
121             }
122              
123              
124             sub DEMOLISH{
125 2     2 1 44 my ($self) = @_;
126 2 50       83 if( my $chunk_id = $self->previous_chunk() ){
127             # Simulate transitioning to an non chunked section of the log.
128 2         81 Log::Log4perl::MDC->put($self->chunk_marker() , undef );
129             # Output an empty log.
130 2         14 $self->log();
131             }
132             }
133              
134             sub _compute_state{
135 39     39   66 my ($self, $chunk) = @_;
136 39         1643 my $previous_chunk = $self->previous_chunk();
137              
138 39 100       87 if( defined $chunk ){
139 25 100       58 if( defined $previous_chunk ){
140 17 100       36 if( $previous_chunk eq $chunk ){
141             # State is INCHUNK
142 12         482 return 'INCHUNK';
143             }else{
144             # Chunks are different
145 5         200 return 'NEWCHUNK';
146             }
147             }else{
148             # No previous chunk.
149 8         322 return 'ENTERCHUNK';
150             }
151             }else{
152             # No chunk defined.
153 14 100       30 if( defined $previous_chunk ){ # But a previous chunk
154 8         322 return 'LEAVECHUNK';
155             }else{
156             # No previous chunk neither
157 6         250 return 'OFFCHUNK';
158             }
159             }
160              
161 0           confess("UNKNOWN CASE. This should never be reached.");
162             }
163              
164             __PACKAGE__->meta->make_immutable();
165              
166             __END__
167              
168             =head1 NAME
169              
170             Log::Log4perl::Appender::Chunk - Group log messages in Identified chunks
171              
172             =head1 DESCRIPTION
173              
174             This appender will write group of Log lines (chunks) to the underlying store under
175             an ID that you choose.
176              
177             A number of Store classes are shipped ( in Log::Log4perl::Appender::Chunk::Store::* ),
178             but it's very easy to write your own store, as it's essentially a Key/Value storage.
179              
180             See L<Log::Log4perl::Appender::Chunk::Store> for more details.
181              
182             =head2 How to mark chunks of logs.
183              
184             Marking chunks of log rely on the Log4perl Mapped Diagnostic Context (MDC) mechanism.
185             See L<Log::Log4perl::MDC>
186              
187             Essentially, each time you set a MDC key 'chunk' to something, this appender will start
188             recording chunks and fetch them to the storage when the key 'chunk' is unset or changes.
189              
190             =head1 SYNOPSIS
191              
192             =head2 In your code
193              
194             Anywhere in your code:
195              
196              
197             # .. Use log4perl as usual ..
198              
199             ## Start capturing Log lines in an identified Chunk
200             Log::Log4perl::MDC->put('chunk', "Your-Log-Chunk-Unique-ID-Key");
201              
202             # .. Use Log4perl as usual ..
203              
204             ## Finish capturing in the identified Chunk
205             Log::Log4perl::MDC->put('chunk',undef);
206              
207             # .. Use Log4perl as usual ..
208             $logger->info("Blabla"); # Triggers storing the log chunk
209              
210             Then depending on the configured store, you will be able to retrieve your log chunks
211             from different places. See below.
212              
213             =head2 Configuration
214              
215              
216             =head3 with built-in store Memory
217              
218             Reference: L<Log::Log4perl::Appender::Chunk::Store::Memory>
219              
220             log4perl.conf:
221              
222             log4perl.rootLogger=TRACE, Chunk
223              
224             log4perl.appender.Chunk=Log::Log4perl::Appender::Chunk
225              
226             # Built-in store class S3
227             log4perl.appender.Chunk.store_class=Memory
228              
229             # Etc..
230             log4perl.appender.Chunk.layout=..
231              
232              
233             =head3 With built-in store S3
234              
235             log4perl.conf:
236              
237             log4perl.rootLogger=TRACE, Chunk
238              
239             log4perl.appender.Chunk=Log::Log4perl::Appender::Chunk
240              
241             # Built-in store class S3
242             log4perl.appender.Chunk.store_class=S3
243             # S3 Specific Arguments:
244             log4perl.appender.Chunk.store_args.bucket_name=MyLogChunks
245             log4perl.appender.Chunk.store_args.aws_access_key_id=YourAWSAccessKey
246             log4perl.appender.Chunk.store_args.aws_secret_access_key=YourAWS
247              
248             # Optional:
249             log4perl.appender.Chunk.store_args.retry=1
250             log4perl.appender.Chunk.store_args.vivify_bucket=1
251              
252             log4perl.appender.Chunk.store_args.expires_in_days=3
253             log4perl.appender.Chunk.store_args.acl_short=public-read
254              
255             # Etc..
256             log4perl.appender.Chunk.layout=...
257              
258             =head2 log
259              
260             L<Log::Log4perl::Appender> framework method.
261              
262             =head2 store
263              
264             The instance of L<Log::Log4perl::Appender::Chunk::Store> this logger uses.
265              
266             It's usually configured from the Log4perl configuration file as shown in the SYNOPSIS, but
267             you can also inject it from your application code:
268              
269             Log::Log4perl->appender_by_name('Chunk')->store($your_instance_of_storage);
270              
271              
272             =head2 DEMOLISH
273              
274             Will attempt to store whatever is left in the buffer if your program
275             finishes before it could output any log file outside a Chunk capturing section.
276              
277             =cut