File Coverage

blib/lib/Rinchi/CIGIPP/TerrestrialSurfaceConditionsControl.pm
Criterion Covered Total %
statement 59 89 66.2
branch 11 32 34.3
condition 6 18 33.3
subroutine 15 17 88.2
pod 13 13 100.0
total 104 169 61.5


line stmt bran cond sub pod time code
1             #
2             # Rinchi Common Image Generator Interface for Perl
3             # Class Identifier: f78adada-200e-11de-bdaf-001c25551abc
4             # Author: Brian M. Ames
5             #
6              
7             package Rinchi::CIGIPP::TerrestrialSurfaceConditionsControl;
8              
9 1     1   26 use 5.006;
  1         3  
  1         47  
10 1     1   7 use strict;
  1         2  
  1         36  
11 1     1   6 use warnings;
  1         3  
  1         44  
12 1     1   6 use Carp;
  1         2  
  1         4042  
13              
14             require Exporter;
15              
16             our @ISA = qw(Exporter);
17              
18             # Items to export into callers namespace by default. Note: do not export
19             # names by default without a very good reason. Use EXPORT_OK instead.
20             # Do not simply export all your public functions/methods/constants.
21              
22             # This allows declaration use Rinchi::CIGI::AtmosphereControl ':all';
23             # If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
24             # will save memory.
25             our %EXPORT_TAGS = ( 'all' => [ qw(
26            
27             ) ] );
28              
29             our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
30              
31             our @EXPORT = qw(
32            
33             );
34              
35             our $VERSION = '0.02';
36              
37             # Preloaded methods go here.
38              
39             =head1 NAME
40              
41             Rinchi::CIGIPP::TerrestrialSurfaceConditionsControl - Perl extension for the
42             Common Image Generator Interface - Terrestrial Surface Conditions Control data packet.
43             data packet.
44             =head1 SYNOPSIS
45              
46             use Rinchi::CIGIPP::TerrestrialSurfaceConditionsControl;
47             my $tsc_ctl = Rinchi::CIGIPP::TerrestrialSurfaceConditionsControl->new();
48              
49             $packet_type = $tsc_ctl->packet_type();
50             $packet_size = $tsc_ctl->packet_size();
51             $region_ident = $tsc_ctl->region_ident(32124);
52             $entity_ident = $tsc_ctl->entity_ident(34318);
53             $surface_condition_ident = $tsc_ctl->surface_condition_ident(62625);
54             $severity = $tsc_ctl->severity(15);
55             $scope = $tsc_ctl->scope(Rinchi::CIGIPP->RegionalScope);
56             $surface_condition_enable = $tsc_ctl->surface_condition_enable(Rinchi::CIGIPP->Disable);
57             $coverage = $tsc_ctl->coverage(174);
58              
59             =head1 DESCRIPTION
60              
61             The Terrestrial Surface Conditions Control packet is used to specify the
62             conditions of the terrain surface. These typically describe driving conditions,
63             runway contaminants, or conditions that would otherwise impede or add risk to
64             the movement of vehicles on the ground.
65              
66             The possible surface conditions are IG-dependent. Examples might range from
67             weather-related conditions such as dry, wet, icy, or slushy, to hazards such as
68             sand, dirt, and gravel.
69              
70             Regional terrestrial surface conditions always take precedence over the global
71             surface conditions. Once the surface conditions of a region are set, global
72             changes will not affect the surface conditions within that region unless it is
73             disabled. Global changes will, however, change the conditions within a region's
74             transition perimeter.
75              
76             If two or more regions overlap, the value of each surface condition attribute
77             within the area of overlap should be the average of the values determined by
78             the overlapping regions.
79              
80             To determine the terrestrial surface conditions within areas of overlap or
81             through a transition perimeter, the Host can request the conditions at a
82             specific latitude and longitude by issuing an Environmental Conditions Request packet.
83              
84             =head2 EXPORT
85              
86             None by default.
87              
88             #==============================================================================
89              
90             =item new $tsc_ctl = Rinchi::CIGIPP::TerrestrialSurfaceConditionsControl->new()
91              
92             Constructor for Rinchi::TerrestrialSurfaceConditionsControl.
93              
94             =cut
95              
96             sub new {
97 1     1 1 226 my $class = shift;
98 1   33     9 $class = ref($class) || $class;
99              
100 1         11 my $self = {
101             '_Buffer' => '',
102             '_ClassIdent' => 'f78adada-200e-11de-bdaf-001c25551abc',
103             '_Pack' => 'CCSSCC',
104             '_Swap1' => 'CCvvCC',
105             '_Swap2' => 'CCnnCC',
106             'packetType' => 15,
107             'packetSize' => 8,
108             'region_entityIdent' => 0,
109             'surfaceConditionIdent' => 0,
110             '_bitfields1' => 0, # Includes bitfields severity, scope, and surfaceConditionEnable.
111             'severity' => 0,
112             'scope' => 0,
113             'surfaceConditionEnable' => 0,
114             'coverage' => 0,
115             };
116              
117 1 50       3 if (@_) {
118 0 0       0 if (ref($_[0]) eq 'ARRAY') {
    0          
119 0         0 $self->{'_Buffer'} = $_[0][0];
120             } elsif (ref($_[0]) eq 'HASH') {
121 0         0 foreach my $attr (keys %{$_[0]}) {
  0         0  
122 0 0       0 $self->{"_$attr"} = $_[0]->{$attr} unless ($attr =~ /^_/);
123             }
124             }
125             }
126              
127 1         3 bless($self,$class);
128 1         3 return $self;
129             }
130              
131             #==============================================================================
132              
133             =item sub packet_type()
134              
135             $value = $tsc_ctl->packet_type();
136              
137             Data Packet Identifier.
138              
139             This attribute identifies this data packet as the Terrestrial Surface
140             Conditions Control packet. The value of this attribute must be 15.
141              
142             =cut
143              
144             sub packet_type() {
145 1     1 1 13 my ($self) = @_;
146 1         8 return $self->{'packetType'};
147             }
148              
149             #==============================================================================
150              
151             =item sub packet_size()
152              
153             $value = $tsc_ctl->packet_size();
154              
155             Data Packet Size. This attribute indicates the number of bytes in this data
156             packet. The value of this attribute must be 8.
157              
158             =cut
159              
160             sub packet_size() {
161 1     1 1 6 my ($self) = @_;
162 1         3 return $self->{'packetSize'};
163             }
164              
165             #==============================================================================
166              
167             =item sub region_ident([$newValue])
168              
169             $value = $tsc_ctl->region_ident($newValue);
170              
171             Region ID.
172              
173             This attribute specifies the region to which the surface conditions are confined.
174              
175             =cut
176              
177             sub region_ident() {
178 1     1 1 6 my ($self,$nv) = @_;
179 1 50       3 if (defined($nv)) {
180 1         3 $self->{'region_entityIdent'} = $nv;
181             }
182 1         3 return $self->{'region_entityIdent'};
183             }
184              
185             #==============================================================================
186              
187             =item sub entity_ident([$newValue])
188              
189             $value = $tsc_ctl->entity_ident($newValue);
190              
191             Entity ID.
192              
193             This attribute specifies the environmental entity to which the surface
194             condition attributes in this packet are applied.
195              
196             =cut
197              
198             sub entity_ident() {
199 1     1 1 4 my ($self,$nv) = @_;
200 1 50       3 if (defined($nv)) {
201 1         3 $self->{'region_entityIdent'} = $nv;
202             }
203 1         3 return $self->{'region_entityIdent'};
204             }
205              
206             #==============================================================================
207              
208             =item sub surface_condition_ident([$newValue])
209              
210             $value = $tsc_ctl->surface_condition_ident($newValue);
211              
212             Surface Condition ID.
213              
214             This attribute identifies a surface condition or contaminant. Multiple
215             conditions can be specified by sending multiple Terrestrial Surface Conditions
216             Control packets.When this attribute is set to Dry (0), all existing surface
217             conditions will be removed within the specified scope. All other surface
218             condition codes are IG-dependent.
219              
220             =cut
221              
222             sub surface_condition_ident() {
223 1     1 1 6 my ($self,$nv) = @_;
224 1 50       4 if (defined($nv)) {
225 1         3 $self->{'surfaceConditionIdent'} = $nv;
226             }
227 1         3 return $self->{'surfaceConditionIdent'};
228             }
229              
230             #==============================================================================
231              
232             =item sub severity([$newValue])
233              
234             $value = $tsc_ctl->severity($newValue);
235              
236             Severity.
237              
238             This attribute determines the degree of severity for the specified surface
239             contaminant(s). A value of zero (0) indicates that any effects of the
240             contaminant are negligible. A value of 31 indicates that the surface is impassable.
241              
242             =cut
243              
244             sub severity() {
245 1     1 1 5 my ($self,$nv) = @_;
246 1 50       87 if (defined($nv)) {
247 1 50 33     13 if ($nv>=0 and $nv<=31 and int($nv)==$nv) {
      33        
248 1         2 $self->{'severity'} = $nv;
249 1         2 $self->{'_bitfields1'} |= ($nv << 3) &0xF8;
250             } else {
251 0         0 carp "severity must be an integer 0-31.";
252             }
253             }
254 1         4 return (($self->{'_bitfields1'} & 0xF8) >> 3);
255             }
256              
257             #==============================================================================
258              
259             =item sub scope([$newValue])
260              
261             $value = $tsc_ctl->scope($newValue);
262              
263             Scope.
264              
265             This attribute determines whether the specified surface conditions are applied
266             globally, regionally, or to an environmental entity. If this value is set to
267             Regional (1), the conditions are confined to the region specified by Region ID.
268             If this value is set to Entity (2), the conditions are applied to the model
269             specified by Entity ID.
270              
271             GlobalScope 0
272             RegionalScope 1
273             EntityScope 2
274              
275             =cut
276              
277             sub scope() {
278 1     1 1 2 my ($self,$nv) = @_;
279 1 50       4 if (defined($nv)) {
280 1 50 33     16 if (($nv==0) or ($nv==1) or ($nv==2)) {
      33        
281 1         1 $self->{'scope'} = $nv;
282 1         3 $self->{'_bitfields1'} |= ($nv << 1) &0x06;
283             } else {
284 0         0 carp "scope must be 0 (GlobalScope), 1 (RegionalScope), or 2 (EntityScope).";
285             }
286             }
287 1         3 return (($self->{'_bitfields1'} & 0x06) >> 1);
288             }
289              
290             #==============================================================================
291              
292             =item sub surface_condition_enable([$newValue])
293              
294             $value = $tsc_ctl->surface_condition_enable($newValue);
295              
296             Surface Condition Enable.
297              
298             This attribute specifies whether the surface condition attribute identified by
299             the Surface Condition ID attribute should be enabled.
300              
301             Disable 0
302             Enable 1
303              
304             =cut
305              
306             sub surface_condition_enable() {
307 1     1 1 3 my ($self,$nv) = @_;
308 1 50       5 if (defined($nv)) {
309 1 50 33     5 if (($nv==0) or ($nv==1)) {
310 1         2 $self->{'surfaceConditionEnable'} = $nv;
311 1         3 $self->{'_bitfields1'} |= $nv &0x01;
312             } else {
313 0         0 carp "surface_condition_enable must be 0 (Disable), or 1 (Enable).";
314             }
315             }
316 1         2 return ($self->{'_bitfields1'} & 0x01);
317             }
318              
319             #==============================================================================
320              
321             =item sub coverage([$newValue])
322              
323             $value = $tsc_ctl->coverage($newValue);
324              
325             Coverage.
326              
327             This attribute determines the degree of coverage of the specified surface contaminant.
328              
329             =cut
330              
331             sub coverage() {
332 1     1 1 5 my ($self,$nv) = @_;
333 1 50       4 if (defined($nv)) {
334 1         3 $self->{'coverage'} = $nv;
335             }
336 1         2 return $self->{'coverage'};
337             }
338              
339             #==========================================================================
340              
341             =item sub pack()
342              
343             $value = $tsc_ctl->pack();
344              
345             Returns the packed data packet.
346              
347             =cut
348              
349             sub pack($) {
350 1     1 1 6 my $self = shift ;
351            
352 1         6 $self->{'_Buffer'} = CORE::pack($self->{'_Pack'},
353             $self->{'packetType'},
354             $self->{'packetSize'},
355             $self->{'region_entityIdent'},
356             $self->{'surfaceConditionIdent'},
357             $self->{'_bitfields1'}, # Includes bitfields severity, scope, and surfaceConditionEnable.
358             $self->{'coverage'},
359             );
360              
361 1         3 return $self->{'_Buffer'};
362             }
363              
364             #==========================================================================
365              
366             =item sub unpack()
367              
368             $value = $tsc_ctl->unpack();
369              
370             Unpacks the packed data packet.
371              
372             =cut
373              
374             sub unpack($) {
375 0     0 1   my $self = shift @_;
376            
377 0 0         if (@_) {
378 0           $self->{'_Buffer'} = shift @_;
379             }
380 0           my ($a,$b,$c,$d,$e,$f) = CORE::unpack($self->{'_Pack'},$self->{'_Buffer'});
381 0           $self->{'packetType'} = $a;
382 0           $self->{'packetSize'} = $b;
383 0           $self->{'region_entityIdent'} = $c;
384 0           $self->{'surfaceConditionIdent'} = $d;
385 0           $self->{'_bitfields1'} = $e; # Includes bitfields severity, scope, and surfaceConditionEnable.
386 0           $self->{'coverage'} = $f;
387              
388 0           $self->{'severity'} = $self->severity();
389 0           $self->{'scope'} = $self->scope();
390 0           $self->{'surfaceConditionEnable'} = $self->surface_condition_enable();
391              
392 0           return $self->{'_Buffer'};
393             }
394              
395             #==========================================================================
396              
397             =item sub byte_swap()
398              
399             $obj_name->byte_swap();
400              
401             Byte swaps the packed data packet.
402              
403             =cut
404              
405             sub byte_swap($) {
406 0     0 1   my $self = shift @_;
407            
408 0 0         if (@_) {
409 0           $self->{'_Buffer'} = shift @_;
410             } else {
411 0           $self->pack();
412             }
413 0           my ($a,$b,$c,$d,$e,$f) = CORE::unpack($self->{'_Swap1'},$self->{'_Buffer'});
414              
415 0           $self->{'_Buffer'} = CORE::pack($self->{'_Swap2'},$a,$b,$c,$d,$e,$f);
416 0           $self->unpack();
417              
418 0           return $self->{'_Buffer'};
419             }
420              
421             1;
422             __END__