The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package main;

use strict;
use warnings;

use Astro::SpaceTrack;
use HTML::Parser;
use LWP::UserAgent;
use Test::More 0.96;

my $ua = LWP::UserAgent->new ();

# Redistributed TLEs

my $rslt = $ua->get ('http://celestrak.com/NORAD/elements/');

$rslt->is_success()
    or plan skip_all => 'Celestrak inaccessable: ' . $rslt->status_line;

my %got = parse_string ($rslt->content);

my $st = Astro::SpaceTrack->new (direct => 1);

(undef, my $names) = $st->names ('celestrak');
my %expect;
foreach (@$names) {
    $expect{$_->[1]} = {
	name => $_->[0],
	ignore => 0,
    };
}

$expect{'1999-025'} = {
    name => 'Fengyun 1C debris',
    note => 'Not actually provided as a fetchable data set.',
    ignore => 1,
};
$expect{'cosmos-2251-debris'} = {
    name => 'Cosmos 2251 debris',
    note => 'Not actually provided as a fetchable data set.',
    ignore => 1,
};
$expect{'iridium-33-debris'} = {
    name => 'Iridium 33 debris',
    note => 'Not actually provided as a fetchable data set.',
    ignore => 1,
};
$expect{'2012-044'} = {
    name => 'BREEZE-M R/B Breakup (2012-044C)',
    note => 'Not actually provided as a fetchable data set.',
    ignore => 1,
};

=begin comment

# Removed October 23, 2008

$expect{'usa-193-debris'} = {
    name => 'USA 193 Debris',
    note => 'Not actually provided as a fetchable data set.',
    ignore => 1,
};

=end comment

=cut

if ($expect{sts}) {
    $expect{sts}{note} = 'Only available when a mission is in progress.';
    $expect{sts}{ignore} = 1;	# What it says.
}

foreach my $key (sort keys %expect) {
    if ($expect{$key}{ignore}) {
	my $presence = delete $got{$key} ? 'present' : 'not present';
	note "Ignored - $key (@{[($got{$key} ||
		$expect{$key})->{name}]}): $presence";
	$expect{$key}{note} and note( "    $expect{$key}{note}" );
    } else {
	ok delete $got{$key}, $expect{$key}{name};
	$expect{$key}{note} and note "    $expect{$key}{note}";
    }
}

ok ( !%got, 'The above is all there is' ) or do {
    diag( 'The following have been added:' );
    foreach (sort keys %got) {
	diag( "    $_ => '$got{$_}{name}'" );
    }
};

# Supplemental TLEs

$rslt = $ua->get ('http://celestrak.com/NORAD/elements/supplemental/');

%got = parse_string ($rslt->content);

foreach my $key ( keys %got ) {
    $key !~ m{ / }smx
	and $key !~ m{ [.] rms \z }smx
	and next;
    delete $got{$key};
}

( undef, $names ) = $st->names( 'celestrak_supplemental' );

%expect = ();

foreach ( @{ $names } ) {
    $expect{$_->[1]} = {
	name => $_->[0],
	ignore => 0,
    };
}

foreach my $key (sort keys %expect) {
    if ($expect{$key}{ignore}) {
	my $presence = delete $got{$key} ? 'present' : 'not present';
	note "Ignored - $key (@{[($got{$key} ||
		$expect{$key})->{name}]}): $presence";
	$expect{$key}{note} and note( "    $expect{$key}{note}" );
    } else {
	ok delete $got{$key}, $expect{$key}{name};
	$expect{$key}{note} and note "    $expect{$key}{note}";
    }
}

ok ( !%got, 'The above is all there is' ) or do {
    diag( 'The following have been added:' );
    foreach (sort keys %got) {
	diag( "    $_ => '$got{$_}{name}'" );
    }
};

done_testing;

sub parse_string {
    my $string = shift;
    my $psr = HTML::Parser->new (api_version => 3);
    $psr->case_sensitive (0);
    my %data;
    my $collect;
    $psr->handler (start => sub {
	    if ($_[1] eq 'a' && $_[2]{href} && $_[2]{href} =~ s/\.txt$//i) {
		$data{$_[2]{href}} = $collect = {
		    name => undef,
		};
	    }
	}, 'self,tagname,attr');
    $psr->handler (text => sub {
	    if ($collect) {
		if (defined $collect->{name}) {
		    $collect->{name} .= ' ' . $_[1];
		} else {
		    $collect->{name} = $_[1];
		}
	    }
	}, 'self,text');
    $psr->handler (end => sub {
	    $_[1] eq 'a' and $collect = undef;
	}, 'self,tagname');
    $psr->parse ($string);
    return %data;
}

1;

# ex: set textwidth=72 :