File Coverage

blib/lib/Text/NASA_Ames/FFI2110.pm
Criterion Covered Total %
statement 57 65 87.6
branch 9 16 56.2
condition 2 6 33.3
subroutine 8 8 100.0
pod 1 1 100.0
total 77 96 80.2


line stmt bran cond sub pod time code
1             package Pure::Text::NASA_Ames::FFI2110;
2 1     1   140066 use base (Text::NASA_Ames);
  1         2  
  1         1010  
3             __PACKAGE__->mk_accessors(qw(xScal1 xMiss1));
4              
5             package Text::NASA_Ames::FFI2110;
6 1     1   18 use base qw(Pure::Text::NASA_Ames::FFI2110);
  1         2162  
  1         1360  
7 1     1   20 use Carp;
  1         3  
  1         460  
8              
9 1     1   44 use 5.00600;
  1         6  
  1         45  
10 1     1   7 use strict;
  1         3  
  1         2600  
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::FFI2110 - Implementation of FFI2110 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 4 my ($class, $fileObj) = @_;
39 2   33     15 $class = ref $class || $class;
40 2 50 33     842 if (! (ref $fileObj && (ref($fileObj) eq 'Text::NASA_Ames'))) {
41 0         0 return new Text::NASA_Ames($fileObj);
42             }
43 2         6 my $self = $fileObj;
44 2         9 bless $self, $class;
45              
46 2         19 $self->_parseList('dX', $self->nIV);
47 2         33 $self->_parseLines('xName', $self->nIV);
48 2         36 $self->_parseVDeclaration;
49 2         27 $self->_parseAuxDeclaration;
50 2         31 $self->_parseTailHeader;
51              
52 2         43 return $self;
53             }
54              
55             sub _parseAuxDeclaration {
56 2     2   4 my $self = shift;
57 2         16 $self->SUPER::_parseAuxDeclaration;
58              
59             # move first aux value to NX1
60 2         30 $self->nAuxV($self->nAuxV - 1);
61 2         35 my @aScal = @{ $self->aScal };
  2         8  
62 2         53 $self->xScal1(shift @aScal);
63 2         26 $self->aScal(\@aScal);
64 2         19 my @aMiss = @{ $self->aMiss };
  2         7  
65 2         30 $self->xMiss1(shift @aMiss);
66 2         27 $self->aMiss(\@aMiss);
67 2         18 my @aName = @{ $self->aName };
  2         7  
68 2         20 shift @aName;
69 2         8 $self->aName(\@aName);
70             }
71              
72             sub _refillBuffer {
73 9     9   16 my $self = shift;
74              
75 9         25 my $line = $self->nextLine;
76 9 100       28 return unless defined $line;
77              
78 8         1055 my ($x2, $nX1, @a) = split ' ', $line;
79 8 50       360 if (@a != $self->nAuxV) {
80 0         0 $self->_carp("not enough elements for Aux, expected ".
81             $self->nAuxV() . ", got ". scalar @a);
82 0         0 return;
83             }
84 8 50       209 $self->_cleanAndScaleVals($self->aMiss, $self->aScal, \@a)
85             if $self->nAuxV > 0;
86              
87 8         26 for (my $i = 0; $i < $nX1; $i++) {
88 44         131 $line = $self->nextLine;
89 44 50       96 unless ($line) {
90 0         0 $self->_carp("not enough elements for V".
91             " in row ". $self->currentLine);
92 0         0 return;
93             }
94            
95 44         122 my ($x1, @v) = split ' ', $line;
96 44 50       457 if (@v != $self->nV) {
97 0         0 $self->_carp("not enough elements for v, expected ".
98             $self->nV . ", got ". scalar @v .
99             " in row ". $self->currentLine);
100 0         0 return;
101             }
102 44 50       483 if ($x1 == $self->xMiss1) {
103 0         0 $x1 = undef;
104             } else {
105 44         730 $x1 *= $self->xScal1;
106             }
107 44 50       391 $self->_cleanAndScaleVals($self->vMiss, $self->vScal, \@v)
108             if $self->nV > 0;
109 44         71 push @{ $self->dataBuffer },
  44         112  
110             new Text::NASA_Ames::DataEntry({X => [ $x1, $x2 ],
111             V => \@v,
112             A => \@a});
113             }
114             }
115              
116             1;
117             __END__