File Coverage

blib/lib/Data/Tubes/Plugin/Reader.pm
Criterion Covered Total %
statement 51 51 100.0
branch 9 12 75.0
condition 3 6 50.0
subroutine 12 12 100.0
pod 4 4 100.0
total 79 85 92.9


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;