File Coverage

blib/lib/Text/NumericData/App/txdnorm.pm
Criterion Covered Total %
statement 29 43 67.4
branch 7 24 29.1
condition 2 9 22.2
subroutine 5 5 100.0
pod 0 3 0.0
total 43 84 51.1


line stmt bran cond sub pod time code
1             package Text::NumericData::App::txdnorm;
2              
3 1     1   102353 use Text::NumericData::App;
  1         5  
  1         49  
4              
5 1     1   9 use strict;
  1         3  
  1         825  
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             my $infostring = 'normalize data sets
14             (c) 2005 (Artistic License) by Thomas Orgis
15             textdata version x
16              
17             Usage:
18             pipe | txdnorm [parameters] | pipe';
19              
20             our @ISA = ('Text::NumericData::App');
21              
22             sub new
23             {
24 1     1 0 81 my $class = shift;
25 1         8 my @pars =
26             (
27             'to',1,'t',
28             'normalize to this (multiplication)'
29             , 'from',-1,'f',
30             'normalize from this (division) - means this value in input becomes the "to" value in output, if < 0, then normalize to maximum found'
31             , 'xcol',0,'x',
32             'if > 0: choose from value via given value in this column (the x data) - see pos parameter'
33             , 'pos',0,'p',
34             'normalize from the value corresponding to this x value'
35             , 'column',2,'c',
36             'column to normalize, starting at 1'
37             , 'append',0,'a',
38             'instead of overwriting existing column, append a new one (you may want to modify titles afterwards!)'
39             , 'verbose', 1, '',
40             'Give note about error conditions beyond the initial parameter checks (normalizing with zero, etc.).'
41             );
42 1         16 return $class->SUPER::new
43             ({
44             parconf=>
45             {
46             info=>$infostring # default version,
47             # default author
48             # default copyright
49             }
50             ,pardef=>\@pars
51             ,filemode=>1
52             ,pipemode=>1
53             ,pipe_init=>\&prepare
54             ,pipe_file=>\&process_file
55             });
56             }
57              
58             sub prepare
59             {
60 1     1 0 3 my $self = shift;
61 1         4 my $param = $self->{param};
62 1 50       5 unless($param->{from})
63             {
64 0         0 print STDERR "txdnorm: invalid from value; must be non-zero!\n";
65 0         0 return -1;
66             }
67             print STDERR "txdnorm: you really want to make it all zero?"
68 1 50       11 unless $param->{to};
69              
70 1         4 $param->{column} = int($param->{column}); #paranoia
71 1         4 $param->{xcol} = int($param->{xcol}); #paranoia
72 1 50       5 unless($param->{column} > 0)
73             {
74 0         0 print STDERR "txdnorm: invalid column!\n";
75 0         0 return -1;
76             }
77              
78 1         5 return 0;
79             }
80              
81             sub process_file
82             {
83 1     1 0 2 my $self = shift;
84 1         2 my $param = $self->{param};
85 1         1 my $good = 0;
86 1         3 my $normcolumn = $param->{column};
87 1 50 33     4 if($param->{append} and @{$self->{txd}->{Data}})
  0         0  
88             {
89 0         0 $normcolumn = $#{$self->{txd}->{Data}[0]}+2;
  0         0  
90             }
91 1 50       3 unless($param->{xcol} > 0)
92             {
93 1 50       9 if($param->{from} < 0)
94             {
95 1         6 my $max = $self->{txd}->max("abs([$param->{column}])");
96             print STDERR "txdnorm: unable to perform normalisation from zero!\n"
97 1 0 33     4 if($max == 0 and $param->{verbose});
98 1 50       10 $self->{txd}->calc("[$normcolumn] = [$param->{column}] * $param->{to} / $max")
99             unless $max == 0;
100             }
101             else
102             {
103 0         0 $self->{txd}->calc("[$normcolumn] = [$param->{column}] * $param->{to} / $param->{from}");
104             }
105 1         4 $good = 1;
106             }
107             else
108             {
109             #normalize from chosen point
110             my $val = $self->{txd}->y( $param->{pos}
111 0         0 , $param->{xcol}-1, $param->{column}-1 );
112 0 0       0 if(defined $val)
113             {
114             print STDERR "txdnorm: unable to perform normalisation from zero!\n"
115 0 0 0     0 if($val == 0 and $param->{verbose});
116 0 0       0 $self->{txd}->calc("[$normcolumn] = [$param->{column}] * $param->{to} / $val")
117             unless $val == 0;
118 0         0 $good = 1;
119             }
120             else
121             {
122             print STDERR "txdnorm: found no value to start with, please try interpolation (if you already have, then you're in trouble).\n"
123 0 0       0 if $param->{verbose};
124             }
125             }
126 1         7 $self->{txd}->write_all($self->{out});
127             }
128