line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Log::Shiras::Types; |
2
|
|
|
|
|
|
|
our $AUTHORITY = 'cpan:JANDREW'; |
3
|
6
|
|
|
6
|
|
118275
|
use version; our $VERSION = version->declare("v0.48.0"); |
|
6
|
|
|
|
|
1441
|
|
|
6
|
|
|
|
|
32
|
|
4
|
6
|
|
|
6
|
|
382
|
use strict; |
|
6
|
|
|
|
|
9
|
|
|
6
|
|
|
|
|
96
|
|
5
|
6
|
|
|
6
|
|
19
|
use warnings; |
|
6
|
|
|
|
|
11
|
|
|
6
|
|
|
|
|
123
|
|
6
|
|
|
|
|
|
|
#~ use lib '../../'; |
7
|
|
|
|
|
|
|
#~ use Log::Shiras::Unhide qw( :InternalTypeSShirasFormat :InternalTypeSFileHash :InternalTypeSReportObject :InternalTypeSHeadeR); |
8
|
|
|
|
|
|
|
###InternalTypeSShirasFormat use Data::Dumper; |
9
|
|
|
|
|
|
|
###InternalTypeSFileHash use Data::Dumper; |
10
|
|
|
|
|
|
|
###InternalTypeSReportObject use Data::Dumper; |
11
|
|
|
|
|
|
|
###InternalTypeSHeadeR use Data::Dumper; |
12
|
6
|
|
|
6
|
|
18
|
use utf8; |
|
6
|
|
|
|
|
8
|
|
|
6
|
|
|
|
|
28
|
|
13
|
6
|
|
|
6
|
|
99
|
use Carp qw( confess ); |
|
6
|
|
|
|
|
7
|
|
|
6
|
|
|
|
|
293
|
|
14
|
6
|
|
|
6
|
|
927
|
use IO::File; |
|
6
|
|
|
|
|
13257
|
|
|
6
|
|
|
|
|
644
|
|
15
|
6
|
|
|
6
|
|
2114
|
use FileHandle; |
|
6
|
|
|
|
|
3691
|
|
|
6
|
|
|
|
|
24
|
|
16
|
6
|
|
|
6
|
|
1981
|
use Fcntl qw( :flock LOCK_EX );# SEEK_END |
|
6
|
|
|
|
|
8
|
|
|
6
|
|
|
|
|
599
|
|
17
|
6
|
|
|
6
|
|
591
|
use MooseX::ShortCut::BuildInstance v1.42 qw( build_instance should_re_use_classes ); |
|
6
|
|
|
|
|
730494
|
|
|
6
|
|
|
|
|
37
|
|
18
|
|
|
|
|
|
|
should_re_use_classes( 1 ); |
19
|
6
|
|
|
|
|
41
|
use MooseX::Types::Moose qw( |
20
|
|
|
|
|
|
|
ArrayRef Int Str HashRef |
21
|
|
|
|
|
|
|
Object Undef GlobRef FileHandle |
22
|
6
|
|
|
6
|
|
2034
|
); |
|
6
|
|
|
|
|
7
|
|
23
|
|
|
|
|
|
|
#~ use MooseX::Types::Structured qw( Optional ); |
24
|
6
|
|
|
|
|
43
|
use MooseX::Types -declare =>[qw( |
25
|
|
|
|
|
|
|
ElevenArray PosInt NewModifier ElevenInt |
26
|
|
|
|
|
|
|
ShirasFormat TextFile HeaderString YamlFile |
27
|
|
|
|
|
|
|
FileHash JsonFile ArgsHash ReportObject |
28
|
|
|
|
|
|
|
NameSpace CSVFile XLSXFile XLSFile |
29
|
|
|
|
|
|
|
XMLFile IOFileType HeaderArray |
30
|
6
|
|
|
6
|
|
22344
|
)];# |
|
6
|
|
|
|
|
6
|
|
31
|
|
|
|
|
|
|
#~ use YAML::Any qw( Dump LoadFile ); |
32
|
6
|
|
|
6
|
|
46854
|
use JSON::XS; |
|
6
|
|
|
|
|
20567
|
|
|
6
|
|
|
|
|
2659
|
|
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
#########1 Package Variables 3#########4#########5#########6#########7#########8#########9 |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
my $standard_char = qr/[csduoxefgXEGbB]/; # Legacy conversions not supported |
37
|
|
|
|
|
|
|
my $producer_char = qr/[pn%]/; # sprintf standards that don't take arguments |
38
|
|
|
|
|
|
|
my $new_type_char = qr/[MPO]/; # M = method style, P = passed data style, O = object style |
39
|
|
|
|
|
|
|
my $split_regex = qr/ |
40
|
|
|
|
|
|
|
([^%]*) # inserted string |
41
|
|
|
|
|
|
|
(%([^%]*?) # get modifiers |
42
|
|
|
|
|
|
|
( ($producer_char)| # get terminator characters |
43
|
|
|
|
|
|
|
($standard_char))) # |
44
|
|
|
|
|
|
|
/x; |
45
|
|
|
|
|
|
|
my $sprintf_dispatch =[ |
46
|
|
|
|
|
|
|
[ \&_append_to_string, ],# 0 |
47
|
|
|
|
|
|
|
[ \&_alt_position, \&_does_not_consume, \&_append_to_string, ], # 1 |
48
|
|
|
|
|
|
|
[ sub{ $_[1] }, ],# pass through # 2 |
49
|
|
|
|
|
|
|
[ sub{ $_[1] }, ],# pass through # 3 |
50
|
|
|
|
|
|
|
[ \&_append_to_string, \&_set_consumption, ], # 4 |
51
|
|
|
|
|
|
|
[ \&_append_to_string, \&_remove_consumption, ],# 5 |
52
|
|
|
|
|
|
|
[ \&_append_to_string, ], # 6 |
53
|
|
|
|
|
|
|
[ sub{ $_[1] }, ],# pass through # 7 |
54
|
|
|
|
|
|
|
[ sub{ $_[1] }, ],# pass through # 8 |
55
|
|
|
|
|
|
|
[ \&_append_to_string, \&_set_consumption, ], # 9 |
56
|
|
|
|
|
|
|
[ \&_append_to_string, \&_remove_consumption, ], # 10 |
57
|
|
|
|
|
|
|
[ \&_append_to_string, ],# 11 |
58
|
|
|
|
|
|
|
[ sub{ $_[1] }, ],# pass through # 12 |
59
|
|
|
|
|
|
|
[ \&_append_to_string, ], # 13 |
60
|
|
|
|
|
|
|
[ sub{ $_[1] }, ],# pass through # 14 |
61
|
|
|
|
|
|
|
[ \&_append_to_string, \&_set_consumption, ], # 15 |
62
|
|
|
|
|
|
|
[ \&_append_to_string, ], # 17 |
63
|
|
|
|
|
|
|
[ \&_test_for_position_change, \&_does_not_consume, \&_set_insert_call, ], # 18 |
64
|
|
|
|
|
|
|
[ sub{ $_[1] }, ],# pass through # 19 |
65
|
|
|
|
|
|
|
[ \&_append_to_string, \&_set_consumption, ], # 20 |
66
|
|
|
|
|
|
|
[ \&_append_to_string, ], # 21 |
67
|
|
|
|
|
|
|
[ sub{ confess "No methods here!!" }, ],# 22 |
68
|
|
|
|
|
|
|
[ sub{ confess "No methods here!!" }, ],# 23 |
69
|
|
|
|
|
|
|
]; |
70
|
|
|
|
|
|
|
my $sprintf_regex = qr/ |
71
|
|
|
|
|
|
|
\A[%] # (required) sequence start |
72
|
|
|
|
|
|
|
([\s\-\+0#]{0,2}) # (optional) flag(s) |
73
|
|
|
|
|
|
|
([1-9]\d*\$)? # (optional) get the formatted value from |
74
|
|
|
|
|
|
|
# some position other than the next position |
75
|
|
|
|
|
|
|
(((\*)([1-9]\d*\$)?)? # (optional) vector flag with optional index and reference |
76
|
|
|
|
|
|
|
(v))? # for gathering a defined vector separator |
77
|
|
|
|
|
|
|
( # (optional) minimum field width formatting |
78
|
|
|
|
|
|
|
((\*)([1-9]\d*\$)?)| # get field from input with possible position call |
79
|
|
|
|
|
|
|
([1-9]\d*) )? # fixed field size definition |
80
|
|
|
|
|
|
|
((\.)( # (optional) maximum field width formatting |
81
|
|
|
|
|
|
|
(\*)| # get field from input with possible position call |
82
|
|
|
|
|
|
|
([0-9]\d*) ))? # fixed field size definition |
83
|
|
|
|
|
|
|
($new_type_char)? # (optional) get input from a method or passed source |
84
|
|
|
|
|
|
|
( # (required) conversion type |
85
|
|
|
|
|
|
|
($standard_char)| # standard character |
86
|
|
|
|
|
|
|
($producer_char) ) # producer character |
87
|
|
|
|
|
|
|
\Z # End of the line |
88
|
|
|
|
|
|
|
/sxmp; |
89
|
|
|
|
|
|
|
my $shiras_format_ref = { |
90
|
|
|
|
|
|
|
final => 1, |
91
|
|
|
|
|
|
|
alt_input => 1, |
92
|
|
|
|
|
|
|
bump_list => 1, |
93
|
|
|
|
|
|
|
}; |
94
|
|
|
|
|
|
|
my $TextFileext = qr/[.](txt|csv)/; |
95
|
|
|
|
|
|
|
my $yamlextention = qr/\.(?i)(yml|yaml)/; |
96
|
|
|
|
|
|
|
my $jsonextention = qr/\.(?i)(jsn|json)/; |
97
|
|
|
|
|
|
|
my $coder = JSON::XS->new->ascii->pretty->allow_nonref;# |
98
|
|
|
|
|
|
|
my $switchboard_attributes = [ qw( |
99
|
|
|
|
|
|
|
name_space_bounds reports buffering |
100
|
|
|
|
|
|
|
conf_file logging_levels |
101
|
|
|
|
|
|
|
) ]; |
102
|
|
|
|
|
|
|
our $recursion_block = 0; |
103
|
6
|
|
|
6
|
|
37
|
use constant IMPORT_DEBUG => 1; # Author testing only |
|
6
|
|
|
|
|
6
|
|
|
6
|
|
|
|
|
15173
|
|
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
#########1 subtype Library 3#########4#########5#########6#########7#########8#########9 |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
subtype ElevenArray, as ArrayRef, |
108
|
|
|
|
|
|
|
where{ scalar( @$_ ) < 13 }, |
109
|
|
|
|
|
|
|
message{ "This goes past the eleventh position! :O" }; |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
subtype PosInt, as Int, |
112
|
|
|
|
|
|
|
where{ $_ >= 0 }, |
113
|
|
|
|
|
|
|
message{ "$_ is not a positive integer" }; |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
subtype ElevenInt, as PosInt, |
116
|
|
|
|
|
|
|
where{ $_ < 12 }, |
117
|
|
|
|
|
|
|
message{ "This goes past eleven! :O" }; |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
subtype NewModifier, as Str, |
120
|
|
|
|
|
|
|
where{ $_ =~ /\A$new_type_char\Z/sxm }, |
121
|
|
|
|
|
|
|
message{ "'$_' does not match $new_type_char" }; |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
subtype ShirasFormat, as HashRef, |
124
|
|
|
|
|
|
|
where{ _has_shiras_keys( $_ ) }, |
125
|
|
|
|
|
|
|
message { $_ }; |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
###InternalTypeSShirasFormat warn "You uncovered internal logging statements for the Type ShirasFormat in Log::Shiras::Types-$VERSION" if !$ENV{hide_warn}; |
128
|
|
|
|
|
|
|
coerce ShirasFormat, from Str, |
129
|
|
|
|
|
|
|
via { |
130
|
|
|
|
|
|
|
my ( $input, ) = @_; |
131
|
|
|
|
|
|
|
###InternalTypeSShirasFormat warn "passed: $input"; |
132
|
|
|
|
|
|
|
my ( $x, $finished_ref, ) = ( 1, {} ); |
133
|
|
|
|
|
|
|
my $escape_off = 1; |
134
|
|
|
|
|
|
|
###InternalTypeSShirasFormat warn "check for a pure sprintf string"; |
135
|
|
|
|
|
|
|
if( $input !~ /{/ ){ |
136
|
|
|
|
|
|
|
###InternalTypeSShirasFormat warn "no need to pre parse this string ..."; |
137
|
|
|
|
|
|
|
return { final => $input }; |
138
|
|
|
|
|
|
|
}else{ |
139
|
|
|
|
|
|
|
###InternalTypeSShirasFormat warn "manage new formats ..."; |
140
|
|
|
|
|
|
|
my $start = 1; |
141
|
|
|
|
|
|
|
while( $input =~ /([^%]*)%([^%]*)/g ){ |
142
|
|
|
|
|
|
|
my $pre = $1; |
143
|
|
|
|
|
|
|
my $post = $2; |
144
|
|
|
|
|
|
|
###InternalTypeSShirasFormat warn "pre: $pre"; |
145
|
|
|
|
|
|
|
###InternalTypeSShirasFormat warn "post: $post"; |
146
|
|
|
|
|
|
|
if( $start ){# |
147
|
|
|
|
|
|
|
push @{$finished_ref->{init_parse}}, $pre; |
148
|
|
|
|
|
|
|
$start = 0; |
149
|
|
|
|
|
|
|
}elsif( $pre ){ |
150
|
|
|
|
|
|
|
return "Coersion to 'ShirasFormat' failed for section -$pre- in " . |
151
|
|
|
|
|
|
|
__FILE__ . " at line " . __LINE__ . ".\n"; |
152
|
|
|
|
|
|
|
} |
153
|
|
|
|
|
|
|
if( $post =~ /^([^{]*)\{([^}]*)\}(.)(\(([^)]*)\))?(.*)$/ ){ |
154
|
|
|
|
|
|
|
my @list = ( $1, $2, $3, $4, $5, $6 ); |
155
|
|
|
|
|
|
|
###InternalTypeSShirasFormat warn "list:" . Dumper( @list ); |
156
|
|
|
|
|
|
|
if( !is_NewModifier( $list[2] ) ){ |
157
|
|
|
|
|
|
|
return "Coersion to 'ShirasFormat' failed because of an " . |
158
|
|
|
|
|
|
|
"unrecognized modifier -$list[2]- found in format string -" . |
159
|
|
|
|
|
|
|
$post . "- by ". __FILE__ . " at line " . __LINE__ . ".\n"; |
160
|
|
|
|
|
|
|
} |
161
|
|
|
|
|
|
|
push @{$finished_ref->{alt_input}}, [ @list[1,2,4] ]; |
162
|
|
|
|
|
|
|
push @{$finished_ref->{init_parse}}, join '', @list[0,2,5]; |
163
|
|
|
|
|
|
|
}elsif( $post =~ /[{}]/ ){ |
164
|
|
|
|
|
|
|
return "Coersion to 'ShirasFormat' failed for section -$post- " . |
165
|
|
|
|
|
|
|
"using " . __FILE__ . " at line " . __LINE__ . ".\n"; |
166
|
|
|
|
|
|
|
}else{ |
167
|
|
|
|
|
|
|
push @{$finished_ref->{init_parse}}, $post; |
168
|
|
|
|
|
|
|
} |
169
|
|
|
|
|
|
|
###InternalTypeSShirasFormat warn "finished ref:" . Dumper( $finished_ref ); |
170
|
|
|
|
|
|
|
} |
171
|
|
|
|
|
|
|
$input = join '%', @{$finished_ref->{init_parse}}; |
172
|
|
|
|
|
|
|
delete $finished_ref->{init_parse}; |
173
|
|
|
|
|
|
|
###InternalTypeSShirasFormat warn "current sprintf ref:" . Dumper( $input ); |
174
|
|
|
|
|
|
|
} |
175
|
|
|
|
|
|
|
###InternalTypeSShirasFormat warn "build input array modifications ..."; |
176
|
|
|
|
|
|
|
my $parsed_length = 0; |
177
|
|
|
|
|
|
|
my $total_length = length( $input ); |
178
|
|
|
|
|
|
|
while( $input =~ /$split_regex/g ){ |
179
|
|
|
|
|
|
|
my @list = ( $1, $2, $3, $4, $5, $6 );# |
180
|
|
|
|
|
|
|
###InternalTypeSShirasFormat warn "matched:" . Dumper( @list ); |
181
|
|
|
|
|
|
|
###InternalTypeSShirasFormat warn "for segment: $&"; |
182
|
|
|
|
|
|
|
if( $list[2] and $list[4] and $list[4] eq '%' ){ |
183
|
|
|
|
|
|
|
return "Coersion to 'ShirasFormat' failed for the segment: " . |
184
|
|
|
|
|
|
|
$list[1] . " using " . __FILE__ . " at line " . |
185
|
|
|
|
|
|
|
__LINE__ . ".\n"; |
186
|
|
|
|
|
|
|
} |
187
|
|
|
|
|
|
|
my $pre_string = $list[0]; |
188
|
|
|
|
|
|
|
$finished_ref->{string} .= $list[0] if $list[0]; |
189
|
|
|
|
|
|
|
$finished_ref->{new_chunk} = $list[1]; |
190
|
|
|
|
|
|
|
my $consumer_format = $list[5]; |
191
|
|
|
|
|
|
|
my $producer_format = $list[4]; |
192
|
|
|
|
|
|
|
$parsed_length += |
193
|
|
|
|
|
|
|
length( $finished_ref->{new_chunk} ) + length( $pre_string ); |
194
|
|
|
|
|
|
|
$input = ${^POSTMATCH}; |
195
|
|
|
|
|
|
|
my $pre_match = ${^PREMATCH}; |
196
|
|
|
|
|
|
|
my $finished_length = $total_length - length( $input ); |
197
|
|
|
|
|
|
|
###InternalTypeSShirasFormat warn "length of chunk: $finished_ref->{new_chunk}"; |
198
|
|
|
|
|
|
|
###InternalTypeSShirasFormat warn "parsed length: $parsed_length"; |
199
|
|
|
|
|
|
|
###InternalTypeSShirasFormat warn "finished length: $finished_length"; |
200
|
|
|
|
|
|
|
###InternalTypeSShirasFormat warn "pre match: $pre_match"; |
201
|
|
|
|
|
|
|
###InternalTypeSShirasFormat warn "remaining: $input"; |
202
|
|
|
|
|
|
|
###InternalTypeSShirasFormat warn "producer: $producer_format"; |
203
|
|
|
|
|
|
|
###InternalTypeSShirasFormat warn "consumer: $consumer_format"; |
204
|
|
|
|
|
|
|
if( $finished_length != $parsed_length ){ |
205
|
|
|
|
|
|
|
return "Coersion to 'ShirasFormat' failed for the modified " . |
206
|
|
|
|
|
|
|
"sprintf segment -$pre_match- using " . |
207
|
|
|
|
|
|
|
__FILE__ . " at line " . __LINE__ . ".\n"; |
208
|
|
|
|
|
|
|
} |
209
|
|
|
|
|
|
|
if( $producer_format or $consumer_format ){ |
210
|
|
|
|
|
|
|
# $finished_ref = _process_producer_format( $finished_ref ); |
211
|
|
|
|
|
|
|
# }elsif( $consumer_format ){ |
212
|
|
|
|
|
|
|
$finished_ref = _process_sprintf_format( $finished_ref ); |
213
|
|
|
|
|
|
|
}else{ |
214
|
|
|
|
|
|
|
delete $finished_ref->{new_chunk}; |
215
|
|
|
|
|
|
|
next; |
216
|
|
|
|
|
|
|
} |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
if( !is_HashRef( $finished_ref ) ){ |
219
|
|
|
|
|
|
|
###InternalTypeSShirasFormat warn "fail:" . Dumper( $finished_ref ); |
220
|
|
|
|
|
|
|
return $finished_ref; |
221
|
|
|
|
|
|
|
} |
222
|
|
|
|
|
|
|
delete $finished_ref->{new_chunk}; |
223
|
|
|
|
|
|
|
###InternalTypeSShirasFormat warn "current:" . Dumper( $finished_ref); |
224
|
|
|
|
|
|
|
$x++; |
225
|
|
|
|
|
|
|
###InternalTypeSShirasFormat warn "current input:" . Dumper( $input ); |
226
|
|
|
|
|
|
|
} |
227
|
|
|
|
|
|
|
###InternalTypeSShirasFormat warn "finished ref:" . Dumper( $finished_ref ); |
228
|
|
|
|
|
|
|
###InternalTypeSShirasFormat warn "input length: " . length( $input ); |
229
|
|
|
|
|
|
|
if( $input and $finished_ref->{string} !~ /$input$/ ){ |
230
|
|
|
|
|
|
|
$finished_ref->{string} .= $input; |
231
|
|
|
|
|
|
|
} |
232
|
|
|
|
|
|
|
###InternalTypeSShirasFormat warn "reviewing:" . Dumper( $finished_ref ); |
233
|
|
|
|
|
|
|
my $parsing_string = $finished_ref->{string}; |
234
|
|
|
|
|
|
|
###InternalTypeSShirasFormat warn "parsing_string: $parsing_string"; |
235
|
|
|
|
|
|
|
delete $finished_ref->{bump_count}; |
236
|
|
|
|
|
|
|
delete $finished_ref->{alt_position}; |
237
|
|
|
|
|
|
|
while( $parsing_string =~ /(\d+)([\$])/ ){ |
238
|
|
|
|
|
|
|
$finished_ref->{final} .= ${^PREMATCH}; |
239
|
|
|
|
|
|
|
$parsing_string = ${^POSTMATCH}; |
240
|
|
|
|
|
|
|
###InternalTypeSShirasFormat warn "updated:" . Dumper( $finished_ref ); |
241
|
|
|
|
|
|
|
###InternalTypeSShirasFormat warn "parsing string: $parsing_string"; |
242
|
|
|
|
|
|
|
my $digits = $1; |
243
|
|
|
|
|
|
|
my $position = $digits - 1; |
244
|
|
|
|
|
|
|
if( exists $finished_ref->{bump_list}->[$position] ){ |
245
|
|
|
|
|
|
|
$digits += $finished_ref->{bump_list}->[$position]; |
246
|
|
|
|
|
|
|
} |
247
|
|
|
|
|
|
|
###InternalTypeSShirasFormat warn "digits: $digits"; |
248
|
|
|
|
|
|
|
###InternalTypeSShirasFormat warn "position: $position"; |
249
|
|
|
|
|
|
|
$finished_ref->{final} .= $digits; |
250
|
|
|
|
|
|
|
$finished_ref->{final} .= '$'; |
251
|
|
|
|
|
|
|
###InternalTypeSShirasFormat warn "updated:" . Dumper( $finished_ref ); |
252
|
|
|
|
|
|
|
} |
253
|
|
|
|
|
|
|
$finished_ref->{final} .= $parsing_string; |
254
|
|
|
|
|
|
|
delete $finished_ref->{string}; |
255
|
|
|
|
|
|
|
###InternalTypeSShirasFormat warn "returning:" . Dumper( $finished_ref ); |
256
|
|
|
|
|
|
|
return $finished_ref; |
257
|
|
|
|
|
|
|
}; |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
subtype TextFile, as Str, |
260
|
|
|
|
|
|
|
message { "$_ does not have the correct suffix (\.txt or \.csv)" }, |
261
|
|
|
|
|
|
|
where { $_ =~ /$TextFileext\Z/sxm }; |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
subtype HeaderString, as Str, |
264
|
|
|
|
|
|
|
where{ $_ =~ /^[a-z\_][a-z0-9\_^\n\r]*$/sxm }; |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
###InternalTypeSShirasFormat warn "You uncovered internal logging statements for the Types HeaderString and HeaderArray in Log::Shiras::Types-$VERSION" if !$ENV{hide_warn}; |
267
|
|
|
|
|
|
|
coerce HeaderString, from Str, |
268
|
|
|
|
|
|
|
via { |
269
|
|
|
|
|
|
|
if( is_Str( $_ ) ) { |
270
|
|
|
|
|
|
|
my $header = $_; |
271
|
|
|
|
|
|
|
###InternalTypeSHeadeR warn "Initital header: $header"; |
272
|
|
|
|
|
|
|
$header = lc( $header ); |
273
|
|
|
|
|
|
|
###InternalTypeSHeadeR warn "Updated header: $header"; |
274
|
|
|
|
|
|
|
$header =~ s/\n/ /gsxm; |
275
|
|
|
|
|
|
|
###InternalTypeSHeadeR warn "Updated header: $header"; |
276
|
|
|
|
|
|
|
$header =~ s/\r/ /gsxm; |
277
|
|
|
|
|
|
|
###InternalTypeSHeadeR warn "Updated header: $header"; |
278
|
|
|
|
|
|
|
$header =~ s/\s/_/gsxm; |
279
|
|
|
|
|
|
|
###InternalTypeSHeadeR warn "Updated header: $header"; |
280
|
|
|
|
|
|
|
chomp $header; |
281
|
|
|
|
|
|
|
###InternalTypeSHeadeR warn "Final header: $header"; |
282
|
|
|
|
|
|
|
return $header; |
283
|
|
|
|
|
|
|
} else { |
284
|
|
|
|
|
|
|
return "Can not coerce -$_- into a 'HeaderString' since it is " . |
285
|
|
|
|
|
|
|
"a -" . ref $_ . "- ref (not a string) using " . |
286
|
|
|
|
|
|
|
"Log::Shiras::Types 'ShirasFormat' line " . __LINE__ . ".\n"; |
287
|
|
|
|
|
|
|
} |
288
|
|
|
|
|
|
|
}; |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
subtype HeaderArray, as ArrayRef[HeaderString]; |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
coerce HeaderArray, from ArrayRef, |
293
|
|
|
|
|
|
|
via { |
294
|
|
|
|
|
|
|
my $array_ref = $_; |
295
|
|
|
|
|
|
|
###InternalTypeSHeadeR warn "Received data:" . Dumper( @_ ); |
296
|
|
|
|
|
|
|
my $new_ref = []; |
297
|
|
|
|
|
|
|
for my $header ( @$array_ref ){ |
298
|
|
|
|
|
|
|
###InternalTypeSHeadeR warn "Initital header: $header"; |
299
|
|
|
|
|
|
|
$header = lc( $header ); |
300
|
|
|
|
|
|
|
###InternalTypeSHeadeR warn "Updated header: $header"; |
301
|
|
|
|
|
|
|
$header =~ s/\n/ /gsxm; |
302
|
|
|
|
|
|
|
###InternalTypeSHeadeR warn "Updated header: $header"; |
303
|
|
|
|
|
|
|
$header =~ s/\r/ /gsxm; |
304
|
|
|
|
|
|
|
###InternalTypeSHeadeR warn "Updated header: $header"; |
305
|
|
|
|
|
|
|
$header =~ s/\s/_/gsxm; |
306
|
|
|
|
|
|
|
###InternalTypeSHeadeR warn "Updated header: $header"; |
307
|
|
|
|
|
|
|
chomp $header; |
308
|
|
|
|
|
|
|
###InternalTypeSHeadeR warn "Final header: $header"; |
309
|
|
|
|
|
|
|
push @$new_ref, $header; |
310
|
|
|
|
|
|
|
} |
311
|
|
|
|
|
|
|
return $new_ref; |
312
|
|
|
|
|
|
|
}; |
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
subtype YamlFile, as Str, |
315
|
|
|
|
|
|
|
where{ $_ =~ $yamlextention and -f $_ }, |
316
|
|
|
|
|
|
|
message{ $_ }; |
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
subtype JsonFile, as Str, |
319
|
|
|
|
|
|
|
where{ $_ =~ $jsonextention and -f $_ }, |
320
|
|
|
|
|
|
|
message{ $_ }; |
321
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
subtype FileHash, as HashRef; |
323
|
|
|
|
|
|
|
###InternalTypeSFileHash warn "You uncovered internal logging statements for the Type FileHash in Log::Shiras::Types-$VERSION" if !$ENV{hide_warn}; |
324
|
|
|
|
|
|
|
coerce FileHash, from YamlFile, |
325
|
|
|
|
|
|
|
via{ |
326
|
|
|
|
|
|
|
my @Array = LoadFile( $_ ); |
327
|
|
|
|
|
|
|
###InternalTypeSFileHash warn "downloaded file:" . Dumper( @Array ); |
328
|
|
|
|
|
|
|
return ( ref $Array[0] eq 'HASH' ) ? |
329
|
|
|
|
|
|
|
$Array[0] : { @Array } ; |
330
|
|
|
|
|
|
|
}; |
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
coerce FileHash, from JsonFile, |
333
|
|
|
|
|
|
|
via{ |
334
|
|
|
|
|
|
|
###InternalTypeSFileHash warn "input: $_"; |
335
|
|
|
|
|
|
|
open( my $fh, "<", $_ ); |
336
|
|
|
|
|
|
|
my @Array = <$fh>; |
337
|
|
|
|
|
|
|
chomp @Array; |
338
|
|
|
|
|
|
|
###InternalTypeSFileHash warn "downloaded file:" . Dumper( @Array ); |
339
|
|
|
|
|
|
|
my $ref = $coder->decode( join '', @Array ); |
340
|
|
|
|
|
|
|
###InternalTypeSFileHash warn "converted file:" . Dumper( $ref ); |
341
|
|
|
|
|
|
|
return $ref ; |
342
|
|
|
|
|
|
|
}; |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
subtype ArgsHash, as HashRef, |
345
|
|
|
|
|
|
|
where{ |
346
|
|
|
|
|
|
|
my $result = 0; |
347
|
|
|
|
|
|
|
for my $key ( @$switchboard_attributes ){ |
348
|
|
|
|
|
|
|
if( exists $_->{$key} ){ |
349
|
|
|
|
|
|
|
$result = 1; |
350
|
|
|
|
|
|
|
last; |
351
|
|
|
|
|
|
|
} |
352
|
|
|
|
|
|
|
} |
353
|
|
|
|
|
|
|
return $result; |
354
|
|
|
|
|
|
|
}, |
355
|
|
|
|
|
|
|
message{ 'None of the required attributes were passed' }; |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
coerce ArgsHash, from FileHash, |
358
|
|
|
|
|
|
|
via{ $_ }; |
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
subtype ReportObject, as Object, |
361
|
|
|
|
|
|
|
where{ $_->can( 'add_line' ) }, |
362
|
|
|
|
|
|
|
message{ $_ }; |
363
|
|
|
|
|
|
|
###InternalTypeSReportObject warn "You uncovered internal logging statements for the Type ReportObject in Log::Shiras::Types-$VERSION" if !$ENV{hide_warn}; |
364
|
|
|
|
|
|
|
coerce ReportObject, from FileHash, |
365
|
|
|
|
|
|
|
via{ |
366
|
|
|
|
|
|
|
###InternalTypeSReportObject warn "the passed value is:" . Dumper( @_ ); |
367
|
|
|
|
|
|
|
return build_instance( %$_ ); |
368
|
|
|
|
|
|
|
}; |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
subtype NameSpace, as Str, |
371
|
|
|
|
|
|
|
where{ |
372
|
|
|
|
|
|
|
my $result = 1; |
373
|
|
|
|
|
|
|
$result = 0 if( !$_ or $_ =~ / / ); |
374
|
|
|
|
|
|
|
return $result; |
375
|
|
|
|
|
|
|
}, |
376
|
|
|
|
|
|
|
message{ |
377
|
|
|
|
|
|
|
my $passed = ( ref $_ eq 'ARRAY' ) ? join( '::', @$_ ) : $_; |
378
|
|
|
|
|
|
|
return "-$passed- could not be coerced into a string without spaces"; |
379
|
|
|
|
|
|
|
}; |
380
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
coerce NameSpace, from ArrayRef, |
382
|
|
|
|
|
|
|
via{ return join( '::', @$_ ) }; |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
subtype CSVFile, |
385
|
|
|
|
|
|
|
as Str, |
386
|
|
|
|
|
|
|
where{ $_ =~ /\.(csv)$/i and -r $_}; |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
coerce CSVFile, |
389
|
|
|
|
|
|
|
from Str, |
390
|
|
|
|
|
|
|
via{ my $fh = IO::File->new; |
391
|
|
|
|
|
|
|
$fh->open( "> $_" );# Vivify the file! |
392
|
|
|
|
|
|
|
$fh->close; |
393
|
|
|
|
|
|
|
return $_; }; |
394
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
subtype XMLFile, |
396
|
|
|
|
|
|
|
as Str, |
397
|
|
|
|
|
|
|
where{ $_ =~ /\.(xml|rels)$/i and -r $_}; |
398
|
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
subtype XLSXFile, |
400
|
|
|
|
|
|
|
as Str, |
401
|
|
|
|
|
|
|
where{ $_ =~ /\.x(ls(x|m)|ml)$/i and -r $_ }; |
402
|
|
|
|
|
|
|
|
403
|
|
|
|
|
|
|
subtype XLSFile, |
404
|
|
|
|
|
|
|
as Str, |
405
|
|
|
|
|
|
|
where{ $_ =~ /\.xls$/i and -r $_ }; |
406
|
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
subtype IOFileType, |
408
|
|
|
|
|
|
|
as FileHandle; |
409
|
|
|
|
|
|
|
#~ { class => 'IO::File' }; |
410
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
#~ coerce IOFileType, |
412
|
|
|
|
|
|
|
#~ from GlobRef, |
413
|
|
|
|
|
|
|
#~ via{ my $fh = bless( $_, 'IO::File' ); |
414
|
|
|
|
|
|
|
#~ $fh->binmode(); |
415
|
|
|
|
|
|
|
#~ return $fh; }; |
416
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
#~ coerce IOFileType, |
418
|
|
|
|
|
|
|
#~ from CSVFile, |
419
|
|
|
|
|
|
|
#~ via{ my $fh = IO::File->new( $_, 'r' ); |
420
|
|
|
|
|
|
|
#~ $fh->binmode(); |
421
|
|
|
|
|
|
|
#~ flock( $fh, LOCK_EX ); |
422
|
|
|
|
|
|
|
#~ return $fh; }; |
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
#~ coerce IOFileType, |
425
|
|
|
|
|
|
|
#~ from XLSXFile, |
426
|
|
|
|
|
|
|
#~ via{ my $fh = IO::File->new( $_, 'r' ); |
427
|
|
|
|
|
|
|
#~ $fh->binmode(); |
428
|
|
|
|
|
|
|
#~ flock( $fh, LOCK_EX ); |
429
|
|
|
|
|
|
|
#~ return $fh; }; |
430
|
|
|
|
|
|
|
|
431
|
|
|
|
|
|
|
#~ coerce IOFileType, |
432
|
|
|
|
|
|
|
#~ from XLSFile, |
433
|
|
|
|
|
|
|
#~ via{ my $fh = IO::File->new( $_, 'r' ); |
434
|
|
|
|
|
|
|
#~ $fh->binmode(); |
435
|
|
|
|
|
|
|
#~ flock( $fh, LOCK_EX ); |
436
|
|
|
|
|
|
|
#~ return $fh; }; |
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
#~ coerce IOFileType, |
439
|
|
|
|
|
|
|
#~ from XMLFile, |
440
|
|
|
|
|
|
|
#~ via{ my $fh = IO::File->new( $_, 'r' ); |
441
|
|
|
|
|
|
|
#~ $fh->binmode(); |
442
|
|
|
|
|
|
|
#~ flock( $fh, LOCK_EX ); |
443
|
|
|
|
|
|
|
#~ return $fh; }; |
444
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
#########1 Private Methods 3#########4#########5#########6#########7#########8#########9 |
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
sub _has_shiras_keys{ |
449
|
0
|
|
|
0
|
|
|
my ( $ref ) =@_; |
450
|
|
|
|
|
|
|
###InternalTypeSShirasFormat warn "passed information is:" . Dumper( $ref ); |
451
|
0
|
|
|
|
|
|
my $result = 1; |
452
|
0
|
0
|
|
|
|
|
if( ref $ref eq 'HASH' ){ |
453
|
|
|
|
|
|
|
###InternalTypeSShirasFormat warn "found a hash ref..."; |
454
|
0
|
|
|
|
|
|
for my $key ( keys %$ref ){ |
455
|
|
|
|
|
|
|
###InternalTypeSShirasFormat warn "testing key: $key"; |
456
|
0
|
0
|
|
|
|
|
if( !(exists $shiras_format_ref->{$key}) ){ |
457
|
|
|
|
|
|
|
###InternalTypeSShirasFormat warn "failed at key: $key"; |
458
|
|
|
|
|
|
|
### <where> - |
459
|
0
|
|
|
|
|
|
$result = 0; |
460
|
0
|
|
|
|
|
|
last; |
461
|
|
|
|
|
|
|
} |
462
|
|
|
|
|
|
|
} |
463
|
|
|
|
|
|
|
}else{ |
464
|
0
|
|
|
|
|
|
$result = 0; |
465
|
|
|
|
|
|
|
} |
466
|
0
|
|
|
|
|
|
return $result; |
467
|
|
|
|
|
|
|
} |
468
|
|
|
|
|
|
|
|
469
|
|
|
|
|
|
|
sub _process_sprintf_format{ |
470
|
0
|
|
|
0
|
|
|
my ( $ref ) = @_; |
471
|
|
|
|
|
|
|
###InternalTypeSShirasFormat warn "passed information is:" . Dumper( $ref ); |
472
|
0
|
0
|
|
|
|
|
if( my @list = $ref->{new_chunk} =~ $sprintf_regex ) { |
473
|
|
|
|
|
|
|
###InternalTypeSShirasFormat warn "results of the next regex element are:" .Dumper( @list ); |
474
|
0
|
|
|
|
|
|
$ref->{string} .= '%'; |
475
|
0
|
|
|
|
|
|
my $x = 0; |
476
|
0
|
|
|
|
|
|
for my $item ( @list ){ |
477
|
0
|
0
|
|
|
|
|
if( defined $item ){ |
478
|
|
|
|
|
|
|
###InternalTypeSShirasFormat warn "processing: $item"; |
479
|
|
|
|
|
|
|
###InternalTypeSShirasFormat warn "position: $x"; |
480
|
0
|
|
|
|
|
|
my $i = 0; |
481
|
0
|
|
|
|
|
|
for my $method ( @{$sprintf_dispatch->[$x]} ){ |
|
0
|
|
|
|
|
|
|
482
|
|
|
|
|
|
|
###InternalTypeSShirasFormat warn "running the -$i- method: $method"; |
483
|
0
|
|
|
|
|
|
$ref = $method->( $item, $ref ); |
484
|
|
|
|
|
|
|
###InternalTypeSShirasFormat warn "updated ref:" . Dumper( $ref ); |
485
|
0
|
0
|
|
|
|
|
return $ref if ref $ref ne 'HASH'; |
486
|
0
|
|
|
|
|
|
$i++; |
487
|
|
|
|
|
|
|
} |
488
|
|
|
|
|
|
|
} |
489
|
0
|
|
|
|
|
|
$x++; |
490
|
|
|
|
|
|
|
} |
491
|
|
|
|
|
|
|
} else { |
492
|
|
|
|
|
|
|
$ref = "Failed to match -" . $ref->{new_chunk} . |
493
|
0
|
|
|
|
|
|
"- as a (modified) sprintf chunk"; |
494
|
|
|
|
|
|
|
} |
495
|
|
|
|
|
|
|
###InternalTypeSShirasFormat warn "after _process_sprintf_format:" . Dumper( $ref ); |
496
|
0
|
|
|
|
|
|
return $ref; |
497
|
|
|
|
|
|
|
} |
498
|
|
|
|
|
|
|
|
499
|
|
|
|
|
|
|
sub _process_producer_format{ |
500
|
0
|
|
|
0
|
|
|
my ( $ref ) = @_; |
501
|
|
|
|
|
|
|
###InternalTypeSShirasFormat warn "passed information is:" . Dumper( $ref ); |
502
|
0
|
|
|
|
|
|
$ref->{string} .= $ref->{new_chunk}; |
503
|
0
|
|
|
|
|
|
delete $ref->{new_chunk}; |
504
|
|
|
|
|
|
|
###InternalTypeSShirasFormat warn "after _process_producer_format:" . Dumper( $ref ); |
505
|
0
|
|
|
|
|
|
return $ref; |
506
|
|
|
|
|
|
|
} |
507
|
|
|
|
|
|
|
|
508
|
|
|
|
|
|
|
sub _append_to_string{ |
509
|
0
|
|
|
0
|
|
|
my ( $item, $item_ref ) = @_; |
510
|
|
|
|
|
|
|
###InternalTypeSShirasFormat warn "reached _append_to_string with:" . Dumper( $item ); |
511
|
0
|
|
|
|
|
|
$item_ref->{string} .= $item; |
512
|
0
|
|
|
|
|
|
return $item_ref; |
513
|
|
|
|
|
|
|
} |
514
|
|
|
|
|
|
|
|
515
|
|
|
|
|
|
|
sub _does_not_consume{ |
516
|
0
|
|
|
0
|
|
|
my ( $item, $item_ref ) = @_; |
517
|
|
|
|
|
|
|
###InternalTypeSShirasFormat warn "reached _does_not_consume with:" . Dumper( $item ); |
518
|
0
|
|
|
|
|
|
$item_ref->{no_primary_consumption} = 1; |
519
|
0
|
|
|
|
|
|
return $item_ref; |
520
|
|
|
|
|
|
|
} |
521
|
|
|
|
|
|
|
|
522
|
|
|
|
|
|
|
sub _set_consumption{ |
523
|
0
|
|
|
0
|
|
|
my ( $item, $item_ref ) = @_; |
524
|
|
|
|
|
|
|
###InternalTypeSShirasFormat warn "reached _set_consumption with:" . Dumper( $item ); |
525
|
0
|
0
|
|
|
|
|
if( !$item_ref->{no_primary_consumption} ){ |
526
|
0
|
|
|
|
|
|
push @{$item_ref->{bump_list}}, |
527
|
0
|
0
|
|
|
|
|
((exists $item_ref->{bump_count})?$item_ref->{bump_count}:0); |
528
|
|
|
|
|
|
|
} |
529
|
0
|
|
|
|
|
|
delete $item_ref->{no_primary_consumption}; |
530
|
0
|
|
|
|
|
|
return $item_ref; |
531
|
|
|
|
|
|
|
} |
532
|
|
|
|
|
|
|
|
533
|
|
|
|
|
|
|
sub _remove_consumption{ |
534
|
0
|
|
|
0
|
|
|
my ( $item, $item_ref ) = @_; |
535
|
|
|
|
|
|
|
###InternalTypeSShirasFormat warn "reached _remove_consumption with:" . Dumper( $item ); |
536
|
0
|
|
|
|
|
|
pop @{$item_ref->{bump_list}}; |
|
0
|
|
|
|
|
|
|
537
|
0
|
|
|
|
|
|
return $item_ref; |
538
|
|
|
|
|
|
|
} |
539
|
|
|
|
|
|
|
|
540
|
|
|
|
|
|
|
sub _set_insert_call{ |
541
|
0
|
|
|
0
|
|
|
my ( $item, $item_ref ) = @_; |
542
|
|
|
|
|
|
|
$item_ref->{alt_position} = ( $item_ref->{alt_position} ) ? |
543
|
0
|
0
|
|
|
|
|
$item_ref->{alt_position} : 0 ; |
544
|
0
|
|
|
|
|
|
$item_ref->{bump_count}++; |
545
|
|
|
|
|
|
|
###InternalTypeSShirasFormat warn "reached _set_insert_call with:" . Dumper( $item ); |
546
|
|
|
|
|
|
|
###InternalTypeSShirasFormat warn "using position:" . Dumper( $item_ref->{alt_position} ); |
547
|
|
|
|
|
|
|
###InternalTypeSShirasFormat warn "with new bump level:" . Dumper( $item_ref->{bump_count} ); |
548
|
|
|
|
|
|
|
my $new_ref = [ |
549
|
|
|
|
|
|
|
$item_ref->{alt_input}->[$item_ref->{alt_position}]->[1], |
550
|
0
|
|
|
|
|
|
$item_ref->{alt_input}->[$item_ref->{alt_position}]->[0], |
551
|
|
|
|
|
|
|
]; |
552
|
0
|
0
|
|
|
|
|
if( $item_ref->{alt_input}->[$item_ref->{alt_position}]->[2] ){ |
553
|
0
|
|
|
|
|
|
my $dispatch = undef; |
554
|
0
|
|
|
|
|
|
for my $value ( |
555
|
|
|
|
|
|
|
split /,|=>/, |
556
|
|
|
|
|
|
|
$item_ref->{alt_input}->[$item_ref->{alt_position}]->[2] ){ |
557
|
0
|
|
|
|
|
|
$value =~ s/\s//g; |
558
|
0
|
|
|
|
|
|
$value =~ s/^['"]([^'"]*)['"]$/$1/g; |
559
|
0
|
|
|
|
|
|
push @$new_ref, $value; |
560
|
0
|
0
|
|
|
|
|
if( $dispatch ){ |
561
|
|
|
|
|
|
|
$item_ref->{bump_count} -= |
562
|
0
|
0
|
|
|
|
|
( $value =~/^\d+$/ )? $value : |
|
|
0
|
|
|
|
|
|
563
|
|
|
|
|
|
|
( $value =~/^\*$/ )? 1 : 0 ; |
564
|
0
|
|
|
|
|
|
$dispatch = undef; |
565
|
|
|
|
|
|
|
}else{ |
566
|
0
|
|
|
|
|
|
$dispatch = $value; |
567
|
|
|
|
|
|
|
} |
568
|
|
|
|
|
|
|
} |
569
|
|
|
|
|
|
|
} |
570
|
0
|
|
|
|
|
|
$item_ref->{alt_input}->[$item_ref->{alt_position}] = { commands => $new_ref }; |
571
|
|
|
|
|
|
|
$item_ref->{alt_input}->[$item_ref->{alt_position}]->{start_at} = |
572
|
|
|
|
|
|
|
( exists $item_ref->{bump_list} ) ? |
573
|
0
|
0
|
|
|
|
|
$#{$item_ref->{bump_list}} + 1 : 0 ; |
|
0
|
|
|
|
|
|
|
574
|
0
|
|
|
|
|
|
$item_ref->{alt_position}++; |
575
|
|
|
|
|
|
|
###InternalTypeSShirasFormat warn "item ref:" . Dumper( $item_ref ); |
576
|
0
|
|
|
|
|
|
return $item_ref; |
577
|
|
|
|
|
|
|
} |
578
|
|
|
|
|
|
|
|
579
|
|
|
|
|
|
|
sub _test_for_position_change{ |
580
|
0
|
|
|
0
|
|
|
my ( $item, $item_ref ) = @_; |
581
|
|
|
|
|
|
|
###InternalTypeSShirasFormat warn "reached _test_for_position_change with:" . Dumper( $item ); |
582
|
0
|
0
|
|
|
|
|
if( exists $item_ref->{conflict_test} ){ |
583
|
|
|
|
|
|
|
$item_ref = "You cannot call for alternative location pull -" . |
584
|
0
|
|
|
|
|
|
$item_ref->{conflict_test} . "- and get data from the -$item- " . |
585
|
|
|
|
|
|
|
"source in ShirasFormat type coersion at line " . __LINE__ . ".\n"; |
586
|
|
|
|
|
|
|
} |
587
|
0
|
|
|
|
|
|
return $item_ref; |
588
|
|
|
|
|
|
|
} |
589
|
|
|
|
|
|
|
|
590
|
|
|
|
|
|
|
sub _alt_position{ |
591
|
0
|
|
|
0
|
|
|
my ( $item, $item_ref ) = @_; |
592
|
|
|
|
|
|
|
###InternalTypeSShirasFormat warn "reached _alt_position with:" . Dumper( $item ); |
593
|
0
|
0
|
|
|
|
|
$item_ref->{conflict_test} = $item if $item; |
594
|
0
|
|
|
|
|
|
return $item_ref; |
595
|
|
|
|
|
|
|
} |
596
|
|
|
|
|
|
|
|
597
|
|
|
|
|
|
|
#########1 Phinish 3#########4#########5#########6#########7#########8#########9 |
598
|
|
|
|
|
|
|
|
599
|
|
|
|
|
|
|
1; |
600
|
|
|
|
|
|
|
# The preceding line will help the module return a true value |
601
|
|
|
|
|
|
|
|
602
|
|
|
|
|
|
|
#########1 main pod docs 3#########4#########5#########6#########7#########8#########9 |
603
|
|
|
|
|
|
|
__END__ |
604
|
|
|
|
|
|
|
|
605
|
|
|
|
|
|
|
=head1 NAME |
606
|
|
|
|
|
|
|
|
607
|
|
|
|
|
|
|
Log::Shiras::Types - The Type::Tiny library for Log::Shiras |
608
|
|
|
|
|
|
|
|
609
|
|
|
|
|
|
|
=head1 SYNOPSIS |
610
|
|
|
|
|
|
|
|
611
|
|
|
|
|
|
|
#!perl |
612
|
|
|
|
|
|
|
package Log::Shiras::Report::MyRole; |
613
|
|
|
|
|
|
|
|
614
|
|
|
|
|
|
|
use Modern::Perl;#suggested |
615
|
|
|
|
|
|
|
use Moose::Role; |
616
|
|
|
|
|
|
|
use Log::Shiras::Types v0.013 qw( |
617
|
|
|
|
|
|
|
ShirasFormat |
618
|
|
|
|
|
|
|
JsonFile |
619
|
|
|
|
|
|
|
); |
620
|
|
|
|
|
|
|
|
621
|
|
|
|
|
|
|
has 'someattribute' =>( |
622
|
|
|
|
|
|
|
isa => ShirasFormat,#Note the lack of quotes |
623
|
|
|
|
|
|
|
); |
624
|
|
|
|
|
|
|
|
625
|
|
|
|
|
|
|
sub valuetestmethod{ |
626
|
|
|
|
|
|
|
return is_JsonFile( 'my_file.jsn' ); |
627
|
|
|
|
|
|
|
} |
628
|
|
|
|
|
|
|
|
629
|
|
|
|
|
|
|
no Moose::Role; |
630
|
|
|
|
|
|
|
|
631
|
|
|
|
|
|
|
1; |
632
|
|
|
|
|
|
|
|
633
|
|
|
|
|
|
|
=head1 DESCRIPTION |
634
|
|
|
|
|
|
|
|
635
|
|
|
|
|
|
|
This is the custom type class that ships with the L<Log::Shiras> package. |
636
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
There are only subtypes in this package! B<WARNING> These types should be |
638
|
|
|
|
|
|
|
considered in a beta state. Future type fixing will be done with a set of tests in |
639
|
|
|
|
|
|
|
the test suit of this package. (currently few are implemented) |
640
|
|
|
|
|
|
|
|
641
|
|
|
|
|
|
|
See L<MooseX::Types> for general re-use of this module. |
642
|
|
|
|
|
|
|
|
643
|
|
|
|
|
|
|
=head1 Types |
644
|
|
|
|
|
|
|
|
645
|
|
|
|
|
|
|
=head2 PosInt |
646
|
|
|
|
|
|
|
|
647
|
|
|
|
|
|
|
=over |
648
|
|
|
|
|
|
|
|
649
|
|
|
|
|
|
|
=item B<Definition: >all integers equal to or greater than 0 |
650
|
|
|
|
|
|
|
|
651
|
|
|
|
|
|
|
=item B<Coercions: >no coersion available |
652
|
|
|
|
|
|
|
|
653
|
|
|
|
|
|
|
=back |
654
|
|
|
|
|
|
|
|
655
|
|
|
|
|
|
|
=head2 ElevenInt |
656
|
|
|
|
|
|
|
|
657
|
|
|
|
|
|
|
=over |
658
|
|
|
|
|
|
|
|
659
|
|
|
|
|
|
|
=item B<Definition: >any posInt less than 11 |
660
|
|
|
|
|
|
|
|
661
|
|
|
|
|
|
|
=item B<Coercions: >no coersion available |
662
|
|
|
|
|
|
|
|
663
|
|
|
|
|
|
|
=back |
664
|
|
|
|
|
|
|
|
665
|
|
|
|
|
|
|
=head2 ElevenArray |
666
|
|
|
|
|
|
|
|
667
|
|
|
|
|
|
|
=over |
668
|
|
|
|
|
|
|
|
669
|
|
|
|
|
|
|
=item B<Definition: >an array with up to 12 total positions [0..11] |
670
|
|
|
|
|
|
|
L<I<This one goes to eleven>|https://en.wikipedia.org/wiki/This_Is_Spinal_Tap> |
671
|
|
|
|
|
|
|
|
672
|
|
|
|
|
|
|
=item B<Coercions: >no coersion available |
673
|
|
|
|
|
|
|
|
674
|
|
|
|
|
|
|
=back |
675
|
|
|
|
|
|
|
|
676
|
|
|
|
|
|
|
=head2 ShirasFormat |
677
|
|
|
|
|
|
|
|
678
|
|
|
|
|
|
|
=over |
679
|
|
|
|
|
|
|
|
680
|
|
|
|
|
|
|
=item B<Definition: >this is the core of the L<Log::Shiras::Report::ShirasFormat> module. |
681
|
|
|
|
|
|
|
When prepared the final 'ShirasFormat' definition is a hashref that contains three keys; |
682
|
|
|
|
|
|
|
|
683
|
|
|
|
|
|
|
=over |
684
|
|
|
|
|
|
|
|
685
|
|
|
|
|
|
|
=item B<final> - a sprintf compliant format string |
686
|
|
|
|
|
|
|
|
687
|
|
|
|
|
|
|
=item B<alt_input> - an arrayref of input definitions and positions for all the additional |
688
|
|
|
|
|
|
|
'ShirasFormat' modifications allowed |
689
|
|
|
|
|
|
|
|
690
|
|
|
|
|
|
|
=item B<bump_list> - a record of where and how many new inputs will be inserted |
691
|
|
|
|
|
|
|
in the passed data for formatting the sprintf compliant string |
692
|
|
|
|
|
|
|
|
693
|
|
|
|
|
|
|
=back |
694
|
|
|
|
|
|
|
|
695
|
|
|
|
|
|
|
In order to simplify sprintf formatting I approached the sprintf definition as having |
696
|
|
|
|
|
|
|
the following sequence; |
697
|
|
|
|
|
|
|
|
698
|
|
|
|
|
|
|
=over |
699
|
|
|
|
|
|
|
|
700
|
|
|
|
|
|
|
=item B<Optional - Pre-string, > any pre-string that would be printed as it stands |
701
|
|
|
|
|
|
|
(not interpolated) |
702
|
|
|
|
|
|
|
|
703
|
|
|
|
|
|
|
=item B<Required - %, >this indicates the start of a formating definition |
704
|
|
|
|
|
|
|
|
705
|
|
|
|
|
|
|
=item B<Optional - L<Flags|http://perldoc.perl.org/functions/sprintf.html#flags>, > |
706
|
|
|
|
|
|
|
any one or two of the following optional flag [\s\-\+0#] as defined in the sprintf |
707
|
|
|
|
|
|
|
documentation. |
708
|
|
|
|
|
|
|
|
709
|
|
|
|
|
|
|
=item B<Optional - |
710
|
|
|
|
|
|
|
L<Order of arguments|http://perldoc.perl.org/functions/sprintf.html#order-of-arguments>, > |
711
|
|
|
|
|
|
|
indicate some other position to obtain the formatted value. |
712
|
|
|
|
|
|
|
|
713
|
|
|
|
|
|
|
=item B<Optional - |
714
|
|
|
|
|
|
|
L<Vector flag|http://perldoc.perl.org/functions/sprintf.html#vector-flag>, >to treat |
715
|
|
|
|
|
|
|
each input character as a value in a vector then you use the vector flag with it's |
716
|
|
|
|
|
|
|
optional vector separator definition. |
717
|
|
|
|
|
|
|
|
718
|
|
|
|
|
|
|
=item B<Optional - |
719
|
|
|
|
|
|
|
L<Minimum field width|http://perldoc.perl.org/functions/sprintf.html#(minimum)-width>, > |
720
|
|
|
|
|
|
|
This defines the space taken for presenting the value |
721
|
|
|
|
|
|
|
|
722
|
|
|
|
|
|
|
=item B<Optional - |
723
|
|
|
|
|
|
|
L<Maximum field width|http://perldoc.perl.org/functions/sprintf.html#precision%2c-or-maximum-width>, > |
724
|
|
|
|
|
|
|
This defines the maximum length of the presented value. If maximum width is smaller |
725
|
|
|
|
|
|
|
than the minimum width then the value is truncatd to the maximum width and presented |
726
|
|
|
|
|
|
|
in the mimimum width space as defined by the flags. |
727
|
|
|
|
|
|
|
|
728
|
|
|
|
|
|
|
=item B<Required - |
729
|
|
|
|
|
|
|
L<Data type definition|http://perldoc.perl.org/functions/sprintf.html#sprintf-FORMAT%2c-LIST>, > |
730
|
|
|
|
|
|
|
This is done with an upper or lower case letter as described in the sprintf documentation. Only |
731
|
|
|
|
|
|
|
the letters defined in the sprintf documentation are supported. These letters close the |
732
|
|
|
|
|
|
|
sprintf documentation segment started with '%'. |
733
|
|
|
|
|
|
|
|
734
|
|
|
|
|
|
|
=back |
735
|
|
|
|
|
|
|
|
736
|
|
|
|
|
|
|
The specific combination of these values is defined in the perldoc |
737
|
|
|
|
|
|
|
L<sprintf|http://perldoc.perl.org/functions/sprintf.html>. |
738
|
|
|
|
|
|
|
|
739
|
|
|
|
|
|
|
The module ShirasFormat expands on this definitions as follows; |
740
|
|
|
|
|
|
|
|
741
|
|
|
|
|
|
|
=over |
742
|
|
|
|
|
|
|
|
743
|
|
|
|
|
|
|
=item B<Word in braces {}, > just prior to the L</Data type definition> you can |
744
|
|
|
|
|
|
|
begin a sequence that starts with a word (no spaces) enclosed in braces. This word will |
745
|
|
|
|
|
|
|
be the name of the source data used in this format sequence. |
746
|
|
|
|
|
|
|
|
747
|
|
|
|
|
|
|
=item B<Source indicator qr/[MP]/, > just after the L</Word in braces {}> you must indicate |
748
|
|
|
|
|
|
|
where the code should look for this information. There are only two choices; |
749
|
|
|
|
|
|
|
|
750
|
|
|
|
|
|
|
=over |
751
|
|
|
|
|
|
|
|
752
|
|
|
|
|
|
|
=item B<P> - a passed value in the message hash reference. The word in braces should be an |
753
|
|
|
|
|
|
|
exact match to a key in the message hashref. The core value used for this ShirasFormat |
754
|
|
|
|
|
|
|
segemnt will be the value assigned to that key. |
755
|
|
|
|
|
|
|
|
756
|
|
|
|
|
|
|
=item B<M> - a method name to be discovered by the class. I<This method must exist at the |
757
|
|
|
|
|
|
|
time the format is set!> When the Shiras format string is set the code will attempt to |
758
|
|
|
|
|
|
|
locate the method and save the location for calling this method to speed up implementation of |
759
|
|
|
|
|
|
|
ongoing formatting operations. If the method does not exist when the format string is |
760
|
|
|
|
|
|
|
set even if it will exist before data is passed for formatting then this call will fail. |
761
|
|
|
|
|
|
|
if you want to pass a closure (subroutine reference) then pass it as the value in the mesage |
762
|
|
|
|
|
|
|
hash L<part |
763
|
|
|
|
|
|
|
of the message ref|/a passed value in the message hash reference> and call it with 'P'. |
764
|
|
|
|
|
|
|
|
765
|
|
|
|
|
|
|
=back |
766
|
|
|
|
|
|
|
|
767
|
|
|
|
|
|
|
=item B<Code pairs in (), following the source indicator> often the passed information |
768
|
|
|
|
|
|
|
is a code reference and for that code to be useful it needs to accept input. These code |
769
|
|
|
|
|
|
|
pairs are a way of implementing the code. The code pairs must be in intended use sequence. |
770
|
|
|
|
|
|
|
The convention is to write these in a fat comma list. There is no limit to code pairs |
771
|
|
|
|
|
|
|
quatities. There are three possible keys for these pairs; |
772
|
|
|
|
|
|
|
|
773
|
|
|
|
|
|
|
=over |
774
|
|
|
|
|
|
|
|
775
|
|
|
|
|
|
|
=item B<m> this indicates a method call. If the code passed is actually an object with |
776
|
|
|
|
|
|
|
methods then this will call the value of this pair as a method on the code. |
777
|
|
|
|
|
|
|
|
778
|
|
|
|
|
|
|
=item B<i> this indicates regular input to the method and input will be provided to a |
779
|
|
|
|
|
|
|
method using the value as follows; |
780
|
|
|
|
|
|
|
|
781
|
|
|
|
|
|
|
$method( 'value' ) |
782
|
|
|
|
|
|
|
|
783
|
|
|
|
|
|
|
=item B<l> this indicates lvalue input to the method and input will be provided to a |
784
|
|
|
|
|
|
|
method using the value as follows; |
785
|
|
|
|
|
|
|
|
786
|
|
|
|
|
|
|
$method->( 'value' ) |
787
|
|
|
|
|
|
|
|
788
|
|
|
|
|
|
|
=item B<[value]> Values to the methods can be provided in one of three ways. A B<string> |
789
|
|
|
|
|
|
|
that will be sent to the method directly. An B<*> to indicate that the method will consume |
790
|
|
|
|
|
|
|
the next value in the passed message array ref. Or an B<integer> indicating how many of the |
791
|
|
|
|
|
|
|
elements of the passed messay array should be consumed. When elements of the passed |
792
|
|
|
|
|
|
|
message array are consumed they are consumed in order just like other sprintf elements. |
793
|
|
|
|
|
|
|
|
794
|
|
|
|
|
|
|
=back |
795
|
|
|
|
|
|
|
|
796
|
|
|
|
|
|
|
When a special ShirasFormat segment is called the braces and the Source indicator are |
797
|
|
|
|
|
|
|
manditory. The code pairs are optional. |
798
|
|
|
|
|
|
|
|
799
|
|
|
|
|
|
|
=item B<Coercions: >from a modified sprintf format string |
800
|
|
|
|
|
|
|
|
801
|
|
|
|
|
|
|
=back |
802
|
|
|
|
|
|
|
|
803
|
|
|
|
|
|
|
=back |
804
|
|
|
|
|
|
|
|
805
|
|
|
|
|
|
|
=head2 TextFile |
806
|
|
|
|
|
|
|
|
807
|
|
|
|
|
|
|
=over |
808
|
|
|
|
|
|
|
|
809
|
|
|
|
|
|
|
=item B<Definition: >a file name with a \.txt or \.csv extention that exists |
810
|
|
|
|
|
|
|
|
811
|
|
|
|
|
|
|
=item B<Coercions: >no coersion available |
812
|
|
|
|
|
|
|
|
813
|
|
|
|
|
|
|
=back |
814
|
|
|
|
|
|
|
|
815
|
|
|
|
|
|
|
=head2 HeaderString |
816
|
|
|
|
|
|
|
|
817
|
|
|
|
|
|
|
=over |
818
|
|
|
|
|
|
|
|
819
|
|
|
|
|
|
|
=item B<Definition: >a string without any newlines |
820
|
|
|
|
|
|
|
|
821
|
|
|
|
|
|
|
=item B<Coercions: >if coercions are turned on, newlines will be stripped (\n\r) |
822
|
|
|
|
|
|
|
|
823
|
|
|
|
|
|
|
=back |
824
|
|
|
|
|
|
|
|
825
|
|
|
|
|
|
|
=head2 YamlFile |
826
|
|
|
|
|
|
|
|
827
|
|
|
|
|
|
|
=over |
828
|
|
|
|
|
|
|
|
829
|
|
|
|
|
|
|
=item B<Definition: >a file name with a qr/(\.yml|\.yaml)/ extention that exists |
830
|
|
|
|
|
|
|
|
831
|
|
|
|
|
|
|
=item B<Coercions: >none |
832
|
|
|
|
|
|
|
|
833
|
|
|
|
|
|
|
=back |
834
|
|
|
|
|
|
|
|
835
|
|
|
|
|
|
|
=head2 JsonFile |
836
|
|
|
|
|
|
|
|
837
|
|
|
|
|
|
|
=over |
838
|
|
|
|
|
|
|
|
839
|
|
|
|
|
|
|
=item B<Definition: >a file name with a qr/(\.jsn|\.json)/ extention that exists |
840
|
|
|
|
|
|
|
|
841
|
|
|
|
|
|
|
=item B<Coercions: >none |
842
|
|
|
|
|
|
|
|
843
|
|
|
|
|
|
|
=back |
844
|
|
|
|
|
|
|
|
845
|
|
|
|
|
|
|
=head2 ArgsHash |
846
|
|
|
|
|
|
|
|
847
|
|
|
|
|
|
|
=over |
848
|
|
|
|
|
|
|
|
849
|
|
|
|
|
|
|
=item B<Definition: >a hashref that has at least one of the following keys |
850
|
|
|
|
|
|
|
|
851
|
|
|
|
|
|
|
name_space_bounds |
852
|
|
|
|
|
|
|
reports |
853
|
|
|
|
|
|
|
buffering |
854
|
|
|
|
|
|
|
ignored_caller_names |
855
|
|
|
|
|
|
|
will_cluck |
856
|
|
|
|
|
|
|
logging_levels |
857
|
|
|
|
|
|
|
|
858
|
|
|
|
|
|
|
This are the primary switchboard settings. |
859
|
|
|
|
|
|
|
|
860
|
|
|
|
|
|
|
=item B<Coersion >from a L</JsonFile> or L</YamlFile> it will attempt to open the file |
861
|
|
|
|
|
|
|
and turn the file into a hashref that will pass the ArgsHash criteria |
862
|
|
|
|
|
|
|
|
863
|
|
|
|
|
|
|
=back |
864
|
|
|
|
|
|
|
|
865
|
|
|
|
|
|
|
=head2 ReportObject |
866
|
|
|
|
|
|
|
|
867
|
|
|
|
|
|
|
=over |
868
|
|
|
|
|
|
|
|
869
|
|
|
|
|
|
|
=item B<Definition: >an object that passes $object->can( 'add_line' ) |
870
|
|
|
|
|
|
|
|
871
|
|
|
|
|
|
|
=item B<Coersion 1: >from a hashref it will use |
872
|
|
|
|
|
|
|
L<MooseX::ShortCut::BuildInstance|http://search.cpan.org/~jandrew/MooseX-ShortCut-BuildInstance/lib/MooseX/ShortCut/BuildInstance.pm> |
873
|
|
|
|
|
|
|
to build a report object if the necessary hashref is passed instead of an object |
874
|
|
|
|
|
|
|
|
875
|
|
|
|
|
|
|
=item B<Coersion 2: >from a L</JsonFile> or L</YamlFile> it will attempt to open the file |
876
|
|
|
|
|
|
|
and turn the file into a hashref that can be used in L</Coersion 1>. |
877
|
|
|
|
|
|
|
|
878
|
|
|
|
|
|
|
=back |
879
|
|
|
|
|
|
|
|
880
|
|
|
|
|
|
|
=head1 GLOBAL VARIABLES |
881
|
|
|
|
|
|
|
|
882
|
|
|
|
|
|
|
=over |
883
|
|
|
|
|
|
|
|
884
|
|
|
|
|
|
|
=item B<$ENV{hide_warn}> |
885
|
|
|
|
|
|
|
|
886
|
|
|
|
|
|
|
The module will warn when debug lines are 'Unhide'n. In the case where the you |
887
|
|
|
|
|
|
|
don't want these notifications set this environmental variable to true. |
888
|
|
|
|
|
|
|
|
889
|
|
|
|
|
|
|
=back |
890
|
|
|
|
|
|
|
|
891
|
|
|
|
|
|
|
=head1 TODO |
892
|
|
|
|
|
|
|
|
893
|
|
|
|
|
|
|
=over |
894
|
|
|
|
|
|
|
|
895
|
|
|
|
|
|
|
=item * write a test suit for the types to fix behavior! |
896
|
|
|
|
|
|
|
|
897
|
|
|
|
|
|
|
=item * write a set of tests for combinations of %n and {string}M |
898
|
|
|
|
|
|
|
|
899
|
|
|
|
|
|
|
=back |
900
|
|
|
|
|
|
|
|
901
|
|
|
|
|
|
|
=head1 SUPPORT |
902
|
|
|
|
|
|
|
|
903
|
|
|
|
|
|
|
=over |
904
|
|
|
|
|
|
|
|
905
|
|
|
|
|
|
|
=item L<Github Log-Shiras/issues|https://github.com/jandrew/Log-Shiras/issues> |
906
|
|
|
|
|
|
|
|
907
|
|
|
|
|
|
|
=back |
908
|
|
|
|
|
|
|
|
909
|
|
|
|
|
|
|
=head1 AUTHOR |
910
|
|
|
|
|
|
|
|
911
|
|
|
|
|
|
|
=over |
912
|
|
|
|
|
|
|
|
913
|
|
|
|
|
|
|
=item Jed Lund |
914
|
|
|
|
|
|
|
|
915
|
|
|
|
|
|
|
=item jandrew@cpan.org |
916
|
|
|
|
|
|
|
|
917
|
|
|
|
|
|
|
=back |
918
|
|
|
|
|
|
|
|
919
|
|
|
|
|
|
|
=head1 COPYRIGHT |
920
|
|
|
|
|
|
|
|
921
|
|
|
|
|
|
|
This program is free software; you can redistribute |
922
|
|
|
|
|
|
|
it and/or modify it under the same terms as Perl itself. |
923
|
|
|
|
|
|
|
|
924
|
|
|
|
|
|
|
The full text of the license can be found in the |
925
|
|
|
|
|
|
|
LICENSE file included with this module. |
926
|
|
|
|
|
|
|
|
927
|
|
|
|
|
|
|
=head1 DEPENDANCIES |
928
|
|
|
|
|
|
|
|
929
|
|
|
|
|
|
|
=over |
930
|
|
|
|
|
|
|
|
931
|
|
|
|
|
|
|
=item L<Carp> - confess |
932
|
|
|
|
|
|
|
|
933
|
|
|
|
|
|
|
=item L<version> |
934
|
|
|
|
|
|
|
|
935
|
|
|
|
|
|
|
=item L<YAML::Any> - ( Dump LoadFile ) |
936
|
|
|
|
|
|
|
|
937
|
|
|
|
|
|
|
=item L<JSON::XS> |
938
|
|
|
|
|
|
|
|
939
|
|
|
|
|
|
|
=item L<MooseX::Types> |
940
|
|
|
|
|
|
|
|
941
|
|
|
|
|
|
|
=item L<MooseX::Types::Moose> |
942
|
|
|
|
|
|
|
|
943
|
|
|
|
|
|
|
=item L<MooseX::ShortCut::BuildInstance> - 1.044 |
944
|
|
|
|
|
|
|
|
945
|
|
|
|
|
|
|
=back |
946
|
|
|
|
|
|
|
|
947
|
|
|
|
|
|
|
=head1 SEE ALSO |
948
|
|
|
|
|
|
|
|
949
|
|
|
|
|
|
|
=over |
950
|
|
|
|
|
|
|
|
951
|
|
|
|
|
|
|
=item L<Type::Tiny> |
952
|
|
|
|
|
|
|
|
953
|
|
|
|
|
|
|
=back |
954
|
|
|
|
|
|
|
|
955
|
|
|
|
|
|
|
=cut |
956
|
|
|
|
|
|
|
|
957
|
|
|
|
|
|
|
#########1 Main POD ends 3#########4#########5#########6#########7#########8#########9 |