File Coverage

blib/lib/Text/NASA_Ames/FFI2310.pm
Criterion Covered Total %
statement 69 76 90.7
branch 8 14 57.1
condition 2 6 33.3
subroutine 8 8 100.0
pod 1 1 100.0
total 88 105 83.8


line stmt bran cond sub pod time code
1             package Pure::Text::NASA_Ames::FFI2310;
2 1     1   38997 use base (Text::NASA_Ames);
  1         3  
  1         648  
3             __PACKAGE__->mk_accessors(qw(xScal1 xMiss1 nXScal1 nXMiss1 dXScal1 dXMiss1));
4              
5             package Text::NASA_Ames::FFI2310;
6 1     1   11 use base qw(Pure::Text::NASA_Ames::FFI2310);
  1         2  
  1         596  
7 1     1   7 use Carp;
  1         2  
  1         78  
8              
9 1     1   24 use 5.00600;
  1         4  
  1         41  
10 1     1   5 use strict;
  1         2  
  1         916  
11              
12             our $VERSION = do { my @r = (q$Revision: 1.1 $ =~ /\d+/g); sprintf " %d." . "%02d" x $#r, @r };
13              
14              
15             =head1 NAME
16              
17             Text::NASA_Ames::FFI2310 - Implementation of FFI2310 NASA_Ames format
18              
19             =head1 SYNOPSIS
20              
21              
22             =head1 DESCRIPTION
23              
24             This class should normally not be called directly but through the
25             L class indirectly.
26              
27             =head1 PUBLIC METHODS
28              
29             =over 4
30              
31             =item new (Text::NASA_Ames-object || options for new NASA_Ames)
32              
33             parses the (rest of the) header (body and comments)
34              
35             =cut
36              
37             sub new {
38 2     2 1 3 my ($class, $fileObj) = @_;
39 2   33     10 $class = ref $class || $class;
40 2 50 33     15 if (! (ref $fileObj && (ref($fileObj) eq 'Text::NASA_Ames'))) {
41 0         0 return new Text::NASA_Ames($fileObj);
42             }
43 2         2 my $self = $fileObj;
44 2         6 bless $self, $class;
45              
46 2         13 $self->_parseList('dX', $self->nIV - 1);
47 2         27 $self->_parseLines('xName', $self->nIV);
48 2         27 $self->_parseVDeclaration;
49 2         24 $self->_parseAuxDeclaration;
50 2         29 $self->_parseTailHeader;
51              
52 2         37 return $self;
53             }
54              
55             sub _parseAuxDeclaration {
56 2     2   3 my $self = shift;
57 2         13 $self->SUPER::_parseAuxDeclaration;
58              
59             # move first three aux value to NX1 .. NX3
60 2         25 $self->nAuxV($self->nAuxV - 3);
61 2         32 my @aScal = @{ $self->aScal };
  2         12  
62 2         32 $self->nXScal1(shift @aScal);
63 2         27 $self->xScal1(shift @aScal);
64 2         26 $self->dXScal1(shift @aScal);
65 2         21 $self->aScal(\@aScal);
66 2         18 my @aMiss = @{ $self->aMiss };
  2         6  
67 2         28 $self->nXMiss1(shift @aMiss);
68 2         27 $self->xMiss1(shift @aMiss);
69 2         25 $self->dXMiss1(shift @aMiss);
70 2         20 $self->aMiss(\@aMiss);
71 2         18 my @aName = @{ $self->aName };
  2         6  
72 2         18 shift @aName;
73 2         3 shift @aName;
74 2         3 shift @aName;
75 2         6 $self->aName(\@aName);
76             }
77              
78             sub _refillBuffer {
79 8     8   9 my $self = shift;
80              
81 8         18 my $line = $self->nextLine;
82 8 100       20 return unless defined $line;
83              
84 7         28 my ($x2, $nX1, $x1_0, $dX1, @a) = split ' ', $line;
85 7         20 my @help = ($nX1, $x1_0, $dX1);
86 7         20 $self->_cleanAndScaleVals([$self->nXMiss1, $self->xMiss1, $self->dXMiss1],
87             [$self->nXScal1, $self->xScal1, $self->dXScal1],
88             \@help);
89 7         22 ($nX1, $x1_0, $dX1) = @help;
90 7 50       21 if (@a != $self->nAuxV) {
91 0         0 $self->_carp("not enough elements for Aux, expected ".
92             $self->nAuxV() . ", got ". scalar @a);
93 0         0 return;
94             }
95 7 50       80 $self->_cleanAndScaleVals($self->aMiss, $self->aScal, \@a)
96             if $self->nAuxV > 0;
97              
98 7         11 my @vHelp;
99 7         22 for (my $i = 0; $i < $self->nV; $i++) {
100 7         78 $line = $self->nextLine;
101 7 50       17 unless ($line) {
102 0         0 $self->_carp("not enough elements for V".
103             " in row ". $self->currentLine);
104 0         0 return;
105             }
106            
107 7         27 my (@vi) = split ' ', $line;
108 7 50       20 if (@vi != $nX1) {
109 0         0 $self->_carp("not enough elements for nX1, expected ".
110             $nX1 . ", got ". scalar @vi .
111             " in row ". $self->currentLine);
112 0         0 return;
113             }
114             # transposing
115 7         16 for (my $j = 0; $j < $nX1; $j++) {
116 40         144 $vHelp[$j][$i] = $vi[$j];
117             }
118             }
119              
120 7         85 for (my $j = 0; $j < $nX1; $j++) {
121 40         62 my $x1 = $x1_0 + $j * $dX1;
122 40 50       108 $self->_cleanAndScaleVals($self->vMiss, $self->vScal, $vHelp[$j])
123             if $self->nV > 0;
124 40         61 push @{ $self->dataBuffer },
  40         100  
125             new Text::NASA_Ames::DataEntry({X => [ $x1, $x2 ],
126             V => $vHelp[$j],
127             A => \@a});
128             }
129             }
130              
131             1;
132             __END__