line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Log::Shiras::Switchboard; |
2
|
|
|
|
|
|
|
our $AUTHORITY = 'cpan:JANDREW'; |
3
|
5
|
|
|
5
|
|
1015364
|
use version; our $VERSION = version->declare("v0.46.0"); |
|
5
|
|
|
|
|
1227
|
|
|
5
|
|
|
|
|
33
|
|
4
|
5
|
|
|
5
|
|
346
|
use strict; |
|
5
|
|
|
|
|
6
|
|
|
5
|
|
|
|
|
80
|
|
5
|
5
|
|
|
5
|
|
15
|
use warnings; |
|
5
|
|
|
|
|
6
|
|
|
5
|
|
|
|
|
100
|
|
6
|
5
|
|
|
5
|
|
86
|
use 5.010; |
|
5
|
|
|
|
|
12
|
|
7
|
5
|
|
|
5
|
|
15
|
use utf8; |
|
5
|
|
|
|
|
4
|
|
|
5
|
|
|
|
|
30
|
|
8
|
5
|
|
|
5
|
|
114
|
use lib '../../'; |
|
5
|
|
|
|
|
5
|
|
|
5
|
|
|
|
|
28
|
|
9
|
|
|
|
|
|
|
#~ use Log::Shiras::Unhide qw( :InternalSwitchboarD ); |
10
|
|
|
|
|
|
|
###InternalSwitchboarD warn "You uncovered internal logging statements for Log::Shiras::Switchboard-$VERSION" if !$ENV{hide_warn}; |
11
|
5
|
|
|
5
|
|
1923
|
use MooseX::Singleton; |
|
5
|
|
|
|
|
279464
|
|
|
5
|
|
|
|
|
15
|
|
12
|
5
|
|
|
5
|
|
109856
|
use MooseX::StrictConstructor; |
|
5
|
|
|
|
|
28398
|
|
|
5
|
|
|
|
|
25
|
|
13
|
5
|
|
|
5
|
|
29342
|
use MooseX::HasDefaults::RO; |
|
5
|
|
|
|
|
22488
|
|
|
5
|
|
|
|
|
17
|
|
14
|
5
|
|
|
5
|
|
32650
|
use DateTime; |
|
5
|
|
|
|
|
972112
|
|
|
5
|
|
|
|
|
218
|
|
15
|
5
|
|
|
5
|
|
35
|
use Carp qw( cluck confess longmess ); |
|
5
|
|
|
|
|
5
|
|
|
5
|
|
|
|
|
394
|
|
16
|
|
|
|
|
|
|
$Carp::CarpInternal{'Log::Shiras::Switchboard'}++; |
17
|
5
|
|
|
|
|
51
|
use MooseX::Types::Moose qw( |
18
|
|
|
|
|
|
|
HashRef ArrayRef Bool RegexpRef Str |
19
|
|
|
|
|
|
|
Int Maybe Undef |
20
|
5
|
|
|
5
|
|
1449
|
); |
|
5
|
|
|
|
|
113497
|
|
21
|
5
|
|
|
5
|
|
20565
|
use Clone 'clone'; |
|
5
|
|
|
|
|
7097
|
|
|
5
|
|
|
|
|
241
|
|
22
|
5
|
|
|
5
|
|
25
|
use Data::Dumper; |
|
5
|
|
|
|
|
6
|
|
|
5
|
|
|
|
|
201
|
|
23
|
|
|
|
|
|
|
use lib |
24
|
5
|
|
|
|
|
33
|
'lib', |
25
|
|
|
|
|
|
|
'../lib', |
26
|
5
|
|
|
5
|
|
18
|
; |
|
5
|
|
|
|
|
8
|
|
27
|
5
|
|
|
5
|
|
1876
|
use MooseX::ShortCut::BuildInstance v1.44 qw( build_instance should_re_use_classes ); |
|
5
|
|
|
|
|
1121336
|
|
|
5
|
|
|
|
|
64
|
|
28
|
|
|
|
|
|
|
should_re_use_classes( 1 ); |
29
|
5
|
|
|
5
|
|
4878
|
use Data::Walk::Extracted v0.28; |
|
5
|
|
|
|
|
1857146
|
|
|
5
|
|
|
|
|
219
|
|
30
|
5
|
|
|
5
|
|
2569
|
use Data::Walk::Prune v0.028; |
|
5
|
|
|
|
|
112981
|
|
|
5
|
|
|
|
|
187
|
|
31
|
5
|
|
|
5
|
|
2302
|
use Data::Walk::Graft v0.028; |
|
5
|
|
|
|
|
61568
|
|
|
5
|
|
|
|
|
162
|
|
32
|
5
|
|
|
5
|
|
2009
|
use Data::Walk::Print v0.028; |
|
5
|
|
|
|
|
46490
|
|
|
5
|
|
|
|
|
162
|
|
33
|
5
|
|
|
5
|
|
1814
|
use Data::Walk::Clone v0.024; |
|
5
|
|
|
|
|
39689
|
|
|
5
|
|
|
|
|
151
|
|
34
|
5
|
|
|
5
|
|
1946
|
use Log::Shiras::Types qw( ElevenArray ElevenInt ReportObject );# |
|
5
|
|
|
|
|
12
|
|
|
5
|
|
|
|
|
37
|
|
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
#########1 Package Variables 3#########4#########5#########6#########7#########8#########9 |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
my @default_levels = ( |
39
|
|
|
|
|
|
|
'trace', 'debug', 'info', 'warn', 'error', 'fatal', |
40
|
|
|
|
|
|
|
undef, undef, undef, undef, undef, 'eleven',# This one goes to eleven :^| |
41
|
|
|
|
|
|
|
); |
42
|
|
|
|
|
|
|
my $time_zone = DateTime::TimeZone->new( name => 'local' ); |
43
|
5
|
|
|
5
|
|
17007
|
use constant TALK_DEBUG => 0; # Author testing only |
|
5
|
|
|
|
|
7
|
|
|
5
|
|
|
|
|
336
|
|
44
|
5
|
|
|
5
|
|
21
|
use constant IMPORT_DEBUG => 0; # Author testing only |
|
5
|
|
|
|
|
5
|
|
|
5
|
|
|
|
|
183
|
|
45
|
5
|
|
|
5
|
|
18
|
use constant GET_OPERATOR_DEBUG => 0; # Author testing only |
|
5
|
|
|
|
|
6
|
|
|
5
|
|
|
|
|
1852
|
|
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
#########1 Public Attributes 3#########4#########5#########6#########7#########8#########9 |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
has name_space_bounds =>( |
50
|
|
|
|
|
|
|
isa => HashRef[HashRef], |
51
|
|
|
|
|
|
|
reader => 'get_name_space', |
52
|
|
|
|
|
|
|
clearer => '_clear_all_name_space', |
53
|
|
|
|
|
|
|
writer => '_set_whole_name_space', |
54
|
|
|
|
|
|
|
default => sub{ {} }, |
55
|
|
|
|
|
|
|
trigger => \&_clear_can_communicate_cash, |
56
|
|
|
|
|
|
|
); |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
has reports =>( |
59
|
|
|
|
|
|
|
traits => ['Hash'], |
60
|
|
|
|
|
|
|
isa => HashRef[ArrayRef], |
61
|
|
|
|
|
|
|
reader => 'get_reports', |
62
|
|
|
|
|
|
|
writer => '_set_all_reports', |
63
|
|
|
|
|
|
|
handles =>{ |
64
|
|
|
|
|
|
|
has_no_reports => 'is_empty', |
65
|
|
|
|
|
|
|
_set_report => 'set', |
66
|
|
|
|
|
|
|
get_report => 'get', |
67
|
|
|
|
|
|
|
remove_reports => 'delete', |
68
|
|
|
|
|
|
|
}, |
69
|
|
|
|
|
|
|
default => sub{ {} }, |
70
|
|
|
|
|
|
|
); |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
has logging_levels =>( |
73
|
|
|
|
|
|
|
traits => ['Hash'], |
74
|
|
|
|
|
|
|
isa => HashRef[ElevenArray], |
75
|
|
|
|
|
|
|
handles =>{ |
76
|
|
|
|
|
|
|
has_log_levels => 'exists', |
77
|
|
|
|
|
|
|
add_log_levels => 'set', |
78
|
|
|
|
|
|
|
_get_log_levels => 'get', |
79
|
|
|
|
|
|
|
remove_log_levels => 'delete', |
80
|
|
|
|
|
|
|
}, |
81
|
|
|
|
|
|
|
writer => 'set_all_log_levels', |
82
|
|
|
|
|
|
|
reader => 'get_all_log_levels', |
83
|
|
|
|
|
|
|
default => sub{ {} }, |
84
|
|
|
|
|
|
|
); |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
has all_buffering =>( |
87
|
|
|
|
|
|
|
isa => HashRef[ArrayRef], |
88
|
|
|
|
|
|
|
traits => ['Hash'], |
89
|
|
|
|
|
|
|
writer => 'set_all_buffering', |
90
|
|
|
|
|
|
|
reader => '_get_all_buffering', |
91
|
|
|
|
|
|
|
handles =>{ |
92
|
|
|
|
|
|
|
has_buffer => 'exists', |
93
|
|
|
|
|
|
|
stop_buffering => 'delete', |
94
|
|
|
|
|
|
|
_set_buffer => 'set', |
95
|
|
|
|
|
|
|
_get_buffer => 'get', |
96
|
|
|
|
|
|
|
_get_buffer_list => 'keys', |
97
|
|
|
|
|
|
|
}, |
98
|
|
|
|
|
|
|
default => sub{ {} }, |
99
|
|
|
|
|
|
|
); |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
#########1 Public Methods 3#########4#########5#########6#########7#########8#########9 |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
sub import { |
104
|
15
|
|
|
15
|
|
60
|
my( $class, @args ) = @_; |
105
|
15
|
|
|
|
|
85
|
my $instance = $class->instance;#Returns a pre-existing instance if it exists |
106
|
15
|
100
|
|
|
|
431
|
return 1 if $instance->_has_import_recursion_block; # Only accept the first build! |
107
|
5
|
|
|
|
|
209
|
$instance->_set_import_recursion_block( 1 ); |
108
|
5
|
50
|
50
|
|
|
80
|
warn "Received args:" . join( '~|~', @args ) if @args and IMPORT_DEBUG; |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
# Handle versions (and other nonsense) |
111
|
5
|
50
|
33
|
|
|
21
|
if( $args[0] and $args[0] =~ /^v?\d+\.?\d*/ ){# Version check since import highjacks the built in |
112
|
0
|
|
|
|
|
0
|
warn "Running version check on version: $args[0]" if IMPORT_DEBUG; |
113
|
0
|
|
|
|
|
0
|
my $result = $VERSION <=> version->parse( $args[0]); |
114
|
0
|
|
|
|
|
0
|
warn "Tested against version -$VERSION- gives result: $result" if IMPORT_DEBUG; |
115
|
0
|
0
|
|
|
|
0
|
if( $result < 0 ){ |
116
|
0
|
|
|
|
|
0
|
confess "Version -$args[0]- requested for Log::Shiras::Switchboard " . |
117
|
|
|
|
|
|
|
"- the installed version is: $VERSION"; |
118
|
|
|
|
|
|
|
} |
119
|
0
|
|
|
|
|
0
|
shift @args; |
120
|
|
|
|
|
|
|
} |
121
|
5
|
50
|
|
|
|
13
|
if( @args ){ |
122
|
0
|
|
|
|
|
0
|
confess "Unknown flags passed to Log::Shiras::Switchboard: " . join( ' ', @args ); |
123
|
|
|
|
|
|
|
} |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
# Still not sure why this is needed but maybe because of the singlton? |
126
|
5
|
|
|
5
|
|
24
|
no warnings 'once'; |
|
5
|
|
|
|
|
5
|
|
|
5
|
|
|
|
|
287
|
|
127
|
5
|
100
|
|
|
|
13
|
if($Log::Shiras::Unhide::strip_match) { |
128
|
1
|
|
|
1
|
|
54
|
eval 'use Log::Shiras::Unhide'; |
|
22
|
|
|
|
|
68
|
|
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
10
|
|
129
|
|
|
|
|
|
|
} |
130
|
5
|
|
|
5
|
|
18
|
use warnings 'once'; |
|
5
|
|
|
|
|
6
|
|
|
5
|
|
|
|
|
3953
|
|
131
|
5
|
|
|
|
|
5099
|
warn "Finished the switchboard import" if IMPORT_DEBUG; |
132
|
|
|
|
|
|
|
} |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
#Special MooseX::Singleton instantiation that pulls multiple instances into the same master case |
135
|
|
|
|
|
|
|
# This method won't report until the caller name_space and report destination are set up |
136
|
|
|
|
|
|
|
# use the constant GET_OPERATOR_DEBUG to see unreported messages |
137
|
|
|
|
|
|
|
sub get_operator{ |
138
|
13
|
|
|
13
|
1
|
3598
|
my( $maybe_class, @args ) = @_; |
139
|
13
|
50
|
|
|
|
41
|
if( $maybe_class ne __PACKAGE__ ){ |
140
|
0
|
|
|
|
|
0
|
unshift @args, $maybe_class; |
141
|
0
|
|
|
|
|
0
|
$maybe_class = __PACKAGE__; |
142
|
|
|
|
|
|
|
} |
143
|
13
|
|
|
|
|
122
|
my $instance = $maybe_class->instance;#Returns a pre-existing instance if it exists |
144
|
13
|
0
|
33
|
|
|
94
|
my $arguments = |
|
|
50
|
0
|
|
|
|
|
|
|
100
|
|
|
|
|
|
145
|
|
|
|
|
|
|
( !@args) ? undef : |
146
|
|
|
|
|
|
|
( ( @args > 1 ) and ( scalar( @args ) % 2 == 0 ) ) ? { @args } : |
147
|
|
|
|
|
|
|
( is_YamlFile( $args[0] ) or is_JsonFile( $args[0] ) ) ? to_FileHash( $args[0] ) : |
148
|
|
|
|
|
|
|
to_ArgsHash( $args[0] ); |
149
|
|
|
|
|
|
|
###InternalSwitchboarD my $talk_result = 1; |
150
|
|
|
|
|
|
|
###InternalSwitchboarD $talk_result = $instance->master_talk( { report => 'log_file', level => 2, |
151
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::get_operator', |
152
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "Initial parsing of arguments yeilds:", $arguments ], } ); |
153
|
|
|
|
|
|
|
###InternalSwitchboarD warn "Initial parsing of arguments yeilds:" . Dumper( $arguments ) if GET_OPERATOR_DEBUG and ($talk_result == 0 or $talk_result == -3); |
154
|
13
|
50
|
66
|
|
|
43
|
if( $arguments and exists $arguments->{conf_file} ){ |
155
|
2
|
|
|
|
|
15
|
my $file_hash = to_FileHash( $arguments->{conf_file} ); |
156
|
2
|
|
|
|
|
5
|
delete $arguments->{conf_file}; |
157
|
2
|
|
|
|
|
7
|
$arguments = $instance->graft_data( tree_ref => $file_hash, scion_ref => $arguments ); |
158
|
|
|
|
|
|
|
} |
159
|
|
|
|
|
|
|
###InternalSwitchboarD $talk_result = $instance->master_talk( { report => 'log_file', level => 0, |
160
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::get_operator', |
161
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "Updated arguments with conf_file key parsed:", $arguments ], } ); |
162
|
|
|
|
|
|
|
###InternalSwitchboarD warn "Updated arguments with conf_file key parsed:" . Dumper( $arguments ) if GET_OPERATOR_DEBUG and ($talk_result == 0 or $talk_result == -3); |
163
|
11
|
|
|
|
|
17
|
my $level = 1; |
164
|
11
|
|
|
|
|
21
|
my $message = [ "Starting get operator" ]; |
165
|
11
|
100
|
|
|
|
37
|
if( keys %$arguments ){ |
166
|
8
|
|
|
|
|
17
|
$level = 2; |
167
|
8
|
|
|
|
|
23
|
push @$message, 'With updates to:' , keys %$arguments; |
168
|
|
|
|
|
|
|
} |
169
|
|
|
|
|
|
|
###InternalSwitchboarD $talk_result = $instance->master_talk( { report => 'log_file', level => $level, |
170
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::get_operator', |
171
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ $message, $arguments ], } ); |
172
|
|
|
|
|
|
|
###InternalSwitchboarD warn Dumper( $message, $arguments ) if GET_OPERATOR_DEBUG and ($talk_result == 0 or $talk_result == -3); |
173
|
13
|
|
|
|
|
17
|
my @action_list; |
174
|
13
|
|
|
|
|
31
|
for my $key ( keys %$arguments ){ |
175
|
14
|
|
|
|
|
39
|
push @action_list, $key; |
176
|
13
|
|
|
|
|
24
|
my $method_1 = "add_$key"; |
177
|
13
|
|
|
|
|
23
|
my $method_2 = "set_$key"; |
178
|
14
|
50
|
|
|
|
56
|
my $input = is_HashRef( $arguments->{$key} ) ? $arguments->{$key} : {$arguments->{$key}}; |
179
|
|
|
|
|
|
|
###InternalSwitchboarD $talk_result = $instance->master_talk( { report => 'log_file', level => 0, |
180
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::get_operator', |
181
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "Processed key -$key- to the methods -$method_1- and -$method_2-", |
182
|
|
|
|
|
|
|
###InternalSwitchboarD "used to implement arguments:", $arguments->{$key} ], } ); |
183
|
|
|
|
|
|
|
###InternalSwitchboarD warn "Processed key -$key- to the methods -$method_1- and -$method_2-" if GET_OPERATOR_DEBUG and ($talk_result == 0 or $talk_result == -3); |
184
|
|
|
|
|
|
|
###InternalSwitchboarD warn "used to implement arguments:" . Dumper( $arguments->{$key} ) if GET_OPERATOR_DEBUG and ($talk_result == 0 or $talk_result == -3); |
185
|
14
|
100
|
|
|
|
1901
|
if( $instance->can( $method_1 ) ){ |
186
|
|
|
|
|
|
|
###InternalSwitchboarD $talk_result = $instance->master_talk( { report => 'log_file', level => 1, |
187
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::get_operator', |
188
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "Using method: $method_1" ], } ); |
189
|
|
|
|
|
|
|
###InternalSwitchboarD warn "Using method: $method_1" if GET_OPERATOR_DEBUG and ($talk_result == 0 or $talk_result == -3); |
190
|
12
|
|
|
|
|
28
|
$instance->$method_1( $input ); |
191
|
|
|
|
|
|
|
}else{ |
192
|
|
|
|
|
|
|
###InternalSwitchboarD $instance->master_talk( { report => 'log_file', level => 1, |
193
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::get_operator', |
194
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "Using method: $method_2" ], } ); |
195
|
|
|
|
|
|
|
###InternalSwitchboarD warn "Using method: $method_2" if GET_OPERATOR_DEBUG and ($talk_result == 0 or $talk_result == -3); |
196
|
4
|
|
|
|
|
15
|
$instance->$method_2( $input ); |
197
|
|
|
|
|
|
|
} |
198
|
|
|
|
|
|
|
} |
199
|
|
|
|
|
|
|
###InternalSwitchboarD $talk_result = $instance->master_talk( { report => 'log_file', level => 2, |
200
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::get_operator', |
201
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "Switchboard finished updating the following arguments: ", @action_list ], } ); |
202
|
|
|
|
|
|
|
###InternalSwitchboarD warn "Switchboard finished updating the following arguments: " . Dumper( @action_list ) if GET_OPERATOR_DEBUG and ($talk_result == 0 or $talk_result == -3); |
203
|
|
|
|
|
|
|
###InternalSwitchboarD $talk_result = $instance->master_talk( { report => 'log_file', level => 0, |
204
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::get_operator', |
205
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ 'The switchboard instance is:', $instance ], } ); |
206
|
|
|
|
|
|
|
###InternalSwitchboarD warn 'The switchboard instance is:' . Dumper( $instance ) if GET_OPERATOR_DEBUG and ($talk_result == 0 or $talk_result == -3); |
207
|
13
|
|
|
|
|
123
|
return $instance; |
208
|
|
|
|
|
|
|
} |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
# This is the only method that can't self report - use the constant TALK_DEBUG instead |
211
|
|
|
|
|
|
|
# (Any self reporting from here is by definition a trigger for deep recursion fails) |
212
|
|
|
|
|
|
|
sub master_talk{ |
213
|
2774
|
|
|
2772
|
1
|
4338
|
my ( $self, $data_ref ) = @_; |
214
|
2774
|
|
|
|
|
82378
|
my $recursion = $self->_has_message_recursion_block; |
215
|
|
|
|
|
|
|
###InternalSwitchboarD warn "Arrived at master_talk with recursion level -$recursion- from line: " . (caller(0))[2] if TALK_DEBUG; |
216
|
2774
|
100
|
|
|
|
34692
|
if( $recursion == 0 ){ |
|
|
100
|
|
|
|
|
|
217
|
|
|
|
|
|
|
###InternalSwitchboarD warn '---->Recursion level 0 acceptable!' if TALK_DEBUG; |
218
|
|
|
|
|
|
|
}elsif( $recursion == 1 ){# Allow for one level so internal junk can report |
219
|
|
|
|
|
|
|
###InternalSwitchboarD warn '------------------->Recursion level 1 acceptable!' if TALK_DEBUG; |
220
|
|
|
|
|
|
|
}else{ |
221
|
|
|
|
|
|
|
###InternalSwitchboarD warn "Allowed recursion level exceeded!" if TALK_DEBUG; |
222
|
2749
|
|
|
|
|
4347
|
return -1; # Special return state for recursion-fail |
223
|
|
|
|
|
|
|
} |
224
|
54
|
|
|
|
|
656
|
$self->_set_message_recursion_block( 1 + $recursion ); |
225
|
|
|
|
|
|
|
###InternalSwitchboarD warn "Arrived at master_talk with the instructions:" . Dumper( $data_ref ) if TALK_DEBUG; |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
# Check the NameSpace |
228
|
|
|
|
|
|
|
###InternalSwitchboarD warn "Checking if report -$data_ref->{report}- level -$data_ref->{level}- and NameSpace -$data_ref->{name_space}- are allowed to communicate" if TALK_DEBUG; |
229
|
400
|
100
|
|
|
|
636
|
if( $self->_can_communicate( |
230
|
|
|
|
|
|
|
$data_ref->{report}, $data_ref->{level}, $data_ref->{name_space} ) ){ |
231
|
|
|
|
|
|
|
###InternalSwitchboarD warn "The message passed the name_space test" if TALK_DEBUG; |
232
|
|
|
|
|
|
|
}else{ |
233
|
|
|
|
|
|
|
###InternalSwitchboarD if( TALK_DEBUG ){ |
234
|
|
|
|
|
|
|
###InternalSwitchboarD my $message = '<----'; |
235
|
|
|
|
|
|
|
###InternalSwitchboarD $message .= $recursion == 1 ? '---------------' : '' ; |
236
|
|
|
|
|
|
|
###InternalSwitchboarD $message .= 'Reducing recursion level!'; |
237
|
|
|
|
|
|
|
###InternalSwitchboarD warn $message; |
238
|
|
|
|
|
|
|
###InternalSwitchboarD warn "The message did NOT pass the name_space test"; |
239
|
|
|
|
|
|
|
###InternalSwitchboarD } |
240
|
2355
|
|
|
|
|
1592
|
$self->_set_message_recursion_block( $recursion );# Early return so cleanup needed |
241
|
2355
|
|
|
|
|
2300
|
return -3; |
242
|
|
|
|
|
|
|
} |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
### Add some meta_data |
245
|
|
|
|
|
|
|
# Add message time |
246
|
421
|
|
|
|
|
11850
|
$data_ref->{date_time} = DateTime->now( time_zone => $time_zone )->format_cldr( 'yyyy-MM-dd hh:mm:ss' ); |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
# Add carp_stack as needed |
249
|
421
|
|
|
|
|
15948
|
$data_ref = $self->_add_carp_stack( $data_ref ); |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
# Add source keys |
252
|
419
|
|
|
|
|
291
|
$data_ref = $self->_add_caller( $data_ref ); |
253
|
|
|
|
|
|
|
###InternalSwitchboarD warn "The message metadata load is complete" if TALK_DEBUG; |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
# Check if the message is buffered |
256
|
419
|
|
|
|
|
684
|
my $y = $self->_buffer_decision( $data_ref ); |
257
|
|
|
|
|
|
|
###InternalSwitchboarD warn "Buffer decision result: $y" if TALK_DEBUG; |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
# Send message to report as needed |
260
|
61
|
100
|
|
|
|
93
|
my $x = ( $y eq 'report' ) ? $self->_really_report( $data_ref ) : -2; |
261
|
|
|
|
|
|
|
###InternalSwitchboarD warn "Returned from _really_report-ing with: $x" if TALK_DEBUG; |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
###InternalSwitchboarD if( TALK_DEBUG ){ |
264
|
|
|
|
|
|
|
###InternalSwitchboarD my $message = '<----'; |
265
|
|
|
|
|
|
|
###InternalSwitchboarD $message .= $recursion == 1 ? '---------------' : '' ; |
266
|
|
|
|
|
|
|
###InternalSwitchboarD $message .= 'Reducing recursion level!'; |
267
|
|
|
|
|
|
|
###InternalSwitchboarD warn $message; |
268
|
|
|
|
|
|
|
###InternalSwitchboarD } |
269
|
378
|
|
|
|
|
686
|
$self->_set_message_recursion_block( $recursion ); |
270
|
378
|
|
|
|
|
10707
|
return $x; |
271
|
|
|
|
|
|
|
} |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
sub add_name_space_bounds{ |
274
|
368
|
|
|
8
|
1
|
5136
|
my ( $self, $name_space_ref ) = @_; |
275
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 0, |
276
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::add_name_space_bounds', |
277
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ 'Arrived at add_name_space_bounds with:', $name_space_ref, |
278
|
|
|
|
|
|
|
###InternalSwitchboarD '...against current master name_space_bounds:', $self->get_name_space ], } ); |
279
|
52
|
|
|
|
|
360
|
my $new_sources = $self->graft_data( |
280
|
|
|
|
|
|
|
tree_ref => $self->get_name_space, |
281
|
|
|
|
|
|
|
scion_ref => $name_space_ref, |
282
|
|
|
|
|
|
|
); |
283
|
52
|
|
|
|
|
92354
|
my $result = $self->_set_whole_name_space( $new_sources ); |
284
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 0, |
285
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::add_name_space_bounds', |
286
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ 'Updated master name_space_bounds:', $new_sources ], } ); |
287
|
50
|
|
|
|
|
21905
|
return 1; |
288
|
|
|
|
|
|
|
} |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
sub remove_name_space_bounds{ |
291
|
44
|
|
|
1
|
1
|
831
|
my ( $self, $removal_ref ) = @_; |
292
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 0, |
293
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::remove_name_space_bounds', |
294
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ 'Arrived at remove_name_space_bounds with:', $removal_ref, |
295
|
|
|
|
|
|
|
###InternalSwitchboarD '...against current master name_space_bounds:', $self->get_name_space ], } ); |
296
|
44
|
|
|
|
|
74
|
my $result; |
297
|
43
|
|
|
|
|
71
|
$self->_set_whole_name_space( |
298
|
|
|
|
|
|
|
$result = $self->prune_data( tree_ref => $self->get_name_space, slice_ref => $removal_ref, ) |
299
|
|
|
|
|
|
|
); |
300
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 0, |
301
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::remove_name_space_bounds', |
302
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ 'Updated master name_space_bounds:', $result ], } ); |
303
|
43
|
|
|
|
|
118
|
return $result; |
304
|
|
|
|
|
|
|
} |
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
sub add_reports{ |
307
|
50
|
|
|
9
|
1
|
3234
|
my( $self, @args ) = @_; |
308
|
50
|
100
|
|
|
|
54
|
my %report_hash = ( scalar( @args ) == 1 ) ? %{$args[0]} : @args ; |
|
48
|
|
|
|
|
1258
|
|
309
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 0, |
310
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::add_reports', |
311
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ 'Arrived at add_reports with:', {%report_hash}, |
312
|
|
|
|
|
|
|
###InternalSwitchboarD 'Current master reports:', $self->get_reports ], } ); |
313
|
50
|
|
|
|
|
600
|
for my $name ( keys %report_hash ){ |
314
|
12
|
|
|
|
|
71
|
my $report_list = []; |
315
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 1, |
316
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::add_reports', |
317
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "Adding output to the report named: $name" ], } ); |
318
|
13
|
|
|
|
|
28
|
for my $report ( @{$report_hash{$name}} ){ |
|
13
|
|
|
|
|
31
|
|
319
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 0, |
320
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::add_reports', |
321
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ 'processing:', $report ], } ); |
322
|
8
|
100
|
|
|
|
24
|
if( is_ReportObject( $report ) ){ |
323
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 0, |
324
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::add_reports', |
325
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ 'no object creation needed for this output' ], } ); |
326
|
|
|
|
|
|
|
}else{ |
327
|
4
|
|
|
|
|
267
|
$report = to_ReportObject( $report ); |
328
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 1, |
329
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::add_reports', |
330
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ 'after building the instance:', $report ], } ); |
331
|
|
|
|
|
|
|
} |
332
|
7
|
|
|
|
|
47
|
push @{$report_list} , $report; |
|
7
|
|
|
|
|
32
|
|
333
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 1, |
334
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::add_reports', |
335
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ 'updated report list:', $report_list ], } ); |
336
|
|
|
|
|
|
|
} |
337
|
12
|
|
|
|
|
293
|
$self->_set_report( $name => $report_list ); |
338
|
|
|
|
|
|
|
} |
339
|
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 0, |
341
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::add_reports', |
342
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ 'Final report space:', $self->get_reports ], } ); |
343
|
8
|
|
|
|
|
135
|
return 1; |
344
|
|
|
|
|
|
|
} |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
sub get_log_levels{ |
347
|
2
|
|
|
2
|
1
|
331
|
my ( $self, $report ) = @_; |
348
|
3
|
|
50
|
|
|
9
|
$report //= 'log_file'; |
349
|
3
|
|
|
|
|
3
|
my $output; |
350
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 1, |
351
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::add_reports', |
352
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "Reached get_log_levels for report: $report" ], } ); |
353
|
3
|
|
|
|
|
7
|
my $x = 0; |
354
|
4
|
100
|
|
|
|
123
|
if( $self->has_log_levels( $report ) ){ |
355
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 2, |
356
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::add_reports', |
357
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "Custom log level for -$report- found" ], } ); |
358
|
2
|
|
|
|
|
122
|
$output = $self->_get_log_levels( $report ); |
359
|
|
|
|
|
|
|
}else{ |
360
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 1, |
361
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::add_reports', |
362
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "No custome log levels in force for -$report- sending the defaults" ], } ); |
363
|
2
|
|
|
|
|
30
|
$output = [ @default_levels ]; |
364
|
|
|
|
|
|
|
} |
365
|
5
|
|
|
5
|
|
23
|
no warnings 'uninitialized';#OK to have undef at some levels |
|
5
|
|
|
|
|
7
|
|
|
5
|
|
|
|
|
170
|
|
366
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 1, |
367
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::add_reports', |
368
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "Returning the log levels for -$report-" . join( ', ', @$output ) ], } ); |
369
|
5
|
|
|
5
|
|
18
|
use warnings 'uninitialized'; |
|
5
|
|
|
|
|
7
|
|
|
5
|
|
|
|
|
8015
|
|
370
|
2
|
|
|
|
|
25
|
return $output; |
371
|
|
|
|
|
|
|
} |
372
|
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
sub send_buffer_to_output{ |
374
|
6
|
|
|
6
|
1
|
21
|
my ( $self, $report ) = @_; |
375
|
6
|
|
50
|
|
|
11
|
$report //= 'log_file'; |
376
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 1, |
377
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::send_buffer_to_output', |
378
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "Reached send_buffer_to_output for report: $report" ], } ); |
379
|
6
|
|
|
|
|
7
|
my $x = 0; |
380
|
6
|
50
|
|
|
|
155
|
if( $self->has_buffer( $report ) ){ |
381
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 1, |
382
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::send_buffer_to_output', |
383
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "Flushing the buffer ..." ], } ); |
384
|
6
|
|
|
|
|
90
|
for my $message_ref ( @{$self->_get_buffer( $report )} ) { |
|
6
|
|
|
|
|
140
|
|
385
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 0, |
386
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::send_buffer_to_output', |
387
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "Sending:", $message_ref->{message} ], } ); |
388
|
3
|
|
|
|
|
42
|
$x += $self->_really_report( $message_ref ); |
389
|
|
|
|
|
|
|
} |
390
|
6
|
|
|
|
|
184
|
$self->_set_buffer( $report => [] ); |
391
|
|
|
|
|
|
|
}else{ |
392
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 3, |
393
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::send_buffer_to_output', |
394
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "Attempting to send buffer to output when no buffering is in force!" ], } ); |
395
|
|
|
|
|
|
|
} |
396
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 1, |
397
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::send_buffer_to_output', |
398
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "Returning from attempt to flush buffer with: $x" ], } ); |
399
|
6
|
|
|
|
|
82
|
return $x; |
400
|
|
|
|
|
|
|
} |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
sub clear_buffer{ |
403
|
1
|
|
|
1
|
1
|
9
|
my ( $self, $report ) = @_; |
404
|
1
|
|
50
|
|
|
4
|
$report //= 'log_file'; |
405
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 1, |
406
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::clear_buffer', |
407
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "Reached clear_buffer for report: $report" ], } ); |
408
|
1
|
|
|
|
|
1
|
my $x = 0; |
409
|
1
|
50
|
|
|
|
30
|
if( $self->has_buffer( $report ) ){ |
410
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 1, |
411
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::clear_buffer', |
412
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "clearing the buffer ..." ], } ); |
413
|
1
|
|
|
|
|
43
|
$self->_set_buffer( $report => [] ); |
414
|
1
|
|
|
|
|
13
|
$x = 1; |
415
|
|
|
|
|
|
|
}else{ |
416
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 2, |
417
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::clear_buffer', |
418
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "Attempting to clear a buffer to output when no buffering is in force!" ], } ); |
419
|
|
|
|
|
|
|
} |
420
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 1, |
421
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::clear_buffer', |
422
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "Returning from attempt to clear the buffer with: $x" ], } ); |
423
|
1
|
|
|
|
|
5
|
return $x; |
424
|
|
|
|
|
|
|
} |
425
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
sub start_buffering{ |
427
|
2
|
|
|
2
|
1
|
12
|
my ( $self, $report ) = @_; |
428
|
2
|
|
50
|
|
|
5
|
$report //= 'log_file'; |
429
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 2, |
430
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::start_buffering', |
431
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "Reached set_buffering for report: $report" ], } ); |
432
|
2
|
|
|
|
|
3
|
my $x = 0; |
433
|
2
|
50
|
|
|
|
59
|
if( $self->has_buffer( $report ) ){ |
434
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 3, |
435
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::start_buffering', |
436
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "Attempting to turn on a buffer to when it already exists!" ], } ); |
437
|
|
|
|
|
|
|
}else{ |
438
|
2
|
|
|
|
|
85
|
$self->_set_buffer( $report => [] ); |
439
|
2
|
|
|
|
|
26
|
$x = 1; |
440
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 1, |
441
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::start_buffering', |
442
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "Buffering turned on ..." ], } ); |
443
|
|
|
|
|
|
|
} |
444
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 2, |
445
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::start_buffering', |
446
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "Returning from attempt to set the buffer with: $x" ], } ); |
447
|
2
|
|
|
|
|
8
|
return $x; |
448
|
|
|
|
|
|
|
} |
449
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
#########1 Private Attributes 3#########4#########5#########6#########7#########8#########9 |
451
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
has _import_recursion_block =>( |
453
|
|
|
|
|
|
|
isa => Bool, |
454
|
|
|
|
|
|
|
reader => '_has_import_recursion_block', |
455
|
|
|
|
|
|
|
writer => '_set_import_recursion_block', |
456
|
|
|
|
|
|
|
init_arg => undef, |
457
|
|
|
|
|
|
|
default => 0, |
458
|
|
|
|
|
|
|
); |
459
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
has _message_recursion_block =>( |
461
|
|
|
|
|
|
|
isa => Int, |
462
|
|
|
|
|
|
|
reader => '_has_message_recursion_block', |
463
|
|
|
|
|
|
|
writer => '_set_message_recursion_block', |
464
|
|
|
|
|
|
|
init_arg => undef, |
465
|
|
|
|
|
|
|
default => 0, |
466
|
|
|
|
|
|
|
); |
467
|
|
|
|
|
|
|
|
468
|
|
|
|
|
|
|
has _data_walker =>( |
469
|
|
|
|
|
|
|
isa => 'Walker', |
470
|
|
|
|
|
|
|
handles =>[ qw( graft_data prune_data print_data ) ], |
471
|
|
|
|
|
|
|
writer => '_set_data_walker', |
472
|
|
|
|
|
|
|
predicate => '_has_data_walker', |
473
|
|
|
|
|
|
|
init_arg => undef, |
474
|
|
|
|
|
|
|
builder => '_build_data_walker', |
475
|
|
|
|
|
|
|
#~ lazy => 1, |
476
|
|
|
|
|
|
|
); |
477
|
|
|
|
|
|
|
|
478
|
|
|
|
|
|
|
has _can_communicate_cash =>( |
479
|
|
|
|
|
|
|
isa => HashRef, |
480
|
|
|
|
|
|
|
traits => ['Hash'], |
481
|
|
|
|
|
|
|
clearer => '_clear_can_communicate_cash', |
482
|
|
|
|
|
|
|
handles =>{ |
483
|
|
|
|
|
|
|
_has_can_com_cash => 'exists', |
484
|
|
|
|
|
|
|
_set_can_com_cash => 'set', |
485
|
|
|
|
|
|
|
_get_can_com_cash => 'get', |
486
|
|
|
|
|
|
|
}, |
487
|
|
|
|
|
|
|
init_arg => undef, |
488
|
|
|
|
|
|
|
default => sub{ {} }, |
489
|
|
|
|
|
|
|
); |
490
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
has _test_buffer =>( |
492
|
|
|
|
|
|
|
isa => HashRef[ArrayRef], |
493
|
|
|
|
|
|
|
clearer => '_clear_all_test_buffers', |
494
|
|
|
|
|
|
|
traits => ['Hash'], |
495
|
|
|
|
|
|
|
handles =>{ |
496
|
|
|
|
|
|
|
_has_test_buffer => 'exists', |
497
|
|
|
|
|
|
|
_set_test_buffer => 'set', |
498
|
|
|
|
|
|
|
_get_test_buffer => 'get', |
499
|
|
|
|
|
|
|
}, |
500
|
|
|
|
|
|
|
default => sub{ {} }, |
501
|
|
|
|
|
|
|
); |
502
|
|
|
|
|
|
|
|
503
|
|
|
|
|
|
|
#########1 Private Methods 3#########4#########5#########6#########7#########8#########9 |
504
|
|
|
|
|
|
|
|
505
|
|
|
|
|
|
|
sub _can_communicate{ |
506
|
425
|
|
|
425
|
|
419
|
my ( $self, $report, $level, $name_string ) = @_; |
507
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 2, |
508
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::master_talk::_can_communicate', |
509
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "Arrived at _can_communicate to see if report: $report", |
510
|
|
|
|
|
|
|
###InternalSwitchboarD "- will accept a call at the urgency of: $level", |
511
|
|
|
|
|
|
|
###InternalSwitchboarD "- from the name_space: $name_string" ], } ); |
512
|
425
|
|
|
|
|
1453
|
my $cash_string = $name_string . $report . $level; |
513
|
425
|
|
|
|
|
797
|
my $pass = 0; |
514
|
425
|
|
|
|
|
418
|
my $x = "Report -$report- is NOT UNBLOCKed for the name-space: $name_string"; |
515
|
425
|
100
|
|
|
|
1106
|
if( $self->_has_can_com_cash( $cash_string ) ){ |
516
|
409
|
|
|
|
|
12785
|
( $pass, $x ) = @{$self->_get_can_com_cash( $cash_string )}; |
|
350
|
|
|
|
|
4799
|
|
517
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 1, |
518
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::master_talk::_can_communicate', |
519
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "Found the permissions cached: $pass" ], } ); |
520
|
|
|
|
|
|
|
}else{ |
521
|
357
|
|
|
|
|
11378
|
my $source_space = $self->get_name_space; |
522
|
357
|
100
|
|
|
|
5651
|
return $pass if !keys %$source_space; |
523
|
75
|
|
|
|
|
2392
|
my @telephone_name_space = ( split /::/, $name_string ); |
524
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 1, |
525
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::master_talk::_can_communicate', |
526
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ 'Consolidating permissions for the name space:', @telephone_name_space , |
527
|
|
|
|
|
|
|
###InternalSwitchboarD 'against the source space:', $source_space ], } ); |
528
|
75
|
|
|
|
|
845
|
my $level_ref = {}; |
529
|
45
|
|
|
|
|
138
|
$level_ref = $self->_get_block_unblock_levels( $level_ref, $source_space ); |
530
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 1, |
531
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::master_talk::_can_communicate', |
532
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ '_get_block_unblock_levels returned returned the level ref:', $level_ref ], } ); |
533
|
45
|
|
|
|
|
136
|
SPACETEST: for my $next_level ( @telephone_name_space ){ |
534
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 1, |
535
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::master_talk::_can_communicate', |
536
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "Checking for additional adjustments at: $next_level" ], } ); |
537
|
58
|
100
|
|
|
|
99
|
if( exists $source_space->{$next_level} ){ |
538
|
48
|
|
|
|
|
347
|
$source_space = clone( $source_space->{$next_level} ); |
539
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 1, |
540
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::master_talk::_can_communicate', |
541
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "The next level -$next_level- exists", $source_space ], } ); |
542
|
48
|
|
|
|
|
128
|
$level_ref = $self->_get_block_unblock_levels( $level_ref, $source_space ); |
543
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 1, |
544
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::master_talk::_can_communicate', |
545
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ '_get_block_unblock_levels returned the level ref:', $level_ref ], } ); |
546
|
|
|
|
|
|
|
}else{ |
547
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 1, |
548
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::master_talk::_can_communicate', |
549
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "Didn't find the next level -$next_level-" ], } ); |
550
|
39
|
|
|
|
|
79
|
last SPACETEST; |
551
|
|
|
|
|
|
|
} |
552
|
|
|
|
|
|
|
} |
553
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 1, |
554
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::master_talk::_can_communicate', |
555
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ 'Final level collection is:', $level_ref, |
556
|
|
|
|
|
|
|
###InternalSwitchboarD "Checking for the report name in the consolidated level ref"], } ); |
557
|
140
|
|
|
|
|
381
|
REPORTTEST: for my $key ( keys %$level_ref ){ |
558
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 0, |
559
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::master_talk::_can_communicate', |
560
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "Testing: $key" ], } ); |
561
|
153
|
100
|
|
|
|
387
|
if( $key =~ /$report/i ){ |
562
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 0, |
563
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::master_talk::_can_communicate', |
564
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "Matched key to the target report: $report" ], } ); |
565
|
125
|
|
|
|
|
2090
|
my $allowed = $self->_convert_level_name_to_number( $level_ref->{$key}, $report ); |
566
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 0, |
567
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::master_talk::_can_communicate', |
568
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "The allowed level for -$report- is: $allowed" ], } ); |
569
|
125
|
|
|
|
|
584
|
my $attempted = $self->_convert_level_name_to_number( $level, $report ); |
570
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 0, |
571
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::master_talk::_can_communicate', |
572
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "The attempted level for -$level- is: $attempted" ], } ); |
573
|
125
|
100
|
|
|
|
267
|
if( $attempted >= $allowed ){ |
574
|
120
|
|
|
|
|
311
|
$x = "The message clears for report -$report- at level: $level"; |
575
|
24
|
|
|
|
|
56
|
$pass = 1 ; |
576
|
|
|
|
|
|
|
}else{ |
577
|
19
|
|
|
|
|
44
|
$x = "The destination -$report- is UNBLOCKed but not to the -$level- level at the name space: $name_string"; |
578
|
|
|
|
|
|
|
} |
579
|
44
|
|
|
|
|
123
|
last REPORTTEST; |
580
|
|
|
|
|
|
|
} |
581
|
|
|
|
|
|
|
} |
582
|
45
|
|
|
|
|
564
|
$self->_set_can_com_cash( $cash_string => [ $pass, $x ] ); |
583
|
|
|
|
|
|
|
} |
584
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 2, |
585
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::master_talk::_can_communicate', |
586
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ $x ], } ); |
587
|
53
|
|
|
|
|
518
|
return $pass; |
588
|
|
|
|
|
|
|
} |
589
|
|
|
|
|
|
|
|
590
|
|
|
|
|
|
|
sub _add_caller{ |
591
|
89
|
|
|
61
|
|
222
|
my ( $self, $data_ref ) = @_; |
592
|
78
|
|
|
|
|
130
|
my $level = 2; |
593
|
78
|
100
|
|
|
|
157
|
if( !exists $data_ref->{source_sub} ){ |
594
|
64
|
|
|
|
|
124
|
$data_ref->{source_sub} = 'Log::Shiras::Switchboard::master_talk'; |
595
|
64
|
|
|
|
|
80
|
$level = 1; |
596
|
|
|
|
|
|
|
} |
597
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 2, |
598
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::master_talk::_add_caller', |
599
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "Arrived at _get_caller for start level (up): $level", |
600
|
|
|
|
|
|
|
###InternalSwitchboarD "and source sub: $data_ref->{source_sub}", ], } ); |
601
|
78
|
|
|
|
|
268
|
my( $caller_ref, $complete, $last_ref,); |
602
|
78
|
|
|
|
|
149
|
while( !$complete ){ |
603
|
74
|
|
|
|
|
230
|
@$caller_ref{qw( package filename line subroutine )} = (caller($level))[0..3]; |
604
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 0, |
605
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::master_talk::_add_caller', |
606
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "Retrieved caller data from up level: $level", $caller_ref ], } ); |
607
|
74
|
100
|
|
|
|
432
|
if( $caller_ref->{subroutine} eq $data_ref->{source_sub} ){ |
608
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 1, |
609
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::master_talk::_add_caller', |
610
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "Matched: $data_ref->{source_sub}" ], } ); |
611
|
71
|
|
|
|
|
248
|
$complete = 1; |
612
|
|
|
|
|
|
|
} |
613
|
84
|
|
|
|
|
172
|
$level++; |
614
|
96
|
50
|
|
|
|
1141
|
last if $level > 6;# safety valve |
615
|
|
|
|
|
|
|
} |
616
|
|
|
|
|
|
|
#~ my $caller_ref = $data_ref->{source_sub} eq 'IO::Callback::print' ? |
617
|
|
|
|
|
|
|
#~ $self->_alt_caller( $data_ref, $level ) : |
618
|
|
|
|
|
|
|
#~ $self->_main_caller( $data_ref, $level ); |
619
|
|
|
|
|
|
|
#~ ###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 2, |
620
|
|
|
|
|
|
|
#~ ###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::master_talk::_add_caller', |
621
|
|
|
|
|
|
|
#~ ###InternalSwitchboarD message =>[ "Returned from caller search with:", $caller_ref ], } ); |
622
|
431
|
|
|
|
|
1778
|
delete $caller_ref->{subroutine}; |
623
|
431
|
|
|
|
|
865
|
$caller_ref->{filename} =~ s/\\/\//g; |
624
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => '2', |
625
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::master_talk::_add_caller', |
626
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "Caller ref - ending at level: $level", $caller_ref], } ); |
627
|
61
|
|
|
|
|
222
|
return { %$caller_ref, %$data_ref }; |
628
|
|
|
|
|
|
|
} |
629
|
|
|
|
|
|
|
|
630
|
|
|
|
|
|
|
sub _add_carp_stack{ |
631
|
103
|
|
|
61
|
|
292
|
my ( $self, $data_ref ) = @_; |
632
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 2, |
633
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::master_talk::_add_carp_stack', |
634
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "Arrived at _add_carp_stack for action: " . exists $data_ref->{carp_stack} ], } ); |
635
|
|
|
|
|
|
|
|
636
|
103
|
100
|
|
|
|
310
|
if( $data_ref->{carp_stack} ){ |
637
|
84
|
|
|
|
|
251
|
my @carp_list = split( /\n\s*/, longmess() ); |
638
|
43
|
|
|
|
|
399
|
push @{$data_ref->{message}}, @carp_list; |
|
1
|
|
|
|
|
261
|
|
639
|
|
|
|
|
|
|
} |
640
|
20
|
|
|
|
|
25
|
delete $data_ref->{carp_stack}; |
641
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => '0', |
642
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::master_talk::_add_carp_stack', |
643
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "Longmess test complete with message: ", $data_ref->{message} ], } ); |
644
|
61
|
|
|
|
|
66
|
return $data_ref; |
645
|
|
|
|
|
|
|
} |
646
|
|
|
|
|
|
|
|
647
|
|
|
|
|
|
|
sub _buffer_decision{ |
648
|
103
|
|
|
61
|
|
187
|
my ( $self, $report_ref ) = @_; |
649
|
|
|
|
|
|
|
#~ warn Dumper( $report_ref ); |
650
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 2, |
651
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::master_talk::_buffer_decision', |
652
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "Arrived at _buffer_decision for report: $report_ref->{report}", |
653
|
|
|
|
|
|
|
###InternalSwitchboarD "..with buffer setting: " . $self->has_buffer( $report_ref->{report} ), ], } ); |
654
|
|
|
|
|
|
|
|
655
|
|
|
|
|
|
|
# Check if the regular buffer is active (and load buffer or report) |
656
|
103
|
|
|
|
|
1451
|
my $x = 'report'; |
657
|
61
|
100
|
|
|
|
615
|
if( $self->has_buffer( $report_ref->{report} ) ){ |
658
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 1, |
659
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::master_talk::_buffer_decision', |
660
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "The buffer is active - sending the message to the buffer (not the report)." ], } ); |
661
|
46
|
|
|
|
|
1326
|
push @{$self->_get_buffer( $report_ref->{report} )}, $report_ref;# Load the buffer |
|
4
|
|
|
|
|
98
|
|
662
|
4
|
|
|
|
|
55
|
$x = 'buffer'; |
663
|
|
|
|
|
|
|
} |
664
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 2, |
665
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::master_talk::_buffer_decision', |
666
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "Current action for report -$report_ref->{report}- is: $x" ], } ); |
667
|
19
|
|
|
|
|
324
|
return $x; |
668
|
|
|
|
|
|
|
} |
669
|
|
|
|
|
|
|
|
670
|
|
|
|
|
|
|
sub _load_test_buffer{ |
671
|
60
|
|
|
60
|
|
50
|
my ( $self, $report_ref ) = @_; |
672
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 2, |
673
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::master_talk::_load_test_buffer', |
674
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "Arrived at _test_buffer for report: $report_ref->{report}", |
675
|
|
|
|
|
|
|
###InternalSwitchboarD "..with test buffer setting: " . $self->_has_test_buffer( $report_ref->{report} ), ], } ); |
676
|
|
|
|
|
|
|
|
677
|
|
|
|
|
|
|
# Start a test buffer for the report if it doesn't exist |
678
|
102
|
100
|
|
|
|
2516
|
if( !$self->_has_test_buffer( $report_ref->{report} ) ){ |
679
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 2, |
680
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::master_talk::_load_test_buffer', |
681
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "This is a new TEST buffer request for report " . |
682
|
|
|
|
|
|
|
###InternalSwitchboarD "-$report_ref->{report}- turning the buffer on!" ], } ); |
683
|
90
|
|
|
|
|
1655
|
$self->_set_test_buffer( $report_ref->{report} =>[] ); |
684
|
|
|
|
|
|
|
} |
685
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 1, |
686
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::master_talk::_load_test_buffer', |
687
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "Loading the line to the test buffer" ], } ); |
688
|
21
|
|
|
|
|
320
|
unshift @{$self->_get_test_buffer( $report_ref->{report} )}, $report_ref; |
|
21
|
|
|
|
|
558
|
|
689
|
|
|
|
|
|
|
|
690
|
|
|
|
|
|
|
# Reduce the buffer size as needed |
691
|
60
|
|
|
|
|
927
|
while( $#{$self->_get_test_buffer( $report_ref->{report} )} > $Log::Shiras::Test2::last_buffer_position ){ |
|
60
|
|
|
|
|
1028
|
|
692
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 2, |
693
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::master_talk::_load_test_buffer', |
694
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "The TEST buffer has outgrown it's allowed size. Reducing it from: " . |
695
|
|
|
|
|
|
|
###InternalSwitchboarD $#{$self->_get_test_buffer( $report_ref->{report} )} ], } ); |
696
|
42
|
|
|
|
|
61
|
pop @{$self->_get_test_buffer( $report_ref->{report} )}; |
|
42
|
|
|
|
|
1260
|
|
697
|
|
|
|
|
|
|
} |
698
|
|
|
|
|
|
|
|
699
|
35
|
|
|
|
|
479
|
return 1; |
700
|
|
|
|
|
|
|
} |
701
|
|
|
|
|
|
|
|
702
|
|
|
|
|
|
|
sub _really_report{ |
703
|
77
|
|
|
60
|
|
839
|
my ( $self, $report_ref ) = @_; |
704
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 2, |
705
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::master_talk::_really_report', |
706
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "Arrived at _really_report to report -$report_ref->{report}- with message:", $report_ref->{message} ], } ); |
707
|
|
|
|
|
|
|
|
708
|
|
|
|
|
|
|
# Load the test buffer as called |
709
|
77
|
50
|
|
|
|
218
|
if( $Log::Shiras::Test2::last_buffer_position ){ |
710
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 1, |
711
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::master_talk::_really_report', |
712
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "Sending the message to the test buffer too!" ], } ); |
713
|
77
|
|
|
|
|
647
|
$self->_load_test_buffer( $report_ref ); |
714
|
|
|
|
|
|
|
} |
715
|
|
|
|
|
|
|
|
716
|
|
|
|
|
|
|
# Send the data to the reports |
717
|
119
|
|
|
|
|
2149
|
my $x = 0; |
718
|
102
|
|
|
|
|
1101
|
my $report_array_ref = $self->get_report( $report_ref->{report} ); |
719
|
60
|
100
|
|
|
|
288
|
if( $report_array_ref ){ |
720
|
55
|
|
|
|
|
1256
|
for my $report ( @{$report_array_ref} ){ |
|
55
|
|
|
|
|
585
|
|
721
|
43
|
50
|
|
|
|
60
|
next if !$report; |
722
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 1, |
723
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::master_talk::_really_report', |
724
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ 'sending message to: ' . $report_ref->{report}, ], } ); |
725
|
43
|
|
|
|
|
64
|
$report->add_line( $report_ref ); |
726
|
42
|
|
|
|
|
83
|
$x++; |
727
|
|
|
|
|
|
|
} |
728
|
|
|
|
|
|
|
###InternalSwitchboarD warn 'Checking if this is a fatal message' if TALK_DEBUG; |
729
|
53
|
|
|
|
|
181
|
$self->_is_fatal( $report_ref ); |
730
|
|
|
|
|
|
|
###InternalSwitchboarD warn 'The message was not fatal!' if TALK_DEBUG; |
731
|
|
|
|
|
|
|
}else{ |
732
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 1, |
733
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::master_talk::_really_report', |
734
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "The report name -$report_ref->{report}- does not have any destination instances to use!" ], } ); |
735
|
|
|
|
|
|
|
} |
736
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 2, |
737
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::master_talk::_really_report', |
738
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "Message was reported -$x- times" ], } ); |
739
|
57
|
|
|
|
|
166
|
return $x; |
740
|
|
|
|
|
|
|
} |
741
|
|
|
|
|
|
|
|
742
|
|
|
|
|
|
|
sub _is_fatal{ |
743
|
94
|
|
|
54
|
|
5465
|
my ( $self, $data_ref ) = @_;#, $recursion |
744
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 2, |
745
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::master_talk::_is_fatal', |
746
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "Arrived at _is_fatal to see if urgency -$data_ref->{level}- equals fatal", ], } ); |
747
|
95
|
100
|
|
|
|
307
|
if( $data_ref->{level} =~ /fatal/i ){ |
748
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 3, |
749
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::master_talk::_is_fatal', |
750
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "Checking which message to send based on the message content:", $data_ref->{message} ], } ); |
751
|
|
|
|
|
|
|
#~ $self->_set_message_recursion_block( $recursion );# Early return so cleanup needed (for the case of an eval'd fatal) |
752
|
83
|
|
|
|
|
211
|
my $fatality = ''; |
753
|
42
|
|
|
|
|
42
|
my $empty = "Fatal call sent to the switchboard"; |
754
|
3
|
100
|
|
|
|
14
|
if(!$data_ref->{message} ){ |
755
|
43
|
|
|
|
|
160
|
$fatality = $empty; |
756
|
|
|
|
|
|
|
}else{ |
757
|
42
|
|
|
|
|
90
|
my $i = 0; |
758
|
0
|
|
|
|
|
0
|
for my $element ( @{$data_ref->{message}} ){ |
|
1
|
|
|
|
|
2
|
|
759
|
1
|
50
|
33
|
|
|
1
|
if( !$element or length( $element ) == 0 ){ |
|
|
0
|
|
|
|
|
|
760
|
|
|
|
|
|
|
}elsif( $i ){ |
761
|
1
|
0
|
|
|
|
3
|
$fatality .= "\n" . ( ref $element ? Dumper( $element ) : $element ); |
762
|
1
|
|
|
|
|
4
|
$i++; |
763
|
|
|
|
|
|
|
}else{ |
764
|
0
|
0
|
|
|
|
0
|
$fatality = "\n" . ( ref $element ? Dumper( $element ) : $element ); |
765
|
0
|
|
|
|
|
0
|
$i++; |
766
|
|
|
|
|
|
|
} |
767
|
|
|
|
|
|
|
} |
768
|
0
|
50
|
|
|
|
0
|
$fatality .= length( $fatality ) > 0 ? "<- sent at a 'fatal' level" : $empty ; |
769
|
|
|
|
|
|
|
} |
770
|
1
|
|
|
|
|
125
|
confess( $fatality ); |
771
|
|
|
|
|
|
|
} |
772
|
13
|
|
|
|
|
16
|
return 1; |
773
|
|
|
|
|
|
|
} |
774
|
|
|
|
|
|
|
|
775
|
|
|
|
|
|
|
sub _get_block_unblock_levels{ |
776
|
175
|
|
|
174
|
|
285
|
my ( $self, $level_ref, $space_ref ) = @_; |
777
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 1, |
778
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::master_talk::_can_communicate::_get_block_unblock_levels', |
779
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ 'Arrived at _get_block_unblock_levels for:', $space_ref, |
780
|
|
|
|
|
|
|
###InternalSwitchboarD 'Received the level ref:', $level_ref ], } ); |
781
|
214
|
100
|
|
|
|
492
|
if( exists $space_ref->{UNBLOCK} ){ |
782
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 1, |
783
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::master_talk::_can_communicate::_get_block_unblock_levels', |
784
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ 'Found an UNBLOCK at this level:', $space_ref->{UNBLOCK} ], } ); |
785
|
169
|
|
|
|
|
329
|
for my $report ( keys %{$space_ref->{UNBLOCK}} ){ |
|
48
|
|
|
|
|
139
|
|
786
|
64
|
|
|
|
|
97
|
$level_ref->{$report} = $space_ref->{UNBLOCK}->{$report}; |
787
|
|
|
|
|
|
|
} |
788
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 1, |
789
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::master_talk::_can_communicate::_get_block_unblock_levels', |
790
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ 'level ref with UNBLOCK changes:', $level_ref ], } ); |
791
|
|
|
|
|
|
|
} |
792
|
53
|
50
|
|
|
|
118
|
if( exists $space_ref->{BLOCK} ){ |
793
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 1, |
794
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::master_talk::_can_communicate::_get_block_unblock_levels', |
795
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ 'Found an BLOCK at this level:', $space_ref->{BLOCK} ], } ); |
796
|
38
|
|
|
|
|
64
|
for my $report ( keys %{$space_ref->{BLOCK}} ){ |
|
18
|
|
|
|
|
65
|
|
797
|
139
|
|
|
|
|
207
|
delete $level_ref->{$report}; |
798
|
|
|
|
|
|
|
} |
799
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 1, |
800
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::master_talk::_can_communicate::_get_block_unblock_levels', |
801
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ 'level ref with BLOCK changes:', $level_ref ], } ); |
802
|
|
|
|
|
|
|
} |
803
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 0, |
804
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::master_talk::_can_communicate::_get_block_unblock_levels', |
805
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ 'Returning the level ref:', $level_ref ], } ); |
806
|
35
|
|
|
|
|
42
|
return $level_ref; |
807
|
|
|
|
|
|
|
} |
808
|
|
|
|
|
|
|
|
809
|
|
|
|
|
|
|
sub _convert_level_name_to_number{ |
810
|
64
|
|
|
64
|
|
89
|
my ( $self, $level, $report ) = @_; |
811
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 0, |
812
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::master_talk::_convert_level_name_to_number', |
813
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "Arrived at _convert_level_name_to_number with level -$level" ], } ); |
814
|
64
|
|
|
|
|
144
|
my $x = 0; |
815
|
64
|
100
|
|
|
|
127
|
if( is_ElevenInt( $level ) ){ |
816
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 0, |
817
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::master_talk::_convert_level_name_to_number', |
818
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "-$level- is already an integer in the correct range." ], } ); |
819
|
45
|
|
|
|
|
136
|
$x = $level; |
820
|
|
|
|
|
|
|
}else{ |
821
|
172
|
50
|
|
|
|
3448
|
my $level_ref = ( !$report ) ? [ @default_levels ] : |
|
|
50
|
|
|
|
|
|
822
|
|
|
|
|
|
|
( $self->has_log_levels( $report ) ) ? $self->get_log_levels( $report ) : |
823
|
|
|
|
|
|
|
[ @default_levels ] ; |
824
|
172
|
50
|
|
|
|
684
|
if( !$level_ref ){ |
825
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 4, |
826
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::master_talk::_convert_level_name_to_number', |
827
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "After trying several options no level list could be isolated for report -" . |
828
|
|
|
|
|
|
|
###InternalSwitchboarD $report . "-. Level -" . ( $level // 'UNDEFINED' ) . |
829
|
|
|
|
|
|
|
###InternalSwitchboarD "- will be set to 0 (These go to eleven)" ], } ); |
830
|
|
|
|
|
|
|
}else{ |
831
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 1, |
832
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::master_talk::_convert_level_name_to_number', |
833
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ 'Checking for a match for -$level- in the level ref:', $level_ref ], } ); |
834
|
39
|
|
|
|
|
3324
|
my $found = 0; |
835
|
39
|
|
|
|
|
449
|
for my $word ( @$level_ref ){ |
836
|
92
|
100
|
100
|
|
|
605
|
if( $word and $level =~ /^$word$/i ){ |
837
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 2, |
838
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::master_talk::_convert_level_name_to_number', |
839
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "Level word -$word- matches passed level: $level" ], } ); |
840
|
39
|
|
|
|
|
106
|
$found = 1; |
841
|
39
|
|
|
|
|
61
|
last; |
842
|
|
|
|
|
|
|
} |
843
|
93
|
|
|
|
|
91
|
$x++; |
844
|
|
|
|
|
|
|
} |
845
|
103
|
50
|
|
|
|
663
|
if( !$found ){ |
846
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 3, |
847
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::master_talk::_convert_level_name_to_number', |
848
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "No match was found for the level -$level-" . |
849
|
|
|
|
|
|
|
###InternalSwitchboarD " assigned to the report -$report-", ], } ); |
850
|
20
|
|
|
|
|
83
|
$x = 0; |
851
|
|
|
|
|
|
|
} |
852
|
|
|
|
|
|
|
} |
853
|
|
|
|
|
|
|
} |
854
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 1, |
855
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::master_talk::_convert_level_name_to_number', |
856
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "Returning -$level- as the integer: $x" ], } ); |
857
|
50
|
|
|
|
|
79
|
return $x; |
858
|
|
|
|
|
|
|
} |
859
|
|
|
|
|
|
|
|
860
|
|
|
|
|
|
|
before stop_buffering => sub{ |
861
|
|
|
|
|
|
|
my ( $self, @buffer_list ) = @_; |
862
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 1, |
863
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::stop_buffering', |
864
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "Action 'before' clearing the buffers:", @buffer_list ], } ); |
865
|
|
|
|
|
|
|
for my $report ( @buffer_list ){ |
866
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 1, |
867
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::stop_buffering', |
868
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "Checking the buffers for report: $report" ], } ); |
869
|
|
|
|
|
|
|
if( $self->has_buffer( $report) ){ |
870
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 1, |
871
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::stop_buffering', |
872
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "Flushing the buffer for: $report" ], } ); |
873
|
|
|
|
|
|
|
$self->send_buffer_to_output( $report ); |
874
|
|
|
|
|
|
|
} |
875
|
|
|
|
|
|
|
} |
876
|
|
|
|
|
|
|
return @buffer_list; |
877
|
|
|
|
|
|
|
}; |
878
|
|
|
|
|
|
|
|
879
|
|
|
|
|
|
|
before set_all_buffering => sub{ |
880
|
|
|
|
|
|
|
my ( $self, $buffer_ref ) = @_; |
881
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 1, |
882
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::set_all_buffering', |
883
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "Setting up new buffers:", $buffer_ref, $self->_get_buffer_list ], } ); |
884
|
|
|
|
|
|
|
for my $report ( $self->_get_buffer_list ){ |
885
|
|
|
|
|
|
|
###InternalSwitchboarD $self->master_talk( { report => 'log_file', level => 1, |
886
|
|
|
|
|
|
|
###InternalSwitchboarD name_space => 'Log::Shiras::Switchboard::set_all_buffering', |
887
|
|
|
|
|
|
|
###InternalSwitchboarD message =>[ "Flushing the buffer for: $report" ], } ); |
888
|
|
|
|
|
|
|
$self->send_buffer_to_output( $report ); |
889
|
|
|
|
|
|
|
} |
890
|
|
|
|
|
|
|
return $buffer_ref; |
891
|
|
|
|
|
|
|
}; |
892
|
|
|
|
|
|
|
|
893
|
|
|
|
|
|
|
after '_set_whole_name_space' => sub{ __PACKAGE__->_clear_can_communicate_cash }; |
894
|
|
|
|
|
|
|
|
895
|
|
|
|
|
|
|
sub _build_data_walker{ |
896
|
25
|
|
|
5
|
|
37
|
my ( $self, ) = @_; |
897
|
|
|
|
|
|
|
###InternalSwitchboarD warn "Arrived at _build_data_walker" if IMPORT_DEBUG; |
898
|
69
|
|
|
|
|
108
|
return build_instance( |
899
|
|
|
|
|
|
|
package => 'Walker', |
900
|
|
|
|
|
|
|
superclasses => ['Data::Walk::Extracted',], |
901
|
|
|
|
|
|
|
roles =>[ |
902
|
|
|
|
|
|
|
'Data::Walk::Graft', |
903
|
|
|
|
|
|
|
'Data::Walk::Clone', |
904
|
|
|
|
|
|
|
'Data::Walk::Prune', |
905
|
|
|
|
|
|
|
'Data::Walk::Print', |
906
|
|
|
|
|
|
|
], |
907
|
|
|
|
|
|
|
skipped_nodes =>{ |
908
|
|
|
|
|
|
|
OBJECT => 1, |
909
|
|
|
|
|
|
|
CODEREF => 1, |
910
|
|
|
|
|
|
|
}, |
911
|
|
|
|
|
|
|
to_string => 1, |
912
|
|
|
|
|
|
|
); |
913
|
|
|
|
|
|
|
} |
914
|
|
|
|
|
|
|
|
915
|
|
|
|
|
|
|
#~ sub DEMOLISH{ |
916
|
|
|
|
|
|
|
#~ my ( $self ) = @_; |
917
|
|
|
|
|
|
|
#~ } |
918
|
|
|
|
|
|
|
|
919
|
|
|
|
|
|
|
#########1 Phinish 3#########4#########5#########6#########7#########8#########9 |
920
|
|
|
|
|
|
|
|
921
|
5
|
|
|
5
|
|
29
|
no MooseX::Singleton; |
|
5
|
|
|
|
|
5
|
|
|
5
|
|
|
|
|
49
|
|
922
|
|
|
|
|
|
|
__PACKAGE__->meta->make_immutable; |
923
|
|
|
|
|
|
|
|
924
|
|
|
|
|
|
|
1; |
925
|
|
|
|
|
|
|
# The preceding line will help the module return a true value |
926
|
|
|
|
|
|
|
|
927
|
|
|
|
|
|
|
#########1 main pod docs 3#########4#########5#########6#########7#########8#########9 |
928
|
|
|
|
|
|
|
|
929
|
|
|
|
|
|
|
__END__ |
930
|
|
|
|
|
|
|
|
931
|
|
|
|
|
|
|
=head1 NAME |
932
|
|
|
|
|
|
|
|
933
|
|
|
|
|
|
|
Log::Shiras::Switchboard - Log::Shiras message screening and delivery |
934
|
|
|
|
|
|
|
|
935
|
|
|
|
|
|
|
=head1 DESCRIPTION |
936
|
|
|
|
|
|
|
|
937
|
|
|
|
|
|
|
L<Shiras|http://en.wikipedia.org/wiki/Moose#Subspecies> - A small subspecies of |
938
|
|
|
|
|
|
|
Moose found in the western United States (of America). |
939
|
|
|
|
|
|
|
|
940
|
|
|
|
|
|
|
This is the class for message traffic control in the 'Log::Shiras' package. For a |
941
|
|
|
|
|
|
|
general overview of the whole package see L<the top level documentation |
942
|
|
|
|
|
|
|
|Log::Shiras>. Traffic is managed using name spaces. For the purposes of logging this |
943
|
|
|
|
|
|
|
package uses three types of name space with an additional wrapper. The first name space |
944
|
|
|
|
|
|
|
is the source code name space. This name space is managed by putting labeled comment |
945
|
|
|
|
|
|
|
tags in the code and then exposing them with a source code filter. This is mostly used |
946
|
|
|
|
|
|
|
when you want to have debug code available that does not impact your regular runs of the |
947
|
|
|
|
|
|
|
code. This space is managed by L<Log::Shiras::Unhide>. The source code name space is a |
948
|
|
|
|
|
|
|
flat list. The next name space is the caller name space. The caller name space is |
949
|
|
|
|
|
|
|
assigned in the code with targeted embedded statements to the L<master_talk |
950
|
|
|
|
|
|
|
|/master_talk( $args_ref )> method. Boilerplate for managing these calls can be found |
951
|
|
|
|
|
|
|
in L<Log::Shiras::Telephone>. If you wish to inject name_space modifications from the |
952
|
|
|
|
|
|
|
calling script you can use the role L<Log::Shiras::LogSpace>. The caller namespace can |
953
|
|
|
|
|
|
|
be heirarchical and represented by a Hash of hashrefs. The final name space is the |
954
|
|
|
|
|
|
|
destination or L<report|/reports> namespace. This namespace is flat but each position can contain |
955
|
|
|
|
|
|
|
more than one actual report. Any message to a specific report name is sent to all reports |
956
|
|
|
|
|
|
|
assigned to that name. Managing the traffic between the caller name space and the report |
957
|
|
|
|
|
|
|
name space is done by setting allowed L<urgency|/logging_levels> levels in the |
958
|
|
|
|
|
|
|
L<name space bounds|/name_space_bounds>., urgency levels, and report names. |
959
|
|
|
|
|
|
|
|
960
|
|
|
|
|
|
|
In order to stich all this together at run time this is a singleton class and so |
961
|
|
|
|
|
|
|
'new' is the wrong way to get a new instance of this class. The right way is to use the |
962
|
|
|
|
|
|
|
method L<get_operator|/get_operator( %args )>. The upside of using a singleton is you |
963
|
|
|
|
|
|
|
can write a caller (message source) with an intended urgency and destination name and not |
964
|
|
|
|
|
|
|
build the actual destination till run time. |
965
|
|
|
|
|
|
|
|
966
|
|
|
|
|
|
|
=head2 Initialization |
967
|
|
|
|
|
|
|
|
968
|
|
|
|
|
|
|
This class does not use ->new. Use 'get_operator' instead. |
969
|
|
|
|
|
|
|
|
970
|
|
|
|
|
|
|
=head3 get_operator( %args ) |
971
|
|
|
|
|
|
|
|
972
|
|
|
|
|
|
|
=over |
973
|
|
|
|
|
|
|
|
974
|
|
|
|
|
|
|
B<Definition:> This method replaces the call to -E<gt>new or other instantiation |
975
|
|
|
|
|
|
|
methods. The Log::Shiras::Switchboard class is a L<MooseX::Singleton |
976
|
|
|
|
|
|
|
|https://metacpan.org/module/MooseX::Singleton> and as such needs to be called in a |
977
|
|
|
|
|
|
|
slightly different fashion. This method can be used to either connect to the existing |
978
|
|
|
|
|
|
|
switchboard or start the switchboard with new settings. Each call to this method will |
979
|
|
|
|
|
|
|
implement the settings passed in %args merging them with any pre-existing settings. |
980
|
|
|
|
|
|
|
Where pre-existing settings disagree with new settings the new settings take |
981
|
|
|
|
|
|
|
precedence. So be careful! |
982
|
|
|
|
|
|
|
|
983
|
|
|
|
|
|
|
B<Accepts:> [%args|$args_ref|full/file/path.(json|yml)] %args are treated the same |
984
|
|
|
|
|
|
|
as attributes passed to other class style calls to new. The data can either be |
985
|
|
|
|
|
|
|
passed as a fat comma list or a hashref. If this method receives a string it will |
986
|
|
|
|
|
|
|
try to treat it like a full file path to a JSON or YAML file with the equivalent |
987
|
|
|
|
|
|
|
$args_ref stored. See L<conf_file|/conf_file> to pass a file path and arguments. |
988
|
|
|
|
|
|
|
|
989
|
|
|
|
|
|
|
B<Returns:> an instance of the Log::Shiras::Switchboard class called an 'operator'. |
990
|
|
|
|
|
|
|
This operator can act on the switchboard to perform any of the methods including |
991
|
|
|
|
|
|
|
any attribute access methods. |
992
|
|
|
|
|
|
|
|
993
|
|
|
|
|
|
|
=back |
994
|
|
|
|
|
|
|
|
995
|
|
|
|
|
|
|
=head2 Attributes |
996
|
|
|
|
|
|
|
|
997
|
|
|
|
|
|
|
Data passed to L<get_operator|/get_operator( %args )> when creating an instance. For |
998
|
|
|
|
|
|
|
modification of these attributes see the remaining L<Methods|/Methods> |
999
|
|
|
|
|
|
|
used to act on the operator. B<DO NOT USE 'Log::Shiras::Switchboard-E<gt>new' to get |
1000
|
|
|
|
|
|
|
a new class instance> |
1001
|
|
|
|
|
|
|
|
1002
|
|
|
|
|
|
|
=head3 name_space_bounds |
1003
|
|
|
|
|
|
|
|
1004
|
|
|
|
|
|
|
=over |
1005
|
|
|
|
|
|
|
|
1006
|
|
|
|
|
|
|
B<Definition:> This attribute stores the boundaries set for the name-space management of |
1007
|
|
|
|
|
|
|
communications (generally from L<Log::Shiras::Telephone>) message data sources. This |
1008
|
|
|
|
|
|
|
value ref defines where in the name-space, to which L<reports|/reports>, and at L<what |
1009
|
|
|
|
|
|
|
urgency level|/logging_levels> messages are allows to pass. Name spaces are stored as |
1010
|
|
|
|
|
|
|
a L<hash of hashes|http://perldoc.perl.org/perldsc.html#HASHES-OF-HASHES> that goes as |
1011
|
|
|
|
|
|
|
deep as needed. To send a message between a specific caller name-space and a named |
1012
|
|
|
|
|
|
|
'report' destination this hash ref tree must have the key 'UNBLOCK' at or below the |
1013
|
|
|
|
|
|
|
target name space in the hashref tree. The UNBLOCK key must have as a value a hashref |
1014
|
|
|
|
|
|
|
with report names as keys and the minimum allowed L<pass level|/logging_levels> as the |
1015
|
|
|
|
|
|
|
value. That(ose) report(s) then remain(s) open to communication farther out on the |
1016
|
|
|
|
|
|
|
caller name space branch until a new UNBLOCK key sets different permission level or |
1017
|
|
|
|
|
|
|
a 'BLOCK' key is implemented. The difference between a BLOCK and UNBLOCK key is that |
1018
|
|
|
|
|
|
|
a BLOCK key value only needs to contain report keys (the key values are unimportant). |
1019
|
|
|
|
|
|
|
Any level assigned to the report name by a BLOCK key is ignored and all communication |
1020
|
|
|
|
|
|
|
at that point and further in the branch is cut off all for all deeper levels of the |
1021
|
|
|
|
|
|
|
name space branch for that report. There are a couple of significant points for review; |
1022
|
|
|
|
|
|
|
|
1023
|
|
|
|
|
|
|
=over |
1024
|
|
|
|
|
|
|
|
1025
|
|
|
|
|
|
|
B<*> UNBLOCK and BLOCK should not be used as branch of the telephone name-space tree |
1026
|
|
|
|
|
|
|
|
1027
|
|
|
|
|
|
|
B<*> If a caller name-space is not listed here or a report name is not explicitly |
1028
|
|
|
|
|
|
|
UNBLOCKed then the message is blocked by default. |
1029
|
|
|
|
|
|
|
|
1030
|
|
|
|
|
|
|
B<*> Even though 'log_file' is the default report it is not 'UNBLOCK'ed by default. |
1031
|
|
|
|
|
|
|
It must be explicitly UNBLOCKed to be used. |
1032
|
|
|
|
|
|
|
|
1033
|
|
|
|
|
|
|
B<*> UNBLOCKing or BLOCKing of a report can occur independant of it's existance. |
1034
|
|
|
|
|
|
|
This allows the addition of a report later and have it work upon its creation. |
1035
|
|
|
|
|
|
|
|
1036
|
|
|
|
|
|
|
B<*> If an UNBLOCK and BLOCK key exist at the same point in a name space then |
1037
|
|
|
|
|
|
|
the hashref associated with the UNBLOCK key is evaluated first and the hashref |
1038
|
|
|
|
|
|
|
associated with the BLOCK key is evaluated second. This means that the BLOCK |
1039
|
|
|
|
|
|
|
command can negate a report UNBLOCKing level. |
1040
|
|
|
|
|
|
|
|
1041
|
|
|
|
|
|
|
B<*> Any name space on the same branch (but deeper) than an UNBLOCK command remains |
1042
|
|
|
|
|
|
|
UNBLOCKed for the listed report urgency levels until a deeper UNBLOCK or BLOCK is |
1043
|
|
|
|
|
|
|
registered for that report. |
1044
|
|
|
|
|
|
|
|
1045
|
|
|
|
|
|
|
B<*> When UNBLOCKing a report at a deeper level than an initial UNBLOCK setting |
1046
|
|
|
|
|
|
|
the new level can be set higher or lower than the initial setting. |
1047
|
|
|
|
|
|
|
|
1048
|
|
|
|
|
|
|
B<*> BLOCK commands are only valuable deeper than an initial UNBLOCK command. The |
1049
|
|
|
|
|
|
|
Tree trunk starts out 'BLOCK'ed by default. |
1050
|
|
|
|
|
|
|
|
1051
|
|
|
|
|
|
|
B<*> All BLOCK commands completly block the report(s) named for that point and |
1052
|
|
|
|
|
|
|
deeper independant of the urgency value associated with report name key in |
1053
|
|
|
|
|
|
|
the BLOCK hashref. |
1054
|
|
|
|
|
|
|
|
1055
|
|
|
|
|
|
|
B<*> The hash key whos hashref value contains an UNBLOCK hash key is the point in |
1056
|
|
|
|
|
|
|
the NameSpace where the report is UNBLOCKed to the defined level. |
1057
|
|
|
|
|
|
|
|
1058
|
|
|
|
|
|
|
=back |
1059
|
|
|
|
|
|
|
|
1060
|
|
|
|
|
|
|
B<Default> all caller name-spaces are blocked (no reporting) |
1061
|
|
|
|
|
|
|
|
1062
|
|
|
|
|
|
|
B<Range> The caller name-space is stored and searched as a hash of hashes. No |
1063
|
|
|
|
|
|
|
array refs will be correctly read as any part of the name-space definition. At each |
1064
|
|
|
|
|
|
|
level of the name-space the switchboard will also recognize the special keys 'UNBLOCK' |
1065
|
|
|
|
|
|
|
and 'BLOCK' I<in that order>. As a consequence UNBLOCK and BLOCK are not supported as |
1066
|
|
|
|
|
|
|
name-space elements. Each UNBLOCK (or BLOCK) key should have a hash ref of L<report |
1067
|
|
|
|
|
|
|
|/reports> name keys as it's value. The hash ref of report name keys should contain |
1068
|
|
|
|
|
|
|
the minimum allowed urgency level down to which the report is UNBLOCKed. The value |
1069
|
|
|
|
|
|
|
associated with any report key in a BLOCK hash ref is not tested since BLOCK closes |
1070
|
|
|
|
|
|
|
all reporting from that point and deeper. |
1071
|
|
|
|
|
|
|
|
1072
|
|
|
|
|
|
|
B<Example> |
1073
|
|
|
|
|
|
|
|
1074
|
|
|
|
|
|
|
name_space_bounds =>{ |
1075
|
|
|
|
|
|
|
Name =>{#<-- name-space |
1076
|
|
|
|
|
|
|
Space =>{#<-- name-space |
1077
|
|
|
|
|
|
|
UNBLOCK =>{#<-- Telephone name-space 'Name::Space' is unblocked |
1078
|
|
|
|
|
|
|
log_file => 'warn'#<-- but only for calls to the 'log_file' report |
1079
|
|
|
|
|
|
|
}, # with an urgency of 'warn' or greater |
1080
|
|
|
|
|
|
|
Boundary =>{#<-- name-space |
1081
|
|
|
|
|
|
|
UNBLOCK =>{#<-- The deeper space 'Name::Space::Boundary' receives a new setting |
1082
|
|
|
|
|
|
|
log_file => 'trace',#<-- messages are allowed at 'trace' urgency now |
1083
|
|
|
|
|
|
|
special_report => 'eleven',<-- a new report and level are added |
1084
|
|
|
|
|
|
|
}, |
1085
|
|
|
|
|
|
|
Place =>{},<-- deeper name-space - log_file permissions still 'trace' |
1086
|
|
|
|
|
|
|
}, |
1087
|
|
|
|
|
|
|
}, |
1088
|
|
|
|
|
|
|
}, |
1089
|
|
|
|
|
|
|
} |
1090
|
|
|
|
|
|
|
|
1091
|
|
|
|
|
|
|
B<Warning> All active name-space boundaries must coexist in the singleton. There |
1092
|
|
|
|
|
|
|
is only one master name-space for the singleton. New calls for object intances can |
1093
|
|
|
|
|
|
|
overwrite existing object instances name-space boundaries. No cross instance name-space |
1094
|
|
|
|
|
|
|
protection is done. This requires conscious managment! I<It is entirely possible to call |
1095
|
|
|
|
|
|
|
for another operator in the same program space with overlapping name-space boundaries that |
1096
|
|
|
|
|
|
|
changes reporting for a callers originally used in the context of the original operator.> |
1097
|
|
|
|
|
|
|
|
1098
|
|
|
|
|
|
|
B<attribute methods> Methods provided to adjust this attribute |
1099
|
|
|
|
|
|
|
|
1100
|
|
|
|
|
|
|
=over |
1101
|
|
|
|
|
|
|
|
1102
|
|
|
|
|
|
|
B<get_name_space> |
1103
|
|
|
|
|
|
|
|
1104
|
|
|
|
|
|
|
=over |
1105
|
|
|
|
|
|
|
|
1106
|
|
|
|
|
|
|
B<Definition:> Returns the full program namespace |
1107
|
|
|
|
|
|
|
|
1108
|
|
|
|
|
|
|
=back |
1109
|
|
|
|
|
|
|
|
1110
|
|
|
|
|
|
|
=back |
1111
|
|
|
|
|
|
|
|
1112
|
|
|
|
|
|
|
=back |
1113
|
|
|
|
|
|
|
|
1114
|
|
|
|
|
|
|
=head3 reports |
1115
|
|
|
|
|
|
|
|
1116
|
|
|
|
|
|
|
=over |
1117
|
|
|
|
|
|
|
|
1118
|
|
|
|
|
|
|
B<Definition:> This attribute stores report names and associated composed class |
1119
|
|
|
|
|
|
|
instances for that name. The attribute expects a L<hash of arrays |
1120
|
|
|
|
|
|
|
|http://perldoc.perl.org/perldsc.html#HASHES-OF-ARRAYS>. Each hash key is the |
1121
|
|
|
|
|
|
|
report name and the array contains the report instances associated with that name. Each |
1122
|
|
|
|
|
|
|
passed array object will be tested to see if it is an object that can( 'add_line' ). |
1123
|
|
|
|
|
|
|
If not this code will try to coerce the passed reference at the array position into an |
1124
|
|
|
|
|
|
|
object using L<MooseX::ShortCut::BuildInstance>. |
1125
|
|
|
|
|
|
|
|
1126
|
|
|
|
|
|
|
B<Default> no reports are active. If a message is sent to a non-existant report |
1127
|
|
|
|
|
|
|
name then nothing happens unless L<self reporting|Log::Shiras::Unhide> is fully enabled. |
1128
|
|
|
|
|
|
|
Then it is possible to collect various warning messages related to the failure of a |
1129
|
|
|
|
|
|
|
message. |
1130
|
|
|
|
|
|
|
|
1131
|
|
|
|
|
|
|
B<Example> |
1132
|
|
|
|
|
|
|
|
1133
|
|
|
|
|
|
|
reports =>{ |
1134
|
|
|
|
|
|
|
log_file =>[<-- report name |
1135
|
|
|
|
|
|
|
Print::Wisper->new,#<-- a reporting instance of a class ( see Synopsis ) |
1136
|
|
|
|
|
|
|
{#<-- MooseX::ShortCut::BuildInstance definition for a different report |
1137
|
|
|
|
|
|
|
package => 'Print::Excited',#<-- name this (new) class |
1138
|
|
|
|
|
|
|
add_methods =>{ |
1139
|
|
|
|
|
|
|
add_line => sub{#<-- ensure it has an 'add_line' method |
1140
|
|
|
|
|
|
|
shift; |
1141
|
|
|
|
|
|
|
my @input = ( ref $_[0]->{message} eq 'ARRAY' ) ? |
1142
|
|
|
|
|
|
|
@{$_[0]->{message}} : $_[0]->{message}; |
1143
|
|
|
|
|
|
|
my @new_list; |
1144
|
|
|
|
|
|
|
map{ push @new_list, $_ if $_ } @input; |
1145
|
|
|
|
|
|
|
chomp @new_list; |
1146
|
|
|
|
|
|
|
print '!!!' . uc(join( ' ', @new_list)) . "!!!\n"; |
1147
|
|
|
|
|
|
|
} |
1148
|
|
|
|
|
|
|
}, |
1149
|
|
|
|
|
|
|
} |
1150
|
|
|
|
|
|
|
], |
1151
|
|
|
|
|
|
|
other_name =>[],#<-- name created but no report instances added (maybe later?) |
1152
|
|
|
|
|
|
|
}, |
1153
|
|
|
|
|
|
|
|
1154
|
|
|
|
|
|
|
B<warning:> any re-definition of the outputs for a report name will only push the new |
1155
|
|
|
|
|
|
|
report instance onto the existing report array ref. To remove an existing report output |
1156
|
|
|
|
|
|
|
instance you must L<delete|/remove_reports( @report_list )> all report instances and the |
1157
|
|
|
|
|
|
|
report name and then re-implement the report name and it's outputs. |
1158
|
|
|
|
|
|
|
|
1159
|
|
|
|
|
|
|
B<attribute methods> Methods provided to adjust this attribute |
1160
|
|
|
|
|
|
|
|
1161
|
|
|
|
|
|
|
=over |
1162
|
|
|
|
|
|
|
|
1163
|
|
|
|
|
|
|
B<get_reports> |
1164
|
|
|
|
|
|
|
|
1165
|
|
|
|
|
|
|
=over |
1166
|
|
|
|
|
|
|
|
1167
|
|
|
|
|
|
|
B<Definition:> Returns the full report hashref of arrays |
1168
|
|
|
|
|
|
|
|
1169
|
|
|
|
|
|
|
=back |
1170
|
|
|
|
|
|
|
|
1171
|
|
|
|
|
|
|
B<has_no_reports( $report )> |
1172
|
|
|
|
|
|
|
|
1173
|
|
|
|
|
|
|
=over |
1174
|
|
|
|
|
|
|
|
1175
|
|
|
|
|
|
|
B<Definition:> Checks if the $report requested has a key in the hashref |
1176
|
|
|
|
|
|
|
|
1177
|
|
|
|
|
|
|
=back |
1178
|
|
|
|
|
|
|
|
1179
|
|
|
|
|
|
|
B<get_report( $report )> |
1180
|
|
|
|
|
|
|
|
1181
|
|
|
|
|
|
|
=over |
1182
|
|
|
|
|
|
|
|
1183
|
|
|
|
|
|
|
B<Definition:> Returns the array ref of stored report objects for that $report |
1184
|
|
|
|
|
|
|
|
1185
|
|
|
|
|
|
|
=back |
1186
|
|
|
|
|
|
|
|
1187
|
|
|
|
|
|
|
B<remove_reports( $report1 [, $report2] )> |
1188
|
|
|
|
|
|
|
|
1189
|
|
|
|
|
|
|
=over |
1190
|
|
|
|
|
|
|
|
1191
|
|
|
|
|
|
|
B<Definition:> Deletes all storeage (and use of) $report1 etc. |
1192
|
|
|
|
|
|
|
|
1193
|
|
|
|
|
|
|
=back |
1194
|
|
|
|
|
|
|
|
1195
|
|
|
|
|
|
|
=back |
1196
|
|
|
|
|
|
|
|
1197
|
|
|
|
|
|
|
=back |
1198
|
|
|
|
|
|
|
|
1199
|
|
|
|
|
|
|
=head3 logging_levels |
1200
|
|
|
|
|
|
|
|
1201
|
|
|
|
|
|
|
=over |
1202
|
|
|
|
|
|
|
|
1203
|
|
|
|
|
|
|
B<Definition:> Each report name recognizes 12 different logging levels [0..11] |
1204
|
|
|
|
|
|
|
(L<They go to 11! |
1205
|
|
|
|
|
|
|
|http://en.wikipedia.org/wiki/Up_to_eleven#Original_scene_from_This_Is_Spinal_Tap> :). Each |
1206
|
|
|
|
|
|
|
position within the logging levels can be assigned a name that is not case sensitive. |
1207
|
|
|
|
|
|
|
Either the position integer or the name assigned to that position can be used to describe |
1208
|
|
|
|
|
|
|
the urgency 'level'. Each message can be sent with name. The urgency level of a message |
1209
|
|
|
|
|
|
|
L<can be defined|master_talk( $args_ref )> for each sent message. If you do not wish to |
1210
|
|
|
|
|
|
|
use the default name for each logging position or you wish to name the logging positions |
1211
|
|
|
|
|
|
|
that are not named then use this attribute. Not all of the elements need to be defined. |
1212
|
|
|
|
|
|
|
There can be gaps between defined levels but counting undefined positions there can never |
1213
|
|
|
|
|
|
|
be more than 12 total positions in the level array. The priority or urgency is lowest |
1214
|
|
|
|
|
|
|
first to highest last on the list. Where requests sent with an urgency at or above the |
1215
|
|
|
|
|
|
|
permissions barrier will pass. Since there are default priority names already in place |
1216
|
|
|
|
|
|
|
this attribute is a window dressing setting and not much more. |
1217
|
|
|
|
|
|
|
|
1218
|
|
|
|
|
|
|
B<Default> The default array of priority / urgency levels is; |
1219
|
|
|
|
|
|
|
|
1220
|
|
|
|
|
|
|
'trace', 'debug', 'info', 'warn', 'error', 'fatal', |
1221
|
|
|
|
|
|
|
undef, undef, undef, undef, undef, 'eleven', |
1222
|
|
|
|
|
|
|
|
1223
|
|
|
|
|
|
|
Any report name without a custom priority array will use the default array. |
1224
|
|
|
|
|
|
|
|
1225
|
|
|
|
|
|
|
B<Example> |
1226
|
|
|
|
|
|
|
|
1227
|
|
|
|
|
|
|
logging_levels =>{ |
1228
|
|
|
|
|
|
|
log_file =>[ qw(<-- report name (others use the default list) |
1229
|
|
|
|
|
|
|
foo |
1230
|
|
|
|
|
|
|
bar |
1231
|
|
|
|
|
|
|
baz |
1232
|
|
|
|
|
|
|
fatal |
1233
|
|
|
|
|
|
|
) ], |
1234
|
|
|
|
|
|
|
} |
1235
|
|
|
|
|
|
|
|
1236
|
|
|
|
|
|
|
B<fatal> The Switchboard will L<confess|Carp/confess> for all messages sent with a |
1237
|
|
|
|
|
|
|
priority or urgency level that matches qr/fatal/i. The switchboard will fully dispatch |
1238
|
|
|
|
|
|
|
the message to it's intended report(s) prior to confessing the message. At this point |
1239
|
|
|
|
|
|
|
the script will die. If the message is not approved (even at the fatal level) then |
1240
|
|
|
|
|
|
|
nothing happens. 'fatal' can be set anywhere in the custom priority list from lowest |
1241
|
|
|
|
|
|
|
to highest but fatal is the only string that will die. (priorities higher than fatal |
1242
|
|
|
|
|
|
|
will not die) B<But>, if the message is blocked for the message I<name-space, report, |
1243
|
|
|
|
|
|
|
and level> then the code will NOT die.> If 'fatal' is the requested level from the |
1244
|
|
|
|
|
|
|
caller but it is not on the (custom) list for the report desination then the priority |
1245
|
|
|
|
|
|
|
of the message drops to 0 (trace equivalent) and that level of urgencie must be accepted |
1246
|
|
|
|
|
|
|
for the report to die. (even if the listed level at the 0 position is not 'fatal'). |
1247
|
|
|
|
|
|
|
|
1248
|
|
|
|
|
|
|
=back |
1249
|
|
|
|
|
|
|
|
1250
|
|
|
|
|
|
|
B<attribute methods> Methods provided to adjust this attribute |
1251
|
|
|
|
|
|
|
|
1252
|
|
|
|
|
|
|
=over |
1253
|
|
|
|
|
|
|
|
1254
|
|
|
|
|
|
|
B<has_log_levels( $report )> |
1255
|
|
|
|
|
|
|
|
1256
|
|
|
|
|
|
|
=over |
1257
|
|
|
|
|
|
|
|
1258
|
|
|
|
|
|
|
B<Definition:> Indicates if a custom log level list is stored for $report. |
1259
|
|
|
|
|
|
|
|
1260
|
|
|
|
|
|
|
=back |
1261
|
|
|
|
|
|
|
|
1262
|
|
|
|
|
|
|
B<add_log_levels( $report )> |
1263
|
|
|
|
|
|
|
|
1264
|
|
|
|
|
|
|
=over |
1265
|
|
|
|
|
|
|
|
1266
|
|
|
|
|
|
|
B<Definition:> Sets the log level name strings for $report |
1267
|
|
|
|
|
|
|
|
1268
|
|
|
|
|
|
|
B<Accepts:> the value must be an array ref of no more than 12 total positions |
1269
|
|
|
|
|
|
|
|
1270
|
|
|
|
|
|
|
=back |
1271
|
|
|
|
|
|
|
|
1272
|
|
|
|
|
|
|
B<remove_log_levels( $report1 [, $report2] )> |
1273
|
|
|
|
|
|
|
|
1274
|
|
|
|
|
|
|
=over |
1275
|
|
|
|
|
|
|
|
1276
|
|
|
|
|
|
|
B<Definition:> Removes the custom log_level list for the $report[s] |
1277
|
|
|
|
|
|
|
|
1278
|
|
|
|
|
|
|
=back |
1279
|
|
|
|
|
|
|
|
1280
|
|
|
|
|
|
|
B<set_all_log_levels( $full_hashref_of_arrayrefs )> |
1281
|
|
|
|
|
|
|
|
1282
|
|
|
|
|
|
|
=over |
1283
|
|
|
|
|
|
|
|
1284
|
|
|
|
|
|
|
B<Definition:> Completely resets all custom log levels to $full_hashref_of_arrayrefs |
1285
|
|
|
|
|
|
|
|
1286
|
|
|
|
|
|
|
=back |
1287
|
|
|
|
|
|
|
|
1288
|
|
|
|
|
|
|
B<get_all_log_levels> |
1289
|
|
|
|
|
|
|
|
1290
|
|
|
|
|
|
|
=over |
1291
|
|
|
|
|
|
|
|
1292
|
|
|
|
|
|
|
B<Definition:> Returns the full hashref of arrayrefs for all custom log levels |
1293
|
|
|
|
|
|
|
|
1294
|
|
|
|
|
|
|
=back |
1295
|
|
|
|
|
|
|
|
1296
|
|
|
|
|
|
|
=back |
1297
|
|
|
|
|
|
|
|
1298
|
|
|
|
|
|
|
=head3 all_buffering |
1299
|
|
|
|
|
|
|
|
1300
|
|
|
|
|
|
|
=over |
1301
|
|
|
|
|
|
|
|
1302
|
|
|
|
|
|
|
B<Definition:> Buffering in this package is only valuable if you want to eliminate some |
1303
|
|
|
|
|
|
|
of the sent messages after they were created. Buffering allows for clearing of sent |
1304
|
|
|
|
|
|
|
messages from between two save points. For this to occur buffering must be on and |
1305
|
|
|
|
|
|
|
L<flushing the buffer|/send_buffer_to_output( $report_name )> to the report need to |
1306
|
|
|
|
|
|
|
occur at all known good points. When some section of prior messages are to be discarded |
1307
|
|
|
|
|
|
|
then a L<clear_buffer|/clear_buffer( $report_name )> command can be sent and all buffered |
1308
|
|
|
|
|
|
|
messages after the last flush will be discarded. If buffering is turned off the |
1309
|
|
|
|
|
|
|
messages are sent directly to the report for processing with no holding period. This |
1310
|
|
|
|
|
|
|
attribute accepts a hash ref where the keys are report names and the values empty arrayrefs |
1311
|
|
|
|
|
|
|
You could theoretically pre-load your buffer here but it is not reccomended. If a new |
1312
|
|
|
|
|
|
|
instance of this class is called with an 'all_buffering' arg sent then it will flush any |
1313
|
|
|
|
|
|
|
pre-existing buffers (even if they are duplicated in the new call) then delete them and |
1314
|
|
|
|
|
|
|
set the new passed list fresh. |
1315
|
|
|
|
|
|
|
|
1316
|
|
|
|
|
|
|
B<Default> All buffering is off |
1317
|
|
|
|
|
|
|
|
1318
|
|
|
|
|
|
|
B<Example> |
1319
|
|
|
|
|
|
|
|
1320
|
|
|
|
|
|
|
buffering =>{ |
1321
|
|
|
|
|
|
|
log_file => [], |
1322
|
|
|
|
|
|
|
} |
1323
|
|
|
|
|
|
|
|
1324
|
|
|
|
|
|
|
B<attribute methods> Methods provided to adjust this attribute |
1325
|
|
|
|
|
|
|
|
1326
|
|
|
|
|
|
|
=over |
1327
|
|
|
|
|
|
|
|
1328
|
|
|
|
|
|
|
B<set_all_buffering( $hasref_of_arrayrefs )> |
1329
|
|
|
|
|
|
|
|
1330
|
|
|
|
|
|
|
=over |
1331
|
|
|
|
|
|
|
|
1332
|
|
|
|
|
|
|
B<Definition:> completely resets all buffers to $hasref_of_arrayrefs but flushes |
1333
|
|
|
|
|
|
|
all the old buffers first |
1334
|
|
|
|
|
|
|
|
1335
|
|
|
|
|
|
|
=back |
1336
|
|
|
|
|
|
|
|
1337
|
|
|
|
|
|
|
B<has_buffer( $report )> |
1338
|
|
|
|
|
|
|
|
1339
|
|
|
|
|
|
|
=over |
1340
|
|
|
|
|
|
|
|
1341
|
|
|
|
|
|
|
B<Definition:> Checks if there is an active buffer for $report |
1342
|
|
|
|
|
|
|
|
1343
|
|
|
|
|
|
|
=back |
1344
|
|
|
|
|
|
|
|
1345
|
|
|
|
|
|
|
B<stop_buffering( $report1 [, $report2] )> |
1346
|
|
|
|
|
|
|
|
1347
|
|
|
|
|
|
|
=over |
1348
|
|
|
|
|
|
|
|
1349
|
|
|
|
|
|
|
B<Definition:> Removes the buffer for the $report[s] (flushing them first) |
1350
|
|
|
|
|
|
|
|
1351
|
|
|
|
|
|
|
=back |
1352
|
|
|
|
|
|
|
|
1353
|
|
|
|
|
|
|
=back |
1354
|
|
|
|
|
|
|
|
1355
|
|
|
|
|
|
|
=back |
1356
|
|
|
|
|
|
|
|
1357
|
|
|
|
|
|
|
=head3 conf_file |
1358
|
|
|
|
|
|
|
|
1359
|
|
|
|
|
|
|
=over |
1360
|
|
|
|
|
|
|
|
1361
|
|
|
|
|
|
|
B<Definition:> It is possible to pass all the Attribute settings to L<get_operator |
1362
|
|
|
|
|
|
|
|/get_operator( %args )> as a config file. If you wish to mix your metaphores then |
1363
|
|
|
|
|
|
|
one of the attribute keys can be 'conf_file' with the value being the full file path |
1364
|
|
|
|
|
|
|
of a YAML or JSON file. If you pass other attributes and conf_file then where there |
1365
|
|
|
|
|
|
|
is conflict the other attributes overwrite the file settings. |
1366
|
|
|
|
|
|
|
|
1367
|
|
|
|
|
|
|
B<Default> nothing |
1368
|
|
|
|
|
|
|
|
1369
|
|
|
|
|
|
|
B<Accepts:> a full file path to a config file with attribute settings |
1370
|
|
|
|
|
|
|
|
1371
|
|
|
|
|
|
|
=back |
1372
|
|
|
|
|
|
|
|
1373
|
|
|
|
|
|
|
=head2 Methods |
1374
|
|
|
|
|
|
|
|
1375
|
|
|
|
|
|
|
These are methods used to adjust outcomes for the activities in the switchboard or to |
1376
|
|
|
|
|
|
|
leverage information held by the switchboard. |
1377
|
|
|
|
|
|
|
|
1378
|
|
|
|
|
|
|
=head3 master_talk( $args_ref ) |
1379
|
|
|
|
|
|
|
|
1380
|
|
|
|
|
|
|
=over |
1381
|
|
|
|
|
|
|
|
1382
|
|
|
|
|
|
|
B<Definition:> This is a way to directly call a report using the switchboard operator. In a |
1383
|
|
|
|
|
|
|
real telephone situation this would be that cool handset that the telephone repairman brought |
1384
|
|
|
|
|
|
|
with him. Like the Telephone repairman's phone it plugs in directly to the switchboard (or |
1385
|
|
|
|
|
|
|
in the repairmains case into a telephone line) and is a bit trickier to operate than absolutely |
1386
|
|
|
|
|
|
|
necessary. For a nicer message sending interface see L<Log::Shiras::Telephone>. When the |
1387
|
|
|
|
|
|
|
$args_ref message is received the switchboard will check the L<name_space_bounds |
1388
|
|
|
|
|
|
|
|/name_space_bounds> permissions. If the message passes that test then it will attach metadata |
1389
|
|
|
|
|
|
|
to to the $args_ref. The metadata attached to the message is a follows; |
1390
|
|
|
|
|
|
|
|
1391
|
|
|
|
|
|
|
date_time => The date and time the message was sent in CLDR format of 'yyyy-MM-dd hh:mm:ss' |
1392
|
|
|
|
|
|
|
|
1393
|
|
|
|
|
|
|
package => The package name of the message source |
1394
|
|
|
|
|
|
|
|
1395
|
|
|
|
|
|
|
filename => The (full) file name of the message source |
1396
|
|
|
|
|
|
|
|
1397
|
|
|
|
|
|
|
line => The line number of the message sourceIf and then test; |
1398
|
|
|
|
|
|
|
|
1399
|
|
|
|
|
|
|
Any L<message buffering|/all_buffering> is then handled or the message is sent to the report |
1400
|
|
|
|
|
|
|
name and each report in that name-space receives the $args_ref as the arguments to a call |
1401
|
|
|
|
|
|
|
$report->add_line( $args_ref ). When that is complete the message is checked to see if it |
1402
|
|
|
|
|
|
|
is fatal; |
1403
|
|
|
|
|
|
|
|
1404
|
|
|
|
|
|
|
$args_ref->{level} =~ /fatal/i |
1405
|
|
|
|
|
|
|
|
1406
|
|
|
|
|
|
|
I<If the message was buffered first the script will not die until the message was flushed into |
1407
|
|
|
|
|
|
|
the report from the buffer.> |
1408
|
|
|
|
|
|
|
|
1409
|
|
|
|
|
|
|
B<Returns:> The number of times the add_line call was made. There are some special cases. |
1410
|
|
|
|
|
|
|
|
1411
|
|
|
|
|
|
|
-3 = The call was not allowed by name_space permissions set in the switchboard |
1412
|
|
|
|
|
|
|
-2 = The message was buffered rather than sent to a report |
1413
|
|
|
|
|
|
|
-1 = The message was blocked as risking deep recursion |
1414
|
|
|
|
|
|
|
0 = The call had permissions but found no report implementations to connect with |
1415
|
|
|
|
|
|
|
1(and greater) = This indicates how many report instances received the message |
1416
|
|
|
|
|
|
|
|
1417
|
|
|
|
|
|
|
B<Accepts:> The passed args must be a HashRef and contain the following elements (any |
1418
|
|
|
|
|
|
|
others will be ignored by the switchboard but not stripped). |
1419
|
|
|
|
|
|
|
|
1420
|
|
|
|
|
|
|
=over |
1421
|
|
|
|
|
|
|
|
1422
|
|
|
|
|
|
|
B<name_space> the value is the caller name_space as used by L<name_space_bounds|/name_space_bounds> |
1423
|
|
|
|
|
|
|
|
1424
|
|
|
|
|
|
|
B<level> value is the urgency level of the message sent. It can either be an integer in the |
1425
|
|
|
|
|
|
|
set [0..11] or one of the L<defined logging level strings|/logging_levels>. |
1426
|
|
|
|
|
|
|
|
1427
|
|
|
|
|
|
|
B<report> the value is the L<report|/reports> name (destination) for the message ref |
1428
|
|
|
|
|
|
|
|
1429
|
|
|
|
|
|
|
B<message> the message key must have a value that is an array_ref. It is assumed that |
1430
|
|
|
|
|
|
|
content can be parsed into somthing else at the report level including any ArrayRef |
1431
|
|
|
|
|
|
|
sub-elements that may be Objects or hashrefs. |
1432
|
|
|
|
|
|
|
|
1433
|
|
|
|
|
|
|
B<carp_stack> if this key is passed and set to a true value then L<Carp> - longmess will |
1434
|
|
|
|
|
|
|
be run on the message and the results will be split on the newline and pushed onto the end |
1435
|
|
|
|
|
|
|
of the 'message' array_ref. |
1436
|
|
|
|
|
|
|
|
1437
|
|
|
|
|
|
|
B<source_sub> this key is generally handled in the background by Log::Shiras but if you |
1438
|
|
|
|
|
|
|
write a new caller subroutine to lay over 'master_talk' then providing that name to this |
1439
|
|
|
|
|
|
|
key will make the metada added to the message stop at the correct caller level. |
1440
|
|
|
|
|
|
|
|
1441
|
|
|
|
|
|
|
=over |
1442
|
|
|
|
|
|
|
|
1443
|
|
|
|
|
|
|
B<example> |
1444
|
|
|
|
|
|
|
|
1445
|
|
|
|
|
|
|
{ |
1446
|
|
|
|
|
|
|
name_space => 'MyCoolScript::my_subroutine', |
1447
|
|
|
|
|
|
|
level => 'warn', |
1448
|
|
|
|
|
|
|
report => 'log_file', |
1449
|
|
|
|
|
|
|
message =>[ 'Dont ignore these words' ], |
1450
|
|
|
|
|
|
|
} |
1451
|
|
|
|
|
|
|
|
1452
|
|
|
|
|
|
|
=back |
1453
|
|
|
|
|
|
|
|
1454
|
|
|
|
|
|
|
B<carp_stack> [optional] This is a simple passed boolean value that will trigger a traditional |
1455
|
|
|
|
|
|
|
L<Carp> longmess stack to be split by /\n\s*/ and then pushed on the end of the message array ref. |
1456
|
|
|
|
|
|
|
Before the message is stored this key will be deleted whether it was positive or negative. |
1457
|
|
|
|
|
|
|
|
1458
|
|
|
|
|
|
|
B<source_sub> [really optional] This is rarely used unless you are writing a replacement for |
1459
|
|
|
|
|
|
|
L<Log::Shiras::Telephone>. If you are writing a replacement then a full method space string is |
1460
|
|
|
|
|
|
|
passed here. This will be used to travel the L<caller|http://perldoc.perl.org/functions/caller.html> |
1461
|
|
|
|
|
|
|
stack to find where the message line originated. The equivalent for Log::Shiras::Telephone is; |
1462
|
|
|
|
|
|
|
|
1463
|
|
|
|
|
|
|
=over |
1464
|
|
|
|
|
|
|
|
1465
|
|
|
|
|
|
|
B<example> |
1466
|
|
|
|
|
|
|
|
1467
|
|
|
|
|
|
|
{ source_sub => 'Log::Shiras::Telephone::talk' } |
1468
|
|
|
|
|
|
|
|
1469
|
|
|
|
|
|
|
=back |
1470
|
|
|
|
|
|
|
|
1471
|
|
|
|
|
|
|
=back |
1472
|
|
|
|
|
|
|
|
1473
|
|
|
|
|
|
|
=back |
1474
|
|
|
|
|
|
|
|
1475
|
|
|
|
|
|
|
=head3 add_name_space_bounds( $ref ) |
1476
|
|
|
|
|
|
|
|
1477
|
|
|
|
|
|
|
=over |
1478
|
|
|
|
|
|
|
|
1479
|
|
|
|
|
|
|
B<Definition:> This will L<graft|Data::Walk::Graft/graft_data( %argsE<verbar>$arg_ref )> |
1480
|
|
|
|
|
|
|
more name-space boundaries onto the existing name-space. I<The passed ref will be treated |
1481
|
|
|
|
|
|
|
as the 'scion_ref' using Data::Walk::Graft.> |
1482
|
|
|
|
|
|
|
|
1483
|
|
|
|
|
|
|
B<Accepts:> a data_ref (must start at the root of the main ref) of data to graft to the main |
1484
|
|
|
|
|
|
|
name_space_bounds ref |
1485
|
|
|
|
|
|
|
|
1486
|
|
|
|
|
|
|
B<Returns:> The updated name-space data ref |
1487
|
|
|
|
|
|
|
|
1488
|
|
|
|
|
|
|
=back |
1489
|
|
|
|
|
|
|
|
1490
|
|
|
|
|
|
|
=head3 remove_name_space_bounds( $ref ) |
1491
|
|
|
|
|
|
|
|
1492
|
|
|
|
|
|
|
=over |
1493
|
|
|
|
|
|
|
|
1494
|
|
|
|
|
|
|
B<Definition:> This will L<prune|Data::Walk::Prune/prune_data( %args )> the name-space |
1495
|
|
|
|
|
|
|
L<boundaries|/name_space_bounds> using the passed name-space ref. I<The passed ref will |
1496
|
|
|
|
|
|
|
be treated as the 'slice_ref' using Data::Walk::Prune.> |
1497
|
|
|
|
|
|
|
|
1498
|
|
|
|
|
|
|
B<Accepts:> a data_ref (must start at the root of the main ref) of data used to prune the |
1499
|
|
|
|
|
|
|
main name_space_bounds ref |
1500
|
|
|
|
|
|
|
|
1501
|
|
|
|
|
|
|
B<Returns:> The updated name-space data ref |
1502
|
|
|
|
|
|
|
|
1503
|
|
|
|
|
|
|
=back |
1504
|
|
|
|
|
|
|
|
1505
|
|
|
|
|
|
|
=head3 add_reports( %args ) |
1506
|
|
|
|
|
|
|
|
1507
|
|
|
|
|
|
|
=over |
1508
|
|
|
|
|
|
|
|
1509
|
|
|
|
|
|
|
B<Definition:> This will add more L<report|/reports> output instances to the existing |
1510
|
|
|
|
|
|
|
named report registered instances. If the items in the passed report list are not already |
1511
|
|
|
|
|
|
|
report object instances that -E<gt>can( 'add_line' ) there will be an attempt to build |
1512
|
|
|
|
|
|
|
them using L<MooseX::ShortCut::BuildInstance/build_instance( %argsE<verbar>\%args )>. |
1513
|
|
|
|
|
|
|
If (and only if) the report name does not exist then the report name will also be added to the |
1514
|
|
|
|
|
|
|
report registry. |
1515
|
|
|
|
|
|
|
|
1516
|
|
|
|
|
|
|
B<Accepts:> a hash of arrays with the report objects as items in the array |
1517
|
|
|
|
|
|
|
|
1518
|
|
|
|
|
|
|
B<Returns:> 1 |
1519
|
|
|
|
|
|
|
|
1520
|
|
|
|
|
|
|
=back |
1521
|
|
|
|
|
|
|
|
1522
|
|
|
|
|
|
|
=head3 get_log_levels( $report_name ) |
1523
|
|
|
|
|
|
|
|
1524
|
|
|
|
|
|
|
=over |
1525
|
|
|
|
|
|
|
|
1526
|
|
|
|
|
|
|
B<Definition:> This will return the L<log level names|/logging_levels> names for a given |
1527
|
|
|
|
|
|
|
report name in an array ref. If no custom levels are defined it will return the default |
1528
|
|
|
|
|
|
|
level list. |
1529
|
|
|
|
|
|
|
|
1530
|
|
|
|
|
|
|
B<Accepts:> a report name |
1531
|
|
|
|
|
|
|
|
1532
|
|
|
|
|
|
|
B<Returns:> an array ref of the defined log levels for that report. |
1533
|
|
|
|
|
|
|
|
1534
|
|
|
|
|
|
|
=back |
1535
|
|
|
|
|
|
|
|
1536
|
|
|
|
|
|
|
=head3 send_buffer_to_output( $report_name ) |
1537
|
|
|
|
|
|
|
|
1538
|
|
|
|
|
|
|
=over |
1539
|
|
|
|
|
|
|
|
1540
|
|
|
|
|
|
|
B<Definition:> This will flush the contents of the $report_name L<buffer|/buffering> |
1541
|
|
|
|
|
|
|
to all the associated report objects. |
1542
|
|
|
|
|
|
|
|
1543
|
|
|
|
|
|
|
B<Accepts:> a $report_name |
1544
|
|
|
|
|
|
|
|
1545
|
|
|
|
|
|
|
B<Returns:> The number of times that $report_object->add_line( $message_ref ) was called to |
1546
|
|
|
|
|
|
|
complete the buffer flush. |
1547
|
|
|
|
|
|
|
|
1548
|
|
|
|
|
|
|
=back |
1549
|
|
|
|
|
|
|
|
1550
|
|
|
|
|
|
|
=head3 start_buffering( $report_name ) |
1551
|
|
|
|
|
|
|
|
1552
|
|
|
|
|
|
|
=over |
1553
|
|
|
|
|
|
|
|
1554
|
|
|
|
|
|
|
B<Definition:> This will start L<buffering|/buffering> for the $report_name. If the buffering is |
1555
|
|
|
|
|
|
|
already implemented then nothing new happens. No equivalent report or name_space_bounds |
1556
|
|
|
|
|
|
|
are required to turn buffering on! |
1557
|
|
|
|
|
|
|
|
1558
|
|
|
|
|
|
|
B<Accepts:> a $report_name string |
1559
|
|
|
|
|
|
|
|
1560
|
|
|
|
|
|
|
B<Returns:> 1 |
1561
|
|
|
|
|
|
|
|
1562
|
|
|
|
|
|
|
=back |
1563
|
|
|
|
|
|
|
|
1564
|
|
|
|
|
|
|
=head3 clear_buffer( $report_name ) |
1565
|
|
|
|
|
|
|
|
1566
|
|
|
|
|
|
|
=over |
1567
|
|
|
|
|
|
|
|
1568
|
|
|
|
|
|
|
B<Definition:> This will remove all messages currently in the L<buffer|/buffering> |
1569
|
|
|
|
|
|
|
without sending them to the report. |
1570
|
|
|
|
|
|
|
|
1571
|
|
|
|
|
|
|
B<Accepts:> a $report_name string |
1572
|
|
|
|
|
|
|
|
1573
|
|
|
|
|
|
|
B<Returns:> 1 |
1574
|
|
|
|
|
|
|
|
1575
|
|
|
|
|
|
|
=back |
1576
|
|
|
|
|
|
|
|
1577
|
|
|
|
|
|
|
=head1 SYNOPSIS |
1578
|
|
|
|
|
|
|
|
1579
|
|
|
|
|
|
|
This is pretty long so I put it at the end |
1580
|
|
|
|
|
|
|
|
1581
|
|
|
|
|
|
|
#!perl |
1582
|
|
|
|
|
|
|
use Modern::Perl; |
1583
|
|
|
|
|
|
|
use lib 'lib', '../lib',; |
1584
|
|
|
|
|
|
|
use Log::Shiras::Unhide qw( :debug :InternalSwitchboarD );# |
1585
|
|
|
|
|
|
|
use Log::Shiras::Switchboard; |
1586
|
|
|
|
|
|
|
###InternalSwitchboarD use Log::Shiras::Report::Stdout; |
1587
|
|
|
|
|
|
|
$| = 1; |
1588
|
|
|
|
|
|
|
###LogSD warn "lets get ready to rumble..."; |
1589
|
|
|
|
|
|
|
my $operator = Log::Shiras::Switchboard->get_operator( |
1590
|
|
|
|
|
|
|
name_space_bounds =>{ |
1591
|
|
|
|
|
|
|
main =>{ |
1592
|
|
|
|
|
|
|
UNBLOCK =>{ |
1593
|
|
|
|
|
|
|
# UNBLOCKing the quiet, loud, and run reports (destinations) |
1594
|
|
|
|
|
|
|
# at the 'main' caller name_space and deeper |
1595
|
|
|
|
|
|
|
quiet => 'warn', |
1596
|
|
|
|
|
|
|
loud => 'info', |
1597
|
|
|
|
|
|
|
run => 'trace', |
1598
|
|
|
|
|
|
|
}, |
1599
|
|
|
|
|
|
|
}, |
1600
|
|
|
|
|
|
|
Log =>{ |
1601
|
|
|
|
|
|
|
Shiras =>{ |
1602
|
|
|
|
|
|
|
###InternalSwitchboarD Switchboard =>{#<-- Internal reporting enabled here |
1603
|
|
|
|
|
|
|
###InternalSwitchboarD get_operator =>{ |
1604
|
|
|
|
|
|
|
###InternalSwitchboarD UNBLOCK =>{ |
1605
|
|
|
|
|
|
|
###InternalSwitchboarD # UNBLOCKing log_file |
1606
|
|
|
|
|
|
|
###InternalSwitchboarD # at Log::Shiras::Switchboard::get_operator |
1607
|
|
|
|
|
|
|
###InternalSwitchboarD # (self reporting) |
1608
|
|
|
|
|
|
|
###InternalSwitchboarD log_file => 'info', |
1609
|
|
|
|
|
|
|
###InternalSwitchboarD }, |
1610
|
|
|
|
|
|
|
###InternalSwitchboarD }, |
1611
|
|
|
|
|
|
|
###InternalSwitchboarD master_talk =>{ |
1612
|
|
|
|
|
|
|
###InternalSwitchboarD _buffer_decision =>{ |
1613
|
|
|
|
|
|
|
###InternalSwitchboarD UNBLOCK =>{ |
1614
|
|
|
|
|
|
|
###InternalSwitchboarD # UNBLOCKing log_file |
1615
|
|
|
|
|
|
|
###InternalSwitchboarD # at Log::Shiras::Switchboard::master_talk::_buffer_decision |
1616
|
|
|
|
|
|
|
###InternalSwitchboarD # (self reporting) |
1617
|
|
|
|
|
|
|
###InternalSwitchboarD log_file => 'trace', |
1618
|
|
|
|
|
|
|
###InternalSwitchboarD }, |
1619
|
|
|
|
|
|
|
###InternalSwitchboarD }, |
1620
|
|
|
|
|
|
|
###InternalSwitchboarD }, |
1621
|
|
|
|
|
|
|
###InternalSwitchboarD send_buffer_to_output =>{ |
1622
|
|
|
|
|
|
|
###InternalSwitchboarD UNBLOCK =>{ |
1623
|
|
|
|
|
|
|
###InternalSwitchboarD # UNBLOCKing log_file |
1624
|
|
|
|
|
|
|
###InternalSwitchboarD # at Log::Shiras::Switchboard::_flush_buffer |
1625
|
|
|
|
|
|
|
###InternalSwitchboarD # (self reporting) |
1626
|
|
|
|
|
|
|
###InternalSwitchboarD log_file => 'info', |
1627
|
|
|
|
|
|
|
###InternalSwitchboarD }, |
1628
|
|
|
|
|
|
|
###InternalSwitchboarD }, |
1629
|
|
|
|
|
|
|
###InternalSwitchboarD },#<-- Internal reporting enabled through here |
1630
|
|
|
|
|
|
|
}, |
1631
|
|
|
|
|
|
|
}, |
1632
|
|
|
|
|
|
|
}, |
1633
|
|
|
|
|
|
|
reports =>{ |
1634
|
|
|
|
|
|
|
quiet =>[ |
1635
|
|
|
|
|
|
|
Print::Wisper->new, |
1636
|
|
|
|
|
|
|
], |
1637
|
|
|
|
|
|
|
loud =>[ |
1638
|
|
|
|
|
|
|
{ |
1639
|
|
|
|
|
|
|
package => 'Print::Excited', |
1640
|
|
|
|
|
|
|
add_methods =>{ |
1641
|
|
|
|
|
|
|
add_line => sub{ |
1642
|
|
|
|
|
|
|
shift; |
1643
|
|
|
|
|
|
|
my @input = ( ref $_[0]->{message} eq 'ARRAY' ) ? |
1644
|
|
|
|
|
|
|
@{$_[0]->{message}} : $_[0]->{message}; |
1645
|
|
|
|
|
|
|
my @new_list; |
1646
|
|
|
|
|
|
|
map{ push @new_list, $_ if $_ } @input; |
1647
|
|
|
|
|
|
|
chomp @new_list; |
1648
|
|
|
|
|
|
|
print '!!!' . uc(join( ' ', @new_list)) . "!!!\n"; |
1649
|
|
|
|
|
|
|
} |
1650
|
|
|
|
|
|
|
}, |
1651
|
|
|
|
|
|
|
} |
1652
|
|
|
|
|
|
|
], |
1653
|
|
|
|
|
|
|
###InternalSwitchboarD log_file =>[ |
1654
|
|
|
|
|
|
|
###InternalSwitchboarD Log::Shiras::Report::Stdout->new, |
1655
|
|
|
|
|
|
|
###InternalSwitchboarD ], |
1656
|
|
|
|
|
|
|
}, |
1657
|
|
|
|
|
|
|
all_buffering =>{ |
1658
|
|
|
|
|
|
|
quiet => [], |
1659
|
|
|
|
|
|
|
}, |
1660
|
|
|
|
|
|
|
); |
1661
|
|
|
|
|
|
|
###LogSD warn "sending the message 'Hello World 1'"; |
1662
|
|
|
|
|
|
|
$operator->master_talk({ |
1663
|
|
|
|
|
|
|
report => 'log_file', level => 'warn', name_space => 'main', |
1664
|
|
|
|
|
|
|
message =>[ 'Hello World 1' ] }); |
1665
|
|
|
|
|
|
|
###LogSD warn "The name_space 'main' does not have destination 'log_file' permissions"; |
1666
|
|
|
|
|
|
|
###LogSD warn "sending the message 'Hello World 2' to the report 'quiet'"; |
1667
|
|
|
|
|
|
|
$operator->master_talk({ |
1668
|
|
|
|
|
|
|
report => 'quiet', level => 'warn', name_space => 'main', |
1669
|
|
|
|
|
|
|
message =>[ 'Hello World 2' ] }); |
1670
|
|
|
|
|
|
|
###LogSD warn "message went to the buffer - turning off buffering for the 'quiet' destination ..."; |
1671
|
|
|
|
|
|
|
$operator->stop_buffering( 'quiet' ); |
1672
|
|
|
|
|
|
|
###LogSD warn "should have printed what was in the 'quiet' buffer ..."; |
1673
|
|
|
|
|
|
|
$operator->master_talk({ |
1674
|
|
|
|
|
|
|
report => 'quiet', level => 'debug', name_space => 'main', |
1675
|
|
|
|
|
|
|
message =>[ 'Hello World 3' ] }); |
1676
|
|
|
|
|
|
|
###LogSD warn "sending the message 'Hello World 4' to the report 'loud'"; |
1677
|
|
|
|
|
|
|
$operator->master_talk({ |
1678
|
|
|
|
|
|
|
report => 'loud', level => 'info', name_space => 'main', |
1679
|
|
|
|
|
|
|
message =>[ 'Hello World 4' ] }); |
1680
|
|
|
|
|
|
|
###LogSD warn "sending the message 'Hello World 5' to the report 'run'"; |
1681
|
|
|
|
|
|
|
my $result = 1; |
1682
|
|
|
|
|
|
|
$result = $operator->master_talk({ |
1683
|
|
|
|
|
|
|
report => 'run', level => 'warn', name_space => 'main', |
1684
|
|
|
|
|
|
|
message =>[ 'Hello World 5' ] }); |
1685
|
|
|
|
|
|
|
###LogSD warn "message to 'run' at 'warn' level was approved"; |
1686
|
|
|
|
|
|
|
###LogSD warn "...but found -$result- reporting destinations (None were set up)"; |
1687
|
|
|
|
|
|
|
|
1688
|
|
|
|
|
|
|
package Print::Wisper; |
1689
|
|
|
|
|
|
|
sub new{ |
1690
|
|
|
|
|
|
|
bless {}, shift; |
1691
|
|
|
|
|
|
|
} |
1692
|
|
|
|
|
|
|
sub add_line{ |
1693
|
|
|
|
|
|
|
shift; |
1694
|
|
|
|
|
|
|
my @input = ( ref $_[0]->{message} eq 'ARRAY' ) ? |
1695
|
|
|
|
|
|
|
@{$_[0]->{message}} : $_[0]->{message}; |
1696
|
|
|
|
|
|
|
my @new_list; |
1697
|
|
|
|
|
|
|
map{ push @new_list, $_ if $_ } @input; |
1698
|
|
|
|
|
|
|
chomp @new_list; |
1699
|
|
|
|
|
|
|
print '--->' . lc(join( ' ', @new_list )) . "<---\n"; |
1700
|
|
|
|
|
|
|
} |
1701
|
|
|
|
|
|
|
|
1702
|
|
|
|
|
|
|
1; |
1703
|
|
|
|
|
|
|
|
1704
|
|
|
|
|
|
|
####################################################################################### |
1705
|
|
|
|
|
|
|
# Synopsis Screen Output for the following condition |
1706
|
|
|
|
|
|
|
# use Log::Shiras::Unhide; |
1707
|
|
|
|
|
|
|
# 01: --->hello world 2<--- |
1708
|
|
|
|
|
|
|
# 02: !!!HELLO WORLD 4!!! |
1709
|
|
|
|
|
|
|
####################################################################################### |
1710
|
|
|
|
|
|
|
|
1711
|
|
|
|
|
|
|
####################################################################################### |
1712
|
|
|
|
|
|
|
# Synopsis Screen Output for the following condition |
1713
|
|
|
|
|
|
|
# use Log::Shiras::Unhide qw( :debug ); |
1714
|
|
|
|
|
|
|
# 01: Using Log::Shiras::Unhide-v0.29_1 strip_match string: (LogSD) at ../lib/Log/Shiras/Unhide.pm line 88. |
1715
|
|
|
|
|
|
|
# 02: lets get ready to rumble... at log_shiras_switchboard.pl line 7. |
1716
|
|
|
|
|
|
|
# 03: sending the message 'Hello World 1' at log_shiras_switchboard.pl line 80. |
1717
|
|
|
|
|
|
|
# 04: The name_space 'main' does not have destination 'log_file' permissions at log_shiras_switchboard.pl line 84. |
1718
|
|
|
|
|
|
|
# 05: sending the message 'Hello World 2' to the report 'quiet' at log_shiras_switchboard.pl line 85. |
1719
|
|
|
|
|
|
|
# 06: message went to the buffer - turning off buffering for the 'quiet' destination ... at log_shiras_switchboard.pl line 89. |
1720
|
|
|
|
|
|
|
# 07: --->hello world 2<--- |
1721
|
|
|
|
|
|
|
# 08: should have printed what was in the 'quiet' buffer ... at log_shiras_switchboard.pl line 91. |
1722
|
|
|
|
|
|
|
# 09: sending the message 'Hello World 4' to the report 'loud' at log_shiras_switchboard.pl line 95. |
1723
|
|
|
|
|
|
|
# 10: !!!HELLO WORLD 4!!! |
1724
|
|
|
|
|
|
|
# 11: sending the message 'Hello World 5' to the report 'run' at log_shiras_switchboard.pl line 99. |
1725
|
|
|
|
|
|
|
# 12: message to 'run' at 'warn' level was approved at log_shiras_switchboard.pl line 104. |
1726
|
|
|
|
|
|
|
# 13: ...but found -0- reporting destinations (None were set up) at log_shiras_switchboard.pl line 105. |
1727
|
|
|
|
|
|
|
####################################################################################### |
1728
|
|
|
|
|
|
|
|
1729
|
|
|
|
|
|
|
####################################################################################### |
1730
|
|
|
|
|
|
|
# Synopsis Screen Output for the following conditions |
1731
|
|
|
|
|
|
|
# use Log::Shiras::Unhide qw( :debug :InternalSwitchboarD ); |
1732
|
|
|
|
|
|
|
# 01: Using Log::Shiras::Unhide-v0.29_1 strip_match string: (LogSD|InternalSwitchboarD) at ../lib/Log/Shiras/Unhide.pm line 88. |
1733
|
|
|
|
|
|
|
# 02: You uncovered internal logging statements for Log::Shiras::Types-v0.29_1 at ..\lib\Log\Shiras\Types.pm line 5. |
1734
|
|
|
|
|
|
|
# 03: You uncovered internal logging statements for Log::Shiras::Switchboard-v0.29_1 at ..\lib\Log\Shiras\Switchboard.pm line 5. |
1735
|
|
|
|
|
|
|
# 04: lets get ready to rumble... at log_shiras_switchboard.pl line 7. |
1736
|
|
|
|
|
|
|
# 05: | level - 2 | name_space - Log::Shiras::Switchboard::master_talk::_buffer_decision |
1737
|
|
|
|
|
|
|
# 06: | line - 0704 | file_name - ..\lib\Log\Shiras\Switchboard.pm |
1738
|
|
|
|
|
|
|
# 07: :( Arrived at _buffer_decision for report: log_file |
1739
|
|
|
|
|
|
|
# 08: ..with buffer setting: ): |
1740
|
|
|
|
|
|
|
# 09: | level - 2 | name_space - Log::Shiras::Switchboard::master_talk::_buffer_decision |
1741
|
|
|
|
|
|
|
# 10: | line - 0715 | file_name - ..\lib\Log\Shiras\Switchboard.pm |
1742
|
|
|
|
|
|
|
# 11: :( Current action for report -log_file- is: report ): |
1743
|
|
|
|
|
|
|
# 12: | level - 2 | name_space - Log::Shiras::Switchboard::get_operator |
1744
|
|
|
|
|
|
|
# 13: | line - 0211 | file_name - ..\lib\Log\Shiras\Switchboard.pm |
1745
|
|
|
|
|
|
|
# 14: :( Switchboard finished updating the following arguments: |
1746
|
|
|
|
|
|
|
# 15: reports |
1747
|
|
|
|
|
|
|
# 16: name_space_bounds |
1748
|
|
|
|
|
|
|
# 17: all_buffering ): |
1749
|
|
|
|
|
|
|
# 18: sending the message 'Hello World 1' at log_shiras_switchboard.pl line 80. |
1750
|
|
|
|
|
|
|
# 19: The name_space 'main' does not have destination 'log_file' permissions at log_shiras_switchboard.pl line 84. |
1751
|
|
|
|
|
|
|
# 20: sending the message 'Hello World 2' to the report 'quiet' at log_shiras_switchboard.pl line 85. |
1752
|
|
|
|
|
|
|
# 21: | level - 2 | name_space - Log::Shiras::Switchboard::master_talk::_buffer_decision |
1753
|
|
|
|
|
|
|
# 22: | line - 0704 | file_name - ..\lib\Log\Shiras\Switchboard.pm |
1754
|
|
|
|
|
|
|
# 23: :( Arrived at _buffer_decision for report: quiet |
1755
|
|
|
|
|
|
|
# 24: ..with buffer setting: 1 ): |
1756
|
|
|
|
|
|
|
# 25: | level - 1 | name_space - Log::Shiras::Switchboard::master_talk::_buffer_decision |
1757
|
|
|
|
|
|
|
# 26: | line - 0709 | file_name - ..\lib\Log\Shiras\Switchboard.pm |
1758
|
|
|
|
|
|
|
# 27: # 01: :( The buffer is active - sending the message to the buffer (not the report). ): |
1759
|
|
|
|
|
|
|
# 28: | level - 2 | name_space - Log::Shiras::Switchboard::master_talk::_buffer_decision |
1760
|
|
|
|
|
|
|
# 29: | line - 0715 | file_name - ..\lib\Log\Shiras\Switchboard.pm |
1761
|
|
|
|
|
|
|
# 30: :( Current action for report -quiet- is: buffer ): |
1762
|
|
|
|
|
|
|
# 31: message went to the buffer - turning off buffering for the 'quiet' destination ... at log_shiras_switchboard.pl line 89. |
1763
|
|
|
|
|
|
|
# 32: --->hello world 2<--- |
1764
|
|
|
|
|
|
|
# 33: should have printed what was in the 'quiet' buffer ... at log_shiras_switchboard.pl line 91. |
1765
|
|
|
|
|
|
|
# 34: sending the message 'Hello World 4' to the report 'loud' at log_shiras_switchboard.pl line 95. |
1766
|
|
|
|
|
|
|
# 35: | level - 2 | name_space - Log::Shiras::Switchboard::master_talk::_buffer_decision |
1767
|
|
|
|
|
|
|
# 36: | line - 0704 | file_name - ..\lib\Log\Shiras\Switchboard.pm |
1768
|
|
|
|
|
|
|
# 37: :( Arrived at _buffer_decision for report: loud |
1769
|
|
|
|
|
|
|
# 38: ..with buffer setting: ): |
1770
|
|
|
|
|
|
|
# 39: | level - 2 | name_space - Log::Shiras::Switchboard::master_talk::_buffer_decision |
1771
|
|
|
|
|
|
|
# 40: | line - 0715 | file_name - ..\lib\Log\Shiras\Switchboard.pm |
1772
|
|
|
|
|
|
|
# 41: :( Current action for report -loud- is: report ): |
1773
|
|
|
|
|
|
|
# 42: !!!HELLO WORLD 4!!! |
1774
|
|
|
|
|
|
|
# 43: sending the message 'Hello World 5' to the report 'run' at log_shiras_switchboard.pl line 99. |
1775
|
|
|
|
|
|
|
# 44: | level - 2 | name_space - Log::Shiras::Switchboard::master_talk::_buffer_decision |
1776
|
|
|
|
|
|
|
# 45: | line - 0704 | file_name - ..\lib\Log\Shiras\Switchboard.pm |
1777
|
|
|
|
|
|
|
# 46: :( Arrived at _buffer_decision for report: run |
1778
|
|
|
|
|
|
|
# 47: ..with buffer setting: ): |
1779
|
|
|
|
|
|
|
# 48: | level - 2 | name_space - Log::Shiras::Switchboard::master_talk::_buffer_decision |
1780
|
|
|
|
|
|
|
# 49: | line - 0715 | file_name - ..\lib\Log\Shiras\Switchboard.pm |
1781
|
|
|
|
|
|
|
# 50: :( Current action for report -run- is: report ): |
1782
|
|
|
|
|
|
|
# 51: message to 'run' at 'warn' level was approved at log_shiras_switchboard.pl line 104. |
1783
|
|
|
|
|
|
|
# 52: ...but found -0- reporting destinations (None were set up) at log_shiras_switchboard.pl line 105. |
1784
|
|
|
|
|
|
|
####################################################################################### |
1785
|
|
|
|
|
|
|
|
1786
|
|
|
|
|
|
|
=head2 SYNOPSIS EXPLANATION |
1787
|
|
|
|
|
|
|
|
1788
|
|
|
|
|
|
|
=over |
1789
|
|
|
|
|
|
|
|
1790
|
|
|
|
|
|
|
use Log::Shiras::Unhide qw( :debug :InternalSwitchboarD ); |
1791
|
|
|
|
|
|
|
.. |
1792
|
|
|
|
|
|
|
###LogSD warn "lets get ready to rumble..."; |
1793
|
|
|
|
|
|
|
|
1794
|
|
|
|
|
|
|
Log::Shiras::Unhide strips ###MyCoolTag tags - see L<Log::Shiras::Unhide> for more information. |
1795
|
|
|
|
|
|
|
It represents the only driver between the three example outputs (All run from the same basic |
1796
|
|
|
|
|
|
|
script). For instance when the :debug tag is passed to Unhide then ###LogSD is stripped. |
1797
|
|
|
|
|
|
|
When :InternalSwitchboarD is passed it strips ###InternalSwitchboarD. |
1798
|
|
|
|
|
|
|
|
1799
|
|
|
|
|
|
|
Each of the remaining functions is documented above but the difference between the three |
1800
|
|
|
|
|
|
|
outputs are based on what is unhid. In all cases 'Hello World [1..5]' is sent to master_talk |
1801
|
|
|
|
|
|
|
in the switchboard. All of the calls are valid syntax but not all calls have the necessary |
1802
|
|
|
|
|
|
|
target or urgency to be completed. |
1803
|
|
|
|
|
|
|
|
1804
|
|
|
|
|
|
|
In the first output it is obvious that only 'Hello World 2' and 'Hello World 4' have the |
1805
|
|
|
|
|
|
|
necessary permissions to be completed. Each one is sent to a different report object so it |
1806
|
|
|
|
|
|
|
will be obvious based on the output what path it took to be printed. |
1807
|
|
|
|
|
|
|
|
1808
|
|
|
|
|
|
|
In the second output only the ###LogSD tags are removed and so comments associated with the |
1809
|
|
|
|
|
|
|
actions are exposed. In this case these comments only exist in the script space so |
1810
|
|
|
|
|
|
|
warning messages are mostly the only thing exposed that is visible. Since ~::Unhide is a |
1811
|
|
|
|
|
|
|
source filter it also provides a warning from the class showing that a source filter is |
1812
|
|
|
|
|
|
|
turned on and what is being scrubbed. This includes scrubbing through the script and |
1813
|
|
|
|
|
|
|
all used modules. (But not 'with' roles!). |
1814
|
|
|
|
|
|
|
|
1815
|
|
|
|
|
|
|
In the final output the ###InternalSwitchboarD tags are also stripped. Since there |
1816
|
|
|
|
|
|
|
are a lot of these in L<Log::Shiras::Switchboard> there is a number of things available to |
1817
|
|
|
|
|
|
|
see from that class. However the operator only has released log_file messages for the |
1818
|
|
|
|
|
|
|
~::get_operator and ~::_buffer_decision name spaces. A new class is also exposed that |
1819
|
|
|
|
|
|
|
can take advantage of message metadata and uses it to show where the message came from |
1820
|
|
|
|
|
|
|
as well has what urgency it was sent with. |
1821
|
|
|
|
|
|
|
|
1822
|
|
|
|
|
|
|
=back |
1823
|
|
|
|
|
|
|
|
1824
|
|
|
|
|
|
|
=head1 SUPPORT |
1825
|
|
|
|
|
|
|
|
1826
|
|
|
|
|
|
|
=over |
1827
|
|
|
|
|
|
|
|
1828
|
|
|
|
|
|
|
L<github Log-Shiras/issues|https://github.com/jandrew/Log-Shiras/issues> |
1829
|
|
|
|
|
|
|
|
1830
|
|
|
|
|
|
|
=back |
1831
|
|
|
|
|
|
|
|
1832
|
|
|
|
|
|
|
=head1 TODO |
1833
|
|
|
|
|
|
|
|
1834
|
|
|
|
|
|
|
=over |
1835
|
|
|
|
|
|
|
|
1836
|
|
|
|
|
|
|
B<1.> Add method to pull a full caller($x) stack and add it to message |
1837
|
|
|
|
|
|
|
metadata. Probably should be triggered in the master_talk call args. |
1838
|
|
|
|
|
|
|
|
1839
|
|
|
|
|
|
|
B<2.> Investigate the possibility of an ONLY keyword in addition to |
1840
|
|
|
|
|
|
|
of UNBLOCK - how would this be implemented? - Future uncertain |
1841
|
|
|
|
|
|
|
|
1842
|
|
|
|
|
|
|
=back |
1843
|
|
|
|
|
|
|
|
1844
|
|
|
|
|
|
|
=head1 AUTHOR |
1845
|
|
|
|
|
|
|
|
1846
|
|
|
|
|
|
|
=over |
1847
|
|
|
|
|
|
|
|
1848
|
|
|
|
|
|
|
=item Jed Lund |
1849
|
|
|
|
|
|
|
|
1850
|
|
|
|
|
|
|
=item jandrew@cpan.org |
1851
|
|
|
|
|
|
|
|
1852
|
|
|
|
|
|
|
=back |
1853
|
|
|
|
|
|
|
|
1854
|
|
|
|
|
|
|
=head1 COPYRIGHT |
1855
|
|
|
|
|
|
|
|
1856
|
|
|
|
|
|
|
This program is free software; you can redistribute |
1857
|
|
|
|
|
|
|
it and/or modify it under the same terms as Perl itself. |
1858
|
|
|
|
|
|
|
|
1859
|
|
|
|
|
|
|
The full text of the license can be found in the |
1860
|
|
|
|
|
|
|
LICENSE file included with this module. |
1861
|
|
|
|
|
|
|
|
1862
|
|
|
|
|
|
|
=head1 DEPENDENCIES |
1863
|
|
|
|
|
|
|
|
1864
|
|
|
|
|
|
|
=over |
1865
|
|
|
|
|
|
|
|
1866
|
|
|
|
|
|
|
L<version> |
1867
|
|
|
|
|
|
|
|
1868
|
|
|
|
|
|
|
L<5.010|http://perldoc.perl.org/perl5100delta.html> |
1869
|
|
|
|
|
|
|
|
1870
|
|
|
|
|
|
|
L<utf8> |
1871
|
|
|
|
|
|
|
|
1872
|
|
|
|
|
|
|
L<MooseX::Singleton> |
1873
|
|
|
|
|
|
|
|
1874
|
|
|
|
|
|
|
L<MooseX::StrictConstructor> |
1875
|
|
|
|
|
|
|
|
1876
|
|
|
|
|
|
|
L<MooseX::HasDefaults::RO> |
1877
|
|
|
|
|
|
|
|
1878
|
|
|
|
|
|
|
L<DateTime> |
1879
|
|
|
|
|
|
|
|
1880
|
|
|
|
|
|
|
L<Carp> - cluck confess |
1881
|
|
|
|
|
|
|
|
1882
|
|
|
|
|
|
|
L<MooseX::Types::Moose> - HashRef ArrayRef Bool RegexpRef Str Int |
1883
|
|
|
|
|
|
|
|
1884
|
|
|
|
|
|
|
L<Clone> - clone |
1885
|
|
|
|
|
|
|
|
1886
|
|
|
|
|
|
|
L<Data::Dumper> |
1887
|
|
|
|
|
|
|
|
1888
|
|
|
|
|
|
|
L<MooseX::ShortCut::BuildInstance> - v1.44 - build_instance should_re_use_classes |
1889
|
|
|
|
|
|
|
|
1890
|
|
|
|
|
|
|
L<Data::Walk::Extracted> - v0.28 |
1891
|
|
|
|
|
|
|
|
1892
|
|
|
|
|
|
|
L<Data::Walk::Prune> - v0.028 |
1893
|
|
|
|
|
|
|
|
1894
|
|
|
|
|
|
|
L<Data::Walk::Graft> - v0.028 |
1895
|
|
|
|
|
|
|
|
1896
|
|
|
|
|
|
|
L<Data::Walk::Print> - v0.028 |
1897
|
|
|
|
|
|
|
|
1898
|
|
|
|
|
|
|
L<Data::Walk::Clone> - v0.024 |
1899
|
|
|
|
|
|
|
|
1900
|
|
|
|
|
|
|
L<Log::Shiras::Types> |
1901
|
|
|
|
|
|
|
|
1902
|
|
|
|
|
|
|
=back |
1903
|
|
|
|
|
|
|
|
1904
|
|
|
|
|
|
|
=head1 SEE ALSO |
1905
|
|
|
|
|
|
|
|
1906
|
|
|
|
|
|
|
=over |
1907
|
|
|
|
|
|
|
|
1908
|
|
|
|
|
|
|
L<Log::Shiras> |
1909
|
|
|
|
|
|
|
|
1910
|
|
|
|
|
|
|
=back |
1911
|
|
|
|
|
|
|
|
1912
|
|
|
|
|
|
|
=cut |
1913
|
|
|
|
|
|
|
|
1914
|
|
|
|
|
|
|
#########1 main pod documentation end 4#########5#########6#########7#########8#########9 |