1package main; 2 3use strict; 4use warnings; 5 6use Astro::SpaceTrack; 7use HTML::TreeBuilder; 8use LWP::UserAgent; 9use Test::More 0.96; 10 11my $ua = LWP::UserAgent->new (); 12 13# Redistributed TLEs 14 15note 'Celestrak current data'; 16 17my $rslt = $ua->get ('https://celestrak.com/NORAD/elements/'); 18 19$rslt->is_success() 20 or plan skip_all => 'Celestrak inaccessable: ' . $rslt->status_line; 21 22my %got = parse_string( $rslt->content(), source => 'celestrak' ); 23 24my $st = Astro::SpaceTrack->new (direct => 1); 25 26(undef, my $names) = $st->names ('celestrak'); 27my %expect; 28foreach (@$names) { 29 $expect{$_->[1]} = { 30 name => $_->[0], 31 ignore => 0, 32 }; 33} 34 35=begin comment 36 37# Fetchable as of November 16 2021. 38 39$expect{'1999-025'} = { 40 name => 'Fengyun 1C debris', 41 note => 'Not actually provided as a fetchable data set.', 42 ignore => 1, 43}; 44$expect{'cosmos-2251-debris'} = { 45 name => 'Cosmos 2251 debris', 46 note => 'Not actually provided as a fetchable data set.', 47 ignore => 1, 48}; 49$expect{'iridium-33-debris'} = { 50 name => 'Iridium 33 debris', 51 note => 'Not actually provided as a fetchable data set.', 52 ignore => 1, 53}; 54$expect{'2019-006'} = { 55 name => 'Indian ASAT Test Debris', 56 note => 'Not actually provided as a fetchable data set.', 57 ignore => 1, 58}; 59 60# Removed October 23, 2008 61 62$expect{'usa-193-debris'} = { 63 name => 'USA 193 Debris', 64 note => 'Not actually provided as a fetchable data set.', 65 ignore => 1, 66}; 67 68=end comment 69 70=cut 71 72$expect{'2012-044'} = { 73 name => 'BREEZE-M R/B Breakup (2012-044C)', 74 note => 'Fetchable as of November 16 2021, but not on web page', 75 ignore => 1, 76}; 77 78if ($expect{sts}) { 79 $expect{sts}{note} = 'Only available when a mission is in progress.'; 80 $expect{sts}{ignore} = 1; # What it says. 81} 82 83foreach my $key (sort keys %expect) { 84 if ($expect{$key}{ignore}) { 85 my $presence = delete $got{$key} ? 'present' : 'not present'; 86 note "Ignored - $key (@{[($got{$key} || 87 $expect{$key})->{name}]}): $presence"; 88 $expect{$key}{note} and note( " $expect{$key}{note}" ); 89 } else { 90 ok delete $got{$key}, $expect{$key}{name}; 91 $expect{$key}{note} and note " $expect{$key}{note}"; 92 } 93} 94 95ok ( ! keys %got, 'The above is all there is' ) or do { 96 diag( 'The following have been added:' ); 97 foreach (sort keys %got) { 98 diag( " $_ => '$got{$_}{name}'" ); 99 } 100}; 101 102# Supplemental TLEs 103 104note 'Celestrak supplemental data'; 105 106$rslt = $ua->get ('https://celestrak.com/NORAD/elements/supplemental/'); 107 108%got = parse_string( $rslt->content, source => 'celestrak_supplemental' ); 109 110foreach my $key ( keys %got ) { 111 $key !~ m{ / }smx 112 and $key !~ m{ [.] rms \z }smx 113 and next; 114 delete $got{$key}; 115} 116 117( undef, $names ) = $st->names( 'celestrak_supplemental' ); 118 119%expect = (); 120 121foreach ( @{ $names } ) { 122 $expect{$_->[1]} = { 123 name => $_->[0], 124 ignore => 0, 125 }; 126} 127 128foreach my $key ( keys %got ) { 129 if ( $got{$key}{name} =~ m/ \b pre-launch \b /smxi ) { 130 $expect{$key}{name} ||= $got{$key}{name}; 131 $expect{$key}{note} = 'Pre-launch data sets are temporary'; 132 $expect{$key}{ignore} = 1; 133 } 134} 135 136foreach my $key (sort keys %expect) { 137 if ($expect{$key}{ignore}) { 138 my $presence = delete $got{$key} ? 'present' : 'not present'; 139 note "Ignored - $key (@{[($got{$key} || 140 $expect{$key})->{name}]}): $presence"; 141 $expect{$key}{note} and note( " $expect{$key}{note}" ); 142 } else { 143 ok delete $got{$key}, $expect{$key}{name}; 144 $expect{$key}{note} and note " $expect{$key}{note}"; 145 } 146} 147 148ok ( ! keys %got, 'The above is all there is' ) or do { 149 diag( 'The following have been added:' ); 150 foreach (sort keys %got) { 151 diag( " $got{$_}{source} $_ => '$got{$_}{name}'" ); 152 } 153}; 154 155done_testing; 156 157sub parse_string { 158 my ( $string, @extra ) = @_; 159 my $tree = HTML::TreeBuilder->new_from_content( $string ); 160 my %data; 161 foreach my $anchor ( $tree->look_down( _tag => 'a' ) ) { 162 my $href = $anchor->attr( 'href' ) 163 or next; 164 $href =~ s/ [.] txt \z //smx 165 or next; 166 $href =~ m{ / }smx 167 and next; 168 $data{$href} = { 169 name => $anchor->as_trimmed_text(), 170 @extra, 171 }; 172 173 } 174 return %data; 175} 176 1771; 178 179# ex: set textwidth=72 : 180