/usr/share/perl5/Log/Dispatch/Array.pm is in liblog-dispatch-array-perl 1.001-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 | package Log::Dispatch::Array;
use base qw(Log::Dispatch::Output);
use warnings;
use strict;
=head1 NAME
Log::Dispatch::Array - log events to an array (reference)
=head1 VERSION
version 1.001
=cut
our $VERSION = '1.001';
=head1 SYNOPSIS
use Log::Dispatch;
use Log::Dispatch::Array;
my $log = Log::Dispatch->new;
my $target = [];
$log->add(Log::Dispatch::Array->new(
name => 'text_table',
min_level => 'debug',
array => $target,
));
$log->warn($_) for @events;
# now $target refers to an array of events
=head1 DESCRIPTION
This provides a Log::Dispatch log output system that appends logged events to
an array reference. This is probably only useful for testing the logging of
your code.
=head1 METHODS
=head2 C<< new >>
my $table_log = Log::Dispatch::Array->new(\%arg);
This method constructs a new Log::Dispatch::Array output object. Valid
arguments are:
array - a reference to an array to append to; defaults to an attr on
$table_log
=cut
sub new {
my ($class, %arg) = @_;
$arg{array} ||= [];
my $self = { array => $arg{array} };
bless $self => $class;
# this is our duty as a well-behaved Log::Dispatch plugin
$self->_basic_init(%arg);
return $self;
}
=head2 array
This method returns a reference to the array to which logging is being
performed.
=cut
sub array { $_[0]->{array} }
=head2 log_message
This is the method which performs the actual logging, as detailed by
Log::Dispatch::Output.
=cut
sub log_message {
my ($self, %p) = @_;
push @{ $self->array }, { %p };
}
=head1 AUTHOR
Ricardo Signes, C<< <rjbs@cpan.org> >>
=head1 BUGS
Please report any bugs or feature requests through the web interface at
L<http://rt.cpan.org>. I will be notified, and then you'll automatically be
notified of progress on your bug as I make changes.
=head1 COPYRIGHT
Copyright 2008 Ricardo SIGNES, all rights reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=cut
1;
|