summaryrefslogtreecommitdiff
path: root/lib/Log/Log4perl/Level.pm
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Log/Log4perl/Level.pm')
-rw-r--r--lib/Log/Log4perl/Level.pm358
1 files changed, 358 insertions, 0 deletions
diff --git a/lib/Log/Log4perl/Level.pm b/lib/Log/Log4perl/Level.pm
new file mode 100644
index 0000000..00168ca
--- /dev/null
+++ b/lib/Log/Log4perl/Level.pm
@@ -0,0 +1,358 @@
+###############r###################################
+package Log::Log4perl::Level;
+##################################################
+
+use 5.006;
+use strict;
+use warnings;
+use Carp;
+
+# log4j, for whatever reason, puts 0 as all and MAXINT as OFF.
+# this seems less optimal, as more logging would imply a higher
+# level. But oh well. Probably some brokenness that has persisted. :)
+use constant ALL_INT => 0;
+use constant TRACE_INT => 5000;
+use constant DEBUG_INT => 10000;
+use constant INFO_INT => 20000;
+use constant WARN_INT => 30000;
+use constant ERROR_INT => 40000;
+use constant FATAL_INT => 50000;
+use constant OFF_INT => (2 ** 31) - 1;
+
+no strict qw(refs);
+use vars qw(%PRIORITY %LEVELS %SYSLOG %L4P_TO_LD);
+
+%PRIORITY = (); # unless (%PRIORITY);
+%LEVELS = () unless (%LEVELS);
+%SYSLOG = () unless (%SYSLOG);
+%L4P_TO_LD = () unless (%L4P_TO_LD);
+
+sub add_priority {
+ my ($prio, $intval, $syslog, $log_dispatch_level) = @_;
+ $prio = uc($prio); # just in case;
+
+ $PRIORITY{$prio} = $intval;
+ $LEVELS{$intval} = $prio;
+
+ # Set up the mapping between Log4perl integer levels and
+ # Log::Dispatch levels
+ # Note: Log::Dispatch uses the following levels:
+ # 0 debug
+ # 1 info
+ # 2 notice
+ # 3 warning
+ # 4 error
+ # 5 critical
+ # 6 alert
+ # 7 emergency
+
+ # The equivalent Log::Dispatch level is optional, set it to
+ # the highest value (7=emerg) if it's not provided.
+ $log_dispatch_level = 7 unless defined $log_dispatch_level;
+
+ $L4P_TO_LD{$prio} = $log_dispatch_level;
+
+ $SYSLOG{$prio} = $syslog if defined($syslog);
+}
+
+# create the basic priorities
+add_priority("OFF", OFF_INT, -1, 7);
+add_priority("FATAL", FATAL_INT, 0, 7);
+add_priority("ERROR", ERROR_INT, 3, 4);
+add_priority("WARN", WARN_INT, 4, 3);
+add_priority("INFO", INFO_INT, 6, 1);
+add_priority("DEBUG", DEBUG_INT, 7, 0);
+add_priority("TRACE", TRACE_INT, 8, 0);
+add_priority("ALL", ALL_INT, 8, 0);
+
+# we often sort numerically, so a helper func for readability
+sub numerically {$a <=> $b}
+
+###########################################
+sub import {
+###########################################
+ my($class, $namespace) = @_;
+
+ if(defined $namespace) {
+ # Export $OFF, $FATAL, $ERROR etc. to
+ # the given namespace
+ $namespace .= "::" unless $namespace =~ /::$/;
+ } else {
+ # Export $OFF, $FATAL, $ERROR etc. to
+ # the caller's namespace
+ $namespace = caller(0) . "::";
+ }
+
+ for my $key (keys %PRIORITY) {
+ my $name = "$namespace$key";
+ my $value = $PRIORITY{$key};
+ *{"$name"} = \$value;
+ my $nameint = "$namespace${key}_INT";
+ my $func = uc($key) . "_INT";
+ *{"$nameint"} = \&$func;
+ }
+}
+
+##################################################
+sub new {
+##################################################
+ # We don't need any of this class nonsense
+ # in Perl, because we won't allow subclassing
+ # from this. We're optimizing for raw speed.
+}
+
+##################################################
+sub to_priority {
+# changes a level name string to a priority numeric
+##################################################
+ my($string) = @_;
+
+ if(exists $PRIORITY{$string}) {
+ return $PRIORITY{$string};
+ }else{
+ croak "level '$string' is not a valid error level (".join ('|', keys %PRIORITY),')';
+ }
+}
+
+##################################################
+sub to_level {
+# changes a priority numeric constant to a level name string
+##################################################
+ my ($priority) = @_;
+ if (exists $LEVELS{$priority}) {
+ return $LEVELS{$priority}
+ }else {
+ croak("priority '$priority' is not a valid error level number (",
+ join("|", sort numerically keys %LEVELS), "
+ )");
+ }
+
+}
+
+##################################################
+sub to_LogDispatch_string {
+# translates into strings that Log::Dispatch recognizes
+##################################################
+ my($priority) = @_;
+
+ confess "do what? no priority?" unless defined $priority;
+
+ my $string;
+
+ if(exists $LEVELS{$priority}) {
+ $string = $LEVELS{$priority};
+ }
+
+ # Log::Dispatch idiosyncrasies
+ if($priority == $PRIORITY{WARN}) {
+ $string = "WARNING";
+ }
+
+ if($priority == $PRIORITY{FATAL}) {
+ $string = "EMERGENCY";
+ }
+
+ return $string;
+}
+
+###################################################
+sub is_valid {
+###################################################
+ my $q = shift;
+
+ if ($q =~ /[A-Z]/) {
+ return exists $PRIORITY{$q};
+ }else{
+ return $LEVELS{$q};
+ }
+
+}
+
+sub get_higher_level {
+ my ($old_priority, $delta) = @_;
+
+ $delta ||= 1;
+
+ my $new_priority = 0;
+
+ foreach (1..$delta){
+ #so the list is TRACE, DEBUG, INFO, WARN, ERROR, FATAL
+ # but remember, the numbers go in reverse order!
+ foreach my $p (sort numerically keys %LEVELS){
+ if ($p > $old_priority) {
+ $new_priority = $p;
+ last;
+ }
+ }
+ $old_priority = $new_priority;
+ }
+ return $new_priority;
+}
+
+sub get_lower_level {
+ my ($old_priority, $delta) = @_;
+
+ $delta ||= 1;
+
+ my $new_priority = 0;
+
+ foreach (1..$delta){
+ #so the list is FATAL, ERROR, WARN, INFO, DEBUG, TRACE
+ # but remember, the numbers go in reverse order!
+ foreach my $p (reverse sort numerically keys %LEVELS){
+ if ($p < $old_priority) {
+ $new_priority = $p;
+ last;
+ }
+ }
+ $old_priority = $new_priority;
+ }
+ return $new_priority;
+}
+
+sub isGreaterOrEqual {
+ my $lval = shift;
+ my $rval = shift;
+
+ # in theory, we should check if the above really ARE valid levels.
+ # but we just use numeric comparison, since they aren't really classes.
+
+ # oh, yeah, and 'cuz level ints go from 0 .. N with 0 being highest,
+ # these are reversed.
+ return $lval <= $rval;
+}
+
+######################################################################
+#
+# since the integer representation of levels is reversed from what
+# we normally want, we don't want to use < and >... instead, we
+# want to use this comparison function
+
+
+1;
+
+__END__
+
+=encoding utf8
+
+=head1 NAME
+
+Log::Log4perl::Level - Predefined log levels
+
+=head1 SYNOPSIS
+
+ use Log::Log4perl::Level;
+ print $ERROR, "\n";
+
+ # -- or --
+
+ use Log::Log4perl qw(:levels);
+ print $ERROR, "\n";
+
+=head1 DESCRIPTION
+
+C<Log::Log4perl::Level> simply exports a predefined set of I<Log4perl> log
+levels into the caller's name space. It is used internally by
+C<Log::Log4perl>. The following scalars are defined:
+
+ $OFF
+ $FATAL
+ $ERROR
+ $WARN
+ $INFO
+ $DEBUG
+ $TRACE
+ $ALL
+
+C<Log::Log4perl> also exports these constants into the caller's namespace
+if you pull it in providing the C<:levels> tag:
+
+ use Log::Log4perl qw(:levels);
+
+This is the preferred way, there's usually no need to call
+C<Log::Log4perl::Level> explicitly.
+
+The numerical values assigned to these constants are purely virtual,
+only used by Log::Log4perl internally and can change at any time,
+so please don't make any assumptions. You can test for numerical equality
+by directly comparing two level values, that's ok:
+
+ if( get_logger()->level() == $DEBUG ) {
+ print "The logger's level is DEBUG\n";
+ }
+
+But if you want to figure out which of two levels is more verbose, use
+Log4perl's own comparator:
+
+ if( Log::Log4perl::Level::isGreaterOrEqual( $level1, $level2 ) ) {
+ print Log::Log4perl::Level::to_level( $level1 ),
+ " is equal or more verbose than ",
+ Log::Log4perl::Level::to_level( $level2 ), "\n";
+ }
+
+If the caller wants to import level constants into a different namespace,
+it can be provided with the C<use> command:
+
+ use Log::Log4perl::Level qw(MyNameSpace);
+
+After this C<$MyNameSpace::ERROR>, C<$MyNameSpace::INFO> etc.
+will be defined accordingly.
+
+=head2 Numeric levels and Strings
+
+Level variables like $DEBUG or $WARN have numeric values that are
+internal to Log4perl. Transform them to strings that can be used
+in a Log4perl configuration file, use the c<to_level()> function
+provided by Log::Log4perl::Level:
+
+ use Log::Log4perl qw(:easy);
+ use Log::Log4perl::Level;
+
+ # prints "DEBUG"
+ print Log::Log4perl::Level::to_level( $DEBUG ), "\n";
+
+To perform the reverse transformation, which takes a string like
+"DEBUG" and converts it into a constant like C<$DEBUG>, use the
+to_priority() function:
+
+ use Log::Log4perl qw(:easy);
+ use Log::Log4perl::Level;
+
+ my $numval = Log::Log4perl::Level::to_priority( "DEBUG" );
+
+after which $numval could be used where a numerical value is required:
+
+ Log::Log4perl->easy_init( $numval );
+
+=head1 LICENSE
+
+Copyright 2002-2013 by Mike Schilli E<lt>m@perlmeister.comE<gt>
+and Kevin Goess E<lt>cpan@goess.orgE<gt>.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 AUTHOR
+
+Please contribute patches to the project on Github:
+
+ http://github.com/mschilli/log4perl
+
+Send bug reports or requests for enhancements to the authors via our
+
+MAILING LIST (questions, bug reports, suggestions/patches):
+log4perl-devel@lists.sourceforge.net
+
+Authors (please contact them via the list above, not directly):
+Mike Schilli <m@perlmeister.com>,
+Kevin Goess <cpan@goess.org>
+
+Contributors (in alphabetical order):
+Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton
+Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony
+Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy
+Grundman, Paul Harrington, Alexander Hartmaier David Hull,
+Robert Jacobson, Jason Kohles, Jeff Macdonald, Markus Peter,
+Brett Rann, Peter Rabbitson, Erik Selberg, Aaron Straup Cope,
+Lars Thegler, David Viner, Mac Yang.
+
View Lorry Controller Status