File Coverage

blib/lib/Text/NumericData/App/txdsort.pm
Criterion Covered Total %
statement 48 54 88.8
branch 11 16 68.7
condition 5 9 55.5
subroutine 5 5 100.0
pod 0 3 0.0
total 69 87 79.3


line stmt bran cond sub pod time code
1             package Text::NumericData::App::txdsort;
2              
3 1     1   72025 use Text::NumericData::App;
  1         3  
  1         34  
4              
5 1     1   6 use strict;
  1         2  
  1         768  
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             #the infostring says it all
14             my $infostring = 'sorting of text data
15              
16             Usage:
17             pipe | txdsort [parameters] | pipe
18              
19             You can sort for multiple columns, in order and down- or upwards for each column.';
20              
21             our @ISA = ('Text::NumericData::App');
22              
23             sub new
24             {
25 1     1 0 94 my $class = shift;
26 1         5 my @pars =
27             (
28             'col',1,'c',
29             'the column(s) concerned (first is 1, comma separated list of integers for multi-stage sorting)'
30             , 'down',0,'d',
31             'sort descending; normal mode is ascending; may be also comma-separated list of 0 or 1 according to col value'
32             , 'scan',0,'',
33             'Introduce empty lines after each block of the last sorting column (when it starts from a smaller value again). That is for creating "scans" for gnuplot pm3d mode.'
34             );
35 1         15 return $class->SUPER::new
36             ({
37             parconf=>
38             {
39             info=>$infostring # default version,
40             # default author
41             # default copyright
42             }
43             ,pardef=>\@pars
44             ,filemode=>1
45             ,pipemode=>1
46             ,pipe_init=>\&prepare
47             ,pipe_file=>\&process_file
48             });
49             }
50              
51             sub prepare
52             {
53 1     1 0 2 my $self = shift;
54 1         4 my $param = $self->{param};
55              
56 1         10 $self->{cols} = [split('\s*,\s*', $param->{col})];
57 1         7 $self->{down} = [split('\s*,\s*', $param->{down})];
58              
59 1         2 $self->{maxcol} = 0; # 1-based maximum column value
60 1         4 for(my $i = 0; $i<=$#{$self->{cols}}; ++$i)
  3         9  
61             {
62 2         7 $self->{cols}[$i] = int($self->{cols}[$i]);
63 2 50       9 unless($self->{cols}[$i] > 0)
64             {
65 0         0 print STDERR "txdsort: invalid column: $self->{cols}[$i]!\n";
66 0         0 return -1;
67             }
68 2 100       7 $self->{maxcol} = $self->{cols}[$i] if $self->{cols}[$i] > $self->{maxcol};
69 2         4 --$self->{cols}[$i]; # from here on normal array indices
70             $self->{down}[$i] = 0
71 2 50       6 unless defined $self->{down}[$i];
72             }
73 1 50       2 unless(@{$self->{cols}})
  1         5  
74             {
75 0         0 print STDERR "txdsort: Need some columns!\n";
76 0         0 return -1;
77             }
78              
79             # possible cache of sort function
80             # It should really be generated just once, without side effects.
81 1         2 $self->{sortfunc} = undef;
82              
83 1         3 return 0;
84             }
85              
86             sub process_file
87             {
88 1     1 0 3 my $self = shift;
89 1         4 my $param = $self->{param};
90 1         2 my $file = $self->{txd};
91              
92 1 50       6 if($file->columns() < $self->{maxcol})
93             {
94 0         0 print STDERR "txdsort: Error: File doesn't have enough columns for that sort (".$file->columns()." vs. $self->{maxcol}).\n";
95             }
96             else
97             {
98 1         5 $self->{sortfunc} = $file->sort_data($self->{cols}, $self->{down}, $self->{sortfunc});
99             }
100 1         5 $file->write_header($self->{out});
101 1 50       4 if($param->{scan})
102             {
103 1         11 my $lend = $file->get_end();
104 1         3 my $lastv = undef;
105 1         3 my $col = $self->{cols}[$#{$self->{cols}}];
  1         4  
106 1         2 my $down = $self->{down}[$#{$self->{cols}}];
  1         3  
107 1         2 foreach my $l (@{$file->{data}})
  1         4  
108             { # Print the lines, watchout for scan border.
109 4         11 my $newv = $l->[$col];
110 4 100       10 if(defined $lastv)
111             {
112 3 100 66     16 print {$self->{out}} "$lend"
  1   33     3  
      66        
113             if(($down and $newv > $lastv) or (not $down and $newv < $lastv));
114             }
115 4         8 $lastv = $newv;
116 4         6 print {$self->{out}} ${$file->data_line($l)};
  4         8  
  4         16  
117             }
118             }
119             else
120             {
121 0           $file->write_data($self->{out});
122             }
123             }
124              
125             1;