File Coverage

blib/lib/Text/NumericData/App/txdfromafors.pm
Criterion Covered Total %
statement 58 58 100.0
branch 12 12 100.0
condition n/a
subroutine 6 6 100.0
pod 0 4 0.0
total 76 80 95.0


line stmt bran cond sub pod time code
1             package Text::NumericData::App::txdfromafors;
2              
3 1     1   53236 use Text::NumericData::App;
  1         5  
  1         42  
4              
5 1     1   6 use strict;
  1         3  
  1         545  
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 = 'Hacky tool to convert AFORS-HET (photovoltaic cell simulation) output to usual columns of textual data. Filters STDIN to STDOUT. Due to AFORS-HET appending data to the end, the whole input is buffered, but that should not be an issue for the moderate size of the 1D data.';
14              
15             our @ISA = ('Text::NumericData::App');
16              
17             sub new
18             {
19 1     1 0 75 my $class = shift;
20 1         5 my @pars =
21             (
22             'title', 'AFORS-HET data', 't',
23             'Provide a title for the data set.'
24             );
25              
26 1         17 return $class->SUPER::new
27             ({
28             parconf =>
29             {
30             info=>$infostring # default version
31             # default author
32             # default copyright
33             }
34             ,pardef => \@pars
35             ,pipemode => 1
36             ,pipe_begin => \&init
37             ,pipe_line => \&process_line
38             ,pipe_end => \&finish
39             });
40             }
41              
42             my $head = 0;
43             my $data = 1;
44             my $post = 2;
45              
46             sub init
47             {
48 2     2 0 224 my $self = shift;
49 2         5 $self->{place} = $head;
50 2         68 $self->{data} = [];
51 2         56 $self->{com} = [];
52 2         6 $self->{titlesets} = [];
53             }
54              
55             # Collect in advance.
56             sub process_line
57             {
58 1149     1149 0 26873 my $self = shift;
59              
60 1149         4768 $_[0] =~ s:[\r\n]::g;
61 1149 100       2760 if($self->{place} == $head)
62             {
63             # first three lines containt title sets
64 8 100       20 if($_[0] =~ /^[\+\-\d]/){ $self->{place} = $data; }
  2         5  
65 6         8 else{ push(@{$self->{titlesets}}, [split("\t", $_[0])]); }
  6         61  
66             }
67              
68 1149 100       2184 if($self->{place} == $data)
69             {
70 386 100       963 if($_[0] =~ /^\s*$/)
71             {
72 2         4 $self->{place} = $post;
73 2         4 $_[0] = ''; return;
  2         6  
74             }
75 384         2001 $_[0] =~ s:,:.:g;
76 384         614 push(@{$self->{data}}, [split("\t", $_[0])]);
  384         4738  
77             }
78              
79 1147 100       2755 if($self->{place} == $post)
80             {
81 757         914 push(@{$self->{com}}, $_[0]);
  757         1709  
82             }
83 1147         2539 $_[0] = '';
84             }
85              
86             # It's a bit nasty to push all in one string, but heck, it's
87             # not that we are talking about gibibytes.
88             sub finish
89             {
90 2     2 0 53 my $self = shift;
91 2         6 my $param = $self->{param};
92 2         30 my $txd = Text::NumericData->new({'separator'=>"\t", 'comment'=>'#'});
93              
94             # output of collected data
95 2         6 $_[0] = ${$txd->comment_line($param->{title})};
  2         12  
96 2         5 for my $c (@{$self->{com}})
  2         7  
97             {
98 757         1219 $_[0] .= ${$txd->comment_line($c)};
  757         1580  
99             }
100             # Print the titles in reverse, so that txd stuff picks up the first, most definite, title set.
101 2         4 while(@{$self->{titlesets}})
  8         27  
102             {
103 6         9 $txd->{titles} = pop(@{$self->{titlesets}});
  6         22  
104 6         10 $_[0] .= ${$txd->title_line()};
  6         17  
105             }
106             # There can be re-iterations forth and back. Bring it in order.
107             # Also, result files aren't ordered along spatial dimension.
108 2         4 my $sortcol = 0;
109             $sortcol = 1
110 2 100       13 if $txd->{titles}[1] =~ /^x/;
111 2         5 @{$self->{data}} = sort {$a->[$sortcol] <=> $b->[$sortcol]} @{$self->{data}};
  2         34  
  382         822  
  2         35  
112 2         7 for my $d (@{$self->{data}})
  2         8  
113             {
114 384         526 $_[0] .= ${$txd->data_line($d)};
  384         730  
115             }
116             }