#
-# Query the DB0SDX QSL server for a callsign
+# Obtain the latest keps from the Amsat site and
+# load them.
#
-# Copyright (c) 2003 Dirk Koopman G1TLH
-# Modified Dec 9, 2004 for new website and xml schema by David Spoelstra N9KT
-# and tidied up by me (Dirk)
+# This will clear out the old keps and rewrite the $root/local/Keps.pm
+# file to retain the data.
#
+# The main state machine code comes more or less straight out of convkeps.pl
+# This command is really to avoid the (even more) messy business of parsing emails
#
+# Copyright (c) 2013 Dirk Koopman, G1TLH
#
+# convert (+/-)00000-0 to (+/-).00000e-0
+sub genenum
+{
+ my ($sign, $frac, $esign, $exp) = unpack "aa5aa", shift;
+ $esign = '+' if $esign eq ' ';
+ my $n = $sign . "." . $frac . 'e' . $esign . $exp;
+ return $n - 0;
+}
+
sub on_disc
{
my $conn = shift;
my $dxchan = shift;
- my @out;
- dbg("keps in: $conn->{kepsin}") if isdbg('keps');
+ if ($conn->{kepsin}) {
+ my $fn = "$main::root/local/Keps.pm";
+ my %keps;
+
+ my @lines = split /[\r\n]+/, $conn->{kepsin};
+ my $state = 1;
+ my $line = 0;
+ my $ref;
+ my $count = 0;
+ my $name;
+ my %lookup = (
+ 'AO-5' => 'AO-05',
+ 'AO-6' => 'AO-06',
+ 'AO-7' => 'AO-07',
+ 'AO-8' => 'AO-08',
+ 'AO-9' => 'AO-09',
+ );
+ for (@lines) {
+
+ last if m{^-};
- $dxchan->send("get/keps: new keps loaded");
+ s/^\s+//;
+ s/[\s\r]+$//;
+ next unless $_;
+ last if m{^/EX}i;
+
+ dbg("keps: $state $_") if isdbg('keps');
+
+ if ($state == 0 && /^Decode/i) {
+ $state = 1;
+ } elsif ($state == 1) {
+ last if m{^-};
+ next if m{^To\s+all}i;
+
+ if (/^([- \w]+)(?:\s+\[[-+\w]\])?$/) {
+ my $n = uc $1;
+ dbg("keps: $state processing $n") if isdbg('keps');
+ $n =~ s/\s/-/g;
+ $name = $lookup{$n};
+ $name ||= $n;
+ $ref = $keps{$name} = {};
+ $state = 2;
+ }
+ } elsif ($state == 2) {
+ if (/^1 /) {
+ my ($id, $number, $epoch, $decay, $mm2, $bstar, $elset) = unpack "xxa5xxa5xxxa15xa10xa8xa8xxxa4x", $_;
+ dbg("keps: $state processing line 1 for $name") if isdbg('keps');
+ $ref->{id} = $id - 0;
+ $ref->{number} = $number - 0;
+ $ref->{epoch} = $epoch - 0;
+ $ref->{mm1} = $decay - 0;
+ $ref->{mm2} = genenum($mm2);
+ $ref->{bstar} = genenum($bstar);
+ $ref->{elset} = $elset - 0;
+ #print "$id $number $epoch $decay $mm2 $bstar $elset\n";
+ #print "mm2: $ref->{mm2} bstar: $ref->{bstar}\n";
+
+ $state = 3;
+ } else {
+ #print "out of order on line $line\n";
+ dbg("keps: $state invalid or out of order line 1 for $name") if isdbg('keps');
+ undef $ref;
+ delete $keps{$name} if defined $name;
+ $state = 1;
+ }
+ } elsif ($state == 3) {
+ if (/^2 /) {
+ my ($id, $incl, $raan, $ecc, $peri, $man, $mmo, $orbit) = unpack "xxa5xa8xa8xa7xa8xa8xa11a5x", $_;
+ dbg("keps: $state processing line 2 for $name") if isdbg('keps');
+ $ref->{meananomaly} = $man - 0;
+ $ref->{meanmotion} = $mmo - 0;
+ $ref->{inclination} = $incl - 0;
+ $ref->{eccentricity} = ".$ecc" - 0;
+ $ref->{argperigee} = $peri - 0;
+ $ref->{raan} = $raan - 0;
+ $ref->{orbit} = $orbit - 0;
+ $count++;
+ } else {
+ #print "out of order on line $line\n";
+ dbg("keps: $state invalid or out of order line 2 for $name") if isdbg('keps');
+ delete $keps{$name};
+ }
+ undef $ref;
+ $state = 1;
+ }
+ }
+ if ($count) {
+ dbg("keps: $count recs, creating $fn") if isdbg('keps');
+ my $dd = new Data::Dumper([\%keps], [qw(*keps)]);
+ $dd->Indent(1);
+ $dd->Quotekeys(0);
+ open(OUT, ">$fn") or die "$fn $!";
+ print OUT "#\n# this file is automatically produced by the get/keps command\n#\n";
+ print OUT "# Last update: ", scalar gmtime, "\n#\n";
+ print OUT "\npackage Sun;\n\n";
+ print OUT $dd->Dumpxs;
+ print OUT "1;\n";
+ close(OUT);
+ dbg("keps: running load/keps") if isdbg('keps');
+ dbg("keps: clearing out old keps") if isdbg('keps');
+ %Sun::keps = ();
+ $dxchan->send($dxchan->run_cmd("load/keps"));
+ }
+ }
}
sub process
$conn->{kepsin} .= "$msg\n";
- dbg("keps in: $conn->{kepsin}") if isdbg('keps');
+# dbg("keps in: $msg") if isdbg('keps');
}
sub handle
$line = uc $line;
return (1, $self->msg('e24')) unless $Internet::allow;
+ return (1, $self->msg('e5')) if $self->priv < 8;
my $target = $Internet::keps_url || 'www.amsat.org';
my $path = $Internet::keps_path || '/amsat/ftp/keps/current/nasa.all';
my $port = 80;
projects / spider.git / blobdiff