1package main;
2
3use 5.006002;
4
5use strict;
6use warnings;
7
8use lib qw{ inc };
9
10use Astro::Coord::ECI::TLE qw{ BODY_TYPE_DEBRIS BODY_TYPE_PAYLOAD };
11use My::Module::Sun;
12use Test::More 0.88;	# Because of done_testing();
13
14eval {
15    require JSON;
16    1;
17} or plan skip_all => 'Optional module JSON required';
18
19my $skip_iridium;
20eval {
21    require Astro::Coord::ECI::TLE::Iridium;
22    1;
23} or $skip_iridium = 'Test uses Astro::Coord::ECI::TLE::Iridium';
24
25my $version = Astro::Coord::ECI::TLE->VERSION();
26
27# The following TLE data are from sgp4-ver.tle, and ultimately from
28# "Revisiting Spacetrack Report #3" by David A. Vallado, Paul Crawford,
29# Richard Hujsak, and T. S. Kelso, presented at the 2006 AIAA/AAS
30# Astrodynamics Specialist Conference.
31
32# This report was obtained from the Celestrak web site, specifically
33# http://celestrak.com/publications/AIAA/2006-6753/
34
35# The common name, RCS and effective date were added by me for testing
36# purposes. The RCS and effective date are fictional, and any
37# resemblance to the actual values are purely coincidental.
38
39my $vanguard = <<'EOD';
40VANGUARD 1 --effective 2000/179/22:00:00 --rcs 0.254
411 00005U 58002B   00179.78495062  .00000023  00000-0  28098-4 0  4753
422 00005  34.2682 348.7242 1859667 331.7664  19.3264 10.82419157413667
43EOD
44
45my ( $tle ) = Astro::Coord::ECI::TLE->parse( $vanguard );
46
47$tle->set(
48    file	=> 42,
49    ordinal	=> 666,
50    originator	=> 'Arthur Dent',
51    intrinsic_magnitude	=> 11.0,
52);
53
54my $hash = $tle->TO_JSON();
55
56foreach my $key ( qw{
57	ARG_OF_PERICENTER
58	BSTAR
59	CLASSIFICATION_TYPE
60	COMMENT
61	CREATION_DATE
62	ECCENTRICITY
63	ELEMENT_SET_NO
64	EPHEMERIS_TYPE
65	EPOCH
66	EPOCH_MICROSECONDS
67	FILE
68	INCLINATION
69	INTLDES
70	LAUNCH_NUM
71	LAUNCH_PIECE
72	LAUNCH_YEAR
73	MEAN_ANOMALY
74	MEAN_MOTION
75	MEAN_MOTION_DDOT
76	MEAN_MOTION_DOT
77	NORAD_CAT_ID
78	OBJECT_NAME
79	OBJECT_NUMBER
80	OBJECT_TYPE
81	ORDINAL
82	ORIGINATOR
83	RA_OF_ASC_NODE
84	RCSVALUE
85	REV_AT_EPOCH
86	TLE_LINE0
87	TLE_LINE1
88	TLE_LINE2
89	effective_date
90	intrinsic_magnitude
91    } ) {
92    ok exists $hash->{$key}, "Hash key $key is present for Vanguard 1";
93}
94
95_fudge_json( $hash );
96
97is_deeply $hash, {
98    'ARG_OF_PERICENTER' => '331.7664',
99    'BSTAR' => '2.8098e-05',
100    'CLASSIFICATION_TYPE' => 'U',
101    'COMMENT' => "Generated by Astro::Coord::ECI::TLE v$version",
102#   'CREATION_DATE' => '2012-07-15 19:14:46',
103    'ECCENTRICITY' => '0.1859667',
104    'ELEMENT_SET_NO' => '475',
105    'EPHEMERIS_TYPE' => '0',
106    'EPOCH' => '2000-06-27 18:50:19',
107    'EPOCH_MICROSECONDS'	=> '733568',
108    FILE	=> '42',
109    'INCLINATION' => '34.2682',
110    'INTLDES' => '58002B',
111    'LAUNCH_NUM' => '002',
112    'LAUNCH_PIECE' => 'B',
113    'LAUNCH_YEAR' => 1958,
114    'MEAN_ANOMALY' => '19.3264',
115    'MEAN_MOTION' => '10.82419157',
116    'MEAN_MOTION_DOT' => '2.3e-07',
117    'MEAN_MOTION_DDOT' => '0',
118    'NORAD_CAT_ID' => '00005',
119    'OBJECT_NAME' => 'VANGUARD 1',
120    'OBJECT_NUMBER'	=> '00005',
121    OBJECT_TYPE	=> uc BODY_TYPE_PAYLOAD,
122    ORDINAL	=> 666,
123    ORIGINATOR	=> 'Arthur Dent',
124    'RA_OF_ASC_NODE' => '348.7242',
125    'RCSVALUE' => '0.254',
126    'REV_AT_EPOCH' => '41366',
127    'TLE_LINE0' => '0 VANGUARD 1',
128    'TLE_LINE1' => '1 00005U 58002B   00179.78495062  .00000023  00000-0  28098-4 0  4753',
129    'TLE_LINE2' => '2 00005  34.2682 348.7242 1859667 331.7664  19.3264 10.82419157413667',
130    'effective_date' => '2000-06-27 22:00:00',
131    intrinsic_magnitude	=> 11.0,
132}, 'Test the hash generated by TO_JSON() for Vanguard 1.';
133
134# The canonical() is for sanity's sake in case the decode fails in the
135# following round-trip test.
136my $json = JSON->new()->utf8()->convert_blessed()->canonical();
137
138{   # Local symbol block. Also single-iteration loop.
139    my $name = 'Vanguard 1 round-trip via JSON';
140
141    my $data;
142    # The following setlocale() stuff is a workaround for JSON::XS bug
143    # https://rt.cpan.org/Public/Bug/Display.html?id=93307
144    # As of this writing, it only affects Perls 5.19.8 through 5.19.10,
145    # and only if JSON::XS is being used. The bug report relates it to
146    # commit bc8ec7cc020d0562094a551b280fd3f32bf5eb04. See
147    # https://rt.perl.org/Ticket/Display.html?id=121317 which is the
148    # related Perl ticket.
149    use POSIX qw{ setlocale LC_NUMERIC };
150    my $locale = setlocale( LC_NUMERIC );
151    eval {
152	# The following setlocale() is what makes the code work when
153	# JSON::XS is in use. Without it, the call to
154	# Astro::Coord::ECI::TLE->parse() below will fail if the
155	# LC_NUMERIC environment variable is something like
156	# 'de_DE.UTF-8'.
157	setlocale( LC_NUMERIC, "C" );
158	$data = $json->encode( [ $tle ] );
159	1;
160    } or do {
161	setlocale( LC_NUMERIC, $locale );
162	fail "$name failed to encode JSON: $@";
163	_json_config();
164	last;
165    };
166    setlocale( LC_NUMERIC, $locale );
167
168    my $attrs = { sun => 'My::Module::Sun' };
169
170    my $tle2;
171    eval {
172	( $tle2 ) = Astro::Coord::ECI::TLE->parse( $attrs, $data );
173	1;
174    } or do {
175	fail "$name failed to parse JSON: $@";
176	_json_config();
177	diag $data;
178	last;
179    };
180
181    is $tle2->get( 'tle' ), $vanguard, $name
182	or diag _json_config();
183
184    isa_ok $tle2->get( 'sun' ), 'My::Module::Sun';
185}
186
187SKIP: {
188    $skip_iridium
189	and skip $skip_iridium, 31;
190
191    Astro::Coord::ECI::TLE->status( add => 5, iridium => 'S' );
192
193    # This TLE duplicates the above, and comes from the same source. The
194    # common name has been changed to reflect the use to which the data are
195    # being put.
196
197    ( $tle ) = Astro::Coord::ECI::TLE->parse( <<'EOD' );
198FAKE IRIDIUM
1991 00005U 58002B   00179.78495062  .00000023  00000-0  28098-4 0  4753
2002 00005  34.2682 348.7242 1859667 331.7664  19.3264 10.82419157413667
201EOD
202
203    $tle->set(
204	object_type	=> 'Debris',
205    );
206
207    $hash = $tle->TO_JSON();
208
209    foreach my $key ( qw{
210	    ARG_OF_PERICENTER
211	    BSTAR
212	    CLASSIFICATION_TYPE
213	    COMMENT
214	    CREATION_DATE
215	    ECCENTRICITY
216	    ELEMENT_SET_NO
217	    EPHEMERIS_TYPE
218	    EPOCH
219	    EPOCH_MICROSECONDS
220	    INCLINATION
221	    INTLDES
222	    LAUNCH_NUM
223	    LAUNCH_PIECE
224	    LAUNCH_YEAR
225	    MEAN_ANOMALY
226	    MEAN_MOTION
227	    MEAN_MOTION_DDOT
228	    MEAN_MOTION_DOT
229	    NORAD_CAT_ID
230	    OBJECT_NAME
231	    OBJECT_NUMBER
232	    OBJECT_TYPE
233	    RA_OF_ASC_NODE
234	    REV_AT_EPOCH
235	    TLE_LINE0
236	    TLE_LINE1
237	    TLE_LINE2
238	    operational_status
239	} ) {
240	ok exists $hash->{$key},
241	    "Hash key $key is present for a fictitious Iridium satellite";
242    }
243
244    _fudge_json( $hash );
245
246    is_deeply $hash, {
247	'ARG_OF_PERICENTER' => '331.7664',
248	'BSTAR' => '2.8098e-05',
249	'CLASSIFICATION_TYPE' => 'U',
250	'COMMENT' => "Generated by Astro::Coord::ECI::TLE v$version",
251    #   'CREATION_DATE' => '2012-07-15 19:14:46',
252	'ECCENTRICITY' => '0.1859667',
253	'ELEMENT_SET_NO' => '475',
254	'EPHEMERIS_TYPE' => '0',
255	'EPOCH' => '2000-06-27 18:50:19',
256	'EPOCH_MICROSECONDS' => '733568',
257	'INCLINATION' => '34.2682',
258	'INTLDES' => '58002B',
259	'LAUNCH_NUM' => '002',
260	'LAUNCH_PIECE' => 'B',
261	'LAUNCH_YEAR' => 1958,
262	'MEAN_ANOMALY' => '19.3264',
263	'MEAN_MOTION' => '10.82419157',
264	'MEAN_MOTION_DOT' => '2.3e-07',
265	'MEAN_MOTION_DDOT' => '0',
266	'NORAD_CAT_ID' => '00005',
267	'OBJECT_NAME' => 'FAKE IRIDIUM',
268	'OBJECT_NUMBER'	=> '00005',
269	'RA_OF_ASC_NODE' => '348.7242',
270	OBJECT_TYPE	=> uc BODY_TYPE_DEBRIS,
271	'REV_AT_EPOCH' => '41366',
272	'TLE_LINE0' => '0 FAKE IRIDIUM',
273	'TLE_LINE1' => '1 00005U 58002B   00179.78495062  .00000023  00000-0  28098-4 0  4753',
274	'TLE_LINE2' => '2 00005  34.2682 348.7242 1859667 331.7664  19.3264 10.82419157413667',
275	'operational_status' => 'S',
276	intrinsic_magnitude	=> 7,	# Added by after_reblessing()
277    }, 'Test the hash generated by TO_JSON() for Vanguard 1.';
278
279    # This TLE duplicates the above, and comes from the same source. The
280    # common name has been changed to reflect the use to which the data are
281    # being put, and a Kelso-type status has been added, which should
282    # override the default.
283
284    ( $tle ) = Astro::Coord::ECI::TLE->parse( <<'EOD' );
285FAKE IRIDIUM [+]
2861 00005U 58002B   00179.78495062  .00000023  00000-0  28098-4 0  4753
2872 00005  34.2682 348.7242 1859667 331.7664  19.3264 10.82419157413667
288EOD
289
290    $hash = $tle->TO_JSON();
291
292    _fudge_json( $hash );
293
294    # All we care about here is whether the canned status got overridden.
295    # This is not really a JSON test, but this was a convenient place to put
296    # it.
297
298    is $hash->{operational_status}, '+', 'Override operational status';
299}
300
301done_testing;
302
303sub _fudge_json {
304    my ( $hash ) = @_;
305
306    # We have no idea what the creation date is going to be, so we just
307    # ignore it.
308    delete $hash->{CREATION_DATE};
309
310    # MSWin32 (at least!) insists on a three-digit exponent, so we fudge
311    # it back to two.
312    foreach my $key ( qw{ BSTAR MEAN_MOTION_DOT MEAN_MOTION_DDOT } ) {
313	$hash->{$key} =~ s{ (?<= e [+-] ) ( \d+ ) \z }
314	    { sprintf '%02d', $1 }smxe;
315    }
316
317    return;
318}
319
320sub _json_config {
321    diag '';
322    foreach my $json ( qw{ JSON JSON::PP JSON::XS } ) {
323	my $version;
324	eval {
325	    $version = $json->VERSION();
326	    1;
327	};
328	defined $version
329	    or $version = 'undef';
330	diag sprintf '%-10s %s', $json, $version;
331    }
332    foreach my $name ( qw{ LC_ALL LC_NUMERIC } ) {
333	my $val = $ENV{$name};
334	$val = defined $val ? "'$val'" : 'undef';
335	diag sprintf '$ENV{%s} %s', $name, $val;
336    }
337    return;
338}
339
3401;
341
342# ex: set textwidth=72 :
343