line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Data::Tubes::Plugin::Reader; |
2
|
3
|
|
|
3
|
|
1403
|
use strict; |
|
3
|
|
|
|
|
59
|
|
|
3
|
|
|
|
|
128
|
|
3
|
3
|
|
|
3
|
|
28
|
use warnings; |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
119
|
|
4
|
3
|
|
|
3
|
|
16
|
use English qw< -no_match_vars >; |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
25
|
|
5
|
|
|
|
|
|
|
our $VERSION = '0.740'; |
6
|
|
|
|
|
|
|
|
7
|
3
|
|
|
3
|
|
1446
|
use Log::Log4perl::Tiny qw< :easy :dead_if_first LOGLEVEL >; |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
29
|
|
8
|
|
|
|
|
|
|
|
9
|
3
|
|
|
3
|
|
1133
|
use Data::Tubes::Util qw< normalize_args shorter_sub_names >; |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
186
|
|
10
|
3
|
|
|
3
|
|
20
|
use Data::Tubes::Plugin::Util qw< identify >; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
1924
|
|
11
|
|
|
|
|
|
|
my %global_defaults = ( |
12
|
|
|
|
|
|
|
input => 'source', |
13
|
|
|
|
|
|
|
output => 'raw', |
14
|
|
|
|
|
|
|
); |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
sub read_by_line { |
17
|
1
|
|
|
1
|
1
|
32
|
return read_by_separator( |
18
|
|
|
|
|
|
|
normalize_args( |
19
|
|
|
|
|
|
|
@_, |
20
|
|
|
|
|
|
|
{ |
21
|
|
|
|
|
|
|
name => 'read_by_line', |
22
|
|
|
|
|
|
|
identification => {caller => [caller(0)]}, |
23
|
|
|
|
|
|
|
} |
24
|
|
|
|
|
|
|
), |
25
|
|
|
|
|
|
|
separator => "\n", |
26
|
|
|
|
|
|
|
); |
27
|
|
|
|
|
|
|
} ## end sub read_by_line |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
sub read_by_paragraph { |
30
|
2
|
|
|
2
|
1
|
33
|
return read_by_separator( |
31
|
|
|
|
|
|
|
normalize_args( |
32
|
|
|
|
|
|
|
@_, |
33
|
|
|
|
|
|
|
{ |
34
|
|
|
|
|
|
|
name => 'read_by_paragraph', |
35
|
|
|
|
|
|
|
identification => {caller => [caller(0)]}, |
36
|
|
|
|
|
|
|
} |
37
|
|
|
|
|
|
|
), |
38
|
|
|
|
|
|
|
separator => '', |
39
|
|
|
|
|
|
|
); |
40
|
|
|
|
|
|
|
} ## end sub read_by_paragraph |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
sub read_by_record_reader { |
43
|
5
|
|
|
5
|
1
|
71
|
my %args = normalize_args( |
44
|
|
|
|
|
|
|
@_, |
45
|
|
|
|
|
|
|
[ |
46
|
|
|
|
|
|
|
{ |
47
|
|
|
|
|
|
|
%global_defaults, |
48
|
|
|
|
|
|
|
emit_eof => 0, |
49
|
|
|
|
|
|
|
name => 'read_by_record_reader', |
50
|
|
|
|
|
|
|
identification => {caller => [caller(0)]}, |
51
|
|
|
|
|
|
|
}, |
52
|
|
|
|
|
|
|
'record_reader' |
53
|
|
|
|
|
|
|
], |
54
|
|
|
|
|
|
|
); |
55
|
5
|
|
|
|
|
38
|
identify(\%args); |
56
|
5
|
|
|
|
|
17
|
my $name = $args{name}; |
57
|
|
|
|
|
|
|
|
58
|
5
|
|
|
|
|
14
|
my $record_reader = $args{record_reader}; |
59
|
5
|
50
|
|
|
|
22
|
LOGDIE "$name undefined record_reader" unless defined $record_reader; |
60
|
5
|
50
|
|
|
|
34
|
LOGDIE "$name record_reader MUST be a sub reference" |
61
|
|
|
|
|
|
|
unless ref($record_reader) eq 'CODE'; |
62
|
|
|
|
|
|
|
|
63
|
5
|
|
|
|
|
13
|
my $emit_eof = $args{emit_eof}; |
64
|
5
|
|
|
|
|
14
|
my $input = $args{input}; |
65
|
5
|
|
33
|
|
|
28
|
my $has_input = defined($input) && length($input); |
66
|
5
|
|
|
|
|
14
|
my $output = $args{output}; |
67
|
|
|
|
|
|
|
return sub { |
68
|
6
|
|
|
6
|
|
18
|
my $record = shift; |
69
|
6
|
50
|
|
|
|
25
|
my $source = $has_input ? $record->{$input} : $record; |
70
|
6
|
|
|
|
|
15
|
my $fh = $source->{fh}; |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
return ( |
73
|
|
|
|
|
|
|
iterator => sub { |
74
|
24
|
|
|
|
|
66
|
my $read = $record_reader->($fh); |
75
|
24
|
|
|
|
|
99
|
my $retval = {%$record, $output => $read}; |
76
|
24
|
100
|
|
|
|
88
|
return $retval if defined $read; |
77
|
7
|
100
|
|
|
|
30
|
if ($emit_eof) { |
78
|
1
|
|
|
|
|
2
|
$emit_eof = 0; |
79
|
1
|
|
|
|
|
7
|
return $retval; |
80
|
|
|
|
|
|
|
} |
81
|
6
|
|
|
|
|
17
|
return; |
82
|
|
|
|
|
|
|
}, |
83
|
6
|
|
|
|
|
48
|
); |
84
|
5
|
|
|
|
|
82
|
}; |
85
|
|
|
|
|
|
|
} ## end sub read_by_record_reader |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
sub read_by_separator { |
88
|
5
|
|
|
5
|
1
|
74
|
my %args = normalize_args( |
89
|
|
|
|
|
|
|
@_, |
90
|
|
|
|
|
|
|
[ |
91
|
|
|
|
|
|
|
{ |
92
|
|
|
|
|
|
|
name => 'read_by_separator', |
93
|
|
|
|
|
|
|
chomp => 1, |
94
|
|
|
|
|
|
|
identification => {caller => [caller(0)]}, |
95
|
|
|
|
|
|
|
}, |
96
|
|
|
|
|
|
|
'separator' |
97
|
|
|
|
|
|
|
] |
98
|
|
|
|
|
|
|
); |
99
|
5
|
|
|
|
|
24
|
my $separator = $args{separator}; |
100
|
5
|
|
|
|
|
11
|
my $chomp = $args{chomp}; |
101
|
|
|
|
|
|
|
return read_by_record_reader( |
102
|
|
|
|
|
|
|
%args, |
103
|
|
|
|
|
|
|
record_reader => sub { |
104
|
24
|
|
|
24
|
|
47
|
my $fh = shift; |
105
|
24
|
|
|
|
|
114
|
local $INPUT_RECORD_SEPARATOR = $separator; |
106
|
24
|
|
|
|
|
179
|
my $retval = <$fh>; |
107
|
24
|
100
|
66
|
|
|
206
|
chomp($retval) if defined($retval) && $chomp; |
108
|
24
|
|
|
|
|
88
|
return $retval; |
109
|
|
|
|
|
|
|
}, |
110
|
5
|
|
|
|
|
35
|
); |
111
|
|
|
|
|
|
|
} ## end sub read_by_separator |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
shorter_sub_names(__PACKAGE__, 'read_'); |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
1; |