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__ |