File Coverage

blib/lib/POE/Declare/Log/File.pm
Criterion Covered Total %
statement 28 30 93.3
branch n/a
condition n/a
subroutine 10 10 100.0
pod n/a
total 38 40 95.0


line stmt bran cond sub pod time code
1             package POE::Declare::Log::File;
2              
3             =pod
4              
5             =head1 NAME
6              
7             POE::Declare::Log::File - A simple HTTP client based on POE::Declare
8              
9             =head1 SYNOPSIS
10              
11             # Create the web server
12             my $http = POE::Declare::Log::File->new(
13             Filename => '/var/log/my.log',
14             Lazy => 1,
15             );
16            
17             # Control with methods
18             $http->start;
19             $http->GET('http://google.com');
20             $http->stop;
21              
22             =head1 DESCRIPTION
23              
24             This module provides a simple logging module which spools output to a file,
25             queueing and batching messages in memory if the message rate exceeds the
26             responsiveness of the filesystem.
27              
28             The implementation is intentionally minimalist and has no dependencies beyond
29             those of L itself, which makes this module useful for simple
30             utility logging or debugging systems.
31              
32             =head1 METHODS
33              
34             =cut
35              
36 2     2   30202 use 5.008;
  2         9  
  2         70  
37 2     2   9 use strict;
  2         4  
  2         54  
38 2     2   10 use Carp ();
  2         12  
  2         30  
39 2     2   1713 use Symbol ();
  2         1797  
  2         47  
40 2     2   11 use File::Spec 0.80 ();
  2         38  
  2         38  
41 2     2   7302 use POE 1.293 ();
  2         143603  
  2         53  
42 2     2   1877 use POE::Driver::SysRW ();
  2         3985  
  2         36  
43 2     2   1616 use POE::Filter::Stream ();
  2         3150  
  2         34  
44 2     2   2078 use POE::Wheel::ReadWrite ();
  2         251234  
  2         148  
45              
46             our $VERSION = '0.01';
47              
48             use POE::Declare 0.54 {
49 0           Filename => 'Param',
50             Handle => 'Param',
51             Lazy => 'Param',
52             ErrorEvent => 'Message',
53             ShutdownEvent => 'Message',
54             wheel => 'Internal',
55             queue => 'Internal',
56             state => 'Internal',
57 2     2   2414 };
  0            
58              
59              
60              
61              
62              
63             ######################################################################
64             # Constructor and Accessors
65              
66             =pod
67              
68             =head2 new
69              
70             my $server = POE::Declare::Log::File->new(
71             Filename =>
72             ShutdownEvent => \&on_shutdown,
73             );
74              
75             The C constructor sets up a reusable HTTP client that can be enabled
76             and disabled repeatedly as needed.
77              
78             =cut
79              
80             sub new {
81             my $class = shift;
82             my $self = $class->SUPER::new(@_);
83              
84             # Set the starting state
85             $self->{state} = 'STOP';
86              
87             # Open the file if needed
88             if ( $self->Lazy ) {
89             if ( $self->Handle ) {
90             Carp::croak("Cannot load Lazy when Handle is provided");
91             } elsif ( $self->Filename ) {
92             ### TODO: Check if the filename is future-writable
93             } else {
94             Carp::croak("Did not provide a Filename or Handle");
95             }
96              
97             } else {
98             if ( $self->Filename and $self->Handle ) {
99             Carp::croak("Filename and Handle are mutually exclusive");
100             } elsif ( $self->Filename ) {
101             # Try to open the file immediately
102             $self->{Handle} = $self->_handle;
103             }
104             unless ( $self->Handle ) {
105             Carp::croak("Did not provide a Filename or Handle")
106             }
107             }
108              
109             return $self;
110             }
111              
112              
113              
114              
115              
116             ######################################################################
117             # Control Methods
118              
119             =pod
120              
121             =head2 start
122              
123             The C method enables the web server. If the server is already running,
124             this method will shortcut and do nothing.
125              
126             If called before L has been started, the web server will start
127             immediately once L is running.
128              
129             =cut
130              
131             sub start {
132             my $self = shift;
133             unless ( $self->spawned ) {
134             $self->spawn;
135             $self->post('startup');
136             }
137              
138             # Allow calling print immediately after start before the POE
139             # startup has completed
140             unless ( exists $self->{buffer} ) {
141             $self->{buffer} = undef;
142             }
143              
144             return 1;
145             }
146              
147             =pod
148              
149             =head2 stop
150              
151             The C method disables the web server. If the server is not running,
152             this method will shortcut and do nothing.
153              
154             =cut
155              
156             sub stop {
157             my $self = shift;
158             if ( $self->spawned ) {
159             $self->post('shutdown');
160             }
161             return 1;
162             }
163              
164             =pod
165              
166             =head2 print
167              
168             $log->print("This is a log message");
169              
170             Writes one or more messages to the log.
171              
172             Returns true if the message will be flushed to the file immediately, false if
173             the message will be queued for later dispatch, or C if the logger is
174             disabled and the message will be dropped.
175              
176             =cut
177              
178             sub print {
179             my $self = shift;
180              
181             # Has something gone wrong and we shouldn't queue?
182             return unless @_;
183             return unless exists $self->{buffer};
184              
185             # Add any messages to the queue of pending output
186             unless ( defined $self->{buffer} ) {
187             $self->{buffer} = shift() . "\n";
188             }
189             while ( @_ ) {
190             $self->{buffer} .= shift() . "\n";
191             }
192              
193             # Do a lazy connection to the file if needed.
194             # The startup will do the equivalent of the below for us.
195             if ( $self->{state} eq 'LAZY' ) {
196             $self->call('startup');
197             return 1;
198             }
199              
200             # Initiate a flush event if we aren't doing one already
201             if ( $self->{state} eq 'IDLE' ) {
202             $self->{state} = 'BUSY';
203             $self->post('flush');
204             return 1;
205             }
206              
207             # Message is delayed
208             return 0;
209             }
210              
211              
212              
213              
214              
215             ######################################################################
216             # Event Methods
217              
218             sub startup : Event {
219             if ( $_[SELF]->Lazy ) {
220             if ( defined $_[SELF]->{buffer} ) {
221             # Open the file immediately
222             $_[SELF]->{Handle} = $_[SELF]->_handle;
223             } else {
224             # Switch to lazy start mode
225             $_[SELF]->{state} = 'LAZY';
226             return;
227             }
228             }
229              
230             # Connect to the handle
231             $_[SELF]->post('connect');
232             }
233              
234             sub connect : Event {
235             # Create the read/write wheel on the filehandle
236             $_[SELF]->{wheel} = POE::Wheel::ReadWrite->new(
237             Handle => $_[SELF]->Handle,
238             Filter => POE::Filter::Stream->new,
239             AutoFlush => 1,
240             FlushedEvent => 'flush',
241             ErrorEvent => 'error',
242             );
243             $_[SELF]->{state} = 'IDLE';
244              
245             # Do an initial queue flush if we have anything
246             if ( defined $_[SELF]->{buffer} ) {
247             $_[SELF]->{state} = 'BUSY';
248             $_[SELF]->post('flush');
249             }
250              
251             return;
252             }
253              
254             sub flush : Event {
255             if ( defined $_[SELF]->{buffer} ) {
256             # Almost all the time we should arrive here already
257             # busy. But if we do arrive IDLE accidentally, set as well.
258             if ( $_[SELF]->{state} eq 'IDLE' ) {
259             $_[SELF]->{state} = 'BUSY';
260             }
261              
262             # Merge the queued messages ourself to prevent having to use a heavier
263             # POE line filter in the Read/Write wheel.
264             $_[SELF]->{wheel}->put( delete $_[SELF]->{buffer} );
265             $_[SELF]->{buffer} = undef;
266              
267             } else {
268             # Nothing (left) to do
269             if ( $_[SELF]->{state} eq 'HALT' ) {
270             $_[SELF]->{state} = 'STOP';
271             $_[SELF]->finish;
272             $_[SELF]->ShutdownEvent;
273              
274             } else {
275             $_[SELF]->{state} = 'IDLE';
276             }
277             }
278              
279             return;
280             }
281              
282             sub error : Event {
283             $_[SELF]->{state} = 'CRASH';
284              
285             # Prevent additional message and flush queue
286             delete $_[SELF]->{buffer};
287              
288             # Clean up streaming resources
289             $_[SELF]->clean;
290              
291             return;
292             }
293              
294             sub shutdown : Event {
295             my $state = $_[SELF]->{state};
296              
297             # Superfluous crash shutdown
298             if ( $state eq 'CRASH' ) {
299             $_[SELF]->finish;
300             $_[SELF]->ShutdownEvent;
301             return;
302             }
303              
304             # Shutdown with nothing pending to write
305             if ( $state eq 'IDLE' or $state eq 'LAZY') {
306             $_[SELF]->{state} = 'STOP';
307             $_[SELF]->finish;
308             $_[SELF]->ShutdownEvent;
309             return;
310             }
311              
312             # Shutdown while writing
313             if ( $state eq 'BUSY' ) {
314             # Signal we want to stop as soon as the queue is empty,
315             # but otherwise just wait for the natural end.
316             $_[SELF]->{state} = 'HALT';
317             return;
318             }
319              
320             # Must be a shutdown while HALT, just keep waiting
321             return;
322             }
323              
324              
325              
326              
327              
328             ######################################################################
329             # POE::Declare::Object Methods
330              
331             sub finish {
332             my $self = shift;
333              
334             # Prevent additional messages and flush the queue
335             delete $self->{buffer};
336              
337             # Clean up streaming resources
338             $self->clean;
339              
340             # Pass through as normal
341             $self->SUPER::finish(@_);
342             }
343              
344             sub clean {
345             my $self = shift;
346              
347             # Shutdown the wheel
348             if ( $self->{wheel} ) {
349             $self->{wheel}->shutdown_output;
350             delete $self->{wheel};
351             }
352              
353             # If we opened a file, close it
354             if ( $self->Filename and $self->{Handle} ) {
355             close delete $self->{Handle};
356             }
357              
358             return;
359             }
360              
361              
362              
363              
364              
365             ######################################################################
366             # Support Methods
367              
368             sub _handle {
369             my $self = shift;
370             my $filename = $self->Filename;
371             my $handle = Symbol::gensym();
372             if ( open( $handle, '>>', $filename ) ) {
373             $handle->autoflush(1);
374             return $handle;
375             }
376             Carp::croak("Failed to open $filename");
377             }
378              
379             compile;
380              
381             =pod
382              
383             =head1 SUPPORT
384              
385             Bugs should be always be reported via the CPAN bug tracker at
386              
387             L
388              
389             For other issues, or commercial enhancement or support, contact the author.
390              
391             =head1 AUTHORS
392              
393             Adam Kennedy Eadamk@cpan.orgE
394              
395             =head1 SEE ALSO
396              
397             L, L, L
398              
399             =head1 COPYRIGHT
400              
401             Copyright 2011 Adam Kennedy.
402              
403             This program is free software; you can redistribute
404             it and/or modify it under the same terms as Perl itself.
405              
406             The full text of the license can be found in the
407             LICENSE file included with this module.
408              
409             =cut