Skip to content

Commit

Permalink
CPANification underway.
Browse files Browse the repository at this point in the history
  • Loading branch information
@daotoad
daotoad committed May 9, 2011
1 parent 5310b14 commit a0e5176
Show file tree
Hide file tree
Showing 4 changed files with 71 additions and 73 deletions.
73 changes: 37 additions & 36 deletions lib/Log/Lager.pm
View file
@@ -1,15 +1,15 @@
package Next::OpenSIPS::Log;
package Log::Lager;

use Data::Dumper ();

use strict;
use warnings;
use Carp qw( croak );
$Carp::Internal{'Next::OpenSIPS::Log'}++;
$Carp::Internal{'Log::Lager'}++;
use Scalar::Util qw(reftype);

use Next::OpenSIPS::Log::CommandParser qw( parse_command );
use Next::OpenSIPS::AbridgeData qw( abridge_items_recursive );
use Log::Lager::CommandParser qw( parse_command );
use Data::Abrdige qw( abridge_items_recursive );


# Global configuration
Expand All @@ -26,6 +26,7 @@ my $OUTPUT_TARGET; # Name of output facility
my $SYSLOG_IDENTITY; # Idenitity if using syslog output
my $SYSLOG_FACILITY; # Facility if using syslog output
my $SYSLOG_OPENED; # Flag - have we called "syslog_open"

my $OUTPUT_FILE_NAME; # File name of for output if using file output.
my $OUTPUT_FILE_HANDLE; # File handle if using file output.
my $OUTPUT_FUNCTION; # Code ref of emitter function.
Expand Down Expand Up @@ -268,8 +269,8 @@ sub _get_bits {
my $s_mask = exists $SUBROUTINE_MASK{$sub} ? $SUBROUTINE_MASK{$sub} : [0,0];
my $p_mask = exists $PACKAGE_MASK{$package} ? $PACKAGE_MASK{$package} : [0,0];
my $l_mask = $ENABLE_LEXICAL
? [$hints->{'Next::OpenSIPS::Log_enable'},
$hints->{'Next::OpenSIPS::Log_disable'}]
? [$hints->{'Log::Lager::Log_enable'},
$hints->{'Log::Lager::Log_disable'}]
: [0,0];
my $mask = defined $BASE_MASK ? $BASE_MASK : 0;
Expand Down Expand Up @@ -473,7 +474,7 @@ sub import {
# Import functions
# Skip if this is not the first time through
my $hints = (caller(1))[10];
unless( defined $hints->{'Next::OpenSIPS::Log_enable'} ) {
unless( defined $hints->{'Log::Lager::Log_enable'} ) {
no strict 'refs';
for my $_ ( @LOG_LEVELS ) {
Expand All @@ -487,13 +488,13 @@ sub import {
if( @_ ) {
# Apply log level mask
my $mask = [
$^H{'Next::OpenSIPS::Log_enable'},
$^H{'Next::OpenSIPS::Log_disable'}
$^H{'Log::Lager::Log_enable'},
$^H{'Log::Lager::Log_disable'}
];
$mask = _parse_commands( $mask, @_ ) if @_;
$^H{'Next::OpenSIPS::Log_enable'} = $mask->[0] // 0;
$^H{'Next::OpenSIPS::Log_disable'} = $mask->[1] // 0;
$^H{'Log::Lager::Log_enable'} = $mask->[0] // 0;
$^H{'Log::Lager::Log_disable'} = $mask->[1] // 0;
}
return;
Expand All @@ -506,15 +507,15 @@ sub unimport {
shift;
my @commands = @_;
croak "Us 'no Next::OpenSIPS::Log' with log level codes only"
croak "Us 'Log::Lager' with log level codes only"
if grep /[^$MASK_REGEX]/, @commands;
my $mask = [
$^H{'Next::OpenSIPS::Log_enable'},
$^H{'Next::OpenSIPS::Log_disable'}
$^H{'Log::Lager::Log_enable'},
$^H{'Log::Lager::Log_disable'}
];
$mask = _parse_commands( $mask , 'lexical disable', @commands );
$^H{'Next::OpenSIPS::Log_disable'} = $mask->[1];
$^H{'Log::Lager::Log_disable'} = $mask->[1];
return;
}
Expand All @@ -523,7 +524,7 @@ sub unimport {
# command.
sub log_level {
my $r = Next::OpenSIPS::Log::CommandResult->new;
my $r = Log::Lager::CommandResult->new;
# Base
Expand All @@ -532,8 +533,8 @@ sub log_level {
# Lexical
my $hints = (caller(0))[10];
_apply_bits_to_mask(
$hints->{'Next::OpenSIPS::Log_enable'},
$hints->{'Next::OpenSIPS::Log_disable'},
$hints->{'Log::Lager::Log_enable'},
$hints->{'Log::Lager::Log_disable'},
$r->lexical
);
Expand Down Expand Up @@ -562,7 +563,7 @@ __END__
=head1 NAME
Next::OpenSIPS::Log - Easy to use, flexible, parsable logs.
Log::Lager - Easy to use, flexible, parsable logs.
=head1 SYNOPSIS
Expand All @@ -574,23 +575,23 @@ The goal is to provide an easy to use logging facility that meets developer
and production needs.
# Enable standard logging levels: FATAL ERROR WARN.
use Next::OpenSIPS::Log;
use Log::Lager;
INFO('I Oh'); # Nothing happens, INFO is OFF
use Next::OpenSIPS::Log nonfatal => 'F', enable => 'I'; # FATAL events are no longer fatal.
use Log::Lager nonfatal => 'F', enable => 'I'; # FATAL events are no longer fatal.
FATAL('Still kicking');
INFO('I Oh'); # Nothing happens, INFO is OFF
{ no Next::OpenSIPS::Log 'I'; # Disable INFO
{ no Log::Lager 'I'; # Disable INFO
INFO('I Oh NO');
}
INFO('I Oh'); # Nothing happens, INFO is OFF
# Make FATAL fatal again.
use Next::OpenSIPS::Log fatal => 'F';
use Log::Lager fatal => 'F';
FATAL('Oh noes');
=head2 Log Format
Expand Down Expand Up @@ -646,7 +647,7 @@ Each mask beyond the base mask is stored as a difference from base. Each mask l
Lexical log mask is set by using this module in a given scope with a command string.
{ use Next::OpenSIPS::Log 'enable IDG stack F';
{ use Log::Lager 'enable IDG stack F';
INFO 'I am ill.';
if( $foo ) {
Expand Down Expand Up @@ -753,11 +754,11 @@ Disabled by default.
=head1 OTHER FUNCTIONS
=head2 Next::OpenSIPS::Log::log_level
=head2 Log::Lager::log_level
Emits a Next::OpenSIPS::Log command string capable of producing the current log level.
Emits a Log::Lager command string capable of producing the current log level.
=head2 Next::OpenSIPS::Log::apply_command
=head2 Log::Lager::apply_command
Run configuration commands at run-time.
Expand Down Expand Up @@ -834,24 +835,24 @@ Default logging is equivalent to C<base enable FEW>.
=head3 Lexical manipulation
=head4 use Next::OpenSIPS::Log
=head4 use Log::Lager
use Next::OpenSIPS::Log 'IDT stack D';
use Log::Lager 'IDT stack D';
Takes standard commands as a list of strings. For example
C<use Next::OpenSIPS::Log qw( fatal FEW );> is equivalent to C<use Next::OpenSIPS::Log "fatal FEW";>
C<use Log::Lager qw( fatal FEW );> is equivalent to C<use Log::Lager "fatal FEW";>
While this usage type is capable of handling any command, it is best to
restrict usage to configuring the lexical mask.
To simplify proper usage, this interface assumes a leading C<lexical enable>
at the beginning of a command set. For example, C<use Next::OpenSIPS::Log 'FEWIDG';> is the
same as and C<use Next::OpenSIPS::Log 'lexicical enable FWEIDG';>.
at the beginning of a command set. For example, C<use Log::Lager 'FEWIDG';> is the
same as and C<use Log::Lager 'lexicical enable FWEIDG';>.
=head4 no Next::OpenSIPS::Log
=head4 no Log::Lager
A simple shorthand for C<use Next::OpenSIPS::Log 'lexical disable BLAH'>.
C<no Next::OpenSIPS::Log XXX> is equivalent to C<use Next::OpenSIPS::Log lexical => disable => 'XXX'>.
A simple shorthand for C<use Log::Lager 'lexical disable BLAH'>.
C<no Log::Lager XXX> is equivalent to C<use Log::Lager lexical => disable => 'XXX'>.
Command strings may consist of only log level characters (nouns).
Expand All @@ -864,7 +865,7 @@ Assumes a leading C<enable base > at the start of the the command string:
C<OPENSIPSLOG=FWEG foo.pl> is identical to C<OPENSIPSLOG='enable base FWEG' foo.pl>.
Use normal command syntax. Operates exactly as a program wide, unoverridable
C<use Next::OpenSIPS::Log $ENV{OPENSIPSLOG}>.
C<use Log::Lager $ENV{OPENSIPSLOG}>.
Any changes to the logging level are applied to the default logging level.
Expand Down
49 changes: 23 additions & 26 deletions lib/Log/Lager/CommandParser.pm
View file
@@ -1,4 +1,4 @@
package Next::OpenSIPS::Log::CommandParser;
package Log::Lager::CommandParser;
use strict;
use warnings;
use Carp qw<croak>;
Expand All @@ -8,19 +8,19 @@ use Scalar::Util qw< blessed >;
use Hash::Util qw< lock_keys >;

use Exporter qw( import );
our @EXPORT_OK = qw( parse_command Next::OpenSIPS::Log::Command::REWIND );
our @EXPORT_OK = qw( parse_command Log::Lager::Command::REWIND );

sub new {

my $self = {
state => 'start',
result => Next::OpenSIPS::Log::CommandResult->new(),
result => Log::Lager::CommandResult->new(),
mask_select => 'lexical',
mask_group => 'enable',
mask => undef,
output => 'stderr',
state_table => \%Next::OpenSIPS::Log::Command::STATE_TABLE,
end_states => \%Next::OpenSIPS::Log::Command::END_STATES,
state_table => \%Log::Lager::Command::STATE_TABLE,
end_states => \%Log::Lager::Command::END_STATES,
};

bless $self;
Expand Down Expand Up @@ -129,15 +129,15 @@ TEST:


BEGIN {
package Next::OpenSIPS::Log::CommandResult;
package Log::Lager::CommandResult;
use overload '""' => 'as_string';

sub new {
my $class = shift;

my $self = {
lexical => Next::OpenSIPS::Log::Mask->new(),
base => Next::OpenSIPS::Log::Mask->new(),
lexical => Log::Lager::Mask->new(),
base => Log::Lager::Mask->new(),
package => {},
sub => {},
syslog_identity => undef,
Expand Down Expand Up @@ -177,11 +177,11 @@ BEGIN {
# Use fully qualified name since 'package' is a Perl keyword.
# This sucks a bit, but it makes it easy to map between language
# keywords and method names.
sub Next::OpenSIPS::Log::CommandResult::package {
sub Log::Lager::CommandResult::package {
my $self = shift;
my $name = shift;

$self->{package}{$name} = Next::OpenSIPS::Log::Mask->new();
$self->{package}{$name} = Log::Lager::Mask->new();

return $self->{package}{$name};
}
Expand All @@ -203,11 +203,11 @@ BEGIN {
# Use fully qualified name since 'sub' is a Perl keyword.
# This sucks a bit, but it makes it easy to map between language
# keywords and method names.
sub Next::OpenSIPS::Log::CommandResult::sub {
sub Log::Lager::CommandResult::sub {
my $self = shift;
my $name = shift;

$self->{sub}{$name} = Next::OpenSIPS::Log::Mask->new();
$self->{sub}{$name} = Log::Lager::Mask->new();

return $self->{sub}{$name};
}
Expand Down Expand Up @@ -238,7 +238,7 @@ BEGIN {
}

BEGIN {
package Next::OpenSIPS::Log::Mask;
package Log::Lager::Mask;
use overload '""' => 'as_string';
use constant GROUP_PAIRS => (
[qw/ enable disable /],
Expand Down Expand Up @@ -351,11 +351,10 @@ BEGIN {


BEGIN {
package Next::OpenSIPS::Log::Command;
package Log::Lager::Command;

=pod
command_string -> command_group ( \s* command_group )
command_group -> ( mask_control | lex_control | output_control )
mask_control -> mask_selector ( \s mask_group ( \s mask_set )* )*
Expand All @@ -371,8 +370,6 @@ syslog_spec -> syslog \s+ (syslog_conf | off )
=cut



# The state table defines a set of named states. Each state consists of an
# array of test definitions that dictate the state's behavior.
#
Expand Down Expand Up @@ -494,15 +491,15 @@ syslog_spec -> syslog \s+ (syslog_conf | off )
return;
}

sub match_mask_group { /^($Next::OpenSIPS::Log::Mask::GROUP_REGEX)$/ }
sub match_mask_group { /^($Log::Lager::Mask::GROUP_REGEX)$/ }
sub select_mask_group {
print "selected mask group: $_\n";
my $cp = shift;
$cp->mask_group($_);
return;
}

sub match_mask_chars { /^[$Next::OpenSIPS::Log::Mask::MASK_REGEX]+$/ }
sub match_mask_chars { /^[$Log::Lager::Mask::MASK_REGEX]+$/ }
sub set_mask {
print "set mask: $_\n";
my $cp = shift;
Expand Down Expand Up @@ -537,13 +534,13 @@ syslog_spec -> syslog \s+ (syslog_conf | off )

=head1 NAME
Next::OpenSIPS::Log::CommandParser
Log::Lager::CommandParser
=head1 SYNOPSIS
Provides command parsing for the Next::OpenSIPS::Log module.
Provides command parsing for the Log::Lager module.
use Next::OpenSIPS::Log::CommandParser 'parse_command';
use Log::Lager::CommandParser 'parse_command';
# Parse a command and get a CommandResult object back:
my $result = parse_command( 'lexical enable FEW stack F' );
Expand All @@ -558,10 +555,10 @@ Collects the results of parsing a command.
=head3 Attributes
lexical - The lexical logging mask. A C<Next::OpenSIPS::Log::Mask> object.
base - The lexical logging mask. A C<Next::OpenSIPS::Log::Mask> object.
package - Package logging masks defined in this command. A hash ref of C<Next::OpenSIPS::Log::Mask> objects, keyed by package name.
sub - Subroutine logging masks defined in this command. A hash ref of C<Next::OpenSIPS::Log::Mask> objects, keyed by subroutine name.
lexical - The lexical logging mask. A C<Log::Lager::Mask> object.
base - The lexical logging mask. A C<Log::Lager::Mask> object.
package - Package logging masks defined in this command. A hash ref of C<Log::Lager::Mask> objects, keyed by package name.
sub - Subroutine logging masks defined in this command. A hash ref of C<Log::Lager::Mask> objects, keyed by subroutine name.
lexicals_enabled - A flag indicating if lexical logging effects are enabled or
disabled. This flag is a three-valued boolean, where B<undef> means no specified value.
output - Contains the output type. Must be one of C<stderr>, C<syslog> or C<file>.
Expand Down
12 changes: 6 additions & 6 deletions t/01-load.t
View file
Expand Up @@ -5,7 +5,7 @@ use lib '../../../../lib';

use Test::More tests => 24;

use_ok( 'Next::OpenSIPS::Log' );
use_ok( 'Log::Lager' );


my @LOG_LEVELS = (
Expand All @@ -20,18 +20,18 @@ my @LOG_LEVELS = (

for ( @LOG_LEVELS ) {
my ($char, $value) = @{$_}[0,2];
is( Next::OpenSIPS::Log::_bitmask_to_mask_string( $value, 0 ), $char, "Mask for $char correct" );
is( Next::OpenSIPS::Log::_bitmask_to_mask_string( $value<<16, 16 ), $char, "Shifted mask for $char correct" );
is( Log::Lager::_bitmask_to_mask_string( $value, 0 ), $char, "Mask for $char correct" );
is( Log::Lager::_bitmask_to_mask_string( $value<<16, 16 ), $char, "Shifted mask for $char correct" );
}
is( Next::OpenSIPS::Log::_bitmask_to_mask_string( 0xFF, 0 ), 'FEWIDTG', "Mask for FEWIDTG correct" );
is( Log::Lager::_bitmask_to_mask_string( 0xFF, 0 ), 'FEWIDTG', "Mask for FEWIDTG correct" );



for ( @LOG_LEVELS ) {
my ($char, $value) = @{$_}[0,2];
is( Next::OpenSIPS::Log::_mask_string_to_bitmask( $char ), $value, "Mask for $char correct" );
is( Log::Lager::_mask_string_to_bitmask( $char ), $value, "Mask for $char correct" );
}
is( Next::OpenSIPS::Log::_mask_string_to_bitmask( 'FEWIDTG' ), 0x7F, "Mask for FEWIDTG correct" );
is( Log::Lager::_mask_string_to_bitmask( 'FEWIDTG' ), 0x7F, "Mask for FEWIDTG correct" );



0 comments on commit a0e5176

Please sign in to comment.