1package Log::Log4perl::Appender::TestBuffer; 2our @ISA = qw(Log::Log4perl::Appender); 3 4################################################## 5# Log dispatcher writing to a string buffer 6# For testing. 7# This is like having a Log::Log4perl::Appender::TestBuffer 8################################################## 9 10our %POPULATION = (); 11our $LOG_PRIORITY = 0; 12our $DESTROY_MESSAGES = ""; 13 14################################################## 15sub new { 16################################################## 17 my $proto = shift; 18 my $class = ref $proto || $proto; 19 my %params = @_; 20 21 my $self = { 22 name => "unknown name", 23 %params, 24 }; 25 26 bless $self, $class; 27 28 $self->{stderr} = exists $params{stderr} ? $params{stderr} : 1; 29 $self->{buffer} = ""; 30 31 $POPULATION{$self->{name}} = $self; 32 33 return $self; 34} 35 36################################################## 37sub log { 38################################################## 39 my $self = shift; 40 my %params = @_; 41 42 if( !defined $params{level} ) { 43 die "No level defined in log() call of " . __PACKAGE__; 44 } 45 $self->{buffer} .= "[$params{level}]: " if $LOG_PRIORITY; 46 $self->{buffer} .= $params{message}; 47} 48 49########################################### 50sub clear { 51########################################### 52 my($self) = @_; 53 54 $self->{buffer} = ""; 55} 56 57################################################## 58sub buffer { 59################################################## 60 my($self, $new) = @_; 61 62 if(defined $new) { 63 $self->{buffer} = $new; 64 } 65 66 return $self->{buffer}; 67} 68 69################################################## 70sub reset { 71################################################## 72 my($self) = @_; 73 74 %POPULATION = (); 75 $self->{buffer} = ""; 76} 77 78################################################## 79sub DESTROY { 80################################################## 81 my($self) = @_; 82 83 $DESTROY_MESSAGES .= __PACKAGE__ . " destroyed"; 84 85 #this delete() along with &reset() above was causing 86 #Attempt to free unreferenced scalar at 87 #blib/lib/Log/Log4perl/TestBuffer.pm line 69. 88 #delete $POPULATION{$self->name}; 89} 90 91################################################## 92sub by_name { 93################################################## 94 my($self, $name) = @_; 95 96 # Return a TestBuffer by appender name. This is useful if 97 # test buffers are created behind our back (e.g. via the 98 # Log4perl config file) and later on we want to 99 # retrieve an instance to query its content. 100 101 die "No name given" unless defined $name; 102 103 return $POPULATION{$name}; 104 105} 106 1071; 108 109__END__ 110 111=head1 NAME 112 113Log::Log4perl::Appender::TestBuffer - Appender class for testing 114 115=head1 SYNOPSIS 116 117 use Log::Log4perl::Appender::TestBuffer; 118 119 my $appender = Log::Log4perl::Appender::TestBuffer->new( 120 name => 'mybuffer', 121 ); 122 123 # Append to the buffer 124 $appender->log( 125 level = > 'alert', 126 message => "I'm searching the city for sci-fi wasabi\n" 127 ); 128 129 # Retrieve the result 130 my $result = $appender->buffer(); 131 132 # Clear the buffer to the empty string 133 $appender->clear(); 134 135=head1 DESCRIPTION 136 137This class is used for internal testing of C<Log::Log4perl>. It 138is a C<Log::Dispatch>-style appender, which writes to a buffer 139in memory, from where actual results can be easily retrieved later 140to compare with expeced results. 141 142Every buffer created is stored in an internal global array, and can 143later be referenced by name: 144 145 my $app = Log::Log4perl::Appender::TestBuffer->by_name("mybuffer"); 146 147retrieves the appender object of a previously created buffer "mybuffer". 148To reset this global array and have it forget all of the previously 149created testbuffer appenders (external references to those appenders 150nonwithstanding), use 151 152 Log::Log4perl::Appender::TestBuffer->reset(); 153 154=head1 SEE ALSO 155 156=head1 LICENSE 157 158Copyright 2002-2012 by Mike Schilli E<lt>m@perlmeister.comE<gt> 159and Kevin Goess E<lt>cpan@goess.orgE<gt>. 160 161This library is free software; you can redistribute it and/or modify 162it under the same terms as Perl itself. 163 164=head1 AUTHOR 165 166Please contribute patches to the project on Github: 167 168 http://github.com/mschilli/log4perl 169 170Send bug reports or requests for enhancements to the authors via our 171 172MAILING LIST (questions, bug reports, suggestions/patches): 173log4perl-devel@lists.sourceforge.net 174 175Authors (please contact them via the list above, not directly): 176Mike Schilli <m@perlmeister.com>, 177Kevin Goess <cpan@goess.org> 178 179Contributors (in alphabetical order): 180Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton 181Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony 182Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy 183Grundman, Paul Harrington, David Hull, Robert Jacobson, Jason Kohles, 184Jeff Macdonald, Markus Peter, Brett Rann, Peter Rabbitson, Erik 185Selberg, Aaron Straup Cope, Lars Thegler, David Viner, Mac Yang. 186 187