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   1771 use strict;
  3         8  
  3         1993  
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 690 my $ff = shift; # formula function
20 421         559 my $config = shift; # see defaults below
21 421         581 my $data = shift; # main data set to work on
22 421         580 my $files = shift; # list of Text::NumericData::File objects to use
23 421         649 my $workarray = shift; # \@A
24 421         571 my $constants = shift; # \@C
25             # configuration defaults
26 421 100       870 $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       826 return undef unless defined $data;
36              
37 421         657 my @delete;
38             # shortcut for context-less computations
39 421 100       752 unless(defined $files)
40             {
41 1         2 for my $row (0..$#{$data})
  1         3  
42             {
43 4 0 33     7 next if(not @{$data->[$row]} and $config->{skipempty});
  4         9  
44 4         87 my $ignore = &$ff([$data->[$row]]);
45 4 50       11 push(@delete, $row) if $ignore;
46             }
47 1         5 return \@delete;
48             }
49              
50             # the real deal, full computation in all complexity
51 420         647 my @fromcol;
52 420         660 my $bycol = 0;
53             $bycol = $config->{bycol}
54 420 50       898 if defined $config->{bycol};
55 420         670 my $byrow = 0;
56             $byrow = $config->{byrow}
57 420 50       916 if defined $config->{byrow};
58 420         666 for my $i (0..$#{$files})
  420         994  
59             {
60 420 50       850 if(defined $config->{fromcol})
61             {
62 420         788 $fromcol[$i] = $config->{fromcol}[$i];
63             }
64 420 50       1087 $fromcol[$i] = $bycol unless defined $fromcol[$i];
65             }
66              
67 420         650 for my $row (0..$#{$data})
  420         809  
68             {
69 420 0 33     622 next if(not @{$data->[$row]} and $config->{skipempty});
  420         941  
70             # Construct array for data arrays.
71 420         872 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         1092 my $realrow = $row + $config->{rowoffset};
75 420         612 for my $i (0..$#{$files})
  420         820  
76             {
77 420         590 my $d = undef;
78             # Correlate via row ...
79 420 100       744 if($byrow){ $d = $files->[$i]->{data}->[$realrow]; }
  20         35  
80             # Interpolation is possible if configured.
81             else
82             {
83 400         1227 $d = $files->[$i]->set_of($fd[0]->[$bycol], $fromcol[$i]);
84             }
85 420         887 push(@fd, $d);
86             }
87 420         695 my $ignore = 0;
88             # Ignore data sets that had no match in given files.
89 420 100       743 for(@fd){ if(not defined $_){ $ignore = 1; last; } }
  840         1708  
  90         130  
  90         142  
90             # Finally compute!
91 420 100       9303 $ignore = &$ff(\@fd, $workarray, $constants) unless $ignore;
92 420 100       1224 if($ignore){ push(@delete, $row); }
  90         211  
93             }
94 420         1345 return \@delete;
95             }
96              
97             1;
98              
99             __END__