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