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