Log-Log4perl
view release on metacpan or search on metacpan
method to leave the logger population alone. Added clear()
to accomodate the need for a single buffer reset.
* (ms) Xavier Caron added %p{1} to allow abbreviated priority
strings in the pattern layout.
* (ms) Redid composite appenders to address problems with incorrect
caller() data. L4p now supports a $cache parameter to be
passed to the log() function, which stores the completely
rendered message and can be passed to log_cached() later on.
1.26 (2009/11/22)
* (ms) [RT 50495] Perl code in the config file is now evaluated/
compiled after the configuration parser has done its work,
opening up Perl subroutines to all configuration parsers, not
just PropertyConfigurator. Configuration subs for cspecs,
filter, warp_message and appender triggers are sheltered.
The previous, flawed implementation surfaced while using
a 'trigger' category, reported by Olivier Bilodeau.
* (ms) [RT 50090] Added non-portable linebreaks to PatternLayout
(requested by Zdeněk Juran).
* (ms) [RT 50094] Docfix for PatternLayout in main manpage (spotted
by Peter Rabbitson).
added to ScreenColoredLevels appender by Jason Kohles.
* (ms) [RT 28987] If UNIVERSAL is available, appender existence is
now verified by checking can() on the appender's new()
method (applied modified patch by Gabriel Berriz).
1.24 (2009/07/08)
* (ms) Fixed bug with Log::Log4perl::Util::tmpfile_name which
surfaced on VMS, reported by Ben Humphreys.
* (ms) Fixed system-wide threshold to no longer lower appender
thresholds. Bug reported by Jean-Denis Muys.
* (ms) Added benchmark to determine impact of eval-free handlers
* (ms) Merged with eval_free branch. Now there are no more
eval("") statements left in the code, making it much easier
to debug. Performance on init() is about the same, performance
on init_and_watch() (noops and logged statements alike) is
25% slower but still in the range of 400,000/sec on my
1.80Ghz CPU.
1.23 (2009/05/12)
* (ms) DBI-1.608 removed a DBD::File 'feature' that allowed leaving
out parameters in a bound execute(). This caused the test
suite to fail (http://groups.google.com/group/perl.cpan.testers/browse_thread/thread/af1f5c875165c387). Fixed the test cases to pass the correct
number of parameters every time.
$parser->file($name) before calling L4p->init($parser).
The Property, DOM and LDAP configurators have been
adapted, check their implementation for details.
* (ms) Added integrity check for Log4perl configurations: Log4perl
now issues a warning if a configuration doesn't define any
appenders. Should anyone not like this, it can be turned
off by setting $L4p::Config::CONFIG_INTEGRITY_CHECK = 0
before calling init().
* (ms) Fixed bug reported by Johannes Kilian <jok@vitronic.com>
with __DIE__ handler and "PatternLayout" shortcut. Replaced
'eval { require ... }' by L4p::Util::module_available in
L4p::Config.pm.
* (ms) Did away with $IS_LOADED internal variable.
* (ms) Fixed bug with L4p::INITIALIZED vs. L4P::Logger::INITIALIZED,
added t/020Easy2.t.
* (ms) Added adm/cvskwexp script to check if we're running into CVS
trouble because of <dollar>Log keyword expansion.
0.47 (07/11/2004)
* (ms) Added suggestion by Hutton Davidson <Davidson.Hutton@ftid.com>
to make the socket appender more forgiving. New option
perl versions (like 5.6.1) don't have it by default.
* (ms) fixed test case in t/020Easy.t for buggy perl 5.6.1
* (ms) added Log::Log4perl::infiltrate_lwp() to make LWP::UserAgent
play in the L4p framework upon request.
* (ms) perl 5.00503 mysteriously core dumps in t/017Watch.t, seems like
this was introduced in 0.46. Disabled these tests for now
if we're on 5.00503 to avoid installation hickups. Longer term,
need to investigate.
0.46 (06/13/2004)
* (ms) removed superfluous eval() in Log4perl.pm, reported anonymously
on the CPAN bugtracker.
* (ms) Added a cleanup() function to Logger.pm which is used by an
END {} block in Logger.pm to tear down all Loggers/Appenders
before global destruction kicks in. In addition, Kevin found
that the eval "" is the cause of an Appender memleak. Moved
assignment variable out of the eval to plug the leak.
Added $Log::Log4perl::CHATTY_DESTROY_METHODS, which shows
what L4p objects are destroyed and when.
* (ms) Kevin's idea is in now, on localizing $? in the L4p global END {}
block. It prevents logdie() et. al from exiting with unwanted
exit codes when global cleanup / global destruction modifies $?,
as seen by Tim with the Email appender.
* (ms) Dave Viner <dviner@yahoo-inc.com> added isLevelEnabled() methods
as aliases to is_level().
0.45 (05/23/2004)
compatibility with 5.005_03.
* (ms) Added a patch to avoid warnings on undefined MDC values referenced
via %X in PatternLayout. Now, the string "[undef]" is used. Bug
was reported by Ritu Kohli <Ritu.Kohli@ubs.com>
0.42 (02/14/2004)
* (kg) added filters to XML DOMConfig and DTD
* (ms) Fixed caller level to cspecs by adding one
* (ms) Added init_once() and documentation
* (ms) Worked around the perl bug that triggers __DIE__ handlers
even if die() occurs within an eval(). So if you did
BEGIN { $SIG{__DIE__} = sub { print "ouch!"; die }; }
use Log::Log4perl;
and Time::HiRes wasn't available, the
eval { require Time::HiRes }
in PatternLayout.pm triggered the __DIE__ handler. Now there's
a function module_available() in L4p::Util to check if a
module is installed.
* (ms) Fixed %M cspec in PatternLayout in case a logging
method is called within one (or more) eval {} block(s).
caller(n+m) will be called repeatedly if necessary
to get the next real subroutine. Anonymous subroutines will
still be called __ANON__, but this can be overridden by
defining
local *__ANON__ = "subroutine_name";
in them explicitely (thanks, Perlmonks :).
0.41 (12/12/2003)
* (ms) Applied documentation update for Synchronized appender, suggested
by David Viner E<lt>dviner@yahoo-inc.comE<gt>
* (ms) renamed l4p-internal DEBUG constant to avoid confusion with
DEBUG() and $DEBUG as suggested by Jim Cromie <jcromie@divsol.com>.
* (ms) Applied patch by Mac Yang <mac@proofpoint.com> for
Log::Log4perl::DateFormat to calculate the timezone for the 'Z'
conversion specifier.
0.36 (07/22/2003)
* (ms) Matthew Keene <mkeene@netspace.net.au> suggested to have
an accessor for all appenders currently defined -- added
appenders() method
* (ms) Test case 041SafeEval.t didn't share $0 explicitely and
created some warnings, fixed that with (jf)'s help.
* (ms) Added performance improvements suggested by
Kyle R. Burton <mortis@voicenet.com>. is_debug/is_info/etc.
are now precompiled, similar to the debug/info/etc. methods.
* (ms) Added a fix to have is_debug()/is_info()/etc. pay
attention to on-the-fly config file changes via init_and_watch().
* (ms) Fixed bug that reloaded the config under init_and_watch()
every time the check period expired, regardless if the config
file itself had changed. Added test case.
* (ms) 0.31 had a Win32 test suite glitch, replaced getpwuid()
(not implemented) by stat() for Safe test.
0.31 05/08/2003
* (kg) fixed bug Appender::DBI where it was consuming the message
array before other appenders could get to it
* (ms) changed config_and_watch to ignore clock differences between
system time and file system time (helpful with skewed NFS
systems). Added Log::Log4perl::Config::Watch.
* James FitzGibbon <james.fitzgibbon@target.com>: Added support for
optionally restricting eval'd code to Safe compartments.
* (ms) allow/deny code in configuration files should now be controlled
via the accessor Log::Log4perl::Config->allow_code(0/1).
$Log::Log4perl::ALLOW_CODE_IN_CONFIG_FILE is still supported
for backwards compatibility.
0.30 03/14/2003
* (ms) Added Log4perl custom filter logic and standard filter set
* (kg) Added url support to init(), finally documenting it
* (kg) Finished implementation of DOMConfigurator allowing xml configs.
* (ms) Corrected DateFormat inconsistencies as reported by
file during program execution and re-initing makes these reference
point to loggers which hold obsolete configurations. Fixed that by
code in debug(), info(), etc. which *replaces* (shudder) the
logger reference the program hands in to them with a new one of
the same category. This happens every time if 'init_and_watch' has
been enabled. However, this introduces a small runtime penalty.
This is different from the original log4j, which does some
half-assed re-initialization, because Java isn't expressive enough
to allow for it. Making this thread-safe might be tough, though.
* Added DEBUG statements to Logger.pm and Config.pm to trace execution
(debugging won't work because of "eval"s). Both files define a
constant named DEBUG towards the top of the file, which will
have perl optimize away the debug statements in case it's set to 0.
* A warning is issued now (once) if init() hasn't been called or
no appenders have been defined.
* Added ':levels' target to Log::Log4perl to import $DEBUG, $ERROR,
etc. levels (just like 'use Log::Log4perl::Level' works).
* Added ':easy' target to allow for simple setup
* Code references can be passed in as log messages to avoid parameter
passing penalty
t/031NDC.t
t/032JRollFile.t
t/033UsrCspec.t
t/034DBI.t
t/035JDBCAppender.t
t/036JSyslog.t
t/037JWin32Event.t
t/038XML-DOM1.t
t/039XML-DOM2.t
t/040Filter.t
t/041SafeEval.t
t/042SyncApp.t
t/043VarSubst.t
t/044XML-Filter.t
t/045Composite.t
t/046RRDs.t
t/048lwp.t
t/049Unhide.t
t/050Buffer.t
t/051Extra.t
t/052Utf8.t
shouldn't have execute rights, you might want to set
Log::Log4perl::Config->allow_code(0);
before you call init(). Alternatively you can supply a restricted set of
Perl opcodes that can be embedded in the config file as described in
"Restricting what Opcodes can be in a Perl Hook".
Restricting what Opcodes can be in a Perl Hook
The value you pass to Log::Log4perl::Config->allow_code() determines
whether the code that is embedded in the config file is eval'd
unrestricted, or eval'd in a Safe compartment. By default, a value of
'1' is assumed, which does a normal 'eval' without any restrictions. A
value of '0' however prevents any embedded code from being evaluated.
If you would like fine-grained control over what can and cannot be
included in embedded code, then please utilize the following methods:
Log::Log4perl::Config->allow_code( $allow );
Log::Log4perl::Config->allowed_code_ops($op1, $op2, ... );
Log::Log4perl::Config->vars_shared_with_safe_compartment( [ \%vars | $package, \@vars ] );
Log::Log4perl::Config->allowed_code_ops_convenience_map( [ \%map | $name, \@mask ] );
Log::Log4perl::Config->allowed_code_ops() takes a list of opcode masks
Log::Log4perl::Config->allowed_code_ops(':subprocess');
This example would allow Perl operations like backticks, system, fork,
and waitpid to be executed in the compartment. Of course, you probably
don't want to use this mask -- it would allow exactly what the Safe
compartment is designed to prevent.
Log::Log4perl::Config->vars_shared_with_safe_compartment() takes the
symbols which should be exported into the Safe compartment before the
code is evaluated. The keys of this hash are the package names that the
symbols are in, and the values are array references to the literal
symbol names. For convenience, the default settings export the '%ENV'
hash from the 'main' package into the compartment:
Log::Log4perl::Config->vars_shared_with_safe_compartment(
main => [ '%ENV' ],
);
Log::Log4perl::Config->allowed_code_ops_convenience_map() is an accessor
method to a map of convenience names to opcode masks. At present, the
to put Log4perl in a more permissive mode.
Prevent croak/confess from stringifying
The logcroak/logconfess functions stringify their arguments before
they pass them to Carp's croak/confess functions. This can get in
the way if you want to throw an object or a hashref as an exception,
in this case use:
$Log::Log4perl::STRINGIFY_DIE_MESSAGE = 0;
eval {
# throws { foo => "bar" }
# without stringification
$logger->logcroak( { foo => "bar" } );
};
EXAMPLE
A simple example to cut-and-paste and get started:
use Log::Log4perl qw(get_logger);
eg/benchmarks/Makefile view on Meta::CPAN
all:
perl -I../../blib/lib -MLog::Log4perl -le 'print $$Log::Log4perl::VERSION'
perl -I../../blib/lib ./simple
master:
cd ../..; git checkout master; perl Makefile.PL >/dev/null; make >/dev/null
eval_free:
cd ../..; git checkout eval_free; perl Makefile.PL >/dev/null; make >/dev/null
lib/Log/Log4perl.pm view on Meta::CPAN
$Log::Log4perl::Logger::NO_STRICT = 1;
delete $tags{':nostrict'};
}
if(exists $tags{':resurrect'}) {
my $FILTER_MODULE = "Filter::Util::Call";
if(! Log::Log4perl::Util::module_available($FILTER_MODULE)) {
die "$FILTER_MODULE required with :resurrect" .
"(install from CPAN)";
}
eval "require $FILTER_MODULE" or die "Cannot pull in $FILTER_MODULE";
Filter::Util::Call::filter_add(
sub {
my($status);
s/^\s*###l4p// if
($status = Filter::Util::Call::filter_read()) > 0;
$status;
});
delete $tags{':resurrect'};
}
lib/Log/Log4perl.pm view on Meta::CPAN
Log::Log4perl::Config->allow_code(0);
before you call init(). Alternatively you can supply a restricted set of
Perl opcodes that can be embedded in the config file as described in
L<"Restricting what Opcodes can be in a Perl Hook">.
=head2 Restricting what Opcodes can be in a Perl Hook
The value you pass to Log::Log4perl::Config->allow_code() determines whether
the code that is embedded in the config file is eval'd unrestricted, or
eval'd in a Safe compartment. By default, a value of '1' is assumed,
which does a normal 'eval' without any restrictions. A value of '0'
however prevents any embedded code from being evaluated.
If you would like fine-grained control over what can and cannot be included
in embedded code, then please utilize the following methods:
Log::Log4perl::Config->allow_code( $allow );
Log::Log4perl::Config->allowed_code_ops($op1, $op2, ... );
Log::Log4perl::Config->vars_shared_with_safe_compartment( [ \%vars | $package, \@vars ] );
Log::Log4perl::Config->allowed_code_ops_convenience_map( [ \%map | $name, \@mask ] );
Log::Log4perl::Config-E<gt>allowed_code_ops() takes a list of opcode masks
lib/Log/Log4perl.pm view on Meta::CPAN
Log::Log4perl::Config->allowed_code_ops(':subprocess');
This example would allow Perl operations like backticks, system, fork, and
waitpid to be executed in the compartment. Of course, you probably don't
want to use this mask -- it would allow exactly what the Safe compartment is
designed to prevent.
Log::Log4perl::Config-E<gt>vars_shared_with_safe_compartment()
takes the symbols which
should be exported into the Safe compartment before the code is evaluated.
The keys of this hash are the package names that the symbols are in, and the
values are array references to the literal symbol names. For convenience,
the default settings export the '%ENV' hash from the 'main' package into the
compartment:
Log::Log4perl::Config->vars_shared_with_safe_compartment(
main => [ '%ENV' ],
);
Log::Log4perl::Config-E<gt>allowed_code_ops_convenience_map() is an accessor
lib/Log/Log4perl.pm view on Meta::CPAN
=item Prevent croak/confess from stringifying
The logcroak/logconfess functions stringify their arguments before
they pass them to Carp's croak/confess functions. This can get in the
way if you want to throw an object or a hashref as an exception, in
this case use:
$Log::Log4perl::STRINGIFY_DIE_MESSAGE = 0;
eval {
# throws { foo => "bar" }
# without stringification
$logger->logcroak( { foo => "bar" } );
};
=back
=head1 EXAMPLE
A simple example to cut-and-paste and get started:
lib/Log/Log4perl/Appender.pm view on Meta::CPAN
# THREADS: Need to unlock here to make it thread safe
return $unique_name;
}
##################################################
sub new {
##################################################
my($class, $appenderclass, %params) = @_;
# Pull in the specified Log::Log4perl::Appender object
eval {
# Eval erroneously succeeds on unknown appender classes if
# the eval string just consists of valid perl code (e.g. an
# appended ';' in $appenderclass variable). Fail if we see
# anything in there that can't be class name.
die "'$appenderclass' not a valid class name " if
$appenderclass =~ /[^:\w]/;
# Check if the class/package is already available because
# something like Class::Prototyped injected it previously.
# Use UNIVERSAL::can to check the appender's new() method
# [RT 28987]
if( ! $appenderclass->can('new') ) {
# Not available yet, try to pull it in.
# see 'perldoc -f require' for why two evals
eval "require $appenderclass";
#unless ${$appenderclass.'::IS_LOADED'}; #for unit tests,
#see 004Config
die $@ if $@;
}
};
$@ and die "ERROR: can't load appenderclass '$appenderclass'\n$@";
print "Appender class $appenderclass loaded OK ($@)\n" if _INTERNAL_DEBUG;
$params{name} = unique_name() unless exists $params{name};
lib/Log/Log4perl/Appender/DBI.pm view on Meta::CPAN
($self->{reconnect_attempts} == 1 ? "" : "s") .
" (last error error was [$errstr]";
}
if(! $self->{dbh}->ping()) {
# Ping failed, try to reconnect
if($attempt) {
#warn "Sleeping"; # TODO
sleep($self->{reconnect_sleep}) if $self->{reconnect_sleep};
}
eval {
#warn "Reconnecting to DB"; # TODO
$self->{dbh} = $self->{connect}->();
};
}
if ($self->{usePreparedStmt}) {
$sth = $self->create_statement($self->{SQL});
$self->{sth} = $sth if $self->{sth};
} else {
#warn "Pending stmt: $self->{pending_stmt}"; #TODO
lib/Log/Log4perl/Appender/File.pm view on Meta::CPAN
return $self;
}
##################################################
sub syswrite_encoder {
##################################################
my($self) = @_;
if( !SYSWRITE_UTF8_OK and $self->{syswrite} and $self->{utf8} ) {
print "Requiring Encode\n" if _INTERNAL_DEBUG;
eval { require Encode };
print "Requiring Encode returned: $@\n" if _INTERNAL_DEBUG;
if( $@ ) {
die "syswrite and utf8 requires Encode.pm";
} else {
return sub { Encode::encode_utf8($_[0]) };
}
}
return undef;
lib/Log/Log4perl/Appender/File.pm view on Meta::CPAN
my $didnt_exist = ! -e $self->{filename};
if($didnt_exist && $self->{mkpath}) {
my ($volume, $path, $file) = splitpath($self->{filename});
if($path ne '' && !-e $path) {
my $old_umask = umask($self->{mkpath_umask}) if defined $self->{mkpath_umask};
my $options = {};
foreach my $param (qw(owner group) ) {
$options->{$param} = $self->{$param} if defined $self->{$param};
}
eval {
mkpath(catpath($volume, $path, ''),$options);
};
umask($old_umask) if defined $old_umask;
die "Can't create path ${path} ($!)" if $@;
}
}
my $old_umask = umask($self->{umask}) if defined $self->{umask};
eval {
if($self->{syswrite}) {
sysopen $fh, "$self->{filename}", $sysmode or
die "Can't sysopen $self->{filename} ($!)";
} else {
open $fh, "$arrows$self->{filename}" or
die "Can't open $self->{filename} ($!)";
}
};
umask($old_umask) if defined $old_umask;
die $@ if $@;
if($didnt_exist and
( defined $self->{owner} or defined $self->{group} )
) {
eval { $self->perms_fix() };
if($@) {
# Cleanup and re-throw
unlink $self->{filename};
die $@;
}
}
if($self->{recreate}) {
$self->{watcher} = Log::Log4perl::Config::Watch->new(
lib/Log/Log4perl/Appender/Socket.pm view on Meta::CPAN
# a connection, try to establish one
# here. If it fails, return.
if(($self->{silent_recovery} or $self->{defer_connection}) and
!defined $self->{socket}) {
if(! $self->connect(%$self)) {
return undef;
}
}
# Try to send the message across
eval { $self->{socket}->send($params{message});
};
if($@) {
warn "Send to " . ref($self) . " failed ($@), retrying once...";
if($self->connect(%$self)) {
redo;
}
if($self->{silent_recovery}) {
return undef;
}
lib/Log/Log4perl/Config.pm view on Meta::CPAN
check_interval => $delay,
l4p_internal => 1,
);
}
if(defined $opts) {
die "Parameter $opts needs to be a hash ref" if ref($opts) ne "HASH";
$OPTS = $opts;
}
eval { _init($class, $config); };
if($@) {
die "$@" unless defined $OLD_CONFIG;
# Call _init with a pre-parsed config to go back to old setting
_init($class, undef, $OLD_CONFIG);
warn "Loading new config failed, reverted to old one\n";
}
}
##################################################
lib/Log/Log4perl/Config.pm view on Meta::CPAN
my $filter;
if(ref($type) eq "CODE") {
# Subroutine - map into generic Log::Log4perl::Filter class
$filter = Log::Log4perl::Filter->new($filter_name, $type);
} else {
# Filter class
die "Filter class '$type' doesn't exist" unless
Log::Log4perl::Util::module_available($type);
eval "require $type" or die "Require of $type failed ($!)";
# Invoke with all defined parameter
# key/values (except the key 'value' which is the entry
# for the class)
$filter = $type->new(name => $filter_name,
map { $_ => $data->{filter}->{$filter_name}->{$_}->{value} }
grep { $_ ne "value" }
sort keys %{$data->{filter}->{$filter_name}});
}
# Register filter with the global filter registry
lib/Log/Log4perl/Config.pm view on Meta::CPAN
my $ref = \$data;
for my $part ( @$leaf_path[0..$#$leaf_path-1] ) {
$ref = \$$ref->{ $part };
}
return $ref;
}
###########################################
sub eval_if_perl {
###########################################
my($value) = @_;
if(my $cref = compile_if_perl($value)) {
return $cref->();
}
return $value;
}
lib/Log/Log4perl/Config.pm view on Meta::CPAN
if( defined( $mask = Log::Log4perl::Config->allowed_code_ops() ) ) {
return compile_in_safe_cpt($value, $mask );
}
elsif( $mask = Log::Log4perl::Config->allowed_code_ops_convenience_map(
Log::Log4perl::Config->allow_code()
) ) {
return compile_in_safe_cpt($value, $mask );
}
elsif( Log::Log4perl::Config->allow_code() == 1 ) {
# eval without restriction
my $cref = eval "package main; $value" or
die "Can't evaluate '$value' ($@)";
return $cref;
}
else {
die "Invalid value for \$Log::Log4perl::Config->allow_code(): '".
Log::Log4perl::Config->allow_code() . "'";
}
}
return undef;
}
lib/Log/Log4perl/Config.pm view on Meta::CPAN
my $safe = Safe->new();
$safe->permit_only( @{ $allowed_ops } );
# share things with the compartment
for( sort keys %{ Log::Log4perl::Config->vars_shared_with_safe_compartment() } ) {
my $toshare = Log::Log4perl::Config->vars_shared_with_safe_compartment($_);
$safe->share_from( $_, $toshare )
or die "Can't share @{ $toshare } with Safe compartment";
}
# evaluate with restrictions
my $cref = $safe->reval("package main; $value") or
die "Can't evaluate '$value' in Safe compartment ($@)";
return $cref;
}
###########################################
sub boolean_to_perlish {
###########################################
my($value) = @_;
# Translate boolean to perlish
lib/Log/Log4perl/Config/BaseConfigurator.pm view on Meta::CPAN
package Log::Log4perl::Config::BaseConfigurator;
use warnings;
use strict;
use constant _INTERNAL_DEBUG => 0;
*eval_if_perl = \&Log::Log4perl::Config::eval_if_perl;
*compile_if_perl = \&Log::Log4perl::Config::compile_if_perl;
*leaf_path_to_hash = \&Log::Log4perl::Config::leaf_path_to_hash;
################################################
sub new {
################################################
my($class, %options) = @_;
my $self = {
utf8 => 0,
lib/Log/Log4perl/Config/BaseConfigurator.pm view on Meta::CPAN
# could be either
# appender appndr layout cspec
# or
# PatternLayout cspec U value ...
#
# do nothing
} else {
my $ref = leaf_path_to_hash( $path, $data );
if(_INTERNAL_DEBUG) {
print "Calling eval_if_perl on $$ref\n";
}
$$ref = eval_if_perl( $$ref );
}
}
return $data;
}
1;
__END__
lib/Log/Log4perl/Config/DOMConfigurator.pm view on Meta::CPAN
use Log::Log4perl::Config::BaseConfigurator;
our @ISA = qw(Log::Log4perl::Config::BaseConfigurator);
#todo
# DONE(param-text) some params not attrs but values, like <sql>...</sql>
# DONE see DEBUG!!! below
# NO, (really is only used for AsyncAppender) appender-ref in <appender>
# DONE check multiple appenders in a category
# DONE in Config.pm re URL loading, steal from XML::DOM
# DONE, OK see PropConfigurator re importing unlog4j, eval_if_perl
# NO (is specified in DTD) - need to handle 0/1, true/false?
# DONE see Config, need to check version of XML::DOM
# OK user defined levels? see parse_level
# OK make sure 2nd test is using log4perl constructs, not log4j
# OK handle new filter stuff
# make sure sample code actually works
# try removing namespace prefixes in the xml
use XML::DOM;
use Log::Log4perl::Level;
lib/Log/Log4perl/Config/DOMConfigurator.pm view on Meta::CPAN
#can't use ValParser here because we're using namespaces?
#doesn't seem to work - kg 3/2003
our $PARSER_CLASS = 'XML::DOM::Parser';
our $LOG4J_PREFIX = 'log4j';
our $LOG4PERL_PREFIX = 'log4perl';
#poor man's export
*eval_if_perl = \&Log::Log4perl::Config::eval_if_perl;
*unlog4j = \&Log::Log4perl::Config::unlog4j;
###################################################
sub parse {
###################################################
my($self, $newtext) = @_;
$self->text($newtext) if defined $newtext;
my $text = $self->{text};
lib/Log/Log4perl/Config/DOMConfigurator.pm view on Meta::CPAN
print "parse_param_nested: got param $name = $value\n"
if _INTERNAL_DEBUG;
if ($value =~ /^(all|debug|info|warn|error|fatal|off|null)$/) {
$value = uc $value;
}
if ($name !~ /warp_message|filter/ &&
$child->getParentNode->getAttribute('name') ne 'cspec') {
$value = eval_if_perl($value);
}
#<param-text>
}elsif ($tag_name eq 'param-text'){
foreach my $grandkid ($child->getChildNodes){
if ($grandkid->getNodeType == TEXT_NODE) {
$value .= $grandkid->getData;
}
}
if ($name !~ /warp_message|filter/ &&
$child->getParentNode->getAttribute('name') ne 'cspec') {
$value = eval_if_perl($value);
}
}
$value = subst($value);
#multiple values for the same param name
if (defined $l4p_branch->{$name}{value} ) {
if (ref $l4p_branch->{$name}{value} ne 'ARRAY'){
my $temp = $l4p_branch->{$name}{value};
$l4p_branch->{$name}{value} = [$temp];
lib/Log/Log4perl/Config/DOMConfigurator.pm view on Meta::CPAN
instead of just <appender>, you can make your own DTD combining
the two DTDs and getting rid of the namespace prefixes. Then you can
validate against that, and log4perl should accept it just fine.
=head1 VARIABLE SUBSTITUTION
This supports variable substitution like C<${foobar}> in text and in
attribute values except for appender-ref. If an environment variable is defined
for that name, its value is substituted. So you can do stuff like
<param name="${hostname}" value="${hostnameval}.foo.com"/>
<param-text name="to">${currentsysadmin}@foo.com</param-text>
=head1 REQUIRES
To use this module you need XML::DOM installed.
To use the log4perl.dtd, you'll have to reference it in your XML config,
and you'll also need to note that log4perl.dtd references the
log4j dtd as "log4j-1.2.dtd", so your validator needs to be able
lib/Log/Log4perl/Config/PropertyConfigurator.pm view on Meta::CPAN
use warnings;
use strict;
our @ISA = qw(Log::Log4perl::Config::BaseConfigurator);
our %NOT_A_MULT_VALUE = map { $_ => 1 }
qw(conversionpattern);
#poor man's export
*eval_if_perl = \&Log::Log4perl::Config::eval_if_perl;
*compile_if_perl = \&Log::Log4perl::Config::compile_if_perl;
*unlog4j = \&Log::Log4perl::Config::unlog4j;
use constant _INTERNAL_DEBUG => 0;
our $COMMENT_REGEX = qr/[#;!]/;
################################################
sub parse {
################################################
lib/Log/Log4perl/FAQ.pm view on Meta::CPAN
open FILE, "<blah" or LOGDIE "Can't open blah -- bailing out!";
What can you do if you're using some library which doesn't use Log::Log4perl
and calls C<die()> internally if something goes wrong? Use a
C<$SIG{__DIE__}> pseudo signal handler
use Log::Log4perl qw(get_logger);
$SIG{__DIE__} = sub {
if($^S) {
# We're in an eval {} and don't want log
# this message but catch it later
return;
}
local $Log::Log4perl::caller_depth =
$Log::Log4perl::caller_depth + 1;
my $logger = get_logger("");
$logger->fatal(@_);
die @_; # Now terminate really
};
lib/Log/Log4perl/FAQ.pm view on Meta::CPAN
given that C<logfile()> is a valid function in your C<main> package
returning a string containing the path to the log file.
Or, think about using the value of an environment variable:
log4perl.appender.DBI.user = sub { $ENV{USERNAME} };
When C<Log::Log4perl-E<gt>init()> parses the configuration
file, it will notice the assignment above because of its
C<sub {...}> pattern and treat it in a special way:
It will evaluate the subroutine (which can contain
arbitrary Perl code) and take its return value as the right side
of the assignment.
A typical application would be called like this on the command line:
app # log file is "test.log"
app -l mylog.txt # log file is "mylog.txt"
Here's some sample code implementing the command line interface above:
lib/Log/Log4perl/FAQ.pm view on Meta::CPAN
in the appropriate appender instead of having a screen full of STDERR
messages. It also works with the C<Carp> module and its C<carp()>
and C<cluck()> functions.
If, on the other hand, catching C<die()> and friends is
required, a C<__DIE__> handler is appropriate:
$SIG{__DIE__} = sub {
if($^S) {
# We're in an eval {} and don't want log
# this message but catch it later
return;
}
local $Log::Log4perl::caller_depth =
$Log::Log4perl::caller_depth + 1;
LOGDIE @_;
};
This will call Log4perl's C<LOGDIE()> function, which will log a fatal
error and then call die() internally, causing the program to exit. Works
lib/Log/Log4perl/FAQ.pm view on Meta::CPAN
Log::Log4perl's C<:easy> mode.
If Log::Log4perl
is installed in the target environment, the regular Log::Log4perl rules
apply. If not, all of DEBUG(), INFO(), etc. are "stubbed" out, i.e. they
turn into no-ops:
use warnings;
use strict;
BEGIN {
eval { require Log::Log4perl; };
if($@) {
print "Log::Log4perl not installed - stubbing.\n";
no strict qw(refs);
*{"main::$_"} = sub { } for qw(DEBUG INFO WARN ERROR FATAL);
} else {
no warnings;
print "Log::Log4perl installed - life is good.\n";
require Log::Log4perl::Level;
Log::Log4perl::Level->import(__PACKAGE__);
lib/Log/Log4perl/Filter/Boolean.pm view on Meta::CPAN
$self->compile_logic($options{logic});
return $self;
}
##################################################
sub ok {
##################################################
my ($self, %p) = @_;
return $self->eval_logic(\%p);
}
##################################################
sub compile_logic {
##################################################
my ($self, $logic) = @_;
# Extract Filter placeholders in logic as defined
# in configuration file.
while($logic =~ /([\w_-]+)/g) {
lib/Log/Log4perl/Filter/Boolean.pm view on Meta::CPAN
# logic into compiled perl code
my $func = <<EOT;
sub {
my($plist) = \@_;
$logic;
}
EOT
print "func=$func\n" if _INTERNAL_DEBUG;
my $eval_func = eval $func;
if(! $eval_func) {
die "Syntax error in Boolean filter logic: $eval_func";
}
$self->{eval_func} = $eval_func;
}
##################################################
sub eval_logic {
##################################################
my($self, $p) = @_;
my @plist = ();
# Eval the results of all filters referenced
# in the code (although the order of keys is
# not predictable, it is consistent :)
for my $param (keys %{$self->{params}}) {
# Pass a coderef as a param that will run the filter's ok method and
# return a 1 or 0.
print "Passing filter $param\n" if _INTERNAL_DEBUG;
push(@plist, sub {
return $self->{params}->{$param}->ok(%$p) ? 1 : 0
});
}
# Now pipe the parameters into the canned function,
# have it evaluate the logic and return the final
# decision
print "Passing in (", join(', ', @plist), ")\n" if _INTERNAL_DEBUG;
return $self->{eval_func}->(@plist);
}
1;
__END__
=encoding utf8
=head1 NAME
lib/Log/Log4perl/JavaMap.pm view on Meta::CPAN
$appender_data->{value} ||
die "ERROR: you didn't tell me how to implement your appender " .
"'$appender_name'";
my $perl_class = $translate{$appender_data->{value}} ||
$user_defined{$appender_data->{value}} ||
die "ERROR: I don't know how to make a '$appender_data->{value}' " .
"to implement your appender '$appender_name', that's not a " .
"supported class\n";
eval {
eval "require $perl_class"; #see 'perldoc -f require' for why two evals
die $@ if $@;
};
$@ and die "ERROR: trying to set appender for $appender_name to " .
"$appender_data->{value} using $perl_class failed\n$@ \n";
my $app = $perl_class->new($appender_name, $appender_data);
return $app;
}
#an external api to the two hashes
lib/Log/Log4perl/Layout/PatternLayout.pm view on Meta::CPAN
} else {
$self->{message_chomp_before_newline} = 1;
}
bless $self, $class;
#add the global user-defined cspecs
foreach my $f (keys %GLOBAL_USER_DEFINED_CSPECS){
#add it to the list of letters
$self->{CSPECS} .= $f;
#for globals, the coderef is already evaled,
$self->{USER_DEFINED_CSPECS}{$f} = $GLOBAL_USER_DEFINED_CSPECS{$f};
}
#add the user-defined cspecs local to this appender
foreach my $f (keys %{$options->{cspec}}){
$self->add_layout_cspec($f, $options->{cspec}{$f}{value});
}
# non-portable line breaks
$layout_string =~ s/\\n/\n/g;
lib/Log/Log4perl/Layout/PatternLayout.pm view on Meta::CPAN
$self->{info_needed}->{F} or
$self->{info_needed}->{C} or
$self->{info_needed}->{l} or
$self->{info_needed}->{M} or
$self->{info_needed}->{T} or
0
) {
my ($package, $filename, $line,
$subroutine, $hasargs,
$wantarray, $evaltext, $is_require,
$hints, $bitmask) = caller($caller_offset);
# If caller() choked because of a whacko caller level,
# correct undefined values to '[undef]' in order to prevent
# warning messages when interpolating later
unless(defined $bitmask) {
for($package,
$filename, $line,
$subroutine, $hasargs,
$wantarray, $evaltext, $is_require,
$hints, $bitmask) {
$_ = '[undef]' unless defined $_;
}
}
$info{L} = $line;
$info{F} = $filename;
$info{C} = $package;
if($self->{info_needed}->{M} or
lib/Log/Log4perl/Layout/PatternLayout.pm view on Meta::CPAN
# logger, we need to go one additional level up.
my $levels_up = 1;
{
my @callinfo = caller($caller_offset+$levels_up);
if(_INTERNAL_DEBUG) {
callinfo_dump( $caller_offset, \@callinfo );
}
$subroutine = $callinfo[3];
# If we're inside an eval, go up one level further.
if(defined $subroutine and
$subroutine eq "(eval)") {
print "Inside an eval, one up\n" if _INTERNAL_DEBUG;
$levels_up++;
redo;
}
}
$subroutine = "main::" unless $subroutine;
print "Subroutine is '$subroutine'\n" if _INTERNAL_DEBUG;
$info{M} = $subroutine;
$info{l} = "$subroutine $filename ($line)";
}
}
lib/Log/Log4perl/Layout/PatternLayout.pm view on Meta::CPAN
$GLOBAL_USER_DEFINED_CSPECS{$letter} =
Log::Log4perl::Config::compile_if_perl($perlcode);
if ($@) {
die qq{Compilation failed for your perl code for }.
qq{"log4j.PatternLayout.cspec.$letter":\n}.
qq{This is the error message: \t$@\n}.
qq{This is the code that failed: \n$perlcode\n};
}
croak "eval'ing your perlcode for 'log4j.PatternLayout.cspec.$letter' ".
"doesn't return a coderef \n".
"Here is the perl code: \n\t$perlcode\n "
unless (ref $GLOBAL_USER_DEFINED_CSPECS{$letter} eq 'CODE');
}else{
croak "I don't know how to handle perlcode=$perlcode ".
"for 'cspec.$letter' in call to add_global_cspec()";
}
}
lib/Log/Log4perl/Layout/PatternLayout.pm view on Meta::CPAN
$self->{USER_DEFINED_CSPECS}{$letter} =
Log::Log4perl::Config::compile_if_perl($perlcode);
if ($@) {
die qq{Compilation failed for your perl code for }.
qq{"cspec.$letter":\n}.
qq{This is the error message: \t$@\n}.
qq{This is the code that failed: \n$perlcode\n};
}
croak "eval'ing your perlcode for 'cspec.$letter' ".
"doesn't return a coderef \n".
"Here is the perl code: \n\t$perlcode\n "
unless (ref $self->{USER_DEFINED_CSPECS}{$letter} eq 'CODE');
}else{
croak "I don't know how to handle perlcode=$perlcode ".
"for 'cspec.$letter' in call to add_layout_cspec()";
}
lib/Log/Log4perl/Layout/PatternLayout.pm view on Meta::CPAN
# Just for internal debugging
$called_by[1] = basename $called_by[1];
print "caller($level) at $called_by[1]-$called_by[2] returned ";
my @by_idx;
# $info->[1] = basename $info->[1] if defined $info->[1];
my $i = 0;
for my $field (qw(package filename line subroutine hasargs
wantarray evaltext is_require hints bitmask)) {
$by_idx[$i] = $field;
$i++;
}
$i = 0;
for my $value (@$info) {
my $field = $by_idx[ $i ];
print "$field=",
(defined $info->[$i] ? $info->[$i] : "[undef]"),
" ";
lib/Log/Log4perl/Logger.pm view on Meta::CPAN
my $watch_check_code = generate_watch_code("logger", 1);
return sub {
my $logger = shift;
my $level = pop;
my $message;
my $appenders_fired = 0;
# Evaluate all parameters that need to be evaluated. Two kinds:
#
# (1) It's a hash like { filter => "filtername",
# value => "value" }
# => filtername(value)
#
# (2) It's a code ref
# => coderef()
#
$message = [map { ref $_ eq "HASH" &&
lib/Log/Log4perl/Logger.pm view on Meta::CPAN
create_log_level_methods($level);
return 0;
}
########################################
#
# if we were hackin' lisp (or scheme), we'd be returning some lambda
# expressions. But we aren't. :) So we'll just create some strings and
# eval them.
########################################
sub create_log_level_methods {
########################################
my $level = shift || die("create_log_level_methods: " .
"forgot to pass in a level string!");
my $lclevel = lc($level);
my $levelint = uc($level) . "_INT";
my $initial_cap = ucfirst($lclevel);
no strict qw(refs);
# This is a bit better way to create code on the fly than eval'ing strings.
# -erik
*{__PACKAGE__ . "::$lclevel"} = sub {
if(_INTERNAL_DEBUG) {
my $level_disp = (defined $_[0]->{level} ? $_[0]->{level}
: "[undef]");
print "$lclevel: ($_[0]->{category}/$level_disp) [@_]\n";
}
init_warn() unless $INITIALIZED or $NON_INIT_WARNED;
$_[0]->{$level}->(@_, $level) if defined $_[0]->{$level};
lib/Log/Log4perl/Util.pm view on Meta::CPAN
die "$pkg: Unknown parameter: ", join( ",", keys %hash_copy );
}
}
}
##################################################
sub module_available { # Check if a module is available
##################################################
my($full_name) = @_;
# Weird cases like "strict;" (including the semicolon) would
# succeed with the eval below, so check those up front.
# I can't believe Perl doesn't have a proper way to check if a
# module is available or not!
return 0 if $full_name =~ /[^\w:]/;
$full_name =~ s#::#/#g;
$full_name .= '.pm';
return 1 if $INC{$full_name};
eval {
local $SIG{__DIE__} = sub {};
require $full_name;
};
return !$@;
}
##################################################
sub tmpfile_name { # File::Temp without the bells and whistles
##################################################
t/002Logger.t view on Meta::CPAN
my $app_screen = Log::Log4perl::Appender::Screen->new();
my $tmpfile = Log::Log4perl::Util::tmpfile_name();
END { unlink $tmpfile if defined $tmpfile };
my $app_file = Log::Log4perl::Appender::File->new(
filename => $tmpfile
);
eval { $log10->add_appender($app_file); };
is($@, "", "Adding file appender");
eval { $log10->add_appender($app_screen); };
is($@, "", "Adding screen appender");
done_testing;
t/003Layout.t view on Meta::CPAN
is($app->buffer(), '12345');
#left justify
$app->buffer("");
$layout = Log::Log4perl::Layout::PatternLayout->new("%-5.5m");
$app->layout($layout);
$logger->debug("123");
is($app->buffer(), '123 ');
############################################################
# Check depth level of %M - with eval {...}
############################################################
$app->buffer("");
$layout = Log::Log4perl::Layout::PatternLayout->new("%M: %m");
$app->layout($layout);
sub foo {
eval {
$logger->debug("Thats the message");
};
}
foo();
is($app->buffer(), 'main::foo: Thats the message');
############################################################
# Check two levels of %M - with eval {...}
############################################################
$app->buffer("");
$layout = Log::Log4perl::Layout::PatternLayout->new("%M: %m");
$app->layout($layout);
sub foo2 {
eval {
eval {
$logger->debug("Thats the message");
};
};
}
foo2();
is($app->buffer(), 'main::foo2: Thats the message');
############################################################
# Check depth level of %M - with eval {...}
############################################################
$app->buffer("");
$layout = Log::Log4perl::Layout::PatternLayout->new("%M: %m");
$app->layout($layout);
eval {
$logger->debug("Thats the message");
};
is($app->buffer(), 'main::: Thats the message');
############################################################
# Non-portable line breaks
############################################################
$app->buffer("");
$layout = Log::Log4perl::Layout::PatternLayout->new("%m\\n");
$app->layout($layout);
eval {
$logger->debug("Thats the message");
};
is($app->buffer(), "Thats the message\n");
$app->buffer("");
$layout = Log::Log4perl::Layout::PatternLayout->new("%m\\r\\n");
$app->layout($layout);
eval {
$logger->debug("Thats the message");
};
is($app->buffer(), "Thats the message\r\n");
############################################################
# Render a multiline message
############################################################
$app->buffer("");
$layout = Log::Log4perl::Layout::PatternLayout::Multiline->new("%M: %m%n");
$app->layout($layout);
eval {
$logger->debug("Thats the\nmultiline\nmessage");
};
is($app->buffer(), "main::: Thats the\nmain::: multiline\nmain::: message\n");
done_testing;
t/004Config.t view on Meta::CPAN
##########################################################################
Log::Log4perl::Appender::TestBuffer->reset();
$conf = <<EOT;
log4perl.logger.Twix.Bar = DEBUG, A1
log4perl.appender.A1=Log::Log4perl::Appender::TestBuffer
log4perl.appender.A1.layout=PatternLayout
#log4perl.appender.A1.layout.ConversionPattern=%d-%c %m%n
EOT
eval { Log::Log4perl->init(\$conf); };
#actually, it turns out that log4j handles this, if no ConversionPattern
#specified is uses DEFAULT_LAYOUT_PATTERN, %m%n
#ok($@, '/No ConversionPattern given for PatternLayout/');
is($@, '', 'PatternLayout without ConversionPattern');
######################################################################
# Test with $/ set to undef
######################################################################
t/004Config.t view on Meta::CPAN
######################################################################
# Test accessors
######################################################################
my $conf = q{
log4perl.category.pf.trigger = DEBUG
log4j.appender.A1 = Log::Log4perl::Appender::TestBuffer
log4j.appender.A1.layout = org.apache.log4j.PatternLayout
log4j.appender.A1.layout.ConversionPattern = object%m%n
};
eval { Log::Log4perl->init( \$conf ); };
is $@, "", "'trigger' category [rt.cpan.org #50495]";
######################################################################
# Test alternate comment syntax
######################################################################
$conf = <<'END_CONF';
log4perl.MyParam = MyVal
; log4perl.MyParam = AnotherVal
END_CONF
eval { Log::Log4perl->init( \$conf ); };
is $@, "", "support semi-colon comment character [github.com #24]";
$conf = <<'END_CONF';
log4perl.MyParam = MyVal
! log4perl.MyParam = AnotherVal
END_CONF
eval { Log::Log4perl->init( \$conf ); };
is $@, "", "support exclamation comment character [github.com #24]";
done_testing;
t/006Config-Java.t view on Meta::CPAN
require Log::Log4perl::InternalDebug;
Log::Log4perl::InternalDebug->enable();
}
}
use Test::More;
our $LOG_DISPATCH_PRESENT = 0;
BEGIN {
eval { require Log::Dispatch; };
if($@) {
plan skip_all => "only with Log::Dispatch";
} else {
$LOG_DISPATCH_PRESENT = 1;
plan tests => 2;
}
};
use Log::Log4perl;
use Log::Log4perl::Appender::TestBuffer;
t/010JConsole.t view on Meta::CPAN
use Log::Log4perl::Appender::TestBuffer;
use Log::Log4perl::Appender::File;
use File::Spec;
use Test::More;
use lib File::Spec->catdir(qw(t lib));
use Log4perlInternalTest qw(tmpdir);
our $LOG_DISPATCH_PRESENT = 0;
BEGIN {
eval { require Log::Dispatch; };
if($@) {
plan skip_all => "only with Log::Dispatch";
} else {
$LOG_DISPATCH_PRESENT = 1;
plan tests => 1;
}
};
my $WORK_DIR = tmpdir();
my $test_logfile = File::Spec->catfile($WORK_DIR,'test1.log');
t/011JFile.t view on Meta::CPAN
use Log::Log4perl;
use Test::More;
use File::Spec;
use lib File::Spec->catdir(qw(t lib));
use Log4perlInternalTest qw(tmpdir);
our $LOG_DISPATCH_PRESENT = 0;
BEGIN {
eval { require Log::Dispatch; };
if($@) {
plan skip_all => "only with Log::Dispatch";
} else {
$LOG_DISPATCH_PRESENT = 1;
plan tests => 1;
}
};
my $WORK_DIR = tmpdir();
my $test_logfile = File::Spec->catfile($WORK_DIR, 'test2.log');
t/012Deeper.t view on Meta::CPAN
use Log::Log4perl;
use Test::More;
use File::Spec;
use lib File::Spec->catdir(qw(t lib));
use Log4perlInternalTest qw(tmpdir);
our $LOG_DISPATCH_PRESENT = 0;
BEGIN {
eval { require Log::Dispatch; };
if($@) {
plan skip_all => "only with Log::Dispatch";
} else {
$LOG_DISPATCH_PRESENT = 1;
plan tests => 3;
}
};
my $WORK_DIR = tmpdir();
t/014ConfErrs.t view on Meta::CPAN
# *****************************************************
# nonexistent appender class
$conf = <<EOL;
log4j.category.simplelayout.test=INFO, myAppender
log4j.appender.myAppender = Log::Log4perl::Appender::FileAppenderx
log4j.appender.myAppender.layout = Log::Log4perl::Layout::SimpleLayout
log4j.appender.myAppender.File = $testfile
EOL
eval{
Log::Log4perl->init(\$conf);
};
like($@, qr/ERROR: can't load appenderclass 'Log::Log4perl::Appender::FileAppenderx'/);
# *****************************************************
# nonexistent layout class
$conf = <<EOL;
log4j.category.simplelayout.test=INFO, myAppender
log4j.appender.myAppender = Log::Log4perl::Appender::TestBuffer
log4j.appender.myAppender.layout = Log::Log4perl::Layout::SimpleLayoutx
log4j.appender.myAppender.File = $testfile
EOL
eval{
Log::Log4perl->init(\$conf);
};
like($@, qr/ERROR: trying to set layout for myAppender to 'Log::Log4perl::Layout::SimpleLayoutx' failed/);
# *****************************************************
# nonexistent appender class containing a ';'
$conf = <<EOL;
log4j.category.simplelayout.test=INFO, myAppender
log4j.appender.myAppender = Log::Log4perl::Appender::TestBuffer;
log4j.appender.myAppender.layout = Log::Log4perl::Layout::SimpleLayout
log4j.appender.myAppender.File = $testfile
EOL
eval{
Log::Log4perl->init(\$conf);
};
like($@, qr/ERROR: can't load appenderclass 'Log::Log4perl::Appender::TestBuffer;'/);
# *****************************************************
# nonexistent layout class containing a ';'
$conf = <<EOL;
log4j.category.simplelayout.test=INFO, myAppender
log4j.appender.myAppender = Log::Log4perl::Appender::TestBuffer
log4j.appender.myAppender.layout = Log::Log4perl::Layout::SimpleLayout;
log4j.appender.myAppender.File = $testfile
EOL
eval{
Log::Log4perl->init(\$conf);
};
like($@, qr/trying to set layout for myAppender to 'Log::Log4perl::Layout::SimpleLayout;' failed/);
# *****************************************************
# Relative Layout class
$conf = <<EOL;
log4j.category.simplelayout.test=INFO, myAppender
log4j.appender.myAppender = Log::Log4perl::Appender::TestBuffer
log4j.appender.myAppender.layout = SimpleLayout
log4j.appender.myAppender.File = $testfile
EOL
eval{
Log::Log4perl->init(\$conf);
};
# It's supposed to find it.
is($@, '', 'relative layout class');
# *****************************************************
# bad priority
$conf = <<EOL;
log4j.category.simplelayout.test=xxINFO, myAppender
log4j.appender.myAppender = Log::Log4perl::Appender::File
log4j.appender.myAppender.layout = Log::Log4perl::Layout::SimpleLayout
log4j.appender.myAppender.File = $testfile
EOL
eval{
Log::Log4perl->init(\$conf);
};
like($@, qr/level 'xxINFO' is not a valid error level/);
# *****************************************************
# nonsense conf file 1
$conf = <<EOL;
log4j.category.simplelayout.test=INFO, myAppender
log4j.appender.myAppender = Log::Log4perl::Appender::Screen
log4j.appender.myAppender.nolayout = Log::Log4perl::Layout::SimpleLayout
log4j.appender.myAppender.File = $testfile
EOL
eval{
Log::Log4perl->init(\$conf);
};
like($@, qr/Layout not specified for appender myAppender at/,
"nonsense conf file 1");
# *****************************************************
# nonsense conf file 2
$conf = <<EOL;
log4j.category.simplelayout.test=INFO, myAppender
log4j.appender.myAppender = Log::Log4perl::Appender::FileAppender
log4j.appender.myAppender.layout = Log::Log4perl::Layout::SimpleLayout
log4j.appender.myAppender = $testfile
EOL
eval{
Log::Log4perl->init(\$conf);
};
like($@, qr/log4j.appender.myAppender redefined/);
# *****************************************************
# never define an appender
$conf = <<EOL;
log4j.category.simplelayout.test=INFO, XXmyAppender
log4j.appender.myAppender = Log::Log4perl::Appender::TestBuffer
log4j.appender.myAppender.layout = Log::Log4perl::Layout::SimpleLayout
log4j.appender.myAppender.File = $testfile
EOL
eval{
Log::Log4perl->init(\$conf);
};
like($@,
qr/ERROR: you didn't tell me how to implement your appender 'XXmyAppender'/);
# *****************************************************
# never define a layout
$conf = <<EOL;
log4j.category.simplelayout.test=INFO, myAppender
log4j.appender.myAppender = Log::Log4perl::Appender::TestBuffer
EOL
eval{
Log::Log4perl->init(\$conf);
};
like($@, qr/Layout not specified for appender myAppender/, 'no layout defined');
# ************************************
# check continuation chars, this should parse fine
$conf = <<EOL;
log4j.category.simplelayout.test=\\
t/014ConfErrs.t view on Meta::CPAN
log4j.appender.myAppender \\
= Log::Log4perl::Appender::TestBuffer
#this is stupid, I know
log4j.appender.myAppender.layout = Log::Log4perl::Lay\\
out::SimpleL\\
ayout
log4j.appender.myAppender.File = $testfile
EOL
eval{
Log::Log4perl->init(\$conf);
};
is($@,"");
# *****************************************************
# init_once
# *****************************************************
Log::Log4perl->reset();
$conf = <<EOL;
t/014ConfErrs.t view on Meta::CPAN
#print "BUFFER: [", $buffer->buffer(), "]\n";
is($buffer->buffer(),"ERROR - foobar\n");
$conf = <<EOL;
log4perl.logger.Foo.Bar = INFO, Screen
log4perl.logger.Foo.Bar = INFO, Screen
log4perl.appender.Screen = Log::Log4perl::Appender::TestBuffer
log4perl.appender.Screen.layout = SimpleLayout
EOL
eval {
Log::Log4perl::init( \$conf );
};
like($@, qr/log4perl.logger.Foo.Bar redefined/);
done_testing;
t/020Easy.t view on Meta::CPAN
# LOGDIE and LOGWARN
############################################################
# redir STDERR again
open STDERR, ">$TMP_FILE";
select STDERR; $| = 1; #needed on win32
open IN, "<$TMP_FILE" or die "Cannot open $TMP_FILE";
Log::Log4perl->easy_init($INFO);
$log = get_logger();
$line = __LINE__ + 1;
eval { LOGDIE("logdie"); };
like($@, qr/logdie at .*?020Easy.t line $line/);
like(readstderr(), qr/^[\d:\/ ]+logdie$/m);
LOGWARN("logwarn");
like(readstderr(), qr/logwarn/);
############################################################
# Test logdie/logwarn with and without "\n"s
############################################################
t/020Easy.t view on Meta::CPAN
LOGWARN("message\n");
unlike(readstderr(), qr/message at .*? line \d+/);
LOGWARN("message\nother");
like(readstderr(), qr/other at .*? line \d+/);
LOGWARN("message\nother\n");
unlike(readstderr(), qr/other at .*? line \d+/);
# logdie
eval { LOGDIE("logdie"); };
like($@, qr/logdie at .*?020Easy.t line \d+/);
eval { LOGDIE("logdie\n"); };
unlike($@, qr/at .*?020Easy.t line \d+/);
eval { LOGDIE("logdie\nother"); };
like($@, qr/other at .*?020Easy.t line \d+/);
eval { LOGDIE("logdie\nother\n"); };
unlike($@, qr/at .*?020Easy.t line \d+/);
############################################################
# Test %T stack traces
############################################################
Log::Log4perl->easy_init({ level => $INFO, layout => "%T: %m%n"});
sub foo {
bar();
}
t/020Easy.t view on Meta::CPAN
use Log::Log4perl qw(:easy);
sub whack {
LOGCROAK("logcroak in whack");
}
package main;
Log::Log4perl->easy_init($INFO);
$log = get_logger();
$line = __LINE__ + 1;
eval { Whack::whack() };
like($@, qr/logcroak in whack at .*?020Easy.t line $line/);
like(readstderr(), qr/^[\d:\/ ]+logcroak in whack.*$line/m);
$line = __LINE__ + 8;
package Junk1;
use Log::Log4perl qw(:easy);
sub foo {
LOGCARP("LOGCARP");
}
t/020Easy.t view on Meta::CPAN
package JunkWrapper;
use Log::Log4perl qw(:easy);
sub foo {
LOGDIE("Ahhh");
}
package main;
Log::Log4perl->wrapper_register("JunkWrapper");
$line = __LINE__ + 2;
eval {
JunkWrapper::foo();
};
like $@, qr/line $line/, "logdie with wrapper";
# Finally close
############################################################
close IN;
done_testing;
t/021AppThres.t view on Meta::CPAN
log4j.logger = ERROR, BUF0
log4j.logger.a = INFO, BUF1
log4j.appender.BUF0 = org.apache.log4j.TestBuffer
log4j.appender.BUF0.layout = SimpleLayout
log4j.appender.BUF0.Threshold = ERROR
log4j.appender.BUF1 = org.apache.log4j.TestBuffer
log4j.appender.BUF1.layout = SimpleLayout
log4j.appender.BUF1.threshold = WARN
EOT
eval { Log::Log4perl::init(\$conf); };
if($@) {
like($@, qr/perhaps you meant 'Threshold'/,
"warn on misspelled 'threshold'");
} else {
ok(0, "Abort on misspelled 'threshold'");
}
##################################################
# Increase threshold of all appenders
t/023Date.t view on Meta::CPAN
q!HH:mm:ss,SSS! => q!%02d:%02d:%02d,%s!,
q!dd MMM yyyy HH:mm:ss,SSS! => q!%02d %.3s %04d %02d:%02d:%02d,%s!,
q!hh 'o''clock' a! => q!%02d o'clock %1s!,
q!hh 'o'clock' a! => q!(undef)!,
q!yyyy-MM-dd 'at' HH:mm:ss! => q!%04d-%02d-%02d at %02d:%02d:%02d!,
);
#' calm down up vim syntax highlighting
while ( my ( $src, $expected ) = splice @tests, 0, 2 ) {
my $df = eval { Log::Log4perl::DateFormat->new( $src ) };
my $err = '';
if ( $@ )
{
chomp $@;
$err = "(error: $@)";
}
my $got = $df->{fmt} || '(undef)';
is($got, $expected, "literal $src");
}
( run in 1.640 second using v1.01-cache-2.11-cpan-0bb4e1dffa6 )