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