File Coverage

blib/lib/Data/Tubes/Plugin/Source.pm
Criterion Covered Total %
statement 62 62 100.0
branch 13 18 72.2
condition 3 5 60.0
subroutine 13 13 100.0
pod 3 3 100.0
total 94 101 93.0


line stmt bran cond sub pod time code
1             package Data::Tubes::Plugin::Source;
2              
3             # vim: ts=3 sts=3 sw=3 et ai :
4              
5 3     3   3034 use strict;
  3         6  
  3         105  
6 3     3   17 use warnings;
  3         5  
  3         86  
7 3     3   15 use English qw< -no_match_vars >;
  3         7  
  3         16  
8 3     3   1130 use Log::Log4perl::Tiny qw< :easy :dead_if_first LOGLEVEL >;
  3         7  
  3         18  
9             our $VERSION = '0.737';
10              
11             use Data::Tubes::Util
12 3     3   1081 qw< normalize_args normalize_filename args_array_with_options >;
  3         7  
  3         181  
13 3     3   459 use Data::Tubes::Plugin::Util qw< identify log_helper >;
  3         17  
  3         2088  
14             my %global_defaults = (
15             input => 'source',
16             output => 'raw',
17             );
18              
19             sub iterate_array {
20 2     2 1 333 my %args = normalize_args(@_,
21             [{name => 'array iterator', array => []}, 'array']);
22 2         14 identify(\%args);
23 2         10 my $logger = log_helper(\%args);
24 2         6 my $global_array = $args{array};
25 2 50       7 LOGDIE 'undefined global array, omit or pass empty one instead'
26             unless defined $global_array;
27 2         4 my $n_global = @$global_array;
28             return sub {
29 3   100 3   12 my $local_array = shift || [];
30 3         6 my $n_local = @$local_array;
31 3         6 my $i = 0;
32             return (
33             iterator => sub {
34 8 100       23 return if $i >= $n_global + $n_local;
35 5 100       17 my $element =
36             ($i < $n_global)
37             ? $global_array->[$i++]
38             : $local_array->[($i++) - $n_global];
39 5 50       13 $logger->($element, \%args) if $logger;
40 5         12 return $element;
41             },
42 3         26 );
43 2         15 };
44             } ## end sub iterate_array
45              
46             sub open_file {
47 6     6 1 1382 my %args = normalize_args(
48             @_,
49             [
50             {
51             binmode => ':encoding(UTF-8)',
52             output => 'source',
53             name => 'open file',
54             },
55             'binmode'
56             ],
57             );
58 6         33 identify(\%args);
59              
60             # valid "output" sub-fields must be defined and at least one char long
61             # otherwise output will be ignored
62 6         15 my $binmode = $args{binmode};
63 6         13 my $output = $args{output};
64 6         11 my $input = $args{input};
65 6   33     22 my $has_input = defined($input) && length($input);
66              
67             return sub {
68             my ($record, $file) =
69 9 50   9   27 $has_input ? ($_[0], $_[0]{$input}) : ({}, $_[0]);
70 9         31 $file = normalize_filename($file);
71              
72 9 100       24 if (ref($file) eq 'GLOB') {
73 1         6 my $is_stdin = fileno($file) == fileno(\*STDIN);
74 1 50       6 my $name = $is_stdin ? 'STDIN' : "$file";
75 1         6 $record->{$output} = {
76             fh => $file,
77             input => $file,
78             type => 'handle',
79             name => "handle\:$name",
80             };
81             } ## end if (ref($file) eq 'GLOB')
82             else {
83 8 50       154 open my $fh, '<', $file
84             or die "open('$file'): $OS_ERROR";
85 8         68 binmode $fh, $binmode;
86 8 100       616 my $type = (ref($file) eq 'SCALAR') ? 'scalar' : 'file';
87 8         56 $record->{$output} = {
88             fh => $fh,
89             input => $file,
90             type => $type,
91             name => "$type\:$file",
92             };
93             } ## end else [ if (ref($file) eq 'GLOB')]
94              
95 9         37 return $record;
96 6         53 };
97             } ## end sub open_file
98              
99             sub iterate_files {
100             my ($files, $args) = args_array_with_options(
101             @_,
102             { # these are the default options
103             name => 'files',
104              
105             # options specific for sub-tubes
106             iterate_array_args => {},
107             open_file_args => {},
108             logger_args => {
109             target => sub {
110 3     3   6 my $record = shift;
111 3         14 return 'reading from ' . $record->{source}{name},;
112             },
113             },
114             }
115 1     1 1 2132 );
116 1         6 identify($args);
117              
118 3     3   500 use Data::Tubes::Plugin::Plumbing;
  3         6  
  3         340  
119             return Data::Tubes::Plugin::Plumbing::sequence(
120             tubes => [
121             iterate_array(
122 1         6 %{$args->{iterate_array_args}}, array => $files,
123             ),
124 1         4 open_file(%{$args->{open_file_args}}),
125 1         2 Data::Tubes::Plugin::Plumbing::logger(%{$args->{logger_args}}),
  1         24  
126             ]
127             );
128             } ## end sub iterate_files
129              
130             1;