Log-Log4perl-1.46HEADLog-Log4perl-1.46master

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.
+