/usr/share/perl5/Log/Any/Adapter/Core.pm is in liblog-any-perl 0.11-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 | package Log::Any::Adapter::Core;
use strict;
use warnings;
# Forward 'warn' to 'warning', 'is_warn' to 'is_warning', and so on for all aliases
#
my %aliases = Log::Any->log_level_aliases;
while ( my ( $alias, $realname ) = each(%aliases) ) {
_make_method( $alias, sub { my $self = shift; $self->$realname(@_) } );
my $is_alias = "is_$alias";
my $is_realname = "is_$realname";
_make_method( $is_alias,
sub { my $self = shift; $self->$is_realname(@_) } );
}
# Add printf-style versions of all logging methods and aliases - e.g. errorf, debugf
#
foreach my $name ( Log::Any->logging_methods, keys(%aliases) ) {
my $methodf = $name . "f";
my $method = $aliases{$name} || $name;
_make_method(
$methodf,
sub {
my ( $self, $format, @params ) = @_;
my @new_params =
map {
!defined($_) ? '<undef>'
: ref($_) ? _dump_one_line($_)
: $_
} @params;
my $new_message = sprintf( $format, @new_params );
$self->$method($new_message);
}
);
}
sub _make_method {
my ( $method, $code, $pkg ) = @_;
$pkg ||= caller();
no strict 'refs';
*{ $pkg . "::$method" } = $code;
}
sub _dump_one_line {
my ($value) = @_;
return Data::Dumper->new( [$value] )->Indent(0)->Sortkeys(1)->Quotekeys(0)
->Terse(1)->Dump();
}
1;
__END__
=pod
=head1 NAME
Log::Any::Adapter::Core
=head1 DESCRIPTION
This is the base class for both real Log::Any adapters and
Log::Any::Adapter::Null.
=head1 AUTHOR
Jonathan Swartz
=head1 COPYRIGHT & LICENSE
Copyright (C) 2009 Jonathan Swartz, all rights reserved.
This program is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.
=cut
|