line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Log::Shiras::Report::CSVFile; |
2
|
|
|
|
|
|
|
our $AUTHORITY = 'cpan:JANDREW'; |
3
|
1
|
|
|
1
|
|
636
|
use version; our $VERSION = version->declare("v0.46.0"); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
8
|
|
4
|
1
|
|
|
1
|
|
74
|
use strict; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
19
|
|
5
|
1
|
|
|
1
|
|
2
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
24
|
|
6
|
1
|
|
|
1
|
|
21
|
use 5.010; |
|
1
|
|
|
|
|
3
|
|
7
|
1
|
|
|
1
|
|
5
|
use utf8; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
6
|
|
8
|
1
|
|
|
1
|
|
20
|
use Moose; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
5
|
|
9
|
1
|
|
|
1
|
|
4192
|
use namespace::autoclean; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
10
|
|
10
|
1
|
|
|
1
|
|
59
|
use MooseX::StrictConstructor; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
7
|
|
11
|
1
|
|
|
1
|
|
1882
|
use MooseX::HasDefaults::RO; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
6
|
|
12
|
|
|
|
|
|
|
#~ use lib '../../../'; |
13
|
|
|
|
|
|
|
#~ use Log::Shiras::Unhide qw( :InternalReporTCSV ); |
14
|
|
|
|
|
|
|
###InternalReporTCSV warn "You uncovered internal logging statements for Log::Shiras::Report::CSVFile-$VERSION" if !$ENV{hide_warn}; |
15
|
1
|
|
|
1
|
|
3895
|
use Text::CSV_XS 1.25; |
|
1
|
|
|
|
|
7901
|
|
|
1
|
|
|
|
|
47
|
|
16
|
1
|
|
|
1
|
|
6
|
use File::Copy qw( copy ); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
42
|
|
17
|
1
|
|
|
1
|
|
5
|
use File::Temp; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
56
|
|
18
|
|
|
|
|
|
|
#~ $File::Temp::DEBUG = 1; |
19
|
1
|
|
|
1
|
|
4
|
use Carp qw( confess cluck ); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
35
|
|
20
|
1
|
|
|
1
|
|
4
|
use Fcntl qw( :flock LOCK_EX LOCK_UN SEEK_END);# |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
141
|
|
21
|
1
|
|
|
|
|
11
|
use MooseX::Types::Moose qw( |
22
|
|
|
|
|
|
|
FileHandle ArrayRef HashRef Str Bool |
23
|
1
|
|
|
1
|
|
4
|
); |
|
1
|
|
|
|
|
2
|
|
24
|
1
|
|
|
1
|
|
3635
|
use lib '../../../../lib'; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
8
|
|
25
|
|
|
|
|
|
|
###InternalReporTCSV use Log::Shiras::Switchboard; |
26
|
|
|
|
|
|
|
###InternalReporTCSV my $switchboard = Log::Shiras::Switchboard->instance; |
27
|
1
|
|
|
1
|
|
124
|
use Log::Shiras::Types qw( HeaderArray HeaderString CSVFile IOFileType ); |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
6
|
|
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
#########1 Public Attributes 3#########4#########5#########6#########7#########8#########9 |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
has file =>( |
32
|
|
|
|
|
|
|
isa => CSVFile, |
33
|
|
|
|
|
|
|
writer => 'set_file_name', |
34
|
|
|
|
|
|
|
reader => 'get_file_name', |
35
|
|
|
|
|
|
|
clearer => '_clear_file', |
36
|
|
|
|
|
|
|
predicate => '_has_file', |
37
|
|
|
|
|
|
|
required => 1, |
38
|
|
|
|
|
|
|
coerce => 1, |
39
|
|
|
|
|
|
|
); |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
has headers =>( |
42
|
|
|
|
|
|
|
isa => HeaderArray, |
43
|
|
|
|
|
|
|
traits =>['Array'], |
44
|
|
|
|
|
|
|
writer => 'set_headers', |
45
|
|
|
|
|
|
|
reader => 'get_headers', |
46
|
|
|
|
|
|
|
predicate => 'has_headers', |
47
|
|
|
|
|
|
|
clearer => '_clear_headers', |
48
|
|
|
|
|
|
|
handles =>{ |
49
|
|
|
|
|
|
|
number_of_headers => 'count', |
50
|
|
|
|
|
|
|
}, |
51
|
|
|
|
|
|
|
coerce => 1, |
52
|
|
|
|
|
|
|
); |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
has reconcile_headers =>( |
55
|
|
|
|
|
|
|
isa => Bool, |
56
|
|
|
|
|
|
|
writer => 'set_reconcile_headers', |
57
|
|
|
|
|
|
|
reader => 'should_reconcile_headers', |
58
|
|
|
|
|
|
|
default => 1, |
59
|
|
|
|
|
|
|
); |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
has test_first_row =>( |
62
|
|
|
|
|
|
|
isa => Bool, |
63
|
|
|
|
|
|
|
writer => '_test_first_row', |
64
|
|
|
|
|
|
|
reader => 'should_test_first_row', |
65
|
|
|
|
|
|
|
default => 1, |
66
|
|
|
|
|
|
|
); |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
#########1 Public Methods 3#########4#########5#########6#########7#########8#########9 |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
sub add_line{ |
71
|
|
|
|
|
|
|
|
72
|
7
|
|
|
7
|
1
|
962
|
my ( $self, $input_ref ) = @_; |
73
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 2, |
74
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::add_line', |
75
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ 'Adding a line to the csv file -' . $self->get_file_name . '- :', $input_ref ], } ); |
76
|
7
|
|
|
|
|
6
|
my $message_ref; |
77
|
7
|
|
|
|
|
5
|
my( $first_ref, @other_args ) = @{$input_ref->{message}}; |
|
7
|
|
|
|
|
13
|
|
78
|
7
|
50
|
|
|
|
25
|
if( !$first_ref ){ |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
79
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 1, |
80
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::add_line::_find_the_actual_message', |
81
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ 'No data in the first position - adding an empty row' ], } ); |
82
|
0
|
|
|
|
|
0
|
$message_ref = $self->_build_message_from_arrayref( [] ); |
83
|
|
|
|
|
|
|
}elsif( @other_args ){ |
84
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 1, |
85
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::add_line::_find_the_actual_message', |
86
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ 'Multiple values passed - treating the inputs like a list' ], } ); |
87
|
3
|
|
|
|
|
12
|
$message_ref = $self->_build_message_from_arrayref( [ $first_ref, @other_args ] ); |
88
|
|
|
|
|
|
|
}elsif( is_HashRef( $first_ref ) ){ |
89
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 1, |
90
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::add_line::_find_the_actual_message', |
91
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ 'Using the ref as it stands:', $first_ref ], } ); |
92
|
4
|
|
|
|
|
505
|
$message_ref = $self->_build_message_from_hashref( $first_ref ); |
93
|
|
|
|
|
|
|
}else{ |
94
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 3, |
95
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::add_line::_find_the_actual_message', |
96
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ 'Treating the input as a one element string' ], } ); |
97
|
0
|
|
|
|
|
0
|
$message_ref = $self->_build_message_from_arrayref( [ $first_ref ] ); |
98
|
|
|
|
|
|
|
} |
99
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 3, |
100
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::add_line', |
101
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ "committing the message:", $message_ref ], } ); |
102
|
7
|
|
|
|
|
154
|
$self->_send_array_ref( $self->_get_file_handle, $message_ref ); |
103
|
|
|
|
|
|
|
|
104
|
7
|
|
|
|
|
303
|
return 1; |
105
|
|
|
|
|
|
|
} |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
#########1 Private Attributes 3#########4#########5#########6#########7#########8#########9 |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
has _file_handle =>( |
110
|
|
|
|
|
|
|
isa => IOFileType, |
111
|
|
|
|
|
|
|
writer => '_set_file_handle', |
112
|
|
|
|
|
|
|
reader => '_get_file_handle', |
113
|
|
|
|
|
|
|
clearer => '_clear_file_handle', |
114
|
|
|
|
|
|
|
predicate => '_has_file_handle', |
115
|
|
|
|
|
|
|
init_arg => undef, |
116
|
|
|
|
|
|
|
); |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
has _file_headers =>( |
119
|
|
|
|
|
|
|
isa => HeaderArray, |
120
|
|
|
|
|
|
|
traits =>['Array'], |
121
|
|
|
|
|
|
|
writer => '_set_file_headers', |
122
|
|
|
|
|
|
|
reader => '_get_file_headers', |
123
|
|
|
|
|
|
|
clearer => '_clear_file_headers', |
124
|
|
|
|
|
|
|
predicate => '_has_file_headers', |
125
|
|
|
|
|
|
|
handles =>{ |
126
|
|
|
|
|
|
|
_file_header_count => 'count', |
127
|
|
|
|
|
|
|
}, |
128
|
|
|
|
|
|
|
init_arg => undef, |
129
|
|
|
|
|
|
|
); |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
has _expected_header_lookup =>( |
132
|
|
|
|
|
|
|
isa => HashRef, |
133
|
|
|
|
|
|
|
traits =>['Hash'], |
134
|
|
|
|
|
|
|
writer => '_set_header_lookup', |
135
|
|
|
|
|
|
|
reader => '_get_header_lookup', |
136
|
|
|
|
|
|
|
clearer => '_clear_header_lookup', |
137
|
|
|
|
|
|
|
predicate => '_has_header_lookup', |
138
|
|
|
|
|
|
|
handles =>{ |
139
|
|
|
|
|
|
|
_get_header_position => 'get', |
140
|
|
|
|
|
|
|
_has_header_named => 'exists', |
141
|
|
|
|
|
|
|
}, |
142
|
|
|
|
|
|
|
init_arg => undef, |
143
|
|
|
|
|
|
|
); |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
has _csv_parser =>( |
146
|
|
|
|
|
|
|
isa => 'Text::CSV_XS', |
147
|
|
|
|
|
|
|
writer => '_set_csv_parser', |
148
|
|
|
|
|
|
|
clearer => '_clear_csv_parser', |
149
|
|
|
|
|
|
|
init_arg => undef, |
150
|
|
|
|
|
|
|
handles =>{ |
151
|
|
|
|
|
|
|
_set_parsing_header => 'header', |
152
|
|
|
|
|
|
|
_send_array_ref => 'say', |
153
|
|
|
|
|
|
|
_send_hash_ref => 'print_hr', |
154
|
|
|
|
|
|
|
_read_next_line => 'getline', |
155
|
|
|
|
|
|
|
_separator_char => 'sep_char', |
156
|
|
|
|
|
|
|
}, |
157
|
|
|
|
|
|
|
); |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
#########1 Private Methods 3#########4#########5#########6#########7#########8#########9 |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
sub BUILD{ |
162
|
5
|
|
|
5
|
0
|
221
|
my( $self, ) = @_; |
163
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 2, |
164
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::BUILD', |
165
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ "Organizing the new file instance"], } ); |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
# Open and collect the header if available |
168
|
5
|
|
|
|
|
107
|
$self->_open_file( $self->get_file_name ); |
169
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 1, |
170
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::BUILD', |
171
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ "Open file complete"], } ); |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
# Check requested headers against an empty file |
174
|
5
|
100
|
|
|
|
113
|
if( $self->has_headers ){ |
175
|
2
|
|
|
|
|
40
|
my $header_ref = $self->get_headers; |
176
|
2
|
|
|
|
|
12
|
$self->_set_expected_header_lookup( $header_ref ); |
177
|
2
|
100
|
66
|
|
|
48
|
if( $self->should_reconcile_headers and !$self->_has_file_headers ){ |
178
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 1, |
179
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::BUILD', |
180
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ "Ensuring the requested headers are in the file:", $header_ref ], } ); |
181
|
1
|
|
|
|
|
4
|
$self->_add_headers_to_file( $header_ref ); |
182
|
|
|
|
|
|
|
} |
183
|
|
|
|
|
|
|
} |
184
|
|
|
|
|
|
|
#~ confess "Died here"; |
185
|
5
|
|
|
|
|
476
|
return 1; |
186
|
|
|
|
|
|
|
} |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
after 'set_file_name' => sub{ my( $self, $file ) = @_; $self->_open_file( $file ) }; |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
sub _open_file{ |
191
|
|
|
|
|
|
|
|
192
|
11
|
|
|
11
|
|
13
|
my ( $self, $file ) = @_; |
193
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 2, |
194
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::_open_file', |
195
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ "Arrived at _open_file for:", $file ], } ); |
196
|
11
|
|
|
|
|
254
|
$self->_clear_file_handle; |
197
|
11
|
|
|
|
|
284
|
$self->_clear_file_headers; |
198
|
11
|
|
|
|
|
235
|
$self->_clear_csv_parser; |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
# Build the csv parser |
201
|
11
|
|
|
|
|
78
|
$self->_set_csv_parser( Text::CSV_XS->new({ binary => 1, eol => $\, auto_diag => 1 }) );# |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
# Open the file handle and collect the header if available |
204
|
1
|
50
|
|
1
|
|
6
|
open( my $fh, "+<:encoding(UTF-8)", $file ) or confess "Can't open $file: $!"; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
5
|
|
|
11
|
|
|
|
|
289
|
|
205
|
11
|
|
|
|
|
8994
|
binmode( $fh ); |
206
|
11
|
|
|
|
|
38
|
flock( $fh, LOCK_EX ); |
207
|
11
|
|
|
|
|
306
|
$self->_set_file_handle( $fh ); |
208
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 1, |
209
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::_open_file', |
210
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ 'Read file handle built: ' . -s $fh ], } ); |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
# Collect the header if available |
213
|
11
|
100
|
|
|
|
255
|
if( -s $self->_get_file_handle ){ |
214
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 1, |
215
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::_open_file', |
216
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ "The file appears to have pre-existing content (headers)" ], } ); |
217
|
7
|
|
|
|
|
7
|
my $header_ref; |
218
|
7
|
|
|
|
|
30
|
@$header_ref = $self->_set_parsing_header( $fh ); |
219
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 1, |
220
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::_open_file', |
221
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ "File headers are: " . join( '~|~', @$header_ref ) ], } ); |
222
|
7
|
|
|
|
|
2087
|
$self->_set_file_headers( $header_ref ); |
223
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 1, |
224
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::_open_file', |
225
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ "File headers set" ], } ); |
226
|
|
|
|
|
|
|
}else{ |
227
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 1, |
228
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::_open_file', |
229
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ "The file is zero size" ], } ); |
230
|
|
|
|
|
|
|
} |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
# Get to the end for add_line (in case you weren't there before) |
233
|
11
|
50
|
|
|
|
232
|
seek( $self->_get_file_handle, 0, SEEK_END) or confess "Can't seek (end) on $file: $!"; |
234
|
|
|
|
|
|
|
|
235
|
11
|
|
|
|
|
19
|
return 1; |
236
|
|
|
|
|
|
|
} |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
around '_set_file_headers' => sub{ |
239
|
|
|
|
|
|
|
my( $_set_file_headers, $self, $header_ref ) = @_; |
240
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 1, |
241
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::_set_file_headers', |
242
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ 'Attempting to set the file headers to:', $header_ref ], } ); |
243
|
|
|
|
|
|
|
if( $self->should_reconcile_headers ){ |
244
|
|
|
|
|
|
|
my( $one_extra, $two_extra ) = $self->_test_headers( $header_ref, $self->get_headers ); |
245
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 0, |
246
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::_set_file_headers', |
247
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ 'Returned from the header test:', $one_extra, $two_extra ], } ); |
248
|
|
|
|
|
|
|
$self->set_reconcile_headers( 0 ); |
249
|
|
|
|
|
|
|
if( $two_extra ){ |
250
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 3, |
251
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::_set_file_headers', |
252
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ 'There are more expected headers than were found in the file:', $two_extra ], } ); |
253
|
|
|
|
|
|
|
push @$header_ref, @$two_extra; |
254
|
|
|
|
|
|
|
$self->_add_headers_to_file( $header_ref ); |
255
|
|
|
|
|
|
|
} |
256
|
|
|
|
|
|
|
if( $one_extra ){ |
257
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 3, |
258
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::_set_file_headers', |
259
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ 'There are more file headers than expected headers:', $one_extra ], } ); |
260
|
|
|
|
|
|
|
$self->set_headers( $header_ref ); |
261
|
|
|
|
|
|
|
} |
262
|
|
|
|
|
|
|
$self->set_reconcile_headers( 1 ); |
263
|
|
|
|
|
|
|
} |
264
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 3, |
265
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::_set_file_headers', |
266
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ "Setting file headers to: ", $header_ref ], } ); |
267
|
|
|
|
|
|
|
$self->$_set_file_headers( $header_ref ); |
268
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 2, |
269
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::_set_file_headers', |
270
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ 'Final file headers:', $self->_get_file_headers ], } ); |
271
|
|
|
|
|
|
|
}; |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
around 'set_headers' => sub{ |
274
|
|
|
|
|
|
|
my( $set_headers_method, $self, $header_ref ) = @_; |
275
|
|
|
|
|
|
|
$self->_clear_header_lookup; |
276
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 1, |
277
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::set_headers', |
278
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ 'Received a request to set headers to:', $header_ref ], } ); |
279
|
|
|
|
|
|
|
$header_ref = $self->_scrub_header_array( $header_ref ); |
280
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 1, |
281
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::set_headers', |
282
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ 'Attempting to set the requested headers with:', $header_ref ], } ); |
283
|
|
|
|
|
|
|
$self->_set_expected_header_lookup( $header_ref ); |
284
|
|
|
|
|
|
|
my( $one_extra, $two_extra, $translation ); |
285
|
|
|
|
|
|
|
if( $self->should_reconcile_headers ){ |
286
|
|
|
|
|
|
|
my $file_headers = $self->_get_file_headers; |
287
|
|
|
|
|
|
|
( $one_extra, $two_extra, $translation ) = $self->_test_headers( $file_headers, $header_ref, ); |
288
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 0, |
289
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::_set_file_headers', |
290
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ 'Returned from the header test:', $one_extra, $two_extra, $translation ], } ); |
291
|
|
|
|
|
|
|
$self->set_reconcile_headers( 0 ); |
292
|
|
|
|
|
|
|
if( $two_extra ){ |
293
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 3, |
294
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::_set_file_headers', |
295
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ 'There are more expected headers than were found in the file:', $two_extra ], } ); |
296
|
|
|
|
|
|
|
my $new_ref; |
297
|
|
|
|
|
|
|
push @$new_ref, @$file_headers if $file_headers; |
298
|
|
|
|
|
|
|
push @$new_ref, @$two_extra; |
299
|
|
|
|
|
|
|
$self->_add_headers_to_file( $new_ref ); |
300
|
|
|
|
|
|
|
$header_ref = $new_ref; |
301
|
|
|
|
|
|
|
} |
302
|
|
|
|
|
|
|
$self->set_reconcile_headers( 1 ); |
303
|
|
|
|
|
|
|
} |
304
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 3, |
305
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::_set_file_headers', |
306
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ "Setting requested headers to: ", $header_ref ], } ); |
307
|
|
|
|
|
|
|
$self->$set_headers_method( $header_ref ); |
308
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 2, |
309
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::set_headers', |
310
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ 'Final requested headers resolved to:', $header_ref, |
311
|
|
|
|
|
|
|
###InternalReporTCSV '...with passing-to translation resolved as:', $translation ], } ); |
312
|
|
|
|
|
|
|
return $translation; |
313
|
|
|
|
|
|
|
}; |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
sub _add_headers_to_file{ |
316
|
|
|
|
|
|
|
|
317
|
6
|
|
|
6
|
|
8
|
my ( $self, $new_ref ) = @_; |
318
|
|
|
|
|
|
|
#~ my $new_line = join( $self->_separator_char, @$new_ref ) . "\n"; |
319
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 2, |
320
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::_add_headers_to_file', |
321
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ "Arrived at _add_headers_to_file for:", $new_ref, ], } ); |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
# Make a temp file to create new data |
324
|
6
|
|
|
|
|
33
|
my $temp_dir = File::Temp->newdir( CLEANUP => 1 ); |
325
|
6
|
|
|
|
|
1649
|
my $fh = File::Temp->new( UNLINK => 0, DIR => $temp_dir ); |
326
|
6
|
|
|
|
|
1470
|
my $temp_parser = Text::CSV_XS->new({ binary => 1, sep_char => $self->_separator_char, eol => $\, auto_diag => 1 });# |
327
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 0, |
328
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::_add_headers_to_file', |
329
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ "Tempfile open: " . $fh->filename, ], } ); |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
# Add the new header |
332
|
6
|
|
|
|
|
629
|
$temp_parser->say( $fh, $new_ref ); |
333
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 0, |
334
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::_add_headers_to_file', |
335
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ "Added headers to the tempfile: ", $new_ref, ], } ); |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
# Write the rest of the lines (except the old header) |
338
|
6
|
|
|
|
|
395
|
my $original_fh = $self->_get_file_handle; |
339
|
6
|
|
|
|
|
129
|
$self->_clear_file_handle; |
340
|
6
|
|
|
|
|
5
|
my $first_line = 1; |
341
|
6
|
|
|
|
|
19
|
seek( $original_fh, 0, 0 ); |
342
|
6
|
|
|
|
|
21
|
while (my $row = $self->_read_next_line($original_fh)) { |
343
|
5
|
100
|
|
|
|
221
|
if( $first_line ){ |
344
|
3
|
|
|
|
|
4
|
$first_line = 0; |
345
|
3
|
|
|
|
|
11
|
next; |
346
|
|
|
|
|
|
|
} |
347
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 0, |
348
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::_add_headers_to_file', |
349
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ "Printing line to tempfile:", $row], } ); |
350
|
2
|
|
|
|
|
6
|
$temp_parser->say( $fh, $row ); |
351
|
|
|
|
|
|
|
} |
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
# Close the original file |
354
|
6
|
|
|
|
|
416
|
flock( $original_fh, LOCK_UN ); |
355
|
6
|
50
|
|
|
|
42
|
close( $original_fh ) or confess "Couldn't close file: $!"; |
356
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 0, |
357
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::_add_headers_to_file', |
358
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ "Closed the original file handle" ], } ); |
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
# Close the new tempfile |
361
|
6
|
|
|
|
|
121
|
flock( $fh, LOCK_UN ); |
362
|
6
|
|
|
|
|
24
|
close( $fh ); |
363
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 0, |
364
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::_add_headers_to_file', |
365
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ "Closed the new temp file" ], } ); |
366
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
# Replace the original file with the tempfile |
368
|
6
|
50
|
|
|
|
23
|
copy( $fh->filename, $self->get_file_name ) or confess "Couldn't copy file: $!"; |
369
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 0, |
370
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::_add_headers_to_file', |
371
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ "Original file replaced: " . $self->get_file_name, |
372
|
|
|
|
|
|
|
###InternalReporTCSV '..with file: ' . $fh->filename ], } ); |
373
|
6
|
|
|
|
|
1129
|
$fh = undef; |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
# Re-run the file to get the headers registered with Text::CSV_XS; |
376
|
6
|
|
|
|
|
18
|
$self->_open_file( $self->get_file_name ); |
377
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 0, |
378
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::_add_headers_to_file', |
379
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ "Updated file re-test complete" ], } ); |
380
|
|
|
|
|
|
|
|
381
|
6
|
|
|
|
|
40
|
return 1; |
382
|
|
|
|
|
|
|
} |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
sub _test_headers{ |
385
|
|
|
|
|
|
|
|
386
|
6
|
|
|
6
|
|
9
|
my ( $self, $header_ref_1, $header_ref_2 ) = @_; |
387
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 2, |
388
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::_test_headers', |
389
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ "Arrived at test headers with:", $header_ref_1, $header_ref_2 ], } ); |
390
|
6
|
|
|
|
|
6
|
my( $one_extra, $two_extra, $translation ); |
391
|
6
|
50
|
|
|
|
15
|
if( !$header_ref_2 ){ |
392
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 3, |
393
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::_test_headers', |
394
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ "No second header list passed for testing" ], } ); |
395
|
0
|
|
|
|
|
0
|
$one_extra = $header_ref_1; |
396
|
|
|
|
|
|
|
}else{ |
397
|
6
|
|
|
|
|
6
|
my $x = 0; |
398
|
6
|
|
|
|
|
13
|
for my $second_header ( @$header_ref_2 ){ |
399
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 0, |
400
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::_test_headers', |
401
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ "Testing second header: $second_header" ], } ); |
402
|
25
|
|
|
|
|
12
|
my $y = 0; |
403
|
25
|
|
|
|
|
20
|
my $found_match = 0; |
404
|
25
|
|
|
|
|
19
|
NEWHEADERTEST: for my $first_header ( @$header_ref_1 ){ |
405
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 0, |
406
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::_test_headers', |
407
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ "Testing first header -$first_header- for a match" ], } ); |
408
|
43
|
100
|
|
|
|
48
|
if( $second_header eq $first_header ){ |
409
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 0, |
410
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::_test_headers', |
411
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ "Second header list -$second_header- at position: $x", |
412
|
|
|
|
|
|
|
###InternalReporTCSV "matches first header list header -$first_header- at position: $y" ], } ); |
413
|
12
|
|
|
|
|
18
|
$translation->{$x} = $y; |
414
|
12
|
|
|
|
|
7
|
$found_match = 1; |
415
|
12
|
|
|
|
|
12
|
last NEWHEADERTEST; |
416
|
|
|
|
|
|
|
} |
417
|
31
|
|
|
|
|
21
|
$y++; |
418
|
|
|
|
|
|
|
} |
419
|
25
|
100
|
|
|
|
38
|
push @$two_extra, $second_header if !$found_match; |
420
|
25
|
|
|
|
|
26
|
$x++; |
421
|
|
|
|
|
|
|
} |
422
|
6
|
|
|
|
|
15
|
for my $pos ( 0 .. $#$header_ref_1 ){ |
423
|
15
|
100
|
|
|
|
26
|
if( !exists $translation->{$pos} ){ |
424
|
3
|
|
|
|
|
5
|
push @$one_extra, $header_ref_1->[$pos]; |
425
|
|
|
|
|
|
|
} |
426
|
|
|
|
|
|
|
} |
427
|
6
|
|
|
|
|
9
|
my $next_pos = $#$header_ref_1 + 1; |
428
|
6
|
|
|
|
|
12
|
for my $pos ( 0 .. $#$header_ref_2 ){ |
429
|
25
|
100
|
|
|
|
37
|
if( !exists $translation->{$pos} ){ |
430
|
13
|
|
|
|
|
19
|
$translation->{$pos} = $next_pos++; |
431
|
|
|
|
|
|
|
} |
432
|
|
|
|
|
|
|
} |
433
|
|
|
|
|
|
|
} |
434
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 2, |
435
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::_test_headers', |
436
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ "Finished with header list 1 extra:", $one_extra, |
437
|
|
|
|
|
|
|
###InternalReporTCSV "...and header list 2 extra:", $two_extra, |
438
|
|
|
|
|
|
|
###InternalReporTCSV "...and translation ref:", $translation ], } ); |
439
|
6
|
|
|
|
|
13
|
return( $one_extra, $two_extra, $translation ); |
440
|
|
|
|
|
|
|
} |
441
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
sub _build_message_from_arrayref{ |
443
|
3
|
|
|
3
|
|
4
|
my( $self, $array_ref )= @_; |
444
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 2, |
445
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::add_line::_build_message_from_arrayref', |
446
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ 'Testing the message from an array ref: ' . ($self->should_test_first_row//0), $array_ref ], } ); |
447
|
3
|
100
|
|
|
|
82
|
my @expected_headers = $self->has_headers ? @{$self->get_headers} : (); |
|
2
|
|
|
|
|
42
|
|
448
|
3
|
100
|
|
|
|
69
|
if( $self->should_test_first_row ){ |
449
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 1, |
450
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::add_line::_build_message_from_arrayref', |
451
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ 'First row - testing if the list matches the header count' ], } ); |
452
|
|
|
|
|
|
|
|
453
|
2
|
50
|
|
|
|
5
|
if( $#$array_ref != $#expected_headers ){ |
454
|
2
|
100
|
|
|
|
5
|
if( scalar( @expected_headers ) == 0 ){ |
455
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 3, |
456
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::add_line::_build_message_from_arrayref', |
457
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ 'Adding dummy file headers' ], } ); |
458
|
1
|
|
|
|
|
2
|
my $dummy_headers; |
459
|
1
|
|
|
|
|
2
|
map{ $dummy_headers->[$_] = "header_" . $_ } ( 0 .. $#$array_ref ); |
|
6
|
|
|
|
|
10
|
|
460
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 1, |
461
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::add_line::_build_message_from_arrayref', |
462
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ 'New dummy headers:', $dummy_headers ], } ); |
463
|
1
|
50
|
|
|
|
107
|
cluck "Setting dummy headers ( " . join( ', ', @$dummy_headers ) . " )" if !$ENV{hide_warn}; |
464
|
1
|
|
|
|
|
26
|
$self->set_reconcile_headers( 1 ); |
465
|
1
|
|
|
|
|
4
|
$self->set_headers( $dummy_headers ); |
466
|
|
|
|
|
|
|
}else{ |
467
|
|
|
|
|
|
|
cluck "The first added row has -" . scalar( @$array_ref ) . |
468
|
|
|
|
|
|
|
"- items - but the report expects -" . |
469
|
1
|
50
|
|
|
|
129
|
scalar( @expected_headers ) . "- items" if !$ENV{hide_warn}; |
470
|
|
|
|
|
|
|
} |
471
|
|
|
|
|
|
|
} |
472
|
2
|
|
|
|
|
51
|
$self->_test_first_row ( 0 ); |
473
|
|
|
|
|
|
|
} |
474
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 2, |
475
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::add_line::_build_message_from_arrayref', |
476
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ 'Returning message ref:', $array_ref ], } ); |
477
|
3
|
|
|
|
|
7
|
return $array_ref; |
478
|
|
|
|
|
|
|
} |
479
|
|
|
|
|
|
|
|
480
|
|
|
|
|
|
|
sub _build_message_from_hashref{ |
481
|
4
|
|
|
4
|
|
4
|
my( $self, $hash_ref )= @_; |
482
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 2, |
483
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::add_line::_build_message_from_hashref', |
484
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ 'Building the array ref from the hash ref: ' . ($self->should_test_first_row//0), $hash_ref ], } ); |
485
|
|
|
|
|
|
|
|
486
|
|
|
|
|
|
|
# Scrub the hash |
487
|
4
|
|
|
|
|
4
|
my( $better_hash, @missing_list ); |
488
|
4
|
|
|
|
|
10
|
for my $key ( keys %$hash_ref ){ |
489
|
12
|
|
|
|
|
19
|
my $fixed_key = $self->_scrub_header_string( $key ); |
490
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 0, |
491
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::add_line::_build_message_from_hashref', |
492
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ "Managing key -$fixed_key- for key: $key" ], } ); |
493
|
12
|
100
|
100
|
|
|
284
|
push @missing_list, $fixed_key if $self->should_test_first_row and !$self->_has_header_named( $fixed_key ); |
494
|
12
|
|
|
|
|
25
|
$better_hash->{$fixed_key} = $hash_ref->{$key}; |
495
|
|
|
|
|
|
|
} |
496
|
4
|
|
|
|
|
87
|
$self->_test_first_row( 0 ); |
497
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 0, |
498
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::add_line::_build_message_from_hashref', |
499
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ "Updated hash message:", $better_hash, |
500
|
|
|
|
|
|
|
###InternalReporTCSV "...with missing list:", @missing_list ], } ); |
501
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
# Handle first row errors |
503
|
4
|
100
|
|
|
|
8
|
if( @missing_list ){ |
504
|
2
|
100
|
|
|
|
41
|
my @expected_headers = $self->has_headers ? @{$self->get_headers} : (); |
|
1
|
|
|
|
|
21
|
|
505
|
2
|
|
|
|
|
3
|
push @expected_headers, @missing_list; |
506
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 3, |
507
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::add_line::_build_message_from_hashref', |
508
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ "Updating the expected headers with new data", [@expected_headers] ], } ); |
509
|
2
|
50
|
|
|
|
219
|
cluck "Adding headers from the first hashref ( " . join( ', ', @missing_list ) . " )" if !$ENV{hide_warn}; |
510
|
2
|
|
|
|
|
51
|
$self->set_reconcile_headers( 1 ); |
511
|
2
|
|
|
|
|
10
|
$self->set_headers( [@expected_headers] ); |
512
|
|
|
|
|
|
|
} |
513
|
|
|
|
|
|
|
|
514
|
|
|
|
|
|
|
# Build the array_ref |
515
|
4
|
|
|
|
|
5
|
my $array_ref = []; |
516
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 2, |
517
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::add_line::_build_message_from_hashref', |
518
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ 'Building an array ref with loookup:', $self->_get_header_lookup ], } ); |
519
|
4
|
|
|
|
|
9
|
for my $header ( keys %$better_hash ){ |
520
|
12
|
100
|
|
|
|
327
|
if( $self->_has_header_named( $header ) ){ |
521
|
11
|
|
|
|
|
282
|
$array_ref->[$self->_get_header_position( $header )] = $better_hash->{$header}; |
522
|
|
|
|
|
|
|
}else{ |
523
|
1
|
50
|
|
|
|
114
|
cluck "found a hash key in the message that doesn't match the expected header ( $header )" if !$ENV{hide_warn}; |
524
|
|
|
|
|
|
|
} |
525
|
|
|
|
|
|
|
} |
526
|
|
|
|
|
|
|
|
527
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 2, |
528
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::add_line::_build_message_from_hashref', |
529
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ 'Returning message array ref:', $array_ref ], } ); |
530
|
4
|
|
|
|
|
11
|
return $array_ref; |
531
|
|
|
|
|
|
|
} |
532
|
|
|
|
|
|
|
|
533
|
|
|
|
|
|
|
sub _set_expected_header_lookup{ |
534
|
6
|
|
|
6
|
|
7
|
my ( $self, $hash_ref ) = @_; |
535
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 2, |
536
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::_set_expected_header_lookup', |
537
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ "Arrived at _set_expected_header_lookup with:", $hash_ref ], } ); |
538
|
6
|
|
|
|
|
8
|
my( $i, $positions, ) = ( 0, {} ); |
539
|
6
|
|
|
|
|
8
|
map{ $positions->{$_} = $i++ } @$hash_ref; |
|
25
|
|
|
|
|
34
|
|
540
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 2, |
541
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::_set_expected_header_lookup', |
542
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ "Header lookup hash is:", $positions ], } ); |
543
|
6
|
|
|
|
|
161
|
$self->_set_header_lookup( $positions ); |
544
|
|
|
|
|
|
|
} |
545
|
|
|
|
|
|
|
|
546
|
|
|
|
|
|
|
sub _scrub_header_array{ |
547
|
4
|
|
|
4
|
|
6
|
my ( $self, @args ) = @_; |
548
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 2, |
549
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::_scrub_header_array', |
550
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ "Arrived at _scrub_header_array:", @args ], } ); |
551
|
4
|
|
|
|
|
6
|
my $new_ref = []; |
552
|
4
|
|
|
|
|
5
|
for my $header ( @{$args[0]} ){ |
|
4
|
|
|
|
|
8
|
|
553
|
17
|
|
|
|
|
67
|
push @$new_ref, $self->_scrub_header_string( $header ); |
554
|
|
|
|
|
|
|
} |
555
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 2, |
556
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::_scrub_header_array', |
557
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ "Updated header is:", $new_ref ], } ); |
558
|
4
|
|
|
|
|
5
|
return $new_ref; |
559
|
|
|
|
|
|
|
} |
560
|
|
|
|
|
|
|
|
561
|
|
|
|
|
|
|
sub _scrub_header_string{ |
562
|
29
|
|
|
29
|
|
28
|
my ( $self, $string ) = @_; |
563
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 2, |
564
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::_scrub_header_string', |
565
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ "Arrived at _scrub_header_string with: $string" ], } ); |
566
|
29
|
|
|
|
|
33
|
$string = lc( $string ); |
567
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 0, |
568
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::_scrub_header_string', |
569
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ "The updated string is: $string" ], } ); |
570
|
29
|
|
|
|
|
25
|
$string =~ s/\n/ /gsxm; |
571
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 0, |
572
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::_scrub_header_string', |
573
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ "The updated string is: $string" ], } ); |
574
|
29
|
|
|
|
|
21
|
$string =~ s/\r/ /gsxm; |
575
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 0, |
576
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::_scrub_header_string', |
577
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ "The updated string is: $string" ], } ); |
578
|
29
|
|
|
|
|
34
|
$string =~ s/\s/_/gsxm; |
579
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 0, |
580
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::_scrub_header_string', |
581
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ "The updated string is: $string" ], } ); |
582
|
29
|
|
|
|
|
22
|
chomp $string; |
583
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 2, |
584
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::_scrub_header_string', |
585
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ "The final string is: $string" ], } ); |
586
|
29
|
|
|
|
|
37
|
return $string; |
587
|
|
|
|
|
|
|
} |
588
|
|
|
|
|
|
|
|
589
|
|
|
|
|
|
|
sub DEMOLISH{ |
590
|
5
|
|
|
5
|
0
|
1505
|
my ( $self ) = @_; |
591
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 2, |
592
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::DEMOLISH', |
593
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ "Arrived at DEMOLISH" ], } ) if $switchboard; |
594
|
5
|
50
|
|
|
|
114
|
if( $self->_has_file_handle ){ |
595
|
5
|
|
|
|
|
124
|
flock( $self->_get_file_handle, LOCK_UN ); |
596
|
5
|
50
|
|
|
|
117
|
close( $self->_get_file_handle ) or confess "Couldn't close the file handle"; |
597
|
5
|
|
|
|
|
124
|
$self->_clear_file_handle; |
598
|
|
|
|
|
|
|
###InternalReporTCSV $switchboard->master_talk( { report => 'log_file', level => 1, |
599
|
|
|
|
|
|
|
###InternalReporTCSV name_space => 'Log::Shiras::Report::CSVFile::DEMOLISH', |
600
|
|
|
|
|
|
|
###InternalReporTCSV message =>[ "Arrived at DEMOLISH" ], } ) if $switchboard; |
601
|
|
|
|
|
|
|
} |
602
|
|
|
|
|
|
|
} |
603
|
|
|
|
|
|
|
|
604
|
|
|
|
|
|
|
#########1 Phinish 3#########4#########5#########6#########7#########8#########9 |
605
|
|
|
|
|
|
|
|
606
|
|
|
|
|
|
|
__PACKAGE__->meta->make_immutable; |
607
|
|
|
|
|
|
|
|
608
|
|
|
|
|
|
|
1; |
609
|
|
|
|
|
|
|
# The preceding line will help the module return a true value |
610
|
|
|
|
|
|
|
|
611
|
|
|
|
|
|
|
#########1 main pod docs 3#########4#########5#########6#########7#########8#########9 |
612
|
|
|
|
|
|
|
|
613
|
|
|
|
|
|
|
__END__ |
614
|
|
|
|
|
|
|
|
615
|
|
|
|
|
|
|
=head1 NAME |
616
|
|
|
|
|
|
|
|
617
|
|
|
|
|
|
|
Log::Shiras::Report::CSVFile - A report base for csv files |
618
|
|
|
|
|
|
|
|
619
|
|
|
|
|
|
|
=head1 SYNOPSIS |
620
|
|
|
|
|
|
|
|
621
|
|
|
|
|
|
|
use Modern::Perl; |
622
|
|
|
|
|
|
|
#~ use Log::Shiras::Unhide qw( :InternalReporTCSV ); |
623
|
|
|
|
|
|
|
use Log::Shiras::Switchboard; |
624
|
|
|
|
|
|
|
use Log::Shiras::Telephone; |
625
|
|
|
|
|
|
|
use Log::Shiras::Report; |
626
|
|
|
|
|
|
|
use Log::Shiras::Report::CSVFile; |
627
|
|
|
|
|
|
|
use Log::Shiras::Report::Stdout; |
628
|
|
|
|
|
|
|
$ENV{hide_warn} = 1; |
629
|
|
|
|
|
|
|
$| = 1; |
630
|
|
|
|
|
|
|
my $operator = Log::Shiras::Switchboard->get_operator( |
631
|
|
|
|
|
|
|
name_space_bounds =>{ |
632
|
|
|
|
|
|
|
UNBLOCK =>{ |
633
|
|
|
|
|
|
|
to_file => 'info',# for info and more urgent messages |
634
|
|
|
|
|
|
|
}, |
635
|
|
|
|
|
|
|
}, |
636
|
|
|
|
|
|
|
reports =>{ |
637
|
|
|
|
|
|
|
to_file =>[{ |
638
|
|
|
|
|
|
|
superclasses =>[ 'Log::Shiras::Report::CSVFile' ], |
639
|
|
|
|
|
|
|
roles =>[ 'Log::Shiras::Report' ],# checks inputs and class requirements |
640
|
|
|
|
|
|
|
file => 'test.csv', |
641
|
|
|
|
|
|
|
}], |
642
|
|
|
|
|
|
|
} |
643
|
|
|
|
|
|
|
); |
644
|
|
|
|
|
|
|
my $telephone = Log::Shiras::Telephone->new( report => 'to_file' ); |
645
|
|
|
|
|
|
|
$telephone->talk( level => 'info', message => 'A new line' ); |
646
|
|
|
|
|
|
|
$telephone->talk( level => 'trace', message => 'A second line' ); |
647
|
|
|
|
|
|
|
$telephone->talk( level => 'warn', message =>[ { |
648
|
|
|
|
|
|
|
header_0 => 'A third line', |
649
|
|
|
|
|
|
|
new_header => 'new header starts here' } ] ); |
650
|
|
|
|
|
|
|
|
651
|
|
|
|
|
|
|
####################################################################################### |
652
|
|
|
|
|
|
|
# Synopsis file (test.csv) output |
653
|
|
|
|
|
|
|
# 01: header_0 |
654
|
|
|
|
|
|
|
# 02: "A new line" |
655
|
|
|
|
|
|
|
# 03: "A third line" |
656
|
|
|
|
|
|
|
####################################################################################### |
657
|
|
|
|
|
|
|
|
658
|
|
|
|
|
|
|
####################################################################################### |
659
|
|
|
|
|
|
|
# Synopsis file (test.csv) output with line 24 commented out |
660
|
|
|
|
|
|
|
# 01: header_0,new_header |
661
|
|
|
|
|
|
|
# 02: "A third line","new header starts here" |
662
|
|
|
|
|
|
|
####################################################################################### |
663
|
|
|
|
|
|
|
|
664
|
|
|
|
|
|
|
=head1 DESCRIPTION |
665
|
|
|
|
|
|
|
|
666
|
|
|
|
|
|
|
This is a report module that can act as a destination in the |
667
|
|
|
|
|
|
|
L<Log::Shiras::Switchboard/reports> name-space. It is meant to be fairly flexible and |
668
|
|
|
|
|
|
|
will have most of the needed elements in the class without added roles. An instance |
669
|
|
|
|
|
|
|
of the class can be built either with ->new or using the implied |
670
|
|
|
|
|
|
|
L<MooseX::ShortCut::BuildInstance> helpers. (See lines 18 - 20 in the example) When the |
671
|
|
|
|
|
|
|
report is set up any call to that report namespace will then implement the L<add_line |
672
|
|
|
|
|
|
|
|/add_line> method of this class. |
673
|
|
|
|
|
|
|
|
674
|
|
|
|
|
|
|
As implied in the Synopsis one of the features of this class is the fact that it will try to |
675
|
|
|
|
|
|
|
reconcile the headers to inbound data and header requests. This class will attempt to |
676
|
|
|
|
|
|
|
reconcile any deviation between the first passed row and the header. Subsequent added |
677
|
|
|
|
|
|
|
rows using a passed array ref will add all values without warning whether the count matches |
678
|
|
|
|
|
|
|
the header count or not. Subsequent added rows using a passed hashref will only used the |
679
|
|
|
|
|
|
|
headers in the fixed L<header|/header> list but will warn for any passed headers not matching |
680
|
|
|
|
|
|
|
the header list. |
681
|
|
|
|
|
|
|
|
682
|
|
|
|
|
|
|
This class will attempt to obtain an exclusive lock on the file. If the file is previously |
683
|
|
|
|
|
|
|
locked it will wait. That will allow you to attach more than one report script to the same |
684
|
|
|
|
|
|
|
file name and not overwrite lines. On the other hand this does have the potential to create |
685
|
|
|
|
|
|
|
scripts that appear to be hung. |
686
|
|
|
|
|
|
|
|
687
|
|
|
|
|
|
|
=head2 Warning |
688
|
|
|
|
|
|
|
|
689
|
|
|
|
|
|
|
This class will always use the header list when adding new hash values. As a consequence |
690
|
|
|
|
|
|
|
there can be no duplicates in the header list after it is coereced to this files requirements. |
691
|
|
|
|
|
|
|
Since the class allows for mixed passing of array refs and hash refs it also has the |
692
|
|
|
|
|
|
|
no duplicate header requirement with array ref handling too. |
693
|
|
|
|
|
|
|
|
694
|
|
|
|
|
|
|
=head2 Attributes |
695
|
|
|
|
|
|
|
|
696
|
|
|
|
|
|
|
Data passed to ->new when creating an instance. For modification of these attributes |
697
|
|
|
|
|
|
|
after the instance is created see the attribute methods. |
698
|
|
|
|
|
|
|
|
699
|
|
|
|
|
|
|
=head3 file |
700
|
|
|
|
|
|
|
|
701
|
|
|
|
|
|
|
=over |
702
|
|
|
|
|
|
|
|
703
|
|
|
|
|
|
|
B<Definition:> This is the file name to be used by the .csv file. This should include the |
704
|
|
|
|
|
|
|
full file path. If the file does not exist then the file will be created. |
705
|
|
|
|
|
|
|
|
706
|
|
|
|
|
|
|
B<Default:> None |
707
|
|
|
|
|
|
|
|
708
|
|
|
|
|
|
|
B<Required:> Yes |
709
|
|
|
|
|
|
|
|
710
|
|
|
|
|
|
|
B<Range:> it must have a .csv extention and can be opened |
711
|
|
|
|
|
|
|
|
712
|
|
|
|
|
|
|
B<attribute methods> |
713
|
|
|
|
|
|
|
|
714
|
|
|
|
|
|
|
=over |
715
|
|
|
|
|
|
|
|
716
|
|
|
|
|
|
|
B<set_file_name( $file_name )> |
717
|
|
|
|
|
|
|
|
718
|
|
|
|
|
|
|
=over |
719
|
|
|
|
|
|
|
|
720
|
|
|
|
|
|
|
B<Description> used to set the attribute |
721
|
|
|
|
|
|
|
|
722
|
|
|
|
|
|
|
=back |
723
|
|
|
|
|
|
|
|
724
|
|
|
|
|
|
|
B<get_file_name> |
725
|
|
|
|
|
|
|
|
726
|
|
|
|
|
|
|
=over |
727
|
|
|
|
|
|
|
|
728
|
|
|
|
|
|
|
B<Description> used to return the current attribute value |
729
|
|
|
|
|
|
|
|
730
|
|
|
|
|
|
|
=back |
731
|
|
|
|
|
|
|
|
732
|
|
|
|
|
|
|
=back |
733
|
|
|
|
|
|
|
|
734
|
|
|
|
|
|
|
=back |
735
|
|
|
|
|
|
|
|
736
|
|
|
|
|
|
|
=head3 headers |
737
|
|
|
|
|
|
|
|
738
|
|
|
|
|
|
|
=over |
739
|
|
|
|
|
|
|
|
740
|
|
|
|
|
|
|
B<Definition:> This an array ref of the requested headers in the file. Each of the headers |
741
|
|
|
|
|
|
|
must match header string requirements. The header strings will be coerced as needed buy forcing |
742
|
|
|
|
|
|
|
then lower case and removing any newlines. |
743
|
|
|
|
|
|
|
|
744
|
|
|
|
|
|
|
B<Default:> None |
745
|
|
|
|
|
|
|
|
746
|
|
|
|
|
|
|
B<Required:> No |
747
|
|
|
|
|
|
|
|
748
|
|
|
|
|
|
|
B<Range:> An array ref of strings starting with a lower case letter and containing letters, |
749
|
|
|
|
|
|
|
underscores, and numbers |
750
|
|
|
|
|
|
|
|
751
|
|
|
|
|
|
|
B<attribute methods> |
752
|
|
|
|
|
|
|
|
753
|
|
|
|
|
|
|
=over |
754
|
|
|
|
|
|
|
|
755
|
|
|
|
|
|
|
B<set_headers( $array_ref )> |
756
|
|
|
|
|
|
|
|
757
|
|
|
|
|
|
|
=over |
758
|
|
|
|
|
|
|
|
759
|
|
|
|
|
|
|
B<Description> used to set all the attribute at once |
760
|
|
|
|
|
|
|
|
761
|
|
|
|
|
|
|
=back |
762
|
|
|
|
|
|
|
|
763
|
|
|
|
|
|
|
B<get_headers> |
764
|
|
|
|
|
|
|
|
765
|
|
|
|
|
|
|
=over |
766
|
|
|
|
|
|
|
|
767
|
|
|
|
|
|
|
B<Description> used to return all the attribute at once |
768
|
|
|
|
|
|
|
|
769
|
|
|
|
|
|
|
=back |
770
|
|
|
|
|
|
|
|
771
|
|
|
|
|
|
|
B<has_headers> |
772
|
|
|
|
|
|
|
|
773
|
|
|
|
|
|
|
=over |
774
|
|
|
|
|
|
|
|
775
|
|
|
|
|
|
|
B<Description> predicate for the whole attribute |
776
|
|
|
|
|
|
|
|
777
|
|
|
|
|
|
|
=back |
778
|
|
|
|
|
|
|
|
779
|
|
|
|
|
|
|
B<number_of_headers> |
780
|
|
|
|
|
|
|
|
781
|
|
|
|
|
|
|
=over |
782
|
|
|
|
|
|
|
|
783
|
|
|
|
|
|
|
B<Description> Returns the complete header count list |
784
|
|
|
|
|
|
|
|
785
|
|
|
|
|
|
|
=back |
786
|
|
|
|
|
|
|
|
787
|
|
|
|
|
|
|
=back |
788
|
|
|
|
|
|
|
|
789
|
|
|
|
|
|
|
=back |
790
|
|
|
|
|
|
|
|
791
|
|
|
|
|
|
|
=head3 reconcile_headers |
792
|
|
|
|
|
|
|
|
793
|
|
|
|
|
|
|
=over |
794
|
|
|
|
|
|
|
|
795
|
|
|
|
|
|
|
B<Definition:> It may be that when you open a file the file already has headers. This |
796
|
|
|
|
|
|
|
attribute determines if the action or L<requested headers|/headers> are merged with the |
797
|
|
|
|
|
|
|
file headers. In the merge the file headers are given order precedence so new requested |
798
|
|
|
|
|
|
|
headers wind up at the end even when that means the requested headers are added out of |
799
|
|
|
|
|
|
|
order to the original request! |
800
|
|
|
|
|
|
|
|
801
|
|
|
|
|
|
|
B<Default:> 1 = the headers will be reconciled |
802
|
|
|
|
|
|
|
|
803
|
|
|
|
|
|
|
B<Range:> Boolean |
804
|
|
|
|
|
|
|
|
805
|
|
|
|
|
|
|
B<attribute methods> |
806
|
|
|
|
|
|
|
|
807
|
|
|
|
|
|
|
=over |
808
|
|
|
|
|
|
|
|
809
|
|
|
|
|
|
|
B<set_reconcile_headers( $bool )> |
810
|
|
|
|
|
|
|
|
811
|
|
|
|
|
|
|
=over |
812
|
|
|
|
|
|
|
|
813
|
|
|
|
|
|
|
B<Description> used to set the attribute |
814
|
|
|
|
|
|
|
|
815
|
|
|
|
|
|
|
=back |
816
|
|
|
|
|
|
|
|
817
|
|
|
|
|
|
|
B<should_reconcile_headers> |
818
|
|
|
|
|
|
|
|
819
|
|
|
|
|
|
|
=over |
820
|
|
|
|
|
|
|
|
821
|
|
|
|
|
|
|
B<Description> used to return the current attribute value |
822
|
|
|
|
|
|
|
|
823
|
|
|
|
|
|
|
=back |
824
|
|
|
|
|
|
|
|
825
|
|
|
|
|
|
|
=back |
826
|
|
|
|
|
|
|
|
827
|
|
|
|
|
|
|
=back |
828
|
|
|
|
|
|
|
|
829
|
|
|
|
|
|
|
=head3 test_first_row |
830
|
|
|
|
|
|
|
|
831
|
|
|
|
|
|
|
=over |
832
|
|
|
|
|
|
|
|
833
|
|
|
|
|
|
|
B<Definition:> It may be that when you send the first row after instance instantiation |
834
|
|
|
|
|
|
|
that the row and the headers don't agree. This will update the requested headers ( |
835
|
|
|
|
|
|
|
L<and maybe the file headers|/reconcile headers>) with any variation between the two. |
836
|
|
|
|
|
|
|
In the case of a passed array ref no header change is implemented but a warning is |
837
|
|
|
|
|
|
|
emitted when the passed list and the header list don't have the same count. For |
838
|
|
|
|
|
|
|
passed hash refs new headers are added to the end of the requested headers. After |
839
|
|
|
|
|
|
|
the first line no warning is emitted for passed array refs that don't match and |
840
|
|
|
|
|
|
|
new hash keys (and their values) that don't match the header will just be left off |
841
|
|
|
|
|
|
|
the report. New hash keys for the first row will be added in a random order. |
842
|
|
|
|
|
|
|
|
843
|
|
|
|
|
|
|
B<Default:> 1 = the first row will attempt reconciliation |
844
|
|
|
|
|
|
|
|
845
|
|
|
|
|
|
|
B<Range:> Boolean |
846
|
|
|
|
|
|
|
|
847
|
|
|
|
|
|
|
B<attribute methods> |
848
|
|
|
|
|
|
|
|
849
|
|
|
|
|
|
|
=over |
850
|
|
|
|
|
|
|
|
851
|
|
|
|
|
|
|
B<should_test_first_row> |
852
|
|
|
|
|
|
|
|
853
|
|
|
|
|
|
|
=over |
854
|
|
|
|
|
|
|
|
855
|
|
|
|
|
|
|
B<Description> used to return the current attribute value |
856
|
|
|
|
|
|
|
|
857
|
|
|
|
|
|
|
=back |
858
|
|
|
|
|
|
|
|
859
|
|
|
|
|
|
|
=back |
860
|
|
|
|
|
|
|
|
861
|
|
|
|
|
|
|
=back |
862
|
|
|
|
|
|
|
|
863
|
|
|
|
|
|
|
=head2 Methods |
864
|
|
|
|
|
|
|
|
865
|
|
|
|
|
|
|
=head3 new( %args ) |
866
|
|
|
|
|
|
|
|
867
|
|
|
|
|
|
|
=over |
868
|
|
|
|
|
|
|
|
869
|
|
|
|
|
|
|
B<Definition:> This creates a new instance of the CSVFile L<report |
870
|
|
|
|
|
|
|
|Log::Shiras::Switchboard/reports> class. |
871
|
|
|
|
|
|
|
|
872
|
|
|
|
|
|
|
B<Range:> It will accept any or none of the L<Attributes|/Attributes> |
873
|
|
|
|
|
|
|
|
874
|
|
|
|
|
|
|
B<Returns:> A report class to be stored in the switchboard. |
875
|
|
|
|
|
|
|
|
876
|
|
|
|
|
|
|
=back |
877
|
|
|
|
|
|
|
|
878
|
|
|
|
|
|
|
=head3 add_line( $message_ref ) |
879
|
|
|
|
|
|
|
|
880
|
|
|
|
|
|
|
=over |
881
|
|
|
|
|
|
|
|
882
|
|
|
|
|
|
|
B<Definition:> This is the method called by the switchboard to add lines to the report. It will |
883
|
|
|
|
|
|
|
expect a message compatible with L<Log::Shiras::Switchboard/master_talk( $args_ref )>. There is |
884
|
|
|
|
|
|
|
some flexibility in the consumption of the value within the 'message' key. This package will |
885
|
|
|
|
|
|
|
check if there is more than one item and handle it like an elements list. If there is only one |
886
|
|
|
|
|
|
|
item and it is a hash ref it will attempt to consume the hashref as having keys matching the |
887
|
|
|
|
|
|
|
columns. Other single elements will be consumed as sub-elements of an element list. |
888
|
|
|
|
|
|
|
|
889
|
|
|
|
|
|
|
B<Returns:> 1 (or dies) |
890
|
|
|
|
|
|
|
|
891
|
|
|
|
|
|
|
=back |
892
|
|
|
|
|
|
|
|
893
|
|
|
|
|
|
|
=head1 GLOBAL VARIABLES |
894
|
|
|
|
|
|
|
|
895
|
|
|
|
|
|
|
=over |
896
|
|
|
|
|
|
|
|
897
|
|
|
|
|
|
|
=item B<$ENV{hide_warn}> |
898
|
|
|
|
|
|
|
|
899
|
|
|
|
|
|
|
The module will warn when debug lines are 'Unhide'n. In the case where the you |
900
|
|
|
|
|
|
|
don't want these notifications set this environmental variable to true. |
901
|
|
|
|
|
|
|
|
902
|
|
|
|
|
|
|
=back |
903
|
|
|
|
|
|
|
|
904
|
|
|
|
|
|
|
=head1 SUPPORT |
905
|
|
|
|
|
|
|
|
906
|
|
|
|
|
|
|
=over |
907
|
|
|
|
|
|
|
|
908
|
|
|
|
|
|
|
L<Log-Shiras/issues|https://github.com/jandrew/Log-Shiras/issues> |
909
|
|
|
|
|
|
|
|
910
|
|
|
|
|
|
|
=back |
911
|
|
|
|
|
|
|
|
912
|
|
|
|
|
|
|
=head1 TODO |
913
|
|
|
|
|
|
|
|
914
|
|
|
|
|
|
|
=over |
915
|
|
|
|
|
|
|
|
916
|
|
|
|
|
|
|
B<1.> Nothing L<currently|/SUPPORT> |
917
|
|
|
|
|
|
|
|
918
|
|
|
|
|
|
|
=back |
919
|
|
|
|
|
|
|
|
920
|
|
|
|
|
|
|
=head1 AUTHOR |
921
|
|
|
|
|
|
|
|
922
|
|
|
|
|
|
|
=over |
923
|
|
|
|
|
|
|
|
924
|
|
|
|
|
|
|
=item Jed Lund |
925
|
|
|
|
|
|
|
|
926
|
|
|
|
|
|
|
=item jandrew@cpan.org |
927
|
|
|
|
|
|
|
|
928
|
|
|
|
|
|
|
=back |
929
|
|
|
|
|
|
|
|
930
|
|
|
|
|
|
|
=head1 COPYRIGHT |
931
|
|
|
|
|
|
|
|
932
|
|
|
|
|
|
|
This program is free software; you can redistribute |
933
|
|
|
|
|
|
|
it and/or modify it under the same terms as Perl itself. |
934
|
|
|
|
|
|
|
|
935
|
|
|
|
|
|
|
The full text of the license can be found in the |
936
|
|
|
|
|
|
|
LICENSE file included with this module. |
937
|
|
|
|
|
|
|
|
938
|
|
|
|
|
|
|
=head1 DEPENDENCIES |
939
|
|
|
|
|
|
|
|
940
|
|
|
|
|
|
|
=over |
941
|
|
|
|
|
|
|
|
942
|
|
|
|
|
|
|
L<perl 5.010|perl/5.10.0> |
943
|
|
|
|
|
|
|
|
944
|
|
|
|
|
|
|
L<utf8> |
945
|
|
|
|
|
|
|
|
946
|
|
|
|
|
|
|
L<version> |
947
|
|
|
|
|
|
|
|
948
|
|
|
|
|
|
|
L<Moose> |
949
|
|
|
|
|
|
|
|
950
|
|
|
|
|
|
|
L<MooseX::StrictConstructor> |
951
|
|
|
|
|
|
|
|
952
|
|
|
|
|
|
|
L<MooseX::HasDefaults::RO> |
953
|
|
|
|
|
|
|
|
954
|
|
|
|
|
|
|
L<MooseX::Types::Moose> |
955
|
|
|
|
|
|
|
|
956
|
|
|
|
|
|
|
L<Text::CSV_XS> |
957
|
|
|
|
|
|
|
|
958
|
|
|
|
|
|
|
L<File::Copy> - copy |
959
|
|
|
|
|
|
|
|
960
|
|
|
|
|
|
|
L<File::Temp> |
961
|
|
|
|
|
|
|
|
962
|
|
|
|
|
|
|
L<Carp> - confess cluck |
963
|
|
|
|
|
|
|
|
964
|
|
|
|
|
|
|
L<Fcntl> - :flock LOCK_EX LOCK_UN SEEK_END |
965
|
|
|
|
|
|
|
|
966
|
|
|
|
|
|
|
=back |
967
|
|
|
|
|
|
|
|
968
|
|
|
|
|
|
|
=cut |
969
|
|
|
|
|
|
|
|
970
|
|
|
|
|
|
|
#########1#########2 main pod documentation end 5#########6#########7#########8#########9 |