From f143295f886621683508190cef5777882a0f6f3d Mon Sep 17 00:00:00 2001 From: Tom Wyant Date: Fri, 19 Jul 2024 21:50:10 -0400 Subject: [PATCH] Bring canned satellite magnitudes up to date and modify testing to take account of the fact that T. S. Kelso seems to touch visual.txt weekly even if it does not change. --- lib/Astro/Coord/ECI/TLE.pm | 42 ++++++------- tools/heavens-above-mag | 39 +++++++------ xt/author/magnitude_status.t | 110 ++++++++++------------------------- 3 files changed, 68 insertions(+), 123 deletions(-) diff --git a/lib/Astro/Coord/ECI/TLE.pm b/lib/Astro/Coord/ECI/TLE.pm index ef799aec..15f1b887 100644 --- a/lib/Astro/Coord/ECI/TLE.pm +++ b/lib/Astro/Coord/ECI/TLE.pm @@ -8178,14 +8178,7 @@ sub _next_elevation_screen { # # $ tools/heavens-above-mag --celestrak # -# Last-Modified: Fri, 07 Jun 2024 06:54:36 GMT - -# The following constants are unsupported, and may be modified or -# revoked at any time. They exist to support -# xt/author/magnitude_status.t -use constant _CELESTRAK_VISUAL => 'Fri, 07 Jun 2024 06:54:36 GMT'; -use constant _MCCANTS_VSNAMES => undef; -use constant _MCCANTS_QUICKSAT => undef; +# Last-Modified: Fri, 19 Jul 2024 16:46:36 GMT %magnitude_table = ( '00694' => 2.7, # ATLAS CENTAUR 2 R/B @@ -8316,7 +8309,7 @@ use constant _MCCANTS_QUICKSAT => undef; '28353' => 2.7, # SL-16 R/B '28415' => 4.2, # CZ-4B R/B '28480' => 3.7, # CZ-2C R/B -# '28499' => undef, # ARIANE 5 R/B has no recorded magnitude + '28499' => undef, # ARIANE 5 R/B has no recorded magnitude '28738' => 4.7, # CZ-2D R/B '28773' => 4.2, # ASTRO E2 '28931' => 3.2, # ALOS @@ -8330,28 +8323,27 @@ use constant _MCCANTS_QUICKSAT => undef; '31792' => 3.2, # COSMOS 2428 '31793' => 2.7, # SL-16 R/B '33504' => 5.3, # KORONAS-FOTON -# '37731' => undef, # CZ-2C R/B has no recorded magnitude + '37731' => undef, # CZ-2C R/B has no recorded magnitude '38341' => 3.2, # H-2A R/B -# '39271' => undef, # CUSAT 2/FALCON 9 has no recorded magnitude -# '39358' => undef, # SJ-16 has no recorded magnitude -# '39364' => undef, # CZ-2C R/B has no recorded magnitude + '39271' => undef, # CUSAT 2/FALCON 9 has no recorded magnitude + '39358' => undef, # SJ-16 has no recorded magnitude '39679' => 3.4, # SL-4 R/B '39766' => 3.7, # ALOS 2 '40354' => 4.2, # SL-27 R/B -# '41038' => undef, # YAOGAN 29 has no recorded magnitude -# '41337' => undef, # ASTRO H has no recorded magnitude -# '42758' => undef, # HXMT has no recorded magnitude -# '43521' => undef, # CZ-2C R/B has no recorded magnitude -# '43641' => undef, # SAOCOM 1-A has no recorded magnitude -# '43682' => undef, # H-2A R/B has no recorded magnitude -# '46265' => undef, # SAOCOM 1-B has no recorded magnitude + '41038' => undef, # YAOGAN 29 has no recorded magnitude + '41337' => undef, # ASTRO H has no recorded magnitude + '42758' => undef, # HXMT has no recorded magnitude + '43521' => undef, # CZ-2C R/B has no recorded magnitude + '43641' => undef, # SAOCOM 1-A has no recorded magnitude + '43682' => undef, # H-2A R/B has no recorded magnitude + '46265' => undef, # SAOCOM 1-B has no recorded magnitude '48274' => 0.0, # CSS (TIANHE-1) -# '48865' => undef, # COSMOS 2550 has no recorded magnitude -# '51842' => undef, # OBJECT U has no recorded magnitude -# '52794' => undef, # CZ-2C R/B has no recorded magnitude + '48865' => undef, # COSMOS 2550 has no recorded magnitude + '51842' => undef, # OBJECT U has no recorded magnitude + '52794' => undef, # CZ-2C R/B has no recorded magnitude '53807' => 3.5, # BLUEWALKER 3 -# '57800' => undef, # XRISM has no recorded magnitude -# '59624' => undef, # SZ-17 MODULE has no recorded magnitude + '57800' => undef, # XRISM has no recorded magnitude + '59624' => undef, # SZ-17 MODULE has no recorded magnitude ); 1; diff --git a/tools/heavens-above-mag b/tools/heavens-above-mag index 5519ea95..6c80b16f 100755 --- a/tools/heavens-above-mag +++ b/tools/heavens-above-mag @@ -150,7 +150,7 @@ sub print_perl { # die "Debug - $oid ($name) '$mag'"; printf " '%05d' => %5.1f, # %s\n", $oid, $mag, $name; } else { - printf "# '%05d' => undef, # %s has no recorded magnitude\n", $oid, $name; + printf " '%05d' => undef, # %s has no recorded magnitude\n", $oid, $name; } return; } @@ -166,38 +166,39 @@ sub process_celestrak { # # Last-Modified: @{[ $last_modified // 'unknown' ]} -# The following constants are unsupported, and may be modified or -# revoked at any time. They exist to support -# xt/author/magnitude_status.t -use constant _CELESTRAK_VISUAL => @{[ defined $last_modified ? -"'$last_modified'" : 'undef' ]}; -use constant _MCCANTS_VSNAMES => undef; -use constant _MCCANTS_QUICKSAT => undef; - %magnitude_table = ( EOD + my %oid = parse_visual( $visual ); + process_perl( sort { $a <=> $b } keys %oid ); + say ');'; + return; +} + +sub parse_visual { + my ( $resp ) = @_; + my $content = $resp->decoded_content(); + local $_ = undef; # while (<>) ... does not localize $_. my %oid; - my $content = $visual->decoded_content(); open my $fh, '<', \$content; - local $_ = undef; # while (<>) ... does not localize $_. + local $_ = undef; # while (<>) ... does not localize $_. while ( <$fh> ) { - $oid{ unpack 'A5' } = 1; # NOTE the presence of leading zeroes. + my ( $id, $name ) = unpack 'A5A*'; + $oid{$id} = $name; } - foreach my $extra ( - '53807', # Bluewalker 3 + close $fh; + foreach ( + [ '53807', 'Bluewalker 3' ], ) { + my ( $extra, $name ) = @{ $_ }; if ( defined $oid{$extra} ) { warn "OID $extra is already in visual.txt\n"; } else { $opt{verbose} and warn "Adding OID $extra\n"; - $oid{$extra} = 1; + $oid{$extra} = $name; } } - close $fh; - process_perl( sort { $a <=> $b } keys %oid ); - say ');'; - return; + return %oid; } sub process_get { diff --git a/xt/author/magnitude_status.t b/xt/author/magnitude_status.t index d355b321..6049f14f 100644 --- a/xt/author/magnitude_status.t +++ b/xt/author/magnitude_status.t @@ -1,16 +1,17 @@ package main; -use 5.008; +use 5.006002; use strict; use warnings; -use Astro::SpaceTrack 0.084; use Astro::Coord::ECI::TLE; -use HTTP::Date; -use LWP::UserAgent; -use Test::More 0.88; # Because of done_testing(); -use Time::Local; +use List::Util 1.55 qw{ uniqint }; +use Test2::V0; + +use constant VISUAL_NAME => 'visual.txt'; +use constant VISUAL_URL => + 'http://celestrak.org/SpaceTrack/query/' . VISUAL_NAME; note <<'EOD'; @@ -23,88 +24,39 @@ EOD $ENV{TLE_DO_MAGNITUDE_STATUS} or plan skip_all => 'TLE_DO_MAGNITUDE_STATUS not set'; -is_last_modified( - 'http://celestrak.org/SpaceTrack/query/visual.txt', - Astro::Coord::ECI::TLE->_CELESTRAK_VISUAL(), - 'Celestrak visual.txt', -); - do './tools/heavens-above-mag' - or die "Failed to execute ./tools/heavens-above-mag"; + or plan skip_all => "Failed to execute ./tools/heavens-above-mag"; my %canned = Astro::Coord::ECI::TLE->magnitude_table( 'show' ); -foreach my $oid ( sort keys %canned ) { - my $got = $canned{$oid}; - my @rslt = heavens_above_mag::process_get( $oid ); - my ( undef, $name, $want ) = @{ $rslt[0] }; - if ( defined( $got ) && defined( $want ) ) { - cmp_ok $got, '==', $want, "Canned magnitude of $oid ($name)"; - } else { - is $got, $want, "Canned magnitude of $oid ($name)"; - } -} - -=begin comment -is_last_modified( mccants => 'vsnames', - Astro::Coord::ECI::TLE->_MCCANTS_VSNAMES(), - 'McCants vsnames.mag', -); +my $resp = heavens_above_mag::get_cached( VISUAL_NAME, VISUAL_URL ); -is_last_modified( mccants => 'mcnames', - 'Thu, 25 May 2017 00:09:56 GMT', - 'McCants mcnames.mag', -); +my %visual = heavens_above_mag::parse_visual( $resp ); -is_last_modified( mccants => 'quicksat', - Astro::Coord::ECI::TLE->_MCCANTS_QUICKSAT(), - 'McCants qs.mag', -); - -=end comment - -=cut +foreach my $oid ( + map { sprintf '%05d', $_ } + sort { $a <=> $b } + uniqint( keys %visual, keys %canned) +) { + if ( ! exists $canned{$oid} ) { + fail "OID $oid in canned magnitudes"; + } elsif ( ! exists $visual{$oid} ) { + fail "OID $oid in current @{[ VISUAL_NAME ]}"; + } else { + my @rslt = heavens_above_mag::process_get( $oid ); + my $want = format_mag( $rslt[0][2] ); + my $got = format_mag( $canned{$oid} ); + is $got, $want, "OID $oid canned magnitude"; + } +} done_testing; -{ - my $st; - my $ua; - - sub is_last_modified { - my @arg = @_; - my $resp; - - my ( $want, $name ) = splice @arg, -2, 2; - - unless ( defined $want ) { - my $builder = Test::More->builder(); - $builder->skip( "$name unused" ); - return; - } - - if ( $arg[0] =~ m/ \A \w+ : /smx ) { - $ua ||= LWP::UserAgent->new(); - $resp = $ua->head( shift @arg ); - } else { - $st ||= Astro::SpaceTrack->new(); - my ( $src, $catalog ) = splice @arg, 0, 2; - $resp = $st->$src( $catalog ); - } - - unless ( $resp->is_success() ) { - @_ = "$name: " . $resp->status_line(); - goto &fail; - } - - if ( my ( $got ) = $resp->header( 'Last-Modified' ) ) { - @_ = ( $got, $want, "$name Last-Modified: $want" ); - goto &is; - } - - @_ = "$name: No Last-Modified header found"; - goto &fail; - } +sub format_mag { + my ( $mag, $dflt ) = @_; + defined $mag + or return $dflt; + return sprintf '%.1f', $mag; } 1;