File Coverage

blib/lib/Text/NumericData/FileCalc.pm
Criterion Covered Total %
statement 52 52 100.0
branch 18 28 64.2
condition 2 6 33.3
subroutine 2 2 100.0
pod 0 1 0.0
total 74 89 83.1


line stmt bran cond sub pod time code
1             package Text::NumericData::FileCalc;
2              
3 3     3   2216 use strict;
  3         7  
  3         1485  
4              
5             require Exporter;
6              
7             # This is just a placeholder because of a past build system bug.
8             # The one and only version for Text::NumericData is kept in
9             # the Text::NumericData module itself.
10             our $VERSION = '1';
11             $VERSION = eval $VERSION;
12              
13             our @ISA = qw(Exporter);
14             our @EXPORT_OK = qw(file_calc);
15              
16             # Returns list ref of deletion indices, undef on failure.
17             sub file_calc
18             {
19 421     421 0 765 my $ff = shift; # formula function
20 421         679 my $config = shift; # see defaults below
21 421         672 my $data = shift; # main data set to work on
22 421         665 my $files = shift; # list of Text::NumericData::File objects to use
23 421         742 my $workarray = shift; # \@A
24 421         679 my $constants = shift; # \@C
25             # configuration defaults
26 421 100       1095 $config =
27             {
28             bycol=>0
29             , fromcol=>undef
30             , byrow=>0
31             , skipempty=>1 # Do nothing on empty data sets,
32             , rowoffset=>0 # offset for byrow ($data starting with that row)
33             } unless(defined $config);
34              
35 421 50       866 return undef unless defined $data;
36              
37 421         668 my @delete;
38             # shortcut for context-less computations
39 421 100       902 unless(defined $files)
40             {
41 1         2 for my $row (0..$#{$data})
  1         6  
42             {
43 4 0 33     8 next if(not @{$data->[$row]} and $config->{skipempty});
  4         15  
44 4         132 my $ignore = &$ff([$data->[$row]]);
45 4 50       17 push(@delete, $row) if $ignore;
46             }
47 1         7 return \@delete;
48             }
49              
50             # the real deal, full computation in all complexity
51 420         690 my @fromcol;
52 420         737 my $bycol = 0;
53             $bycol = $config->{bycol}
54 420 50       1119 if defined $config->{bycol};
55 420         750 my $byrow = 0;
56             $byrow = $config->{byrow}
57 420 50       1026 if defined $config->{byrow};
58 420         793 for my $i (0..$#{$files})
  420         1326  
59             {
60 420 50       1211 if(defined $config->{fromcol})
61             {
62 420         1260 $fromcol[$i] = $config->{fromcol}[$i];
63             }
64 420 50       1262 $fromcol[$i] = $bycol unless defined $fromcol[$i];
65             }
66              
67 420         824 for my $row (0..$#{$data})
  420         1009  
68             {
69 420 0 33     662 next if(not @{$data->[$row]} and $config->{skipempty});
  420         1062  
70             # Construct array for data arrays.
71 420         1050 my @fd = ($data->[$row]); # main data set first
72             # Add the files' sets, possibly using interpolation.
73             # This uses Text::Numeric::Data::File methods.
74 420         954 my $realrow = $row + $config->{rowoffset};
75 420         718 for my $i (0..$#{$files})
  420         985  
76             {
77 420         742 my $d = undef;
78             # Correlate via row ...
79 420 100       877 if($byrow){ $d = $files->[$i]->{data}->[$realrow]; }
  20         54  
80             # Interpolation is possible if configured.
81             else
82             {
83 400         1559 $d = $files->[$i]->set_of($fd[0]->[$bycol], $fromcol[$i]);
84             }
85 420         1153 push(@fd, $d);
86             }
87 420         799 my $ignore = 0;
88             # Ignore data sets that had no match in given files.
89 420 100       935 for(@fd){ if(not defined $_){ $ignore = 1; last; } }
  840         2033  
  90         140  
  90         161  
90             # Finally compute!
91 420 100       11511 $ignore = &$ff(\@fd, $workarray, $constants) unless $ignore;
92 420 100       1570 if($ignore){ push(@delete, $row); }
  90         232  
93             }
94 420         1661 return \@delete;
95             }
96              
97             1;
98              
99             __END__