NAME
Log::Shiras::TapWarn - Reroute warn to Log::Shiras::Switchboard
SYNOPSIS
use Modern::Perl;
#~ use Log::Shiras::Unhide qw( :InternalTaPWarN );# :InternalSwitchboarD
$ENV{hide_warn} = 0;
use Log::Shiras::Switchboard;
use Log::Shiras::TapWarn qw( re_route_warn restore_warn );
my $ella_peterson = Log::Shiras::Switchboard->get_operator(
name_space_bounds =>{
UNBLOCK =>{
log_file => 'trace',
},
main =>{
32 =>{
UNBLOCK =>{
log_file => 'fatal',
},
},
34 =>{
UNBLOCK =>{
log_file => 'fatal',
},
},
},
},
reports =>{ log_file =>[ Print::Log->new ] },
);
re_route_warn(
fail_over => 0,
level => 'debug',
report => 'log_file',
);
warn "Hello World 1";
warn "Hello World 2";
restore_warn;
warn "Hello World 3";
package Print::Log;
use Data::Dumper;
sub new{
bless {}, shift;
}
sub add_line{
shift;
my @input = ( ref $_[0]->{message} eq 'ARRAY' ) ?
@{$_[0]->{message}} : $_[0]->{message};
my ( @print_list, @initial_list );
no warnings 'uninitialized';
for my $value ( @input ){
push @initial_list, (( ref $value ) ? Dumper( $value ) : $value );
}
for my $line ( @initial_list ){
$line =~ s/\n$//;
$line =~ s/\n/\n\t\t/g;
push @print_list, $line;
}
my $output = sprintf( "| level - %-6s | name_space - %-s\n| line - %04d | file_name - %-s\n\t:(\t%s ):\n",
$_[0]->{level}, $_[0]->{name_space},
$_[0]->{line}, $_[0]->{filename},
join( "\n\t\t", @print_list ) );
print $output;
use warnings 'uninitialized';
}
1;
#######################################################################################
# Synopsis Screen Output
# 01: Re-routing warn statements at ../lib/Log/Shiras/TapWarn.pm line 22, <DATA> line 1.
# 02: | level - debug | name_space - main::33
# 03: | line - 0033 | file_name - log_shiras_tapwarn.pl
# 04: :( Hello World 1 at log_shiras_tapwarn.pl line 33, <DATA> line 1. ):
# 05: Hello World 3 at log_shiras_tapwarn.pl line 36, <DATA> line 1.
#######################################################################################DESCRIPTION
This package allows Log::Shiras to be used for code previously written with warn statement outputs. It will re-direct the warn statements using the $SIG{__WARN__} (%SIG) handler. Using this mechanisim means that the string in;
warn "Print some line";Will be routed to Log::Shiras::Switchboard after the method call re_route_warn
This class is used to import functions into the script. These are not object methods and there is no reason to call ->new. Uncomment line 2 of the SYNOPSIS to watch the inner workings.
Output Explanation
01: The method re_route_warn will throw a warning statement whenever $ENV{hide_warn} is not set and the method is called.
02-04: Line 31 of the code has been captured (meta data appended) and then sent to the Print::Log class for reporting.
05: Line 32 of the script did not print since that line has a higher required urgency than the standard 'warn' level provided by the re_route_warn call in the SYNOPSIS.
06: Line 33 of the script turns off re-routing so Line 34 of the script prints normally with no shenanigans. (Even though it is also blocked by line number)
Functions
These functions are used to change the routing of warn statements.
re_route_warn( %args )
This is the function used to re_route warnings to Log::Shiras::Switchboard for processing. There are several settings adjustments that affect the routing of warnings. Since warnings are intended to be captured in-place, with no modification, all these settings must be fixed when the re-routing is implemented. Fine grained control of which warnings are processed is done by line number (See the SYNOPSIS for an example). This function accepts all of the possible settings, minimally scrubs the settings as needed, builds the needed anonymous subroutine, and then redirects (runtime) future warnings to that subroutine. Each set of content from a warning statement will then be packaged by the anonymous subroutine and sent to "master_talk( $args_ref )" in Log::Shiras::Switchboard. Since warnings are generally scattered throughout pre-existing code the auto assigned name-space is either 'main::line_number' for top level scripts or the subroutine block name and warning line number within the block. For example the name_space 'main::my_sub::32' would be applied to a warning executed on line 32 within the sub block named 'my_sub' in the 'main' script.
Accepts
The following keys in a hash or hashref which are passed directly to "master_talk( $args_ref )" in Log::Shiras::Switchboard - see the documentation there to understand how they are used by the switchboard. All values that are passed remain in force until a new re_route_warn call is made or the restore_warn call is made.
report - default = 'log_file'
level - default = 3 (warn)
fail_over - default = 0
carp_stack - default = 0
Returns 1
restore_warn
This returns the $SIG{__WARN__} settings to what they were before or undef. The result is warn statements will start to be processed as they were prior to the 're_route_warn' call.
Accepts: Nothing
Returns: 1
SUPPORT
GLOBAL VARIABLES
- $ENV{hide_warn}
-
The module will warn when re-routing warn statements are turned on. It will also warn when internal debug lines are 'Unhide'n. In the case where the you don't want these warnings then set this environmental variable to true.
TODO
1. Nothing currently
AUTHOR
COPYRIGHT
This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
The full text of the license can be found in the LICENSE file included with this module.
DEPENDANCIES
5.010 (for use of defined or //)
Carp - longmess
SEE ALSO
Capture::Tiny - capture_stderr