| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
=head1 NAME |
|
2
|
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
Astro::SpaceTrack - Retrieve orbital data from www.space-track.org. |
|
4
|
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
=head1 SYNOPSIS |
|
6
|
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
my $st = Astro::SpaceTrack->new (username => $me, |
|
8
|
|
|
|
|
|
|
password => $secret, with_name => 1) or die; |
|
9
|
|
|
|
|
|
|
my $rslt = $st->spacetrack ('special'); |
|
10
|
|
|
|
|
|
|
print $rslt->is_success ? $rslt->content : |
|
11
|
|
|
|
|
|
|
$rslt->status_line; |
|
12
|
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
or |
|
14
|
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
$ SpaceTrack |
|
16
|
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
(some banner text gets printed here) |
|
18
|
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
SpaceTrack> set username me password secret |
|
20
|
|
|
|
|
|
|
OK |
|
21
|
|
|
|
|
|
|
SpaceTrack> set with_name 1 |
|
22
|
|
|
|
|
|
|
OK |
|
23
|
|
|
|
|
|
|
SpaceTrack> spacetrack special >special.txt |
|
24
|
|
|
|
|
|
|
SpaceTrack> celestrak visual >visual.txt |
|
25
|
|
|
|
|
|
|
SpaceTrack> exit |
|
26
|
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
In either of the above, username and password entry can be omitted if |
|
28
|
|
|
|
|
|
|
you have installed L, created an |
|
29
|
|
|
|
|
|
|
L (see below) containing these values, and |
|
30
|
|
|
|
|
|
|
set the C attribute to a true value. You probably |
|
31
|
|
|
|
|
|
|
want to encrypt the identity file, if you have C and C. |
|
32
|
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
In practice, it is probably not useful to retrieve data from any source |
|
34
|
|
|
|
|
|
|
more often than once every four hours, and in fact daily usually |
|
35
|
|
|
|
|
|
|
suffices. |
|
36
|
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
=head1 LEGAL NOTICE |
|
38
|
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
The following two paragraphs are quoted from the Space Track web site. |
|
40
|
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
Due to existing National Security Restrictions pertaining to access of |
|
42
|
|
|
|
|
|
|
and use of U.S. Government-provided information and data, all users |
|
43
|
|
|
|
|
|
|
accessing this web site must be an approved registered user to access |
|
44
|
|
|
|
|
|
|
data on this site. |
|
45
|
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
By logging in to the site, you accept and agree to the terms of the |
|
47
|
|
|
|
|
|
|
User Agreement specified in |
|
48
|
|
|
|
|
|
|
L. |
|
49
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
You should consult the above link for the full text of the user |
|
51
|
|
|
|
|
|
|
agreement before using this software to retrieve content from the Space |
|
52
|
|
|
|
|
|
|
Track web site. |
|
53
|
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
=head1 FUNCTIONAL NOTICES |
|
55
|
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
=head2 CELESTRAK API |
|
57
|
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
The Celestrak web site, L, is in transition from |
|
59
|
|
|
|
|
|
|
being simply a file based repository of TLEs to an API-based service |
|
60
|
|
|
|
|
|
|
providing orbital elements in a number of formats. The C |
|
61
|
|
|
|
|
|
|
and C methods will track this, growing new |
|
62
|
|
|
|
|
|
|
arguments as needed. |
|
63
|
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
The API-based service appears not to provide OID lists. Accordingly, as |
|
65
|
|
|
|
|
|
|
of version 0.150 the C attribute defaults to true, and is |
|
66
|
|
|
|
|
|
|
deprecated. Six months from the release of 0.150 this attribute will |
|
67
|
|
|
|
|
|
|
warn on the first use; six months after that it will warn on all uses, |
|
68
|
|
|
|
|
|
|
and six months after that any use will be fatal. |
|
69
|
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
The absence of OID lists also means that the Space Track options on |
|
71
|
|
|
|
|
|
|
Celestrak queries are deprecated. Six months after the release of 0.158 |
|
72
|
|
|
|
|
|
|
these will warn on the first use, and so on as for the C |
|
73
|
|
|
|
|
|
|
attribute. |
|
74
|
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
The absence of OID lists also means that the Space Track options on |
|
76
|
|
|
|
|
|
|
Celestrak queries are deprecated. Six months after the release of 0.158 |
|
77
|
|
|
|
|
|
|
these will warn on the first use, and so on as for the C |
|
78
|
|
|
|
|
|
|
attribute. |
|
79
|
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
=head2 DEPRECATION NOTICE: IRIDIUM STATUS |
|
81
|
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
As of version 0.137, Iridium status format C<'mccants'> is fully |
|
83
|
|
|
|
|
|
|
deprecated, and will result in an exception. |
|
84
|
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
As of version 0.143, any access of attribute |
|
86
|
|
|
|
|
|
|
C is fatal. |
|
87
|
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
Of course, since there are no longer any Iridium Classic satellites in |
|
89
|
|
|
|
|
|
|
service, all the Iridium status machinery is a candidate for deprecation |
|
90
|
|
|
|
|
|
|
and removal. Stay tuned. |
|
91
|
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
=head1 DESCRIPTION |
|
93
|
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
This package retrieves orbital data from the Space Track web site |
|
95
|
|
|
|
|
|
|
L and several others. You must register and |
|
96
|
|
|
|
|
|
|
get a user name and password before you can get data from Space Track. |
|
97
|
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
Other methods (C, C, ...) have |
|
99
|
|
|
|
|
|
|
been added to access other repositories of orbital data, and in general |
|
100
|
|
|
|
|
|
|
these do not require a Space Track username and password. |
|
101
|
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
Nothing is exported by default, but the shell method/subroutine |
|
103
|
|
|
|
|
|
|
and the BODY_STATUS constants (see C) |
|
104
|
|
|
|
|
|
|
can be exported if you so desire. |
|
105
|
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
Most methods return an HTTP::Response object. See the individual |
|
107
|
|
|
|
|
|
|
method document for details. Methods which return orbital data on |
|
108
|
|
|
|
|
|
|
success add a 'Pragma: spacetrack-type = orbit' header to the |
|
109
|
|
|
|
|
|
|
HTTP::Response object if the request succeeds, and a 'Pragma: |
|
110
|
|
|
|
|
|
|
spacetrack-source =' header to specify what source the data came from. |
|
111
|
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
=head2 Methods |
|
113
|
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
The following methods should be considered public: |
|
115
|
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
=over 4 |
|
117
|
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
=cut |
|
119
|
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
package Astro::SpaceTrack; |
|
121
|
|
|
|
|
|
|
|
|
122
|
10
|
|
|
10
|
|
83199
|
use 5.006002; |
|
|
10
|
|
|
|
|
92
|
|
|
123
|
|
|
|
|
|
|
|
|
124
|
10
|
|
|
10
|
|
53
|
use strict; |
|
|
10
|
|
|
|
|
20
|
|
|
|
10
|
|
|
|
|
258
|
|
|
125
|
10
|
|
|
10
|
|
49
|
use warnings; |
|
|
10
|
|
|
|
|
30
|
|
|
|
10
|
|
|
|
|
291
|
|
|
126
|
|
|
|
|
|
|
|
|
127
|
10
|
|
|
10
|
|
61
|
use Exporter; |
|
|
10
|
|
|
|
|
19
|
|
|
|
10
|
|
|
|
|
1815
|
|
|
128
|
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
our @ISA = qw{ Exporter }; |
|
130
|
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
our $VERSION = '0.162_01'; |
|
132
|
|
|
|
|
|
|
our @EXPORT_OK = qw{ |
|
133
|
|
|
|
|
|
|
shell |
|
134
|
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
BODY_STATUS_IS_OPERATIONAL |
|
136
|
|
|
|
|
|
|
BODY_STATUS_IS_SPARE |
|
137
|
|
|
|
|
|
|
BODY_STATUS_IS_TUMBLING |
|
138
|
|
|
|
|
|
|
BODY_STATUS_IS_DECAYED |
|
139
|
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
ARRAY_REF |
|
141
|
|
|
|
|
|
|
CODE_REF |
|
142
|
|
|
|
|
|
|
HASH_REF |
|
143
|
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
}; |
|
145
|
|
|
|
|
|
|
our %EXPORT_TAGS = ( |
|
146
|
|
|
|
|
|
|
ref => [ grep { m/ _REF \z /smx } @EXPORT_OK ], |
|
147
|
|
|
|
|
|
|
status => [ grep { m/ \A BODY_STATUS_IS_ /smx } @EXPORT_OK ], |
|
148
|
|
|
|
|
|
|
); |
|
149
|
|
|
|
|
|
|
|
|
150
|
10
|
|
|
10
|
|
71
|
use Carp (); |
|
|
10
|
|
|
|
|
29
|
|
|
|
10
|
|
|
|
|
295
|
|
|
151
|
10
|
|
|
10
|
|
7754
|
use Getopt::Long 2.39; |
|
|
10
|
|
|
|
|
128717
|
|
|
|
10
|
|
|
|
|
244
|
|
|
152
|
10
|
|
|
10
|
|
6038
|
use HTTP::Date (); |
|
|
10
|
|
|
|
|
50176
|
|
|
|
10
|
|
|
|
|
6609
|
|
|
153
|
10
|
|
|
10
|
|
4487
|
use HTTP::Request; |
|
|
10
|
|
|
|
|
210702
|
|
|
|
10
|
|
|
|
|
343
|
|
|
154
|
10
|
|
|
10
|
|
4903
|
use HTTP::Response; |
|
|
10
|
|
|
|
|
74486
|
|
|
|
10
|
|
|
|
|
486
|
|
|
155
|
10
|
|
|
|
|
1676
|
use HTTP::Status qw{ |
|
156
|
|
|
|
|
|
|
HTTP_PAYMENT_REQUIRED |
|
157
|
|
|
|
|
|
|
HTTP_NOT_FOUND |
|
158
|
|
|
|
|
|
|
HTTP_I_AM_A_TEAPOT |
|
159
|
|
|
|
|
|
|
HTTP_INTERNAL_SERVER_ERROR |
|
160
|
|
|
|
|
|
|
HTTP_NOT_ACCEPTABLE |
|
161
|
|
|
|
|
|
|
HTTP_NOT_MODIFIED |
|
162
|
|
|
|
|
|
|
HTTP_OK |
|
163
|
|
|
|
|
|
|
HTTP_PRECONDITION_FAILED |
|
164
|
|
|
|
|
|
|
HTTP_UNAUTHORIZED |
|
165
|
|
|
|
|
|
|
HTTP_INTERNAL_SERVER_ERROR |
|
166
|
10
|
|
|
10
|
|
76
|
}; |
|
|
10
|
|
|
|
|
22
|
|
|
167
|
10
|
|
|
10
|
|
5175
|
use IO::File; |
|
|
10
|
|
|
|
|
86552
|
|
|
|
10
|
|
|
|
|
1086
|
|
|
168
|
10
|
|
|
10
|
|
6886
|
use IO::Uncompress::Unzip (); |
|
|
10
|
|
|
|
|
573851
|
|
|
|
10
|
|
|
|
|
320
|
|
|
169
|
10
|
|
|
10
|
|
6728
|
use JSON qw{}; |
|
|
10
|
|
|
|
|
107046
|
|
|
|
10
|
|
|
|
|
285
|
|
|
170
|
10
|
|
|
10
|
|
80
|
use List::Util (); |
|
|
10
|
|
|
|
|
28
|
|
|
|
10
|
|
|
|
|
181
|
|
|
171
|
10
|
|
|
10
|
|
7901
|
use LWP::UserAgent; # Not in the base. |
|
|
10
|
|
|
|
|
182466
|
|
|
|
10
|
|
|
|
|
335
|
|
|
172
|
10
|
|
|
10
|
|
79
|
use POSIX (); |
|
|
10
|
|
|
|
|
37
|
|
|
|
10
|
|
|
|
|
208
|
|
|
173
|
10
|
|
|
10
|
|
55
|
use Scalar::Util 1.07 (); |
|
|
10
|
|
|
|
|
302
|
|
|
|
10
|
|
|
|
|
234
|
|
|
174
|
10
|
|
|
10
|
|
4885
|
use Text::ParseWords (); |
|
|
10
|
|
|
|
|
13051
|
|
|
|
10
|
|
|
|
|
237
|
|
|
175
|
10
|
|
|
10
|
|
68
|
use Time::Local (); |
|
|
10
|
|
|
|
|
23
|
|
|
|
10
|
|
|
|
|
191
|
|
|
176
|
10
|
|
|
10
|
|
50
|
use URI qw{}; |
|
|
10
|
|
|
|
|
26
|
|
|
|
10
|
|
|
|
|
484
|
|
|
177
|
|
|
|
|
|
|
# use URI::Escape qw{}; |
|
178
|
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
# Number of OIDs to retrieve at once. This is a global variable so I can |
|
180
|
|
|
|
|
|
|
# play with it, but it is neither documented nor supported, and I |
|
181
|
|
|
|
|
|
|
# reserve the right to change it or delete it without notice. |
|
182
|
|
|
|
|
|
|
our $RETRIEVAL_SIZE = $ENV{SPACETRACK_RETRIEVAL_SIZE}; |
|
183
|
|
|
|
|
|
|
defined $RETRIEVAL_SIZE or $RETRIEVAL_SIZE = 200; |
|
184
|
|
|
|
|
|
|
|
|
185
|
10
|
|
|
10
|
|
60
|
use constant COPACETIC => 'OK'; |
|
|
10
|
|
|
|
|
32
|
|
|
|
10
|
|
|
|
|
735
|
|
|
186
|
10
|
|
|
|
|
714
|
use constant BAD_SPACETRACK_RESPONSE => |
|
187
|
10
|
|
|
10
|
|
68
|
'Unable to parse SpaceTrack response'; |
|
|
10
|
|
|
|
|
21
|
|
|
188
|
10
|
|
|
|
|
543
|
use constant INVALID_CATALOG => |
|
189
|
10
|
|
|
10
|
|
67
|
'Catalog name %s invalid. Legal names are %s.'; |
|
|
10
|
|
|
|
|
28
|
|
|
190
|
10
|
|
|
10
|
|
64
|
use constant LAPSED_FUNDING => 'Funding lapsed.'; |
|
|
10
|
|
|
|
|
34
|
|
|
|
10
|
|
|
|
|
505
|
|
|
191
|
10
|
|
|
10
|
|
64
|
use constant LOGIN_FAILED => 'Login failed'; |
|
|
10
|
|
|
|
|
18
|
|
|
|
10
|
|
|
|
|
512
|
|
|
192
|
10
|
|
|
10
|
|
60
|
use constant NO_CREDENTIALS => 'Username or password not specified.'; |
|
|
10
|
|
|
|
|
19
|
|
|
|
10
|
|
|
|
|
516
|
|
|
193
|
10
|
|
|
10
|
|
66
|
use constant NO_CAT_ID => 'No catalog IDs specified.'; |
|
|
10
|
|
|
|
|
17
|
|
|
|
10
|
|
|
|
|
532
|
|
|
194
|
10
|
|
|
10
|
|
64
|
use constant NO_OBJ_NAME => 'No object name specified.'; |
|
|
10
|
|
|
|
|
17
|
|
|
|
10
|
|
|
|
|
512
|
|
|
195
|
10
|
|
|
10
|
|
64
|
use constant NO_RECORDS => 'No records found.'; |
|
|
10
|
|
|
|
|
19
|
|
|
|
10
|
|
|
|
|
516
|
|
|
196
|
|
|
|
|
|
|
|
|
197
|
10
|
|
|
10
|
|
90
|
use constant SESSION_PATH => '/'; |
|
|
10
|
|
|
|
|
22
|
|
|
|
10
|
|
|
|
|
507
|
|
|
198
|
|
|
|
|
|
|
|
|
199
|
10
|
|
|
10
|
|
61
|
use constant DEFAULT_SPACE_TRACK_REST_SEARCH_CLASS => 'satcat'; |
|
|
10
|
|
|
|
|
22
|
|
|
|
10
|
|
|
|
|
577
|
|
|
200
|
10
|
|
|
10
|
|
63
|
use constant DEFAULT_SPACE_TRACK_VERSION => 2; |
|
|
10
|
|
|
|
|
20
|
|
|
|
10
|
|
|
|
|
500
|
|
|
201
|
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
# dump_headers constants. |
|
203
|
10
|
|
|
10
|
|
60
|
use constant DUMP_NONE => 0; # No dump |
|
|
10
|
|
|
|
|
20
|
|
|
|
10
|
|
|
|
|
500
|
|
|
204
|
10
|
|
|
10
|
|
58
|
use constant DUMP_TRACE => 0x01; # Logic trace |
|
|
10
|
|
|
|
|
18
|
|
|
|
10
|
|
|
|
|
488
|
|
|
205
|
10
|
|
|
10
|
|
57
|
use constant DUMP_REQUEST => 0x02; # Request content |
|
|
10
|
|
|
|
|
19
|
|
|
|
10
|
|
|
|
|
551
|
|
|
206
|
10
|
|
|
10
|
|
66
|
use constant DUMP_DRY_RUN => 0x04; # Do not execute request |
|
|
10
|
|
|
|
|
20
|
|
|
|
10
|
|
|
|
|
493
|
|
|
207
|
10
|
|
|
10
|
|
68
|
use constant DUMP_COOKIE => 0x08; # Dump cookies. |
|
|
10
|
|
|
|
|
22
|
|
|
|
10
|
|
|
|
|
479
|
|
|
208
|
10
|
|
|
10
|
|
57
|
use constant DUMP_RESPONSE => 0x10; # Dump response. |
|
|
10
|
|
|
|
|
25
|
|
|
|
10
|
|
|
|
|
468
|
|
|
209
|
10
|
|
|
10
|
|
61
|
use constant DUMP_TRUNCATED => 0x20; # Dump with truncated content |
|
|
10
|
|
|
|
|
15
|
|
|
|
10
|
|
|
|
|
1131
|
|
|
210
|
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
my @dump_options; |
|
212
|
|
|
|
|
|
|
foreach my $key ( sort keys %Astro::SpaceTrack:: ) { |
|
213
|
|
|
|
|
|
|
$key =~ s/ \A DUMP_ //smx |
|
214
|
|
|
|
|
|
|
or next; |
|
215
|
|
|
|
|
|
|
push @dump_options, lc $key; |
|
216
|
|
|
|
|
|
|
} |
|
217
|
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
# Manifest constants for reference types |
|
219
|
10
|
|
|
10
|
|
72
|
use constant ARRAY_REF => ref []; |
|
|
10
|
|
|
|
|
20
|
|
|
|
10
|
|
|
|
|
699
|
|
|
220
|
10
|
|
|
10
|
|
67
|
use constant CODE_REF => ref sub {}; |
|
|
10
|
|
|
|
|
19
|
|
|
|
10
|
|
|
|
|
560
|
|
|
221
|
10
|
|
|
10
|
|
68
|
use constant HASH_REF => ref {}; |
|
|
10
|
|
|
|
|
49
|
|
|
|
10
|
|
|
|
|
829
|
|
|
222
|
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
# These are the Space Track version 1 retrieve Getopt::Long option |
|
224
|
|
|
|
|
|
|
# specifications, and the descriptions of each option. These need to |
|
225
|
|
|
|
|
|
|
# survive the returement of Version 1 as a separate entity because I |
|
226
|
|
|
|
|
|
|
# emulated them in the celestrak() method. I'm _NOT_ |
|
227
|
|
|
|
|
|
|
# emulating the options added in version 2 because they require parsing |
|
228
|
|
|
|
|
|
|
# the TLE. |
|
229
|
10
|
|
|
|
|
548
|
use constant CLASSIC_RETRIEVE_OPTIONS => [ |
|
230
|
|
|
|
|
|
|
descending => '(direction of sort)', |
|
231
|
|
|
|
|
|
|
'end_epoch=s' => 'date', |
|
232
|
|
|
|
|
|
|
last5 => '(ignored if -start_epoch or -end_epoch specified)', |
|
233
|
|
|
|
|
|
|
'sort=s' => |
|
234
|
|
|
|
|
|
|
"type ('catnum' or 'epoch', with 'catnum' the default)", |
|
235
|
|
|
|
|
|
|
'start_epoch=s' => 'date', |
|
236
|
10
|
|
|
10
|
|
67
|
]; |
|
|
10
|
|
|
|
|
20
|
|
|
237
|
|
|
|
|
|
|
|
|
238
|
10
|
|
|
|
|
710
|
use constant CELESTRAK_API_OPTIONS => [ |
|
239
|
|
|
|
|
|
|
'query=s', 'query type', |
|
240
|
|
|
|
|
|
|
'format=s', 'data format', |
|
241
|
10
|
|
|
10
|
|
65
|
]; |
|
|
10
|
|
|
|
|
27
|
|
|
242
|
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
use constant CELESTRAK_OPTIONS => [ |
|
244
|
10
|
|
|
|
|
20
|
@{ CLASSIC_RETRIEVE_OPTIONS() }, # TODO deprecate and remove |
|
245
|
10
|
|
|
|
|
21
|
@{ CELESTRAK_API_OPTIONS() }, |
|
|
10
|
|
|
|
|
810
|
|
|
246
|
10
|
|
|
10
|
|
63
|
]; |
|
|
10
|
|
|
|
|
28
|
|
|
247
|
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
use constant CELESTRAK_SUPPLEMENTAL_VALID_QUERY => { |
|
249
|
10
|
|
|
10
|
|
64
|
map { $_ => 1 } qw{ CATNR INTDES SOURCE NAME SPECIAL FILE } }; |
|
|
10
|
|
|
|
|
27
|
|
|
|
10
|
|
|
|
|
23
|
|
|
|
60
|
|
|
|
|
914
|
|
|
250
|
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
use constant CELESTRAK_VALID_QUERY => { |
|
252
|
10
|
|
|
10
|
|
74
|
map { $_ => 1 } qw{ CATNR INTDES GROUP NAME SPECIAL } }; |
|
|
10
|
|
|
|
|
19
|
|
|
|
10
|
|
|
|
|
31
|
|
|
|
50
|
|
|
|
|
57684
|
|
|
253
|
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
our $COMPLETION_APP; # A hack. |
|
255
|
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
my %catalogs = ( # Catalog names (and other info) for each source. |
|
257
|
|
|
|
|
|
|
celestrak => { |
|
258
|
|
|
|
|
|
|
'last-30-days' => {name => "Last 30 Days' Launches"}, |
|
259
|
|
|
|
|
|
|
stations => {name => 'International Space Station'}, |
|
260
|
|
|
|
|
|
|
visual => {name => '100 (or so) brightest'}, |
|
261
|
|
|
|
|
|
|
active => { name => 'Active Satellites' }, |
|
262
|
|
|
|
|
|
|
analyst => { name => 'Analyst Satellites' }, |
|
263
|
|
|
|
|
|
|
weather => {name => 'Weather'}, |
|
264
|
|
|
|
|
|
|
noaa => {name => 'NOAA'}, |
|
265
|
|
|
|
|
|
|
goes => {name => 'GOES'}, |
|
266
|
|
|
|
|
|
|
resource => {name => 'Earth Resources'}, |
|
267
|
|
|
|
|
|
|
sarsat => {name => 'Search and Rescue (SARSAT)'}, |
|
268
|
|
|
|
|
|
|
dmc => {name => 'Disaster Monitoring'}, |
|
269
|
|
|
|
|
|
|
tdrss => {name => 'Tracking and Data Relay Satellite System (TDRSS)'}, |
|
270
|
|
|
|
|
|
|
geo => {name => 'Geostationary'}, |
|
271
|
|
|
|
|
|
|
intelsat => {name => 'Intelsat'}, |
|
272
|
|
|
|
|
|
|
gorizont => {name => 'Gorizont'}, |
|
273
|
|
|
|
|
|
|
raduga => {name => 'Raduga'}, |
|
274
|
|
|
|
|
|
|
molniya => {name => 'Molniya'}, |
|
275
|
|
|
|
|
|
|
iridium => {name => 'Iridium'}, |
|
276
|
|
|
|
|
|
|
'iridium-NEXT' => { name => 'Iridium NEXT' }, |
|
277
|
|
|
|
|
|
|
ses => { name => 'SES communication satellites' }, |
|
278
|
|
|
|
|
|
|
orbcomm => {name => 'Orbcomm'}, |
|
279
|
|
|
|
|
|
|
globalstar => {name => 'Globalstar'}, |
|
280
|
|
|
|
|
|
|
amateur => {name => 'Amateur Radio'}, |
|
281
|
|
|
|
|
|
|
'x-comm' => {name => 'Experimental Communications'}, |
|
282
|
|
|
|
|
|
|
'other-comm' => {name => 'Other communications'}, |
|
283
|
|
|
|
|
|
|
'gps-ops' => {name => 'GPS Operational'}, |
|
284
|
|
|
|
|
|
|
'glo-ops' => {name => 'Glonass Operational'}, |
|
285
|
|
|
|
|
|
|
galileo => {name => 'Galileo'}, |
|
286
|
|
|
|
|
|
|
sbas => {name => |
|
287
|
|
|
|
|
|
|
'Satellite-Based Augmentation System (WAAS/EGNOS/MSAS)'}, |
|
288
|
|
|
|
|
|
|
nnss => {name => 'Navy Navigation Satellite System (NNSS)'}, |
|
289
|
|
|
|
|
|
|
musson => {name => 'Russian LEO Navigation'}, |
|
290
|
|
|
|
|
|
|
science => {name => 'Space and Earth Science'}, |
|
291
|
|
|
|
|
|
|
geodetic => {name => 'Geodetic'}, |
|
292
|
|
|
|
|
|
|
engineering => {name => 'Engineering'}, |
|
293
|
|
|
|
|
|
|
education => {name => 'Education'}, |
|
294
|
|
|
|
|
|
|
military => {name => 'Miscellaneous Military'}, |
|
295
|
|
|
|
|
|
|
radar => {name => 'Radar Calibration'}, |
|
296
|
|
|
|
|
|
|
cubesat => {name => 'CubeSats'}, |
|
297
|
|
|
|
|
|
|
other => {name => 'Other'}, |
|
298
|
|
|
|
|
|
|
beidou => { name => 'Beidou navigational satellites' }, |
|
299
|
|
|
|
|
|
|
argos => { name => 'ARGOS Data Collection System' }, |
|
300
|
|
|
|
|
|
|
planet => { name => 'Planet Labs (Rapideye, Flock)' }, |
|
301
|
|
|
|
|
|
|
spire => { name => 'Spire Global (Lemur weather and ship tracking)' }, |
|
302
|
|
|
|
|
|
|
satnogs => { name => 'SatNOGS' }, |
|
303
|
|
|
|
|
|
|
starlink => { name => 'Starlink' }, |
|
304
|
|
|
|
|
|
|
oneweb => { name => 'OneWeb' }, |
|
305
|
|
|
|
|
|
|
swarm => { name => 'Swarm' }, |
|
306
|
|
|
|
|
|
|
gnss => { name => 'GNSS navigational satellites' }, |
|
307
|
|
|
|
|
|
|
'1982-092' => { name => 'Russian ASAT Test Debris (COSMOS 1408)' }, |
|
308
|
|
|
|
|
|
|
'1999-025' => { name => 'Fengyun 1C debris' }, |
|
309
|
|
|
|
|
|
|
'cosmos-2251-debris' => { name => 'Cosmos 2251 debris' }, |
|
310
|
|
|
|
|
|
|
'iridium-33-debris' => { name => 'Iridium 33 debris' }, |
|
311
|
|
|
|
|
|
|
'2012-044' => { name => 'BREEZE-M R/B Breakup (2012-044C)' }, |
|
312
|
|
|
|
|
|
|
# Removed 2022-05-12 |
|
313
|
|
|
|
|
|
|
# '2019-006' => { name => 'Indian ASAT Test Debris' }, |
|
314
|
|
|
|
|
|
|
}, |
|
315
|
|
|
|
|
|
|
celestrak_supplemental => { |
|
316
|
|
|
|
|
|
|
gps => { |
|
317
|
|
|
|
|
|
|
name => 'GPS Operational', |
|
318
|
|
|
|
|
|
|
# source => 'GPS-A', |
|
319
|
|
|
|
|
|
|
rms => 1, |
|
320
|
|
|
|
|
|
|
match => 1, |
|
321
|
|
|
|
|
|
|
}, |
|
322
|
|
|
|
|
|
|
glonass => { |
|
323
|
|
|
|
|
|
|
name => 'GLONASS Operational', |
|
324
|
|
|
|
|
|
|
# source => 'GLONASS-RE', |
|
325
|
|
|
|
|
|
|
rms => 1, |
|
326
|
|
|
|
|
|
|
match => 1, |
|
327
|
|
|
|
|
|
|
}, |
|
328
|
|
|
|
|
|
|
meteosat => { |
|
329
|
|
|
|
|
|
|
name => 'METEOSAT', |
|
330
|
|
|
|
|
|
|
# source => 'METEOSAT-SV', |
|
331
|
|
|
|
|
|
|
rms => 1, |
|
332
|
|
|
|
|
|
|
match => 1, |
|
333
|
|
|
|
|
|
|
}, |
|
334
|
|
|
|
|
|
|
intelsat => { |
|
335
|
|
|
|
|
|
|
name => 'Intelsat', |
|
336
|
|
|
|
|
|
|
# source => 'Intelsat-11P', |
|
337
|
|
|
|
|
|
|
rms => 1, |
|
338
|
|
|
|
|
|
|
match => 1, |
|
339
|
|
|
|
|
|
|
}, |
|
340
|
|
|
|
|
|
|
ses => { |
|
341
|
|
|
|
|
|
|
name => 'SES', |
|
342
|
|
|
|
|
|
|
# source => 'SES-11P', |
|
343
|
|
|
|
|
|
|
rms => 1, |
|
344
|
|
|
|
|
|
|
match => 1, |
|
345
|
|
|
|
|
|
|
}, |
|
346
|
|
|
|
|
|
|
telesat => { |
|
347
|
|
|
|
|
|
|
name => 'Telesat', |
|
348
|
|
|
|
|
|
|
# source => 'Telesat-E', |
|
349
|
|
|
|
|
|
|
rms => 1, |
|
350
|
|
|
|
|
|
|
match => 1, |
|
351
|
|
|
|
|
|
|
}, |
|
352
|
|
|
|
|
|
|
orbcomm => { |
|
353
|
|
|
|
|
|
|
name => 'Orbcomm (no RMS or match data)', |
|
354
|
|
|
|
|
|
|
# source => 'Orbcomm-TLE', |
|
355
|
|
|
|
|
|
|
}, |
|
356
|
|
|
|
|
|
|
iss => { |
|
357
|
|
|
|
|
|
|
name => 'ISS (from NASA, no match data)', |
|
358
|
|
|
|
|
|
|
# source => 'ISS-E', |
|
359
|
|
|
|
|
|
|
rms => 1, |
|
360
|
|
|
|
|
|
|
}, |
|
361
|
|
|
|
|
|
|
cpf => { |
|
362
|
|
|
|
|
|
|
name => 'CPF (no match data)', |
|
363
|
|
|
|
|
|
|
# source => 'CPF', |
|
364
|
|
|
|
|
|
|
rms => 1, |
|
365
|
|
|
|
|
|
|
}, |
|
366
|
|
|
|
|
|
|
starlink => { |
|
367
|
|
|
|
|
|
|
name => 'Starlink', |
|
368
|
|
|
|
|
|
|
# source => 'SpaceX-E', |
|
369
|
|
|
|
|
|
|
rms => 1, |
|
370
|
|
|
|
|
|
|
match => 1, |
|
371
|
|
|
|
|
|
|
}, |
|
372
|
|
|
|
|
|
|
oneweb => { |
|
373
|
|
|
|
|
|
|
name => 'OneWeb', |
|
374
|
|
|
|
|
|
|
# source => 'OneWeb-E', |
|
375
|
|
|
|
|
|
|
rms => 1, |
|
376
|
|
|
|
|
|
|
match => 1, |
|
377
|
|
|
|
|
|
|
}, |
|
378
|
|
|
|
|
|
|
planet => { |
|
379
|
|
|
|
|
|
|
name => 'Planet (no, not Mercury etc)', |
|
380
|
|
|
|
|
|
|
# source => 'Planet-E', |
|
381
|
|
|
|
|
|
|
rms => 1, |
|
382
|
|
|
|
|
|
|
match => 1, |
|
383
|
|
|
|
|
|
|
}, |
|
384
|
|
|
|
|
|
|
iridium => { |
|
385
|
|
|
|
|
|
|
name => 'Iridium Next', |
|
386
|
|
|
|
|
|
|
# source => 'Iridium-E', |
|
387
|
|
|
|
|
|
|
rms => 1, |
|
388
|
|
|
|
|
|
|
match => 1, |
|
389
|
|
|
|
|
|
|
}, |
|
390
|
|
|
|
|
|
|
ast => { |
|
391
|
|
|
|
|
|
|
name => 'AST Space Mobile', |
|
392
|
|
|
|
|
|
|
rms => 1, |
|
393
|
|
|
|
|
|
|
match => 1, |
|
394
|
|
|
|
|
|
|
}, |
|
395
|
|
|
|
|
|
|
# Project Kuiper Internet |
|
396
|
|
|
|
|
|
|
}, |
|
397
|
|
|
|
|
|
|
iridium_status => { |
|
398
|
|
|
|
|
|
|
kelso => {name => 'Celestrak (Kelso)'}, |
|
399
|
|
|
|
|
|
|
mccants => {name => 'McCants'}, |
|
400
|
|
|
|
|
|
|
sladen => {name => 'Sladen'}, |
|
401
|
|
|
|
|
|
|
spacetrack => { name => 'SpaceTrack' }, |
|
402
|
|
|
|
|
|
|
}, |
|
403
|
|
|
|
|
|
|
mccants => { |
|
404
|
|
|
|
|
|
|
classified => { |
|
405
|
|
|
|
|
|
|
name => 'Classified TLE file', |
|
406
|
|
|
|
|
|
|
member => undef, # classfd.tle |
|
407
|
|
|
|
|
|
|
spacetrack_type => 'orbit', |
|
408
|
|
|
|
|
|
|
url => 'https://www.mmccants.org/tles/classfd.zip', |
|
409
|
|
|
|
|
|
|
}, |
|
410
|
|
|
|
|
|
|
integrated => { |
|
411
|
|
|
|
|
|
|
name => 'Integrated TLE file', |
|
412
|
|
|
|
|
|
|
member => undef, # inttles.tle |
|
413
|
|
|
|
|
|
|
spacetrack_type => 'orbit', |
|
414
|
|
|
|
|
|
|
url => 'https://www.mmccants.org/tles/inttles.zip', |
|
415
|
|
|
|
|
|
|
}, |
|
416
|
|
|
|
|
|
|
mcnames => { |
|
417
|
|
|
|
|
|
|
name => 'Molczan-format magnitude file', |
|
418
|
|
|
|
|
|
|
member => undef, # mcnames |
|
419
|
|
|
|
|
|
|
spacetrack_type => 'molczan', |
|
420
|
|
|
|
|
|
|
url => 'https://www.mmccants.org/tles/mcnames.zip', |
|
421
|
|
|
|
|
|
|
}, |
|
422
|
|
|
|
|
|
|
quicksat => { |
|
423
|
|
|
|
|
|
|
name => 'Quicksat-format magnitude file', |
|
424
|
|
|
|
|
|
|
member => undef, # qs.mag |
|
425
|
|
|
|
|
|
|
spacetrack_type => 'quicksat', |
|
426
|
|
|
|
|
|
|
url => 'https://www.mmccants.org/programs/qsmag.zip', |
|
427
|
|
|
|
|
|
|
}, |
|
428
|
|
|
|
|
|
|
rcs => { |
|
429
|
|
|
|
|
|
|
name => 'McCants-format RCS data', |
|
430
|
|
|
|
|
|
|
member => undef, # rcs |
|
431
|
|
|
|
|
|
|
spacetrack_type => 'rcs.mccants', |
|
432
|
|
|
|
|
|
|
url => 'https://www.mmccants.org/catalogs/rcs.zip', |
|
433
|
|
|
|
|
|
|
}, |
|
434
|
|
|
|
|
|
|
vsnames => { |
|
435
|
|
|
|
|
|
|
name => 'Molczan-format magnitude file (visual only)', |
|
436
|
|
|
|
|
|
|
member => undef, # vsnames |
|
437
|
|
|
|
|
|
|
spacetrack_type => 'molczan', |
|
438
|
|
|
|
|
|
|
url => 'https://www.mmccants.org/tles/vsnames.zip', |
|
439
|
|
|
|
|
|
|
}, |
|
440
|
|
|
|
|
|
|
}, |
|
441
|
|
|
|
|
|
|
spacetrack => [ # Numbered by space_track_version |
|
442
|
|
|
|
|
|
|
undef, # No interface version 0 |
|
443
|
|
|
|
|
|
|
undef, # No interface version 1 any more |
|
444
|
|
|
|
|
|
|
{ # Interface version 2 (REST) |
|
445
|
|
|
|
|
|
|
full => { |
|
446
|
|
|
|
|
|
|
name => 'Full catalog', |
|
447
|
|
|
|
|
|
|
# We have to go through satcat to eliminate bodies that |
|
448
|
|
|
|
|
|
|
# are not on orbit, since tle_latest includes bodies |
|
449
|
|
|
|
|
|
|
# decayed in the last two years or so |
|
450
|
|
|
|
|
|
|
# satcat => {}, |
|
451
|
|
|
|
|
|
|
tle => { |
|
452
|
|
|
|
|
|
|
EPOCH => '>now-30', |
|
453
|
|
|
|
|
|
|
}, |
|
454
|
|
|
|
|
|
|
# number => 1, |
|
455
|
|
|
|
|
|
|
}, |
|
456
|
|
|
|
|
|
|
payloads => { |
|
457
|
|
|
|
|
|
|
name => 'All payloads', |
|
458
|
|
|
|
|
|
|
satcat => { |
|
459
|
|
|
|
|
|
|
OBJECT_TYPE => 'PAYLOAD', |
|
460
|
|
|
|
|
|
|
}, |
|
461
|
|
|
|
|
|
|
}, |
|
462
|
|
|
|
|
|
|
geosynchronous => { # GEO |
|
463
|
|
|
|
|
|
|
name => 'Geosynchronous satellites', |
|
464
|
|
|
|
|
|
|
# number => 3, |
|
465
|
|
|
|
|
|
|
# We have to go through satcat to eliminate bodies that |
|
466
|
|
|
|
|
|
|
# are not on orbit, since tle_latest includes bodies |
|
467
|
|
|
|
|
|
|
# decayed in the last two years or so |
|
468
|
|
|
|
|
|
|
# satcat => { |
|
469
|
|
|
|
|
|
|
# PERIOD => '1425.6--1454.4' |
|
470
|
|
|
|
|
|
|
# }, |
|
471
|
|
|
|
|
|
|
# Note that the v2 interface specimen query is |
|
472
|
|
|
|
|
|
|
# PERIOD 1430--1450. |
|
473
|
|
|
|
|
|
|
# The v1 definition is |
|
474
|
|
|
|
|
|
|
# MEAN_MOTION 0.99--1.01 |
|
475
|
|
|
|
|
|
|
# ECCENTRICITY <0.01 |
|
476
|
|
|
|
|
|
|
# tle => { |
|
477
|
|
|
|
|
|
|
# ECCENTRICITY => '<0.01', |
|
478
|
|
|
|
|
|
|
## MEAN_MOTION => '0.99--1.01', |
|
479
|
|
|
|
|
|
|
# }, |
|
480
|
|
|
|
|
|
|
tle => { |
|
481
|
|
|
|
|
|
|
ECCENTRICITY => '<0.01', |
|
482
|
|
|
|
|
|
|
EPOCH => '>now-30', |
|
483
|
|
|
|
|
|
|
MEAN_MOTION => '0.99--1.01', |
|
484
|
|
|
|
|
|
|
OBJECT_TYPE => 'payload', |
|
485
|
|
|
|
|
|
|
}, |
|
486
|
|
|
|
|
|
|
}, |
|
487
|
|
|
|
|
|
|
medium_earth_orbit => { # MEO |
|
488
|
|
|
|
|
|
|
name => 'Medium Earth Orbit', |
|
489
|
|
|
|
|
|
|
tle => { |
|
490
|
|
|
|
|
|
|
ECCENTRICITY => '<0.25', |
|
491
|
|
|
|
|
|
|
EPOCH => '>now-30', |
|
492
|
|
|
|
|
|
|
# The web page says '600 minutes <= Period <= 800 |
|
493
|
|
|
|
|
|
|
# minutes', but the query is in terms of mean |
|
494
|
|
|
|
|
|
|
# motion. |
|
495
|
|
|
|
|
|
|
MEAN_MOTION => '1.8--2.30', |
|
496
|
|
|
|
|
|
|
OBJECT_TYPE => 'payload', |
|
497
|
|
|
|
|
|
|
}, |
|
498
|
|
|
|
|
|
|
}, |
|
499
|
|
|
|
|
|
|
low_earth_orbit => { # LEO |
|
500
|
|
|
|
|
|
|
name => 'Low Earth Orbit', |
|
501
|
|
|
|
|
|
|
tle => { |
|
502
|
|
|
|
|
|
|
ECCENTRICITY => '<0.25', |
|
503
|
|
|
|
|
|
|
EPOCH => '>now-30', |
|
504
|
|
|
|
|
|
|
MEAN_MOTION => '>11.25', |
|
505
|
|
|
|
|
|
|
OBJECT_TYPE => 'payload', |
|
506
|
|
|
|
|
|
|
}, |
|
507
|
|
|
|
|
|
|
}, |
|
508
|
|
|
|
|
|
|
highly_elliptical_orbit => { # HEO |
|
509
|
|
|
|
|
|
|
name => 'Highly Elliptical Orbit', |
|
510
|
|
|
|
|
|
|
tle => { |
|
511
|
|
|
|
|
|
|
ECCENTRICITY => '>0.25', |
|
512
|
|
|
|
|
|
|
EPOCH => '>now-30', |
|
513
|
|
|
|
|
|
|
OBJECT_TYPE => 'payload', |
|
514
|
|
|
|
|
|
|
}, |
|
515
|
|
|
|
|
|
|
}, |
|
516
|
|
|
|
|
|
|
navigation => { |
|
517
|
|
|
|
|
|
|
name => 'Navigation satellites', |
|
518
|
|
|
|
|
|
|
favorite => 'Navigation', |
|
519
|
|
|
|
|
|
|
tle => { |
|
520
|
|
|
|
|
|
|
EPOCH => '>now-30', |
|
521
|
|
|
|
|
|
|
}, |
|
522
|
|
|
|
|
|
|
# number => 5, |
|
523
|
|
|
|
|
|
|
}, |
|
524
|
|
|
|
|
|
|
weather => { |
|
525
|
|
|
|
|
|
|
name => 'Weather satellites', |
|
526
|
|
|
|
|
|
|
favorite => 'Weather', |
|
527
|
|
|
|
|
|
|
tle => { |
|
528
|
|
|
|
|
|
|
EPOCH => '>now-30', |
|
529
|
|
|
|
|
|
|
}, |
|
530
|
|
|
|
|
|
|
# number => 7, |
|
531
|
|
|
|
|
|
|
}, |
|
532
|
|
|
|
|
|
|
iridium => { |
|
533
|
|
|
|
|
|
|
name => 'Iridium satellites', |
|
534
|
|
|
|
|
|
|
tle => { |
|
535
|
|
|
|
|
|
|
EPOCH => '>now-30', |
|
536
|
|
|
|
|
|
|
OBJECT_NAME => 'iridium~~', |
|
537
|
|
|
|
|
|
|
OBJECT_TYPE => 'payload', |
|
538
|
|
|
|
|
|
|
}, |
|
539
|
|
|
|
|
|
|
# number => 9, |
|
540
|
|
|
|
|
|
|
}, |
|
541
|
|
|
|
|
|
|
orbcomm => { |
|
542
|
|
|
|
|
|
|
name => 'OrbComm satellites', |
|
543
|
|
|
|
|
|
|
tle => { |
|
544
|
|
|
|
|
|
|
EPOCH => '>now-30', |
|
545
|
|
|
|
|
|
|
OBJECT_NAME => 'ORBCOMM~~,VESSELSAT~~', |
|
546
|
|
|
|
|
|
|
OBJECT_TYPE => 'payload', |
|
547
|
|
|
|
|
|
|
}, |
|
548
|
|
|
|
|
|
|
# number => 11, |
|
549
|
|
|
|
|
|
|
}, |
|
550
|
|
|
|
|
|
|
globalstar => { |
|
551
|
|
|
|
|
|
|
name => 'Globalstar satellites', |
|
552
|
|
|
|
|
|
|
tle => { |
|
553
|
|
|
|
|
|
|
EPOCH => '>now-30', |
|
554
|
|
|
|
|
|
|
OBJECT_NAME => 'globalstar~~', |
|
555
|
|
|
|
|
|
|
OBJECT_TYPE => 'payload', |
|
556
|
|
|
|
|
|
|
}, |
|
557
|
|
|
|
|
|
|
# number => 13, |
|
558
|
|
|
|
|
|
|
}, |
|
559
|
|
|
|
|
|
|
intelsat => { |
|
560
|
|
|
|
|
|
|
name => 'Intelsat satellites', |
|
561
|
|
|
|
|
|
|
tle => { |
|
562
|
|
|
|
|
|
|
EPOCH => '>now-30', |
|
563
|
|
|
|
|
|
|
OBJECT_NAME => 'intelsat~~', |
|
564
|
|
|
|
|
|
|
OBJECT_TYPE => 'payload', |
|
565
|
|
|
|
|
|
|
}, |
|
566
|
|
|
|
|
|
|
# number => 15, |
|
567
|
|
|
|
|
|
|
}, |
|
568
|
|
|
|
|
|
|
inmarsat => { |
|
569
|
|
|
|
|
|
|
name => 'Inmarsat satellites', |
|
570
|
|
|
|
|
|
|
tle => { |
|
571
|
|
|
|
|
|
|
EPOCH => '>now-30', |
|
572
|
|
|
|
|
|
|
OBJECT_NAME => 'inmarsat~~', |
|
573
|
|
|
|
|
|
|
OBJECT_TYPE => 'payload', |
|
574
|
|
|
|
|
|
|
}, |
|
575
|
|
|
|
|
|
|
# number => 17, |
|
576
|
|
|
|
|
|
|
}, |
|
577
|
|
|
|
|
|
|
amateur => { |
|
578
|
|
|
|
|
|
|
favorite => 'Amateur', |
|
579
|
|
|
|
|
|
|
name => 'Amateur Radio satellites', |
|
580
|
|
|
|
|
|
|
tle => { |
|
581
|
|
|
|
|
|
|
EPOCH => '>now-30', |
|
582
|
|
|
|
|
|
|
}, |
|
583
|
|
|
|
|
|
|
# number => 19, |
|
584
|
|
|
|
|
|
|
}, |
|
585
|
|
|
|
|
|
|
visible => { |
|
586
|
|
|
|
|
|
|
favorite => 'Visible', |
|
587
|
|
|
|
|
|
|
name => 'Visible satellites', |
|
588
|
|
|
|
|
|
|
tle => { |
|
589
|
|
|
|
|
|
|
EPOCH => '>now-30', |
|
590
|
|
|
|
|
|
|
}, |
|
591
|
|
|
|
|
|
|
# number => 21, |
|
592
|
|
|
|
|
|
|
}, |
|
593
|
|
|
|
|
|
|
special => { |
|
594
|
|
|
|
|
|
|
favorite => 'Special_interest', |
|
595
|
|
|
|
|
|
|
name => 'Special interest satellites', |
|
596
|
|
|
|
|
|
|
tle => { |
|
597
|
|
|
|
|
|
|
EPOCH => '>now-30', |
|
598
|
|
|
|
|
|
|
}, |
|
599
|
|
|
|
|
|
|
# number => 23, |
|
600
|
|
|
|
|
|
|
}, |
|
601
|
|
|
|
|
|
|
bright_geosynchronous => { |
|
602
|
|
|
|
|
|
|
favorite => 'brightgeo', |
|
603
|
|
|
|
|
|
|
name => 'Bright Geosynchronous satellites', |
|
604
|
|
|
|
|
|
|
tle => { |
|
605
|
|
|
|
|
|
|
EPOCH => '>now-30', |
|
606
|
|
|
|
|
|
|
}, |
|
607
|
|
|
|
|
|
|
}, |
|
608
|
|
|
|
|
|
|
human_spaceflight => { |
|
609
|
|
|
|
|
|
|
favorite => 'human_spaceflight', |
|
610
|
|
|
|
|
|
|
name => 'Human Spaceflight', |
|
611
|
|
|
|
|
|
|
tle => { |
|
612
|
|
|
|
|
|
|
EPOCH => '>now-30', |
|
613
|
|
|
|
|
|
|
}, |
|
614
|
|
|
|
|
|
|
}, |
|
615
|
|
|
|
|
|
|
well_tracked_objects => { |
|
616
|
|
|
|
|
|
|
name => 'Well-Tracked Objects', |
|
617
|
|
|
|
|
|
|
satcat => { |
|
618
|
|
|
|
|
|
|
COUNTRY => 'UNKN', |
|
619
|
|
|
|
|
|
|
SITE => 'UNKN', |
|
620
|
|
|
|
|
|
|
}, |
|
621
|
|
|
|
|
|
|
}, |
|
622
|
|
|
|
|
|
|
}, |
|
623
|
|
|
|
|
|
|
], |
|
624
|
|
|
|
|
|
|
); |
|
625
|
|
|
|
|
|
|
|
|
626
|
|
|
|
|
|
|
my %mutator = ( # Mutators for the various attributes. |
|
627
|
|
|
|
|
|
|
addendum => \&_mutate_attrib, # Addendum to banner text. |
|
628
|
|
|
|
|
|
|
banner => \&_mutate_attrib, |
|
629
|
|
|
|
|
|
|
cookie_expires => \&_mutate_spacetrack_interface, |
|
630
|
|
|
|
|
|
|
cookie_name => \&_mutate_spacetrack_interface, |
|
631
|
|
|
|
|
|
|
direct => \&_mutate_attrib, |
|
632
|
|
|
|
|
|
|
domain_space_track => \&_mutate_spacetrack_interface, |
|
633
|
|
|
|
|
|
|
dump_headers => \&_mutate_dump_headers, # Dump all HTTP headers. Undocumented and unsupported. |
|
634
|
|
|
|
|
|
|
fallback => \&_mutate_attrib, |
|
635
|
|
|
|
|
|
|
filter => \&_mutate_attrib, |
|
636
|
|
|
|
|
|
|
identity => \&_mutate_identity, |
|
637
|
|
|
|
|
|
|
iridium_status_format => \&_mutate_iridium_status_format, |
|
638
|
|
|
|
|
|
|
max_range => \&_mutate_number, |
|
639
|
|
|
|
|
|
|
password => \&_mutate_authen, |
|
640
|
|
|
|
|
|
|
pretty => \&_mutate_attrib, |
|
641
|
|
|
|
|
|
|
prompt => \&_mutate_attrib, |
|
642
|
|
|
|
|
|
|
scheme_space_track => \&_mutate_attrib, |
|
643
|
|
|
|
|
|
|
session_cookie => \&_mutate_spacetrack_interface, |
|
644
|
|
|
|
|
|
|
space_track_version => \&_mutate_space_track_version, |
|
645
|
|
|
|
|
|
|
url_iridium_status_kelso => \&_mutate_attrib, |
|
646
|
|
|
|
|
|
|
url_iridium_status_mccants => \&_mutate_attrib, |
|
647
|
|
|
|
|
|
|
url_iridium_status_sladen => \&_mutate_attrib, |
|
648
|
|
|
|
|
|
|
username => \&_mutate_authen, |
|
649
|
|
|
|
|
|
|
verbose => \&_mutate_attrib, |
|
650
|
|
|
|
|
|
|
verify_hostname => \&_mutate_verify_hostname, |
|
651
|
|
|
|
|
|
|
webcmd => \&_mutate_attrib, |
|
652
|
|
|
|
|
|
|
with_name => \&_mutate_attrib, |
|
653
|
|
|
|
|
|
|
); |
|
654
|
|
|
|
|
|
|
|
|
655
|
|
|
|
|
|
|
my %accessor = ( |
|
656
|
|
|
|
|
|
|
cookie_expires => \&_access_spacetrack_interface, |
|
657
|
|
|
|
|
|
|
cookie_name => \&_access_spacetrack_interface, |
|
658
|
|
|
|
|
|
|
domain_space_track => \&_access_spacetrack_interface, |
|
659
|
|
|
|
|
|
|
session_cookie => \&_access_spacetrack_interface, |
|
660
|
|
|
|
|
|
|
); |
|
661
|
|
|
|
|
|
|
foreach my $key ( keys %mutator ) { |
|
662
|
|
|
|
|
|
|
exists $accessor{$key} |
|
663
|
|
|
|
|
|
|
or $accessor{$key} = sub { |
|
664
|
|
|
|
|
|
|
$_[0]->_deprecation_notice( attribute => $_[1] ); |
|
665
|
|
|
|
|
|
|
return $_[0]->{$_[1]}; |
|
666
|
|
|
|
|
|
|
}; |
|
667
|
|
|
|
|
|
|
} |
|
668
|
|
|
|
|
|
|
|
|
669
|
|
|
|
|
|
|
# Maybe I really want a cookie_file attribute, which is used to do |
|
670
|
|
|
|
|
|
|
# $self->{agent}->cookie_jar ({file => $self->{cookie_file}, autosave => 1}). |
|
671
|
|
|
|
|
|
|
# We'll want to use a false attribute value to pass an empty hash. Going to |
|
672
|
|
|
|
|
|
|
# this may imply modification of the new () method where the cookie_jar is |
|
673
|
|
|
|
|
|
|
# defaulted and the session cookie's age is initialized. |
|
674
|
|
|
|
|
|
|
|
|
675
|
|
|
|
|
|
|
|
|
676
|
|
|
|
|
|
|
=item $st = Astro::SpaceTrack->new ( ... ) |
|
677
|
|
|
|
|
|
|
|
|
678
|
|
|
|
|
|
|
=for html |
|
679
|
|
|
|
|
|
|
|
|
680
|
|
|
|
|
|
|
This method instantiates a new Space-Track accessor object. If any |
|
681
|
|
|
|
|
|
|
arguments are passed, the C method is called on the new object, |
|
682
|
|
|
|
|
|
|
and passed the arguments given. |
|
683
|
|
|
|
|
|
|
|
|
684
|
|
|
|
|
|
|
For both historical and operational reasons, this method can get the |
|
685
|
|
|
|
|
|
|
C and C values from multiple locations. It uses the |
|
686
|
|
|
|
|
|
|
first defined value it finds in the following list: |
|
687
|
|
|
|
|
|
|
|
|
688
|
|
|
|
|
|
|
=over |
|
689
|
|
|
|
|
|
|
|
|
690
|
|
|
|
|
|
|
=item a value explicitly specified as an argument to C; |
|
691
|
|
|
|
|
|
|
|
|
692
|
|
|
|
|
|
|
=item a value from the L, if the |
|
693
|
|
|
|
|
|
|
C attribute is explicitly specified as true and |
|
694
|
|
|
|
|
|
|
L is installed; |
|
695
|
|
|
|
|
|
|
|
|
696
|
|
|
|
|
|
|
=item a value from environment variable C if that has a |
|
697
|
|
|
|
|
|
|
non-empty value; |
|
698
|
|
|
|
|
|
|
|
|
699
|
|
|
|
|
|
|
=item a value from the L, if the |
|
700
|
|
|
|
|
|
|
C attribute defaulted to true and |
|
701
|
|
|
|
|
|
|
L s installed; |
|
702
|
|
|
|
|
|
|
|
|
703
|
|
|
|
|
|
|
=item a value from environment variable C. |
|
704
|
|
|
|
|
|
|
|
|
705
|
|
|
|
|
|
|
=back |
|
706
|
|
|
|
|
|
|
|
|
707
|
|
|
|
|
|
|
The reason for preferring C over an identity file value |
|
708
|
|
|
|
|
|
|
taken by default is that I have found that under Mac OS X an SSH session |
|
709
|
|
|
|
|
|
|
does not have access to the system keyring, and |
|
710
|
|
|
|
|
|
|
L provides no other way to specify |
|
711
|
|
|
|
|
|
|
the passphrase used to decrypt the private key. I concluded that if the |
|
712
|
|
|
|
|
|
|
user explicitly requested an identity that it should be preferred to |
|
713
|
|
|
|
|
|
|
anything from the environment, but that, for SSH access to be usable, I |
|
714
|
|
|
|
|
|
|
needed to provide a source of username and password that would be taken |
|
715
|
|
|
|
|
|
|
before the L was tried by default. |
|
716
|
|
|
|
|
|
|
|
|
717
|
|
|
|
|
|
|
Proxies are taken from the environment if defined. See the ENVIRONMENT |
|
718
|
|
|
|
|
|
|
section of the Perl LWP documentation for more information on how to |
|
719
|
|
|
|
|
|
|
set these up. |
|
720
|
|
|
|
|
|
|
|
|
721
|
|
|
|
|
|
|
=cut |
|
722
|
|
|
|
|
|
|
|
|
723
|
|
|
|
|
|
|
sub new { |
|
724
|
10
|
|
|
10
|
1
|
2880
|
my ( $class, %arg ) = @_; |
|
725
|
10
|
50
|
|
|
|
61
|
$class = ref $class if ref $class; |
|
726
|
|
|
|
|
|
|
|
|
727
|
10
|
|
|
|
|
244
|
my $self = { |
|
728
|
|
|
|
|
|
|
banner => 1, # shell () displays banner if true. |
|
729
|
|
|
|
|
|
|
direct => 1, # Direct-fetch from redistributors |
|
730
|
|
|
|
|
|
|
dump_headers => DUMP_NONE, # No dumping. |
|
731
|
|
|
|
|
|
|
fallback => 0, # Do not fall back if primary source offline |
|
732
|
|
|
|
|
|
|
filter => 0, # Filter mode. |
|
733
|
|
|
|
|
|
|
iridium_status_format => 'kelso', |
|
734
|
|
|
|
|
|
|
max_range => 500, # Sanity limit on range size. |
|
735
|
|
|
|
|
|
|
password => undef, # Login password. |
|
736
|
|
|
|
|
|
|
pretty => 0, # Pretty-format content |
|
737
|
|
|
|
|
|
|
prompt => 'SpaceTrack> ', |
|
738
|
|
|
|
|
|
|
scheme_space_track => 'https', |
|
739
|
|
|
|
|
|
|
_space_track_interface => [ |
|
740
|
|
|
|
|
|
|
undef, # No such thing as version 0 |
|
741
|
|
|
|
|
|
|
undef, # Interface version 1 retured. |
|
742
|
|
|
|
|
|
|
{ # Interface version 2 |
|
743
|
|
|
|
|
|
|
# This interface does not seem to put an expiration time |
|
744
|
|
|
|
|
|
|
# on the cookie. But the docs say it's only good for a |
|
745
|
|
|
|
|
|
|
# couple hours, so we need this so we can fudge |
|
746
|
|
|
|
|
|
|
# something in when the time comes. |
|
747
|
|
|
|
|
|
|
cookie_expires => 0, |
|
748
|
|
|
|
|
|
|
cookie_name => 'chocolatechip', |
|
749
|
|
|
|
|
|
|
domain_space_track => 'www.space-track.org', |
|
750
|
|
|
|
|
|
|
session_cookie => undef, |
|
751
|
|
|
|
|
|
|
}, |
|
752
|
|
|
|
|
|
|
], |
|
753
|
|
|
|
|
|
|
space_track_version => DEFAULT_SPACE_TRACK_VERSION, |
|
754
|
|
|
|
|
|
|
url_iridium_status_kelso => |
|
755
|
|
|
|
|
|
|
'https://celestrak.org/SpaceTrack/query/iridium.txt', |
|
756
|
|
|
|
|
|
|
url_iridium_status_sladen => |
|
757
|
|
|
|
|
|
|
'http://www.rod.sladen.org.uk/iridium.htm', |
|
758
|
|
|
|
|
|
|
username => undef, # Login username. |
|
759
|
|
|
|
|
|
|
verbose => undef, # Verbose error messages for catalogs. |
|
760
|
|
|
|
|
|
|
verify_hostname => 1, # Don't verify host names by default. |
|
761
|
|
|
|
|
|
|
webcmd => undef, # Command to get web help. |
|
762
|
|
|
|
|
|
|
with_name => undef, # True to retrieve three-line element sets. |
|
763
|
|
|
|
|
|
|
}; |
|
764
|
10
|
|
|
|
|
38
|
bless $self, $class; |
|
765
|
|
|
|
|
|
|
|
|
766
|
10
|
|
|
|
|
68
|
$self->set( identity => delete $arg{identity} ); |
|
767
|
|
|
|
|
|
|
|
|
768
|
|
|
|
|
|
|
$ENV{SPACETRACK_OPT} and |
|
769
|
10
|
50
|
|
|
|
57
|
$self->set (grep {defined $_} split '\s+', $ENV{SPACETRACK_OPT}); |
|
|
0
|
|
|
|
|
0
|
|
|
770
|
|
|
|
|
|
|
|
|
771
|
|
|
|
|
|
|
# TODO this makes no sense - the first branch of the if() can never |
|
772
|
|
|
|
|
|
|
# be executed because I already deleted $arg{identity}. But I do not |
|
773
|
|
|
|
|
|
|
# want to execute the SPACETRACK_USER code willy-nilly -- maybe warn |
|
774
|
|
|
|
|
|
|
# if identity is 1 and I don't have both a username and a password. |
|
775
|
10
|
50
|
|
|
|
90
|
if ( defined( my $id = delete $arg{identity} ) ) { |
|
|
|
50
|
|
|
|
|
|
|
776
|
0
|
|
|
|
|
0
|
$self->set( identity => $id ); |
|
777
|
|
|
|
|
|
|
} elsif ( $ENV{SPACETRACK_USER} ) { |
|
778
|
0
|
|
|
|
|
0
|
my ($user, $pass) = split qr{ [:/] }smx, $ENV{SPACETRACK_USER}, 2; |
|
779
|
0
|
0
|
0
|
|
|
0
|
'' ne $user |
|
780
|
|
|
|
|
|
|
and '' ne $pass |
|
781
|
|
|
|
|
|
|
or $user = $pass = undef; |
|
782
|
0
|
|
|
|
|
0
|
$self->set (username => $user, password => $pass); |
|
783
|
|
|
|
|
|
|
} else { |
|
784
|
10
|
|
|
|
|
47
|
$self->set( identity => undef ); |
|
785
|
|
|
|
|
|
|
} |
|
786
|
|
|
|
|
|
|
|
|
787
|
|
|
|
|
|
|
defined $ENV{SPACETRACK_VERIFY_HOSTNAME} |
|
788
|
|
|
|
|
|
|
and $self->set( verify_hostname => |
|
789
|
10
|
50
|
|
|
|
60
|
$ENV{SPACETRACK_VERIFY_HOSTNAME} ); |
|
790
|
|
|
|
|
|
|
|
|
791
|
10
|
100
|
|
|
|
59
|
keys %arg |
|
792
|
|
|
|
|
|
|
and $self->set( %arg ); |
|
793
|
|
|
|
|
|
|
|
|
794
|
10
|
|
|
|
|
293
|
return $self; |
|
795
|
|
|
|
|
|
|
} |
|
796
|
|
|
|
|
|
|
|
|
797
|
|
|
|
|
|
|
=for html |
|
798
|
|
|
|
|
|
|
|
|
799
|
|
|
|
|
|
|
=item $resp = $st->amsat () |
|
800
|
|
|
|
|
|
|
|
|
801
|
|
|
|
|
|
|
This method downloads current orbital elements from the Radio Amateur |
|
802
|
|
|
|
|
|
|
Satellite Corporation's web page, L. This lists |
|
803
|
|
|
|
|
|
|
satellites of interest to radio amateurs, and appears to be updated |
|
804
|
|
|
|
|
|
|
weekly. |
|
805
|
|
|
|
|
|
|
|
|
806
|
|
|
|
|
|
|
No Space Track account is needed to access this data, even if the |
|
807
|
|
|
|
|
|
|
'direct' attribute is false. As of version 0.150 the setting of |
|
808
|
|
|
|
|
|
|
the 'with_name' attribute is honored even if the 'direct' attribute is |
|
809
|
|
|
|
|
|
|
true. |
|
810
|
|
|
|
|
|
|
|
|
811
|
|
|
|
|
|
|
You can specify options as either command-type options (e.g. |
|
812
|
|
|
|
|
|
|
C<< amsat( '-file', 'foo.dat' ) >>) or as a leading hash reference (e.g. |
|
813
|
|
|
|
|
|
|
C<< amsat( { file => 'foo.dat' } ) >>). If you specify the hash |
|
814
|
|
|
|
|
|
|
reference, option names must be specified in full, without the leading |
|
815
|
|
|
|
|
|
|
'-', and the argument list will not be parsed for command-type options. |
|
816
|
|
|
|
|
|
|
If you specify command-type options, they may be abbreviated, as long as |
|
817
|
|
|
|
|
|
|
the abbreviation is unique. Errors in either sort result in an exception |
|
818
|
|
|
|
|
|
|
being thrown. |
|
819
|
|
|
|
|
|
|
|
|
820
|
|
|
|
|
|
|
The legal options are: |
|
821
|
|
|
|
|
|
|
|
|
822
|
|
|
|
|
|
|
-file |
|
823
|
|
|
|
|
|
|
specifies the name of the cache file. If the data |
|
824
|
|
|
|
|
|
|
on line are newer than the modification date of |
|
825
|
|
|
|
|
|
|
the cache file, the cache file will be updated. |
|
826
|
|
|
|
|
|
|
Otherwise the data will be returned from the file. |
|
827
|
|
|
|
|
|
|
Either way the content of the file and the content |
|
828
|
|
|
|
|
|
|
of the returned HTTP::Response object end up the |
|
829
|
|
|
|
|
|
|
same. |
|
830
|
|
|
|
|
|
|
|
|
831
|
|
|
|
|
|
|
On a successful return, the response object will contain headers |
|
832
|
|
|
|
|
|
|
|
|
833
|
|
|
|
|
|
|
Pragma: spacetrack-type = orbit |
|
834
|
|
|
|
|
|
|
Pragma: spacetrack-source = amsat |
|
835
|
|
|
|
|
|
|
|
|
836
|
|
|
|
|
|
|
These can be accessed by C<< $st->content_type( $resp ) >> and |
|
837
|
|
|
|
|
|
|
C<< $st->content_source( $resp ) >> respectively. |
|
838
|
|
|
|
|
|
|
|
|
839
|
|
|
|
|
|
|
If the C option was passed, the following additional header will |
|
840
|
|
|
|
|
|
|
be provided: |
|
841
|
|
|
|
|
|
|
|
|
842
|
|
|
|
|
|
|
Pragma: spacetrack-cache-hit = (either true or false) |
|
843
|
|
|
|
|
|
|
|
|
844
|
|
|
|
|
|
|
This can be accessed by the C method. If this pragma is |
|
845
|
|
|
|
|
|
|
true, the C header of the response will contain the |
|
846
|
|
|
|
|
|
|
modification time of the file. |
|
847
|
|
|
|
|
|
|
|
|
848
|
|
|
|
|
|
|
This method is a web page scraper. Any change in the location of the |
|
849
|
|
|
|
|
|
|
web page will break this method. |
|
850
|
|
|
|
|
|
|
|
|
851
|
|
|
|
|
|
|
=cut |
|
852
|
|
|
|
|
|
|
|
|
853
|
|
|
|
|
|
|
# Called dynamically |
|
854
|
|
|
|
|
|
|
sub _amsat_opts { ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) |
|
855
|
|
|
|
|
|
|
return [ |
|
856
|
1
|
|
|
1
|
|
5
|
'file=s' => 'Name of cache file', |
|
857
|
|
|
|
|
|
|
]; |
|
858
|
|
|
|
|
|
|
} |
|
859
|
|
|
|
|
|
|
|
|
860
|
|
|
|
|
|
|
sub amsat { |
|
861
|
1
|
|
|
1
|
1
|
6
|
my ( $self, @args ) = @_; |
|
862
|
|
|
|
|
|
|
|
|
863
|
1
|
|
|
|
|
8
|
( my $opt, @args ) = _parse_args( @args ); |
|
864
|
|
|
|
|
|
|
|
|
865
|
|
|
|
|
|
|
return $self->_get_from_net( |
|
866
|
1
|
|
|
|
|
13
|
%{ $opt }, |
|
867
|
|
|
|
|
|
|
# url => 'http://www.amsat.org/amsat/ftp/keps/current/nasabare.txt', |
|
868
|
|
|
|
|
|
|
url => 'https://www.amsat.org/tle/current/nasabare.txt', |
|
869
|
|
|
|
|
|
|
post_process => sub { |
|
870
|
1
|
|
|
1
|
|
22
|
my ( $self, $resp ) = @_; |
|
871
|
1
|
50
|
|
|
|
5
|
unless ( $self->{with_name} ) { |
|
872
|
1
|
|
|
|
|
61
|
my @content = split qr{ \015? \012 }smx, |
|
873
|
|
|
|
|
|
|
$resp->content(); |
|
874
|
1
|
50
|
|
|
|
394
|
@content % 3 |
|
875
|
|
|
|
|
|
|
and return HTTP::Response->new( |
|
876
|
|
|
|
|
|
|
HTTP_PRECONDITION_FAILED, |
|
877
|
|
|
|
|
|
|
'Response does not contain a multiple of 3 lines' ); |
|
878
|
1
|
|
|
|
|
3
|
my $ct = ''; |
|
879
|
1
|
|
|
|
|
4
|
while ( @content ) { |
|
880
|
177
|
|
|
|
|
234
|
shift @content; |
|
881
|
177
|
|
|
|
|
252
|
$ct .= join '', map { "$_\n" } splice @content, 0, 2; |
|
|
354
|
|
|
|
|
858
|
|
|
882
|
|
|
|
|
|
|
} |
|
883
|
1
|
|
|
|
|
9
|
$resp->content( $ct ); |
|
884
|
|
|
|
|
|
|
} |
|
885
|
1
|
50
|
|
|
|
35
|
'' eq $resp->content() |
|
886
|
|
|
|
|
|
|
and return HTTP::Response->new( |
|
887
|
|
|
|
|
|
|
HTTP_PRECONDITION_FAILED, NO_CAT_ID ); |
|
888
|
1
|
|
|
|
|
21
|
return $resp; |
|
889
|
|
|
|
|
|
|
}, |
|
890
|
1
|
|
|
|
|
3
|
spacetrack_type => 'orbit', |
|
891
|
|
|
|
|
|
|
); |
|
892
|
|
|
|
|
|
|
} |
|
893
|
|
|
|
|
|
|
|
|
894
|
|
|
|
|
|
|
=for html |
|
895
|
|
|
|
|
|
|
|
|
896
|
|
|
|
|
|
|
=item @names = $st->attribute_names |
|
897
|
|
|
|
|
|
|
|
|
898
|
|
|
|
|
|
|
This method returns a list of legal attribute names. |
|
899
|
|
|
|
|
|
|
|
|
900
|
|
|
|
|
|
|
=cut |
|
901
|
|
|
|
|
|
|
|
|
902
|
|
|
|
|
|
|
sub attribute_names { |
|
903
|
1
|
|
|
1
|
1
|
2
|
my ( $self ) = @_; |
|
904
|
1
|
|
|
|
|
13
|
my @keys = grep { ! { |
|
905
|
|
|
|
|
|
|
url_iridium_status_mccants => 1, |
|
906
|
26
|
|
|
|
|
58
|
}->{$_} } sort keys %mutator; |
|
907
|
1
|
50
|
|
|
|
21
|
ref $self |
|
|
|
50
|
|
|
|
|
|
|
908
|
|
|
|
|
|
|
or return wantarray ? @keys : \@keys; |
|
909
|
0
|
|
|
|
|
0
|
my $space_track_version = $self->getv( 'space_track_version' ); |
|
910
|
|
|
|
|
|
|
my @names = grep { |
|
911
|
0
|
|
|
|
|
0
|
$mutator{$_} == \&_mutate_spacetrack_interface ? |
|
912
|
0
|
0
|
|
|
|
0
|
exists $self->{_space_track_interface}[$space_track_version]{$_} |
|
913
|
|
|
|
|
|
|
: 1 |
|
914
|
|
|
|
|
|
|
} @keys; |
|
915
|
0
|
0
|
|
|
|
0
|
return wantarray ? @names : \@names; |
|
916
|
|
|
|
|
|
|
} |
|
917
|
|
|
|
|
|
|
|
|
918
|
|
|
|
|
|
|
|
|
919
|
|
|
|
|
|
|
=for html |
|
920
|
|
|
|
|
|
|
|
|
921
|
|
|
|
|
|
|
=item $resp = $st->banner (); |
|
922
|
|
|
|
|
|
|
|
|
923
|
|
|
|
|
|
|
This method is a convenience/nuisance: it simply returns a fake |
|
924
|
|
|
|
|
|
|
HTTP::Response with standard banner text. It's really just for the |
|
925
|
|
|
|
|
|
|
benefit of the shell method. |
|
926
|
|
|
|
|
|
|
|
|
927
|
|
|
|
|
|
|
=cut |
|
928
|
|
|
|
|
|
|
|
|
929
|
|
|
|
|
|
|
{ |
|
930
|
|
|
|
|
|
|
my $perl_version; |
|
931
|
|
|
|
|
|
|
|
|
932
|
|
|
|
|
|
|
sub banner { |
|
933
|
1
|
|
|
1
|
1
|
2
|
my $self = shift; |
|
934
|
1
|
|
33
|
|
|
5
|
$perl_version ||= do { |
|
935
|
1
|
50
|
|
|
|
13
|
$] >= 5.01 ? $^V : do { |
|
936
|
0
|
|
|
|
|
0
|
require Config; |
|
937
|
0
|
|
|
|
|
0
|
'v' . $Config::Config{version}; ## no critic (ProhibitPackageVars) |
|
938
|
|
|
|
|
|
|
} |
|
939
|
|
|
|
|
|
|
}; |
|
940
|
1
|
|
|
|
|
9
|
my $url = $self->_make_space_track_base_url(); |
|
941
|
1
|
|
|
|
|
4
|
return HTTP::Response->new (HTTP_OK, undef, undef, <<"EOD"); |
|
942
|
|
|
|
|
|
|
|
|
943
|
1
|
|
|
|
|
13
|
@{[__PACKAGE__]} version $VERSION |
|
944
|
|
|
|
|
|
|
Perl $perl_version under $^O |
|
945
|
|
|
|
|
|
|
|
|
946
|
|
|
|
|
|
|
This package acquires satellite orbital elements and other data from a |
|
947
|
|
|
|
|
|
|
variety of web sites. It is your responsibility to abide by the terms of |
|
948
|
|
|
|
|
|
|
use of the individual web sites. In particular, to acquire data from |
|
949
|
|
|
|
|
|
|
Space Track ($url/) you must register and |
|
950
|
|
|
|
|
|
|
get a username and password, and you may not make the data available to |
|
951
|
|
|
|
|
|
|
a third party without prior permission from Space Track. |
|
952
|
|
|
|
|
|
|
|
|
953
|
|
|
|
|
|
|
Copyright 2005-2022 by T. R. Wyant (wyant at cpan dot org). |
|
954
|
|
|
|
|
|
|
|
|
955
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it |
|
956
|
|
|
|
|
|
|
under the same terms as Perl 5.10.0. For more details, see the full text |
|
957
|
|
|
|
|
|
|
of the licenses in the directory LICENSES. |
|
958
|
|
|
|
|
|
|
|
|
959
|
|
|
|
|
|
|
This program is distributed in the hope that it will be useful, but |
|
960
|
|
|
|
|
|
|
without any warranty; without even the implied warranty of |
|
961
|
|
|
|
|
|
|
merchantability or fitness for a particular purpose. |
|
962
|
1
|
|
50
|
|
|
8
|
@{[$self->{addendum} || '']} |
|
963
|
|
|
|
|
|
|
EOD |
|
964
|
|
|
|
|
|
|
} |
|
965
|
|
|
|
|
|
|
|
|
966
|
|
|
|
|
|
|
} |
|
967
|
|
|
|
|
|
|
|
|
968
|
|
|
|
|
|
|
=for html |
|
969
|
|
|
|
|
|
|
|
|
970
|
|
|
|
|
|
|
=item $resp = $st->box_score (); |
|
971
|
|
|
|
|
|
|
|
|
972
|
|
|
|
|
|
|
This method returns an HTTP::Response object. If the request succeeds, |
|
973
|
|
|
|
|
|
|
the content of the object will be the SATCAT Satellite Box Score |
|
974
|
|
|
|
|
|
|
information in the desired format. If the desired format is C<'legacy'> |
|
975
|
|
|
|
|
|
|
or C<'json'> and the method is called in list context, the second |
|
976
|
|
|
|
|
|
|
returned item will be a reference to an array containing the parsed |
|
977
|
|
|
|
|
|
|
data. |
|
978
|
|
|
|
|
|
|
|
|
979
|
|
|
|
|
|
|
This method takes the following options, specified either command-style |
|
980
|
|
|
|
|
|
|
or as a hash reference. |
|
981
|
|
|
|
|
|
|
|
|
982
|
|
|
|
|
|
|
C<-format> specifies the desired format of the retrieved data. Possible |
|
983
|
|
|
|
|
|
|
values are C<'xml'>, C<'json'>, C<'html'>, C<'csv'>, and C<'legacy'>, |
|
984
|
|
|
|
|
|
|
which is the default. The legacy format is tab-delimited text, such as |
|
985
|
|
|
|
|
|
|
was returned by the version 1 interface. |
|
986
|
|
|
|
|
|
|
|
|
987
|
|
|
|
|
|
|
C<-json> specifies JSON format. If you specify both C<-json> and |
|
988
|
|
|
|
|
|
|
C<-format> you will get an exception unless you specify C<-format=json>. |
|
989
|
|
|
|
|
|
|
|
|
990
|
|
|
|
|
|
|
This method requires a Space Track username and password. It implicitly |
|
991
|
|
|
|
|
|
|
calls the C method if the session cookie is missing or expired. |
|
992
|
|
|
|
|
|
|
If C fails, you will get the HTTP::Response from C. |
|
993
|
|
|
|
|
|
|
|
|
994
|
|
|
|
|
|
|
If this method succeeds, the response will contain headers |
|
995
|
|
|
|
|
|
|
|
|
996
|
|
|
|
|
|
|
Pragma: spacetrack-type = box_score |
|
997
|
|
|
|
|
|
|
Pragma: spacetrack-source = spacetrack |
|
998
|
|
|
|
|
|
|
|
|
999
|
|
|
|
|
|
|
There are no arguments. |
|
1000
|
|
|
|
|
|
|
|
|
1001
|
|
|
|
|
|
|
=cut |
|
1002
|
|
|
|
|
|
|
|
|
1003
|
|
|
|
|
|
|
{ |
|
1004
|
|
|
|
|
|
|
|
|
1005
|
|
|
|
|
|
|
my @fields = qw{ SPADOC_CD |
|
1006
|
|
|
|
|
|
|
ORBITAL_PAYLOAD_COUNT ORBITAL_ROCKET_BODY_COUNT |
|
1007
|
|
|
|
|
|
|
ORBITAL_DEBRIS_COUNT ORBITAL_TOTAL_COUNT |
|
1008
|
|
|
|
|
|
|
DECAYED_PAYLOAD_COUNT DECAYED_ROCKET_BODY_COUNT |
|
1009
|
|
|
|
|
|
|
DECAYED_DEBRIS_COUNT DECAYED_TOTAL_COUNT |
|
1010
|
|
|
|
|
|
|
COUNTRY_TOTAL |
|
1011
|
|
|
|
|
|
|
}; |
|
1012
|
|
|
|
|
|
|
|
|
1013
|
|
|
|
|
|
|
my @head = ( |
|
1014
|
|
|
|
|
|
|
[ '', 'Objects in Orbit', 'Decayed Objects' ], |
|
1015
|
|
|
|
|
|
|
[ 'Country/Organization', |
|
1016
|
|
|
|
|
|
|
'Payload', 'Rocket Body', 'Debris', 'Total', |
|
1017
|
|
|
|
|
|
|
'Payload', 'Rocket Body', 'Debris', 'Total', |
|
1018
|
|
|
|
|
|
|
'Grand Total', |
|
1019
|
|
|
|
|
|
|
], |
|
1020
|
|
|
|
|
|
|
); |
|
1021
|
|
|
|
|
|
|
|
|
1022
|
|
|
|
|
|
|
# Called dynamically |
|
1023
|
|
|
|
|
|
|
sub _box_score_opts { ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) |
|
1024
|
|
|
|
|
|
|
return [ |
|
1025
|
2
|
|
|
2
|
|
13
|
'json!' => 'Return data in JSON format', |
|
1026
|
|
|
|
|
|
|
'format=s' => 'Specify return format', |
|
1027
|
|
|
|
|
|
|
]; |
|
1028
|
|
|
|
|
|
|
} |
|
1029
|
|
|
|
|
|
|
|
|
1030
|
|
|
|
|
|
|
sub box_score { |
|
1031
|
2
|
|
|
2
|
1
|
1148
|
my ( $self, @args ) = @_; |
|
1032
|
|
|
|
|
|
|
|
|
1033
|
2
|
|
|
|
|
8
|
( my $opt, @args ) = _parse_args( @args ); |
|
1034
|
2
|
|
|
|
|
8
|
my $format = _retrieval_format( box_score => $opt ); |
|
1035
|
|
|
|
|
|
|
|
|
1036
|
2
|
|
|
|
|
11
|
my $resp = $self->spacetrack_query_v2( qw{ |
|
1037
|
|
|
|
|
|
|
basicspacedata query class boxscore }, |
|
1038
|
|
|
|
|
|
|
format => $format, |
|
1039
|
|
|
|
|
|
|
qw{ predicates all }, |
|
1040
|
|
|
|
|
|
|
); |
|
1041
|
2
|
100
|
|
|
|
10
|
$resp->is_success() |
|
1042
|
|
|
|
|
|
|
or return $resp; |
|
1043
|
|
|
|
|
|
|
|
|
1044
|
1
|
|
|
|
|
11
|
$self->_add_pragmata($resp, |
|
1045
|
|
|
|
|
|
|
'spacetrack-type' => 'box_score', |
|
1046
|
|
|
|
|
|
|
'spacetrack-source' => 'spacetrack', |
|
1047
|
|
|
|
|
|
|
'spacetrack-interface' => 2, |
|
1048
|
|
|
|
|
|
|
); |
|
1049
|
|
|
|
|
|
|
|
|
1050
|
1
|
50
|
|
|
|
4
|
'json' eq $format |
|
1051
|
|
|
|
|
|
|
or return $resp; |
|
1052
|
|
|
|
|
|
|
|
|
1053
|
1
|
|
|
|
|
3
|
my $data; |
|
1054
|
|
|
|
|
|
|
|
|
1055
|
1
|
50
|
|
|
|
5
|
if ( ! $opt->{json} ) { |
|
1056
|
|
|
|
|
|
|
|
|
1057
|
1
|
|
|
|
|
4
|
$data = $self->_get_json_object()->decode( $resp->content() ); |
|
1058
|
|
|
|
|
|
|
|
|
1059
|
1
|
|
|
|
|
118
|
my $content; |
|
1060
|
1
|
|
|
|
|
5
|
foreach my $row ( @head ) { |
|
1061
|
2
|
|
|
|
|
3
|
$content .= join( "\t", @{ $row } ) . "\n"; |
|
|
2
|
|
|
|
|
12
|
|
|
1062
|
|
|
|
|
|
|
} |
|
1063
|
1
|
|
|
|
|
2
|
foreach my $datum ( @{ $data } ) { |
|
|
1
|
|
|
|
|
3
|
|
|
1064
|
|
|
|
|
|
|
defined $datum->{SPADOC_CD} |
|
1065
|
|
|
|
|
|
|
and $datum->{SPADOC_CD} eq 'ALL' |
|
1066
|
100
|
50
|
33
|
|
|
199
|
and $datum->{SPADOC_CD} = 'Total'; |
|
1067
|
|
|
|
|
|
|
$content .= join( "\t", map { |
|
1068
|
100
|
50
|
|
|
|
140
|
defined $datum->{$_} ? $datum->{$_} : '' |
|
|
1000
|
|
|
|
|
1893
|
|
|
1069
|
|
|
|
|
|
|
} @fields ) . "\n"; |
|
1070
|
|
|
|
|
|
|
} |
|
1071
|
|
|
|
|
|
|
|
|
1072
|
1
|
|
|
|
|
9
|
$resp = HTTP::Response->new (HTTP_OK, undef, undef, $content); |
|
1073
|
|
|
|
|
|
|
} |
|
1074
|
|
|
|
|
|
|
|
|
1075
|
|
|
|
|
|
|
wantarray |
|
1076
|
1
|
50
|
|
|
|
90
|
or return $resp; |
|
1077
|
|
|
|
|
|
|
|
|
1078
|
0
|
|
|
|
|
0
|
my @table; |
|
1079
|
0
|
|
|
|
|
0
|
foreach my $row ( @head ) { |
|
1080
|
0
|
|
|
|
|
0
|
push @table, [ @{ $row } ]; |
|
|
0
|
|
|
|
|
0
|
|
|
1081
|
|
|
|
|
|
|
} |
|
1082
|
0
|
|
0
|
|
|
0
|
$data ||= $self->_get_json_object()->decode( $resp->content() ); |
|
1083
|
0
|
|
|
|
|
0
|
foreach my $datum ( @{ $data } ) { |
|
|
0
|
|
|
|
|
0
|
|
|
1084
|
0
|
|
|
|
|
0
|
push @table, [ map { $datum->{$_} } @fields ]; |
|
|
0
|
|
|
|
|
0
|
|
|
1085
|
|
|
|
|
|
|
} |
|
1086
|
0
|
|
|
|
|
0
|
return ( $resp, \@table ); |
|
1087
|
|
|
|
|
|
|
} |
|
1088
|
|
|
|
|
|
|
} |
|
1089
|
|
|
|
|
|
|
|
|
1090
|
|
|
|
|
|
|
# UNSUPPORTED AND SUBJECT TO CHANGE OR REMOVAL WITHOUT NOTICE! |
|
1091
|
|
|
|
|
|
|
# If you have a use for this information, please let me know and I will |
|
1092
|
|
|
|
|
|
|
# see about putting together something I believe I can support. |
|
1093
|
|
|
|
|
|
|
sub __catalog { |
|
1094
|
0
|
|
|
0
|
|
0
|
my ( undef, $name ) = @_; |
|
1095
|
0
|
0
|
|
|
|
0
|
$catalogs{$name} |
|
1096
|
|
|
|
|
|
|
or Carp::confess "Bug - catalog $name does not exist"; |
|
1097
|
0
|
|
|
|
|
0
|
return $catalogs{$name}; |
|
1098
|
|
|
|
|
|
|
} |
|
1099
|
|
|
|
|
|
|
|
|
1100
|
|
|
|
|
|
|
=for html |
|
1101
|
|
|
|
|
|
|
|
|
1102
|
|
|
|
|
|
|
=item $resp = $st->celestrak ($name); |
|
1103
|
|
|
|
|
|
|
|
|
1104
|
|
|
|
|
|
|
B As of version 0.150 of this module a false value of the |
|
1105
|
|
|
|
|
|
|
C<'direct'> attribute is unsupported. See L |
|
1106
|
|
|
|
|
|
|
above for details. |
|
1107
|
|
|
|
|
|
|
|
|
1108
|
|
|
|
|
|
|
As of version 0.158 this version is an interface to the CelesTrak API. |
|
1109
|
|
|
|
|
|
|
The argument is the argument of a Celestrak query (see |
|
1110
|
|
|
|
|
|
|
L). The |
|
1111
|
|
|
|
|
|
|
following options are available: |
|
1112
|
|
|
|
|
|
|
|
|
1113
|
|
|
|
|
|
|
=over |
|
1114
|
|
|
|
|
|
|
|
|
1115
|
|
|
|
|
|
|
=item format |
|
1116
|
|
|
|
|
|
|
|
|
1117
|
|
|
|
|
|
|
--format json |
|
1118
|
|
|
|
|
|
|
|
|
1119
|
|
|
|
|
|
|
This option specifies the format of the returned data. Valid values are |
|
1120
|
|
|
|
|
|
|
C<'TLE'>, C<'3LE'>, C<'2LE'>, C<'XML'>, C<'KVN'>, C<'JSON'>, or |
|
1121
|
|
|
|
|
|
|
C<'CSV'>. See |
|
1122
|
|
|
|
|
|
|
L for a |
|
1123
|
|
|
|
|
|
|
discussion of these. C<'JSON-PRETTY'> is not a valid format option, but |
|
1124
|
|
|
|
|
|
|
will be generated if the C attribute is true. |
|
1125
|
|
|
|
|
|
|
|
|
1126
|
|
|
|
|
|
|
The default is C<'TLE'>. |
|
1127
|
|
|
|
|
|
|
|
|
1128
|
|
|
|
|
|
|
=item query |
|
1129
|
|
|
|
|
|
|
|
|
1130
|
|
|
|
|
|
|
--query name |
|
1131
|
|
|
|
|
|
|
|
|
1132
|
|
|
|
|
|
|
This option specifies the type of query to be done. Valid values are |
|
1133
|
|
|
|
|
|
|
|
|
1134
|
|
|
|
|
|
|
=over |
|
1135
|
|
|
|
|
|
|
|
|
1136
|
|
|
|
|
|
|
=item CATNR |
|
1137
|
|
|
|
|
|
|
|
|
1138
|
|
|
|
|
|
|
The argument is a NORAD catalog number (1-9 digits). |
|
1139
|
|
|
|
|
|
|
|
|
1140
|
|
|
|
|
|
|
=item GROUP |
|
1141
|
|
|
|
|
|
|
|
|
1142
|
|
|
|
|
|
|
The argument is the name of a named group of satellites. |
|
1143
|
|
|
|
|
|
|
|
|
1144
|
|
|
|
|
|
|
=item INTDES |
|
1145
|
|
|
|
|
|
|
|
|
1146
|
|
|
|
|
|
|
The argument is an international launch designator of the form yyyy-nnn, |
|
1147
|
|
|
|
|
|
|
where the C is the Gregorian year, and the C is the launch |
|
1148
|
|
|
|
|
|
|
number in the year. |
|
1149
|
|
|
|
|
|
|
|
|
1150
|
|
|
|
|
|
|
=item NAME |
|
1151
|
|
|
|
|
|
|
|
|
1152
|
|
|
|
|
|
|
The argument is a satellite name or a portion thereof. |
|
1153
|
|
|
|
|
|
|
|
|
1154
|
|
|
|
|
|
|
=item SPECIAL |
|
1155
|
|
|
|
|
|
|
|
|
1156
|
|
|
|
|
|
|
The argument specifies a special data set. |
|
1157
|
|
|
|
|
|
|
|
|
1158
|
|
|
|
|
|
|
=back |
|
1159
|
|
|
|
|
|
|
|
|
1160
|
|
|
|
|
|
|
The default is C<'CATNR'> if the argument is numeric, C<'INTDES'> if the |
|
1161
|
|
|
|
|
|
|
argument looks like an international designator, or C<'GROUP'> |
|
1162
|
|
|
|
|
|
|
otherwise. |
|
1163
|
|
|
|
|
|
|
|
|
1164
|
|
|
|
|
|
|
=back |
|
1165
|
|
|
|
|
|
|
|
|
1166
|
|
|
|
|
|
|
A list of valid C names and brief descriptions can be obtained by |
|
1167
|
|
|
|
|
|
|
calling C<< $st->names ('celestrak') >>. If you have set the C |
|
1168
|
|
|
|
|
|
|
attribute true (e.g. C<< $st->set (verbose => 1) >>), the content of the |
|
1169
|
|
|
|
|
|
|
error response will include this list. Note, however, that this list |
|
1170
|
|
|
|
|
|
|
does not determine what can be retrieved; if Dr. Kelso adds a data set, |
|
1171
|
|
|
|
|
|
|
it can be retrieved even if it is not on the list, and if he removes |
|
1172
|
|
|
|
|
|
|
one, being on the list won't help. |
|
1173
|
|
|
|
|
|
|
|
|
1174
|
|
|
|
|
|
|
If this method succeeds, the response will contain headers |
|
1175
|
|
|
|
|
|
|
|
|
1176
|
|
|
|
|
|
|
Pragma: spacetrack-type = orbit |
|
1177
|
|
|
|
|
|
|
Pragma: spacetrack-source = celestrak |
|
1178
|
|
|
|
|
|
|
|
|
1179
|
|
|
|
|
|
|
These can be accessed by C<< $st->content_type( $resp ) >> and |
|
1180
|
|
|
|
|
|
|
C<< $st->content_source( $resp ) >> respectively. |
|
1181
|
|
|
|
|
|
|
|
|
1182
|
|
|
|
|
|
|
You can specify the C options on this method as well, but |
|
1183
|
|
|
|
|
|
|
they will have no effect, are deprecated, and warn on the first use. Six |
|
1184
|
|
|
|
|
|
|
months after the release of version 0.161 these will warn on every use. |
|
1185
|
|
|
|
|
|
|
Six months after that they will be fatal. After a further six months all |
|
1186
|
|
|
|
|
|
|
related code will be removed. |
|
1187
|
|
|
|
|
|
|
|
|
1188
|
|
|
|
|
|
|
=cut |
|
1189
|
|
|
|
|
|
|
|
|
1190
|
|
|
|
|
|
|
# Called dynamically |
|
1191
|
|
|
|
|
|
|
sub _celestrak_opts { ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) |
|
1192
|
0
|
|
|
0
|
|
0
|
return CELESTRAK_OPTIONS; |
|
1193
|
|
|
|
|
|
|
} |
|
1194
|
|
|
|
|
|
|
|
|
1195
|
|
|
|
|
|
|
sub celestrak { |
|
1196
|
3
|
|
|
3
|
1
|
12
|
my ($self, @args) = @_; |
|
1197
|
3
|
|
|
|
|
13
|
delete $self->{_pragmata}; |
|
1198
|
|
|
|
|
|
|
|
|
1199
|
3
|
|
|
|
|
15
|
( my $opt, @args ) = _parse_args( CELESTRAK_OPTIONS, @args ); |
|
1200
|
|
|
|
|
|
|
|
|
1201
|
3
|
|
|
|
|
10
|
my $name = shift @args; |
|
1202
|
3
|
50
|
|
|
|
15
|
defined $name |
|
1203
|
|
|
|
|
|
|
or return HTTP::Response->new( |
|
1204
|
|
|
|
|
|
|
HTTP_PRECONDITION_FAILED, |
|
1205
|
|
|
|
|
|
|
'No catalog name specified' ); |
|
1206
|
|
|
|
|
|
|
|
|
1207
|
3
|
|
|
|
|
17
|
$self->_deprecation_notice( celestrak => $name ); |
|
1208
|
3
|
|
|
|
|
7
|
$self->_deprecation_notice( celestrak => "--$_" ) foreach sort keys %{ $opt }; |
|
|
3
|
|
|
|
|
16
|
|
|
1209
|
|
|
|
|
|
|
|
|
1210
|
3
|
|
|
|
|
7
|
my $query; |
|
1211
|
|
|
|
|
|
|
ref( $query = $self->_celestrak_validate_query( |
|
1212
|
3
|
50
|
|
|
|
18
|
delete $opt->{query}, $name, |
|
1213
|
|
|
|
|
|
|
CELESTRAK_VALID_QUERY, 'GROUP' ) ) |
|
1214
|
|
|
|
|
|
|
and return $query; |
|
1215
|
|
|
|
|
|
|
|
|
1216
|
3
|
|
|
|
|
8
|
my $format; |
|
1217
|
|
|
|
|
|
|
ref( $format = $self->_celestrak_validate_format( |
|
1218
|
3
|
50
|
|
|
|
16
|
delete $opt->{format} ) ) |
|
1219
|
|
|
|
|
|
|
and return $format; |
|
1220
|
|
|
|
|
|
|
|
|
1221
|
3
|
|
|
|
|
19
|
my $uri = URI->new( 'https://celestrak.org/NORAD/elements/gp.php' ); |
|
1222
|
3
|
|
|
|
|
360
|
$uri->query_form( |
|
1223
|
|
|
|
|
|
|
$query => $name, |
|
1224
|
|
|
|
|
|
|
FORMAT => $format, |
|
1225
|
|
|
|
|
|
|
); |
|
1226
|
|
|
|
|
|
|
|
|
1227
|
|
|
|
|
|
|
return $self->_get_from_net( |
|
1228
|
3
|
|
|
|
|
36
|
%{ $opt }, |
|
1229
|
|
|
|
|
|
|
url => $uri, |
|
1230
|
|
|
|
|
|
|
post_process => sub { |
|
1231
|
3
|
|
|
3
|
|
75
|
my ( $self, $resp ) = @_; |
|
1232
|
3
|
|
|
|
|
8
|
my $check; |
|
1233
|
3
|
100
|
|
|
|
17
|
$check = $self->_celestrak_response_check( $resp, |
|
1234
|
|
|
|
|
|
|
celestrak => $name ) |
|
1235
|
|
|
|
|
|
|
and return $check; |
|
1236
|
2
|
100
|
|
|
|
14
|
$name eq 'iridium' |
|
1237
|
|
|
|
|
|
|
and _celestrak_repack_iridium( $resp ); |
|
1238
|
2
|
|
|
|
|
6
|
return $resp; |
|
1239
|
|
|
|
|
|
|
}, |
|
1240
|
3
|
|
|
|
|
349
|
spacetrack_source => 'celestrak', |
|
1241
|
|
|
|
|
|
|
spacetrack_type => 'orbit', |
|
1242
|
|
|
|
|
|
|
); |
|
1243
|
|
|
|
|
|
|
} |
|
1244
|
|
|
|
|
|
|
|
|
1245
|
|
|
|
|
|
|
=for html |
|
1246
|
|
|
|
|
|
|
|
|
1247
|
|
|
|
|
|
|
=item $resp = $st->celestrak_supplemental ($name); |
|
1248
|
|
|
|
|
|
|
|
|
1249
|
|
|
|
|
|
|
This method takes the name of a Celestrak supplemental data set and |
|
1250
|
|
|
|
|
|
|
returns an HTTP::Response object whose content is the relevant element |
|
1251
|
|
|
|
|
|
|
sets. |
|
1252
|
|
|
|
|
|
|
|
|
1253
|
|
|
|
|
|
|
These TLE data are B redistributed from Space Track, but are |
|
1254
|
|
|
|
|
|
|
derived from publicly available ephemeris data for the satellites in |
|
1255
|
|
|
|
|
|
|
question. |
|
1256
|
|
|
|
|
|
|
|
|
1257
|
|
|
|
|
|
|
As of version 0.158 this version is an interface to the CelesTrak API. |
|
1258
|
|
|
|
|
|
|
The argument is the argument of a Celestrak query (see |
|
1259
|
|
|
|
|
|
|
L). The |
|
1260
|
|
|
|
|
|
|
following options are available: |
|
1261
|
|
|
|
|
|
|
|
|
1262
|
|
|
|
|
|
|
=over |
|
1263
|
|
|
|
|
|
|
|
|
1264
|
|
|
|
|
|
|
=item file |
|
1265
|
|
|
|
|
|
|
|
|
1266
|
|
|
|
|
|
|
--file my_data.tle |
|
1267
|
|
|
|
|
|
|
|
|
1268
|
|
|
|
|
|
|
This option specifies the name of an output file for the data. |
|
1269
|
|
|
|
|
|
|
|
|
1270
|
|
|
|
|
|
|
=item format |
|
1271
|
|
|
|
|
|
|
|
|
1272
|
|
|
|
|
|
|
--format json |
|
1273
|
|
|
|
|
|
|
|
|
1274
|
|
|
|
|
|
|
This option specifies the format of the returned data. Valid values are |
|
1275
|
|
|
|
|
|
|
C<'TLE'>, C<'3LE'>, C<'2LE'>, C<'XML'>, C<'KVN'>, C<'JSON'>, or |
|
1276
|
|
|
|
|
|
|
C<'CSV'>. See |
|
1277
|
|
|
|
|
|
|
L for a |
|
1278
|
|
|
|
|
|
|
discussion of these. C<'JSON-PRETTY'> is not a valid format option, but |
|
1279
|
|
|
|
|
|
|
will be generated if the C attribute is true. |
|
1280
|
|
|
|
|
|
|
|
|
1281
|
|
|
|
|
|
|
The default is C<'TLE'>. |
|
1282
|
|
|
|
|
|
|
|
|
1283
|
|
|
|
|
|
|
=item match |
|
1284
|
|
|
|
|
|
|
|
|
1285
|
|
|
|
|
|
|
This Boolean option specifies that match data be returned rather than |
|
1286
|
|
|
|
|
|
|
TLE data, if available. This option is valid only on known catalogs that |
|
1287
|
|
|
|
|
|
|
actually have match data. If this option is asserted, C<--format> and |
|
1288
|
|
|
|
|
|
|
C<--query> are invalid. |
|
1289
|
|
|
|
|
|
|
|
|
1290
|
|
|
|
|
|
|
=item query |
|
1291
|
|
|
|
|
|
|
|
|
1292
|
|
|
|
|
|
|
--query name |
|
1293
|
|
|
|
|
|
|
|
|
1294
|
|
|
|
|
|
|
This option specifies the type of query to be done. Valid values are |
|
1295
|
|
|
|
|
|
|
|
|
1296
|
|
|
|
|
|
|
=over |
|
1297
|
|
|
|
|
|
|
|
|
1298
|
|
|
|
|
|
|
=item CATNR |
|
1299
|
|
|
|
|
|
|
|
|
1300
|
|
|
|
|
|
|
The argument is a NORAD catalog number (1-9 digits). |
|
1301
|
|
|
|
|
|
|
|
|
1302
|
|
|
|
|
|
|
=item FILE |
|
1303
|
|
|
|
|
|
|
|
|
1304
|
|
|
|
|
|
|
The argument is the name of a standard data set. |
|
1305
|
|
|
|
|
|
|
|
|
1306
|
|
|
|
|
|
|
=item INTDES |
|
1307
|
|
|
|
|
|
|
|
|
1308
|
|
|
|
|
|
|
The argument is an international launch designator of the form yyyy-nnn, |
|
1309
|
|
|
|
|
|
|
where the C is the Gregorian year, and the C is the launch |
|
1310
|
|
|
|
|
|
|
number in the year. |
|
1311
|
|
|
|
|
|
|
|
|
1312
|
|
|
|
|
|
|
=item NAME |
|
1313
|
|
|
|
|
|
|
|
|
1314
|
|
|
|
|
|
|
The argument is a satellite name or a portion thereof. |
|
1315
|
|
|
|
|
|
|
|
|
1316
|
|
|
|
|
|
|
=item SOURCE |
|
1317
|
|
|
|
|
|
|
|
|
1318
|
|
|
|
|
|
|
The argument specifies a data source as specified at |
|
1319
|
|
|
|
|
|
|
L. |
|
1320
|
|
|
|
|
|
|
|
|
1321
|
|
|
|
|
|
|
=item SPECIAL |
|
1322
|
|
|
|
|
|
|
|
|
1323
|
|
|
|
|
|
|
The argument specifies a special data set. |
|
1324
|
|
|
|
|
|
|
|
|
1325
|
|
|
|
|
|
|
=back |
|
1326
|
|
|
|
|
|
|
|
|
1327
|
|
|
|
|
|
|
The default is C<'CATNR'> if the argument is numeric, C<'INTDES'> if the |
|
1328
|
|
|
|
|
|
|
argument looks like an international designator, or C<'FILE'> otherwise. |
|
1329
|
|
|
|
|
|
|
|
|
1330
|
|
|
|
|
|
|
=item rms |
|
1331
|
|
|
|
|
|
|
|
|
1332
|
|
|
|
|
|
|
This Boolean option specifies that RMS data be returned rather than TLE |
|
1333
|
|
|
|
|
|
|
data, if available. This option is valid only on known catalogs that |
|
1334
|
|
|
|
|
|
|
actually have RMS data. If this option is asserted, C<--format> and |
|
1335
|
|
|
|
|
|
|
C<--query> are invalid. |
|
1336
|
|
|
|
|
|
|
|
|
1337
|
|
|
|
|
|
|
=back |
|
1338
|
|
|
|
|
|
|
|
|
1339
|
|
|
|
|
|
|
Valid catalog names are: |
|
1340
|
|
|
|
|
|
|
|
|
1341
|
|
|
|
|
|
|
cpf: CPF TLEs |
|
1342
|
|
|
|
|
|
|
glonass: Glonass satellites |
|
1343
|
|
|
|
|
|
|
gps: GPS satellites |
|
1344
|
|
|
|
|
|
|
intelsat: Intelsat satellites |
|
1345
|
|
|
|
|
|
|
iss: ISS (from NASA, no rms data |
|
1346
|
|
|
|
|
|
|
meteosat: Meteosat satellites |
|
1347
|
|
|
|
|
|
|
orbcomm: Orbcomm satellites (no RMS data) |
|
1348
|
|
|
|
|
|
|
ses: SES satellites |
|
1349
|
|
|
|
|
|
|
starlink Starlink TLEs |
|
1350
|
|
|
|
|
|
|
|
|
1351
|
|
|
|
|
|
|
You can specify options as either command-type options (e.g. |
|
1352
|
|
|
|
|
|
|
C<< celestrak_supplemental( '-file', 'foo.dat' ) >>) or as a leading |
|
1353
|
|
|
|
|
|
|
hash reference (e.g. |
|
1354
|
|
|
|
|
|
|
C<< celestrak_supplemental( { file => 'foo.dat' }) >>). If you specify |
|
1355
|
|
|
|
|
|
|
the hash reference, option names must be specified in full, without the |
|
1356
|
|
|
|
|
|
|
leading '-', and the argument list will not be parsed for command-type |
|
1357
|
|
|
|
|
|
|
options. If you specify command-type options, they may be abbreviated, |
|
1358
|
|
|
|
|
|
|
as long as the abbreviation is unique. Errors in either sort result in |
|
1359
|
|
|
|
|
|
|
an exception being thrown. |
|
1360
|
|
|
|
|
|
|
|
|
1361
|
|
|
|
|
|
|
A list of valid catalog names and brief descriptions can be obtained by |
|
1362
|
|
|
|
|
|
|
calling C<< $st->names( 'celestrak_supplemental' ) >>. If you have set |
|
1363
|
|
|
|
|
|
|
the C attribute true (e.g. C<< $st->set (verbose => 1) >>), the |
|
1364
|
|
|
|
|
|
|
content of the error response will include this list. Note, however, |
|
1365
|
|
|
|
|
|
|
that this list does not determine what can be retrieved; if Dr. Kelso |
|
1366
|
|
|
|
|
|
|
adds a data set, it can be retrieved even if it is not on the list, and |
|
1367
|
|
|
|
|
|
|
if he removes one, being on the list won't help. |
|
1368
|
|
|
|
|
|
|
|
|
1369
|
|
|
|
|
|
|
If the C option was passed, the following additional header will |
|
1370
|
|
|
|
|
|
|
be provided: |
|
1371
|
|
|
|
|
|
|
|
|
1372
|
|
|
|
|
|
|
Pragma: spacetrack-cache-hit = (either true or false) |
|
1373
|
|
|
|
|
|
|
|
|
1374
|
|
|
|
|
|
|
This can be accessed by the C method. If this pragma is |
|
1375
|
|
|
|
|
|
|
true, the C header of the response will contain the |
|
1376
|
|
|
|
|
|
|
modification time of the file. |
|
1377
|
|
|
|
|
|
|
|
|
1378
|
|
|
|
|
|
|
B that it is my belief that the current Celestrak API (as of |
|
1379
|
|
|
|
|
|
|
September 26 2022) does not support this kind of functionality, so |
|
1380
|
|
|
|
|
|
|
C will always return false. |
|
1381
|
|
|
|
|
|
|
|
|
1382
|
|
|
|
|
|
|
For more information, see |
|
1383
|
|
|
|
|
|
|
L. |
|
1384
|
|
|
|
|
|
|
|
|
1385
|
|
|
|
|
|
|
=cut |
|
1386
|
|
|
|
|
|
|
|
|
1387
|
|
|
|
|
|
|
# Called dynamically |
|
1388
|
|
|
|
|
|
|
sub _celestrak_supplemental_opts { ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) |
|
1389
|
|
|
|
|
|
|
return [ |
|
1390
|
2
|
|
|
2
|
|
4
|
@{ CELESTRAK_API_OPTIONS() }, |
|
|
2
|
|
|
|
|
12
|
|
|
1391
|
|
|
|
|
|
|
'file=s' => 'Name of cache file', |
|
1392
|
|
|
|
|
|
|
'rms!' => 'Return RMS data', |
|
1393
|
|
|
|
|
|
|
'match!' => 'Return match data', |
|
1394
|
|
|
|
|
|
|
]; |
|
1395
|
|
|
|
|
|
|
} |
|
1396
|
|
|
|
|
|
|
|
|
1397
|
|
|
|
|
|
|
sub celestrak_supplemental { |
|
1398
|
2
|
|
|
2
|
1
|
8
|
my ( $self, @args ) = @_; |
|
1399
|
2
|
|
|
|
|
11
|
( my $opt, @args ) = _parse_args( @args ); |
|
1400
|
|
|
|
|
|
|
|
|
1401
|
|
|
|
|
|
|
$opt->{rms} |
|
1402
|
|
|
|
|
|
|
and $opt->{match} |
|
1403
|
2
|
50
|
66
|
|
|
13
|
and return HTTP::Response->new( |
|
1404
|
|
|
|
|
|
|
HTTP_PRECONDITION_FAILED, |
|
1405
|
|
|
|
|
|
|
'You may not assert both --rms and --match', |
|
1406
|
|
|
|
|
|
|
); |
|
1407
|
|
|
|
|
|
|
|
|
1408
|
2
|
100
|
66
|
|
|
12
|
if ( $opt->{rms} || $opt->{match} ) { |
|
1409
|
1
|
|
|
|
|
4
|
foreach my $key ( qw{ query format } ) { |
|
1410
|
2
|
50
|
|
|
|
8
|
defined $opt->{$key} |
|
1411
|
|
|
|
|
|
|
and return HTTP::Response->new( |
|
1412
|
|
|
|
|
|
|
HTTP_PRECONDITION_FAILED, |
|
1413
|
|
|
|
|
|
|
"You may not assert --$key with --rms or --match", |
|
1414
|
|
|
|
|
|
|
); |
|
1415
|
|
|
|
|
|
|
} |
|
1416
|
|
|
|
|
|
|
} |
|
1417
|
|
|
|
|
|
|
|
|
1418
|
2
|
|
|
|
|
5
|
my $name = $args[0]; |
|
1419
|
|
|
|
|
|
|
|
|
1420
|
2
|
|
|
|
|
11
|
my $info = $catalogs{celestrak_supplemental}{$name}; |
|
1421
|
|
|
|
|
|
|
|
|
1422
|
2
|
|
|
|
|
6
|
foreach my $key ( qw{ rms match } ) { |
|
1423
|
|
|
|
|
|
|
not $opt->{$key} |
|
1424
|
4
|
50
|
66
|
|
|
17
|
or $info->{$key} |
|
1425
|
|
|
|
|
|
|
or return HTTP::Response->new( |
|
1426
|
|
|
|
|
|
|
HTTP_PRECONDITION_FAILED, |
|
1427
|
|
|
|
|
|
|
"$name does not take the --$key option" ); |
|
1428
|
|
|
|
|
|
|
} |
|
1429
|
|
|
|
|
|
|
|
|
1430
|
2
|
|
|
|
|
6
|
my $base_url = 'https://celestrak.org/NORAD/elements/supplemental'; |
|
1431
|
|
|
|
|
|
|
|
|
1432
|
2
|
|
|
|
|
8
|
my ( $spacetrack_type, $uri ); |
|
1433
|
|
|
|
|
|
|
|
|
1434
|
2
|
100
|
|
|
|
10
|
if ( $opt->{rms} ) { |
|
|
|
50
|
|
|
|
|
|
|
1435
|
1
|
|
|
|
|
2
|
$spacetrack_type = 'rms'; |
|
1436
|
1
|
|
|
|
|
11
|
$uri = URI->new( "$base_url/$name.rms.txt" ); |
|
1437
|
|
|
|
|
|
|
} elsif ( $opt->{match} ) { |
|
1438
|
0
|
|
|
|
|
0
|
$spacetrack_type = 'match'; |
|
1439
|
0
|
|
|
|
|
0
|
$uri = URI->new( "$base_url/$name.match.txt" ); |
|
1440
|
|
|
|
|
|
|
} else { |
|
1441
|
1
|
|
|
|
|
3
|
$spacetrack_type = 'orbit'; |
|
1442
|
|
|
|
|
|
|
|
|
1443
|
1
|
|
|
|
|
2
|
my $source = $info->{source}; |
|
1444
|
1
|
50
|
|
|
|
4
|
defined $source |
|
1445
|
|
|
|
|
|
|
or $source = $name; |
|
1446
|
|
|
|
|
|
|
|
|
1447
|
1
|
|
|
|
|
2
|
my $query; |
|
1448
|
|
|
|
|
|
|
ref( $query = $self->_celestrak_validate_query( |
|
1449
|
1
|
50
|
|
|
|
5
|
delete $opt->{query}, $name, |
|
1450
|
|
|
|
|
|
|
CELESTRAK_SUPPLEMENTAL_VALID_QUERY, 'FILE' ) ) |
|
1451
|
|
|
|
|
|
|
and return $query; |
|
1452
|
|
|
|
|
|
|
|
|
1453
|
1
|
|
|
|
|
3
|
my $format; |
|
1454
|
|
|
|
|
|
|
ref( $format = $self->_celestrak_validate_format( |
|
1455
|
1
|
50
|
|
|
|
4
|
delete $opt->{format} ) ) |
|
1456
|
|
|
|
|
|
|
and return $format; |
|
1457
|
|
|
|
|
|
|
|
|
1458
|
1
|
|
|
|
|
8
|
$uri = URI->new( "$base_url/sup-gp.php" ); |
|
1459
|
1
|
|
|
|
|
136
|
$uri->query_form( |
|
1460
|
|
|
|
|
|
|
$query => $source, |
|
1461
|
|
|
|
|
|
|
FORMAT => $format, |
|
1462
|
|
|
|
|
|
|
); |
|
1463
|
|
|
|
|
|
|
} |
|
1464
|
|
|
|
|
|
|
|
|
1465
|
|
|
|
|
|
|
return $self->_get_from_net( |
|
1466
|
2
|
|
|
|
|
22
|
%{ $opt }, |
|
1467
|
|
|
|
|
|
|
url => $uri, |
|
1468
|
|
|
|
|
|
|
post_process => sub { |
|
1469
|
2
|
|
|
2
|
|
48
|
my ( $self, $resp ) = @_; |
|
1470
|
2
|
|
|
|
|
5
|
my $check; |
|
1471
|
2
|
50
|
|
|
|
13
|
$check = $self->_celestrak_response_check( $resp, |
|
1472
|
|
|
|
|
|
|
celestrak_supplemental => $name ) |
|
1473
|
|
|
|
|
|
|
and return $check; |
|
1474
|
2
|
|
|
|
|
6
|
return $resp; |
|
1475
|
|
|
|
|
|
|
}, |
|
1476
|
2
|
|
|
|
|
238
|
spacetrack_source => 'celestrak', |
|
1477
|
|
|
|
|
|
|
spacetrack_type => $spacetrack_type, |
|
1478
|
|
|
|
|
|
|
); |
|
1479
|
|
|
|
|
|
|
} |
|
1480
|
|
|
|
|
|
|
|
|
1481
|
|
|
|
|
|
|
{ |
|
1482
|
|
|
|
|
|
|
my %valid_format = map { $_ => 1 } qw{ TLE 3LE 2LE XML KVN JSON CSV }; |
|
1483
|
|
|
|
|
|
|
|
|
1484
|
|
|
|
|
|
|
sub _celestrak_validate_format { |
|
1485
|
4
|
|
|
4
|
|
15
|
my ( $self, $format ) = @_; |
|
1486
|
4
|
50
|
|
|
|
15
|
$format = defined $format ? uc( $format ) : 'TLE'; |
|
1487
|
4
|
50
|
|
|
|
19
|
$valid_format{$format} |
|
1488
|
|
|
|
|
|
|
or return HTTP::Response->new( |
|
1489
|
|
|
|
|
|
|
HTTP_PRECONDITION_FAILED, |
|
1490
|
|
|
|
|
|
|
"Format '$format' is not valid" ); |
|
1491
|
4
|
50
|
33
|
|
|
20
|
$format eq 'JSON' |
|
1492
|
|
|
|
|
|
|
and $self->getv( 'pretty' ) |
|
1493
|
|
|
|
|
|
|
and $format = 'JSON-PRETTY'; |
|
1494
|
4
|
|
|
|
|
17
|
return $format; |
|
1495
|
|
|
|
|
|
|
} |
|
1496
|
|
|
|
|
|
|
} |
|
1497
|
|
|
|
|
|
|
|
|
1498
|
|
|
|
|
|
|
sub _celestrak_validate_query { |
|
1499
|
4
|
|
|
4
|
|
17
|
my ( undef, $query, $name, $valid, $dflt ) = @_; |
|
1500
|
4
|
50
|
|
|
|
37
|
$query = defined $query ? uc( $query ) : |
|
|
|
50
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
1501
|
|
|
|
|
|
|
$name =~ m/ \A [0-9]+ \z /smx ? 'CATNR' : |
|
1502
|
|
|
|
|
|
|
$name =~ m/ \A [0-9]{4}-[0-9]+ \z /smx ? 'INTDES' : |
|
1503
|
|
|
|
|
|
|
defined $dflt ? uc( $dflt ) : $dflt; |
|
1504
|
4
|
50
|
|
|
|
14
|
defined $query |
|
1505
|
|
|
|
|
|
|
or return $query; |
|
1506
|
4
|
50
|
|
|
|
20
|
$valid->{$query} |
|
1507
|
|
|
|
|
|
|
or return HTTP::Response->new( |
|
1508
|
|
|
|
|
|
|
HTTP_PRECONDITION_FAILED, |
|
1509
|
|
|
|
|
|
|
"Query '$query' is not valid" ); |
|
1510
|
4
|
|
|
|
|
21
|
return $query; |
|
1511
|
|
|
|
|
|
|
} |
|
1512
|
|
|
|
|
|
|
|
|
1513
|
|
|
|
|
|
|
sub _celestrak_repack_iridium { |
|
1514
|
1
|
|
|
1
|
|
3
|
my ( $resp ) = @_; |
|
1515
|
1
|
|
|
|
|
7
|
local $_ = $resp->content(); |
|
1516
|
1
|
|
|
|
|
120
|
s/ \s+ [[] . []] [ \t]* (?= \r? \n | \z ) //smxg; |
|
1517
|
1
|
|
|
|
|
6
|
$resp->content( $_ ); |
|
1518
|
1
|
|
|
|
|
24
|
return; |
|
1519
|
|
|
|
|
|
|
} |
|
1520
|
|
|
|
|
|
|
|
|
1521
|
|
|
|
|
|
|
{ # Local symbol block. |
|
1522
|
|
|
|
|
|
|
|
|
1523
|
|
|
|
|
|
|
my %valid_type = map { $_ => 1 } |
|
1524
|
|
|
|
|
|
|
qw{ text/plain text/text application/json application/xml }; |
|
1525
|
|
|
|
|
|
|
|
|
1526
|
|
|
|
|
|
|
sub _celestrak_response_check { |
|
1527
|
5
|
|
|
5
|
|
25
|
my ($self, $resp, $source, $name, @args) = @_; |
|
1528
|
5
|
50
|
|
|
|
17
|
unless ($resp->is_success) { |
|
1529
|
0
|
0
|
|
|
|
0
|
$resp->code == HTTP_NOT_FOUND |
|
1530
|
|
|
|
|
|
|
and return $self->_no_such_catalog( |
|
1531
|
|
|
|
|
|
|
$source => $name, @args); |
|
1532
|
0
|
|
|
|
|
0
|
return $resp; |
|
1533
|
|
|
|
|
|
|
} |
|
1534
|
5
|
50
|
|
|
|
57
|
if (my $loc = $resp->header('Content-Location')) { |
|
1535
|
0
|
0
|
|
|
|
0
|
if ($loc =~ m/ redirect [.] htm [?] ( \d{3} ) ; /smx) { |
|
1536
|
0
|
|
|
|
|
0
|
my $msg = "redirected $1"; |
|
1537
|
0
|
0
|
|
|
|
0
|
@args and $msg = "@args; $msg"; |
|
1538
|
0
|
0
|
|
|
|
0
|
$1 == HTTP_NOT_FOUND |
|
1539
|
|
|
|
|
|
|
and return $self->_no_such_catalog( |
|
1540
|
|
|
|
|
|
|
$source => $name, $msg); |
|
1541
|
0
|
|
|
|
|
0
|
return HTTP::Response->new (+$1, "$msg\n") |
|
1542
|
|
|
|
|
|
|
} |
|
1543
|
|
|
|
|
|
|
} |
|
1544
|
|
|
|
|
|
|
my $type = lc $resp->header('Content-Type') |
|
1545
|
5
|
50
|
|
|
|
264
|
or do { |
|
1546
|
0
|
|
|
|
|
0
|
my $msg = 'No Content-Type header found'; |
|
1547
|
0
|
0
|
|
|
|
0
|
@args and $msg = "@args; $msg"; |
|
1548
|
0
|
|
|
|
|
0
|
return $self->_no_such_catalog( |
|
1549
|
|
|
|
|
|
|
$source => $name, $msg); |
|
1550
|
|
|
|
|
|
|
}; |
|
1551
|
5
|
|
|
|
|
276
|
foreach my $type ( _trim( split ',', $type ) ) { |
|
1552
|
5
|
|
|
|
|
31
|
$type =~ s/ ; .* //smx; |
|
1553
|
5
|
50
|
|
|
|
32
|
$valid_type{$type} |
|
1554
|
|
|
|
|
|
|
or next; |
|
1555
|
5
|
|
|
|
|
32
|
local $_ = $resp->decoded_content(); |
|
1556
|
|
|
|
|
|
|
# As of February 12 2022 Celestrak does this |
|
1557
|
|
|
|
|
|
|
# As of July 23 2022 this is not at the beginning of the |
|
1558
|
|
|
|
|
|
|
# string |
|
1559
|
5
|
50
|
|
|
|
2699
|
m/^No GP data found\b/sm |
|
1560
|
|
|
|
|
|
|
and last; |
|
1561
|
|
|
|
|
|
|
# As of July 25 2022 Celestrak does this. |
|
1562
|
5
|
100
|
|
|
|
41
|
m/^(?:GROUP|FILE) "[^"]+" does not exist/sm |
|
1563
|
|
|
|
|
|
|
and last; |
|
1564
|
4
|
|
|
|
|
26
|
return; |
|
1565
|
|
|
|
|
|
|
} |
|
1566
|
1
|
|
|
|
|
6
|
my $msg = "Content-Type: $type"; |
|
1567
|
1
|
50
|
|
|
|
4
|
@args and $msg = "@args; $msg"; |
|
1568
|
1
|
|
|
|
|
7
|
return $self->_no_such_catalog( |
|
1569
|
|
|
|
|
|
|
$source => $name, $msg); |
|
1570
|
|
|
|
|
|
|
} |
|
1571
|
|
|
|
|
|
|
|
|
1572
|
|
|
|
|
|
|
} # End local symbol block. |
|
1573
|
|
|
|
|
|
|
|
|
1574
|
|
|
|
|
|
|
=item $bool = $st->cache_hit( $resp ); |
|
1575
|
|
|
|
|
|
|
|
|
1576
|
|
|
|
|
|
|
This method takes the given HTTP::Response object and returns the cache |
|
1577
|
|
|
|
|
|
|
hit indicator specified by the 'Pragma: spacetrack-cache-hit =' header. |
|
1578
|
|
|
|
|
|
|
This will be true if the response came from cache, false if it did not, |
|
1579
|
|
|
|
|
|
|
and C if cache was not available. |
|
1580
|
|
|
|
|
|
|
|
|
1581
|
|
|
|
|
|
|
If the response object is not provided, it returns the data type |
|
1582
|
|
|
|
|
|
|
from the last method call that returned an HTTP::Response object. |
|
1583
|
|
|
|
|
|
|
|
|
1584
|
|
|
|
|
|
|
=cut |
|
1585
|
|
|
|
|
|
|
|
|
1586
|
|
|
|
|
|
|
sub cache_hit { |
|
1587
|
1
|
|
|
1
|
1
|
4
|
$_[2] = 'spacetrack-cache-hit'; |
|
1588
|
1
|
|
|
|
|
5
|
goto &_get_pragma_value; |
|
1589
|
|
|
|
|
|
|
} |
|
1590
|
|
|
|
|
|
|
|
|
1591
|
|
|
|
|
|
|
=item $source = $st->content_source($resp); |
|
1592
|
|
|
|
|
|
|
|
|
1593
|
|
|
|
|
|
|
This method takes the given HTTP::Response object and returns the data |
|
1594
|
|
|
|
|
|
|
source specified by the 'Pragma: spacetrack-source =' header. What |
|
1595
|
|
|
|
|
|
|
values you can expect depend on the content_type (see below) as follows: |
|
1596
|
|
|
|
|
|
|
|
|
1597
|
|
|
|
|
|
|
If the C method returns C<'box_score'>, you can expect |
|
1598
|
|
|
|
|
|
|
a content-source value of C<'spacetrack'>. |
|
1599
|
|
|
|
|
|
|
|
|
1600
|
|
|
|
|
|
|
If the content_type method returns C<'iridium-status'>, you can expect |
|
1601
|
|
|
|
|
|
|
content_source values of C<'kelso'>, C<'mccants'>, or C<'sladen'>, |
|
1602
|
|
|
|
|
|
|
corresponding to the main source of the data. |
|
1603
|
|
|
|
|
|
|
|
|
1604
|
|
|
|
|
|
|
If the content_type method returns C<'molczan'>, you can expect a |
|
1605
|
|
|
|
|
|
|
content_source value of C<'mccants'>. |
|
1606
|
|
|
|
|
|
|
|
|
1607
|
|
|
|
|
|
|
If the C method returns C<'orbit'>, you can expect |
|
1608
|
|
|
|
|
|
|
content-source values of C<'amsat'>, C<'celestrak'>, C<'mccants'>, |
|
1609
|
|
|
|
|
|
|
or C<'spacetrack'>, corresponding to the actual source |
|
1610
|
|
|
|
|
|
|
of the TLE data. Note that the C method may return a |
|
1611
|
|
|
|
|
|
|
content_type of C<'spacetrack'> if the C attribute is false. |
|
1612
|
|
|
|
|
|
|
|
|
1613
|
|
|
|
|
|
|
If the content_type method returns C<'quicksat'>, you can expect a |
|
1614
|
|
|
|
|
|
|
content_source value of C<'mccants'>. |
|
1615
|
|
|
|
|
|
|
|
|
1616
|
|
|
|
|
|
|
If the C method returns C<'search'>, you can expect a |
|
1617
|
|
|
|
|
|
|
content-source value of C<'spacetrack'>. |
|
1618
|
|
|
|
|
|
|
|
|
1619
|
|
|
|
|
|
|
For any other values of content-type (e.g. C<'get'>, C<'help'>), the |
|
1620
|
|
|
|
|
|
|
expected values are undefined. In fact, you will probably literally get |
|
1621
|
|
|
|
|
|
|
undef, but the author does not commit even to this. |
|
1622
|
|
|
|
|
|
|
|
|
1623
|
|
|
|
|
|
|
If the response object is not provided, it returns the data source |
|
1624
|
|
|
|
|
|
|
from the last method call that returned an HTTP::Response object. |
|
1625
|
|
|
|
|
|
|
|
|
1626
|
|
|
|
|
|
|
If the response object B provided, you can call this as a static |
|
1627
|
|
|
|
|
|
|
method (i.e. as Astro::SpaceTrack->content_source($response)). |
|
1628
|
|
|
|
|
|
|
|
|
1629
|
|
|
|
|
|
|
=cut |
|
1630
|
|
|
|
|
|
|
|
|
1631
|
|
|
|
|
|
|
sub content_source { |
|
1632
|
37
|
|
|
37
|
1
|
113
|
$_[2] = 'spacetrack-source'; |
|
1633
|
37
|
|
|
|
|
130
|
goto &_get_pragma_value; |
|
1634
|
|
|
|
|
|
|
} |
|
1635
|
|
|
|
|
|
|
|
|
1636
|
|
|
|
|
|
|
=item $type = $st->content_type ($resp); |
|
1637
|
|
|
|
|
|
|
|
|
1638
|
|
|
|
|
|
|
This method takes the given HTTP::Response object and returns the |
|
1639
|
|
|
|
|
|
|
data type specified by the 'Pragma: spacetrack-type =' header. The |
|
1640
|
|
|
|
|
|
|
following values are supported: |
|
1641
|
|
|
|
|
|
|
|
|
1642
|
|
|
|
|
|
|
'box_score': The content is the Space Track satellite |
|
1643
|
|
|
|
|
|
|
box score. |
|
1644
|
|
|
|
|
|
|
'get': The content is a parameter value. |
|
1645
|
|
|
|
|
|
|
'help': The content is help text. |
|
1646
|
|
|
|
|
|
|
'iridium_status': The content is Iridium status. |
|
1647
|
|
|
|
|
|
|
'modeldef': The content is a REST model definition. |
|
1648
|
|
|
|
|
|
|
'molczan': Molczan-format magnitude data. |
|
1649
|
|
|
|
|
|
|
'orbit': The content is NORAD data sets. |
|
1650
|
|
|
|
|
|
|
'quicksat': Quicksat-format magnitude data. |
|
1651
|
|
|
|
|
|
|
'search': The content is Space Track search results. |
|
1652
|
|
|
|
|
|
|
'set': The content is the result of a 'set' operation. |
|
1653
|
|
|
|
|
|
|
undef: No spacetrack-type pragma was specified. The |
|
1654
|
|
|
|
|
|
|
content is something else (typically 'OK'). |
|
1655
|
|
|
|
|
|
|
|
|
1656
|
|
|
|
|
|
|
If the response object is not provided, it returns the data type |
|
1657
|
|
|
|
|
|
|
from the last method call that returned an HTTP::Response object. |
|
1658
|
|
|
|
|
|
|
|
|
1659
|
|
|
|
|
|
|
If the response object B provided, you can call this as a static |
|
1660
|
|
|
|
|
|
|
method (i.e. as Astro::SpaceTrack->content_type($response)). |
|
1661
|
|
|
|
|
|
|
|
|
1662
|
|
|
|
|
|
|
For the format of the magnitude data, see |
|
1663
|
|
|
|
|
|
|
L. |
|
1664
|
|
|
|
|
|
|
|
|
1665
|
|
|
|
|
|
|
=cut |
|
1666
|
|
|
|
|
|
|
|
|
1667
|
|
|
|
|
|
|
sub content_type { |
|
1668
|
38
|
|
|
38
|
1
|
1314
|
$_[2] = 'spacetrack-type'; |
|
1669
|
38
|
|
|
|
|
168
|
goto &_get_pragma_value; |
|
1670
|
|
|
|
|
|
|
} |
|
1671
|
|
|
|
|
|
|
|
|
1672
|
|
|
|
|
|
|
=item $type = $st->content_interface( $resp ); |
|
1673
|
|
|
|
|
|
|
|
|
1674
|
|
|
|
|
|
|
This method takes the given HTTP::Response object and returns the Space |
|
1675
|
|
|
|
|
|
|
Track interface version specified by the |
|
1676
|
|
|
|
|
|
|
C<'Pragma: spacetrack-interface ='> header. The following values are |
|
1677
|
|
|
|
|
|
|
supported: |
|
1678
|
|
|
|
|
|
|
|
|
1679
|
|
|
|
|
|
|
1: The content was obtained using the version 1 interface. |
|
1680
|
|
|
|
|
|
|
2: The content was obtained using the version 2 interface. |
|
1681
|
|
|
|
|
|
|
undef: The content did not come from Space Track. |
|
1682
|
|
|
|
|
|
|
|
|
1683
|
|
|
|
|
|
|
If the response object is not provided, it returns the data type |
|
1684
|
|
|
|
|
|
|
from the last method call that returned an HTTP::Response object. |
|
1685
|
|
|
|
|
|
|
|
|
1686
|
|
|
|
|
|
|
If the response object B provided, you can call this as a static |
|
1687
|
|
|
|
|
|
|
method (i.e. as Astro::SpaceTrack->content_type($response)). |
|
1688
|
|
|
|
|
|
|
|
|
1689
|
|
|
|
|
|
|
=cut |
|
1690
|
|
|
|
|
|
|
|
|
1691
|
|
|
|
|
|
|
sub content_interface { |
|
1692
|
22
|
|
|
22
|
1
|
61
|
$_[2] = 'spacetrack-interface'; |
|
1693
|
22
|
|
|
|
|
67
|
goto &_get_pragma_value; |
|
1694
|
|
|
|
|
|
|
} |
|
1695
|
|
|
|
|
|
|
|
|
1696
|
|
|
|
|
|
|
sub _get_pragma_value { |
|
1697
|
98
|
|
|
98
|
|
229
|
my ( $self, $resp, $pragma ) = @_; |
|
1698
|
|
|
|
|
|
|
defined $resp |
|
1699
|
98
|
100
|
|
|
|
747
|
or return $self->{_pragmata}{$pragma}; |
|
1700
|
5
|
|
|
|
|
22
|
( my $re = $pragma ) =~ s/ _ /-/smxg; |
|
1701
|
5
|
|
|
|
|
75
|
$re = qr{ \Q$re\E }smxi; |
|
1702
|
5
|
|
|
|
|
24
|
foreach ( $resp->header( 'Pragma' ) ) { |
|
1703
|
3
|
100
|
|
|
|
158
|
m/ $re \s+ = \s+ (.+) /smxi and return $1; |
|
1704
|
|
|
|
|
|
|
} |
|
1705
|
|
|
|
|
|
|
# Sorry, PBP -- to be compatible with the performance of this method |
|
1706
|
|
|
|
|
|
|
# when $resp is defined, we must return an explicit undef here. |
|
1707
|
3
|
|
|
|
|
156
|
return undef; ## no critic (ProhibitExplicitReturnUndef) |
|
1708
|
|
|
|
|
|
|
} |
|
1709
|
|
|
|
|
|
|
|
|
1710
|
|
|
|
|
|
|
=for html |
|
1711
|
|
|
|
|
|
|
|
|
1712
|
|
|
|
|
|
|
=item $resp = $st->country_names() |
|
1713
|
|
|
|
|
|
|
|
|
1714
|
|
|
|
|
|
|
This method returns an HTTP::Response object. If the request succeeds, |
|
1715
|
|
|
|
|
|
|
the content of the object will be the known country names and their |
|
1716
|
|
|
|
|
|
|
abbreviations in the desired format. If the desired format is |
|
1717
|
|
|
|
|
|
|
C<'legacy'> or C<'json'> and the method is called in list context, the |
|
1718
|
|
|
|
|
|
|
second returned item will be a reference to an array containing the |
|
1719
|
|
|
|
|
|
|
parsed data. |
|
1720
|
|
|
|
|
|
|
|
|
1721
|
|
|
|
|
|
|
This method takes the following options, specified either command-style |
|
1722
|
|
|
|
|
|
|
or as a hash reference. |
|
1723
|
|
|
|
|
|
|
|
|
1724
|
|
|
|
|
|
|
C<-format> specifies the desired format of the retrieved data. Possible |
|
1725
|
|
|
|
|
|
|
values are C<'xml'>, C<'json'>, C<'html'>, C<'csv'>, and C<'legacy'>, |
|
1726
|
|
|
|
|
|
|
which is the default. The legacy format is tab-delimited text, such as |
|
1727
|
|
|
|
|
|
|
was returned by the version 1 interface. |
|
1728
|
|
|
|
|
|
|
|
|
1729
|
|
|
|
|
|
|
C<-json> specifies JSON format. If you specify both C<-json> and |
|
1730
|
|
|
|
|
|
|
C<-format> you will get an exception unless you specify C<-format=json>. |
|
1731
|
|
|
|
|
|
|
|
|
1732
|
|
|
|
|
|
|
This method requires a Space Track username and password. It |
|
1733
|
|
|
|
|
|
|
implicitly calls the C method if the session cookie is |
|
1734
|
|
|
|
|
|
|
missing or expired. If C fails, you will get the |
|
1735
|
|
|
|
|
|
|
HTTP::Response from C. |
|
1736
|
|
|
|
|
|
|
|
|
1737
|
|
|
|
|
|
|
If this method succeeds, the response will contain headers |
|
1738
|
|
|
|
|
|
|
|
|
1739
|
|
|
|
|
|
|
Pragma: spacetrack-type = country_names |
|
1740
|
|
|
|
|
|
|
Pragma: spacetrack-source = spacetrack |
|
1741
|
|
|
|
|
|
|
|
|
1742
|
|
|
|
|
|
|
There are no arguments. |
|
1743
|
|
|
|
|
|
|
|
|
1744
|
|
|
|
|
|
|
=cut |
|
1745
|
|
|
|
|
|
|
|
|
1746
|
|
|
|
|
|
|
sub country_names { |
|
1747
|
|
|
|
|
|
|
|
|
1748
|
1
|
|
|
1
|
1
|
5
|
my ( $self, @args ) = @_; |
|
1749
|
|
|
|
|
|
|
|
|
1750
|
1
|
|
|
|
|
6
|
( my $opt, @args ) = _parse_args( |
|
1751
|
|
|
|
|
|
|
[ |
|
1752
|
|
|
|
|
|
|
'json!' => 'Return data in JSON format', |
|
1753
|
|
|
|
|
|
|
'format=s' => 'Specify return format', |
|
1754
|
|
|
|
|
|
|
], @args ); |
|
1755
|
1
|
|
|
|
|
10
|
my $format = _retrieval_format( country_names => $opt ); |
|
1756
|
|
|
|
|
|
|
|
|
1757
|
1
|
|
|
|
|
7
|
my $resp = $self->spacetrack_query_v2( |
|
1758
|
|
|
|
|
|
|
basicspacedata => 'query', |
|
1759
|
|
|
|
|
|
|
class => 'boxscore', |
|
1760
|
|
|
|
|
|
|
format => $format, |
|
1761
|
|
|
|
|
|
|
predicates => 'COUNTRY,SPADOC_CD', |
|
1762
|
|
|
|
|
|
|
); |
|
1763
|
1
|
50
|
|
|
|
6
|
$resp->is_success() |
|
1764
|
|
|
|
|
|
|
or return $resp; |
|
1765
|
|
|
|
|
|
|
|
|
1766
|
1
|
|
|
|
|
11
|
$self->_add_pragmata( $resp, |
|
1767
|
|
|
|
|
|
|
'spacetrack-type' => 'country_names', |
|
1768
|
|
|
|
|
|
|
'spacetrack-source' => 'spacetrack', |
|
1769
|
|
|
|
|
|
|
'spacetrack-interface' => 2, |
|
1770
|
|
|
|
|
|
|
); |
|
1771
|
|
|
|
|
|
|
|
|
1772
|
1
|
50
|
|
|
|
3
|
'json' eq $format |
|
1773
|
|
|
|
|
|
|
or return $resp; |
|
1774
|
|
|
|
|
|
|
|
|
1775
|
1
|
|
|
|
|
3
|
my $json = $self->_get_json_object(); |
|
1776
|
|
|
|
|
|
|
|
|
1777
|
1
|
|
|
|
|
6
|
my $data = $json->decode( $resp->content() ); |
|
1778
|
|
|
|
|
|
|
|
|
1779
|
1
|
|
|
|
|
114
|
my %dict; |
|
1780
|
1
|
|
|
|
|
4
|
foreach my $datum ( @{ $data } ) { |
|
|
1
|
|
|
|
|
4
|
|
|
1781
|
|
|
|
|
|
|
defined $datum->{SPADOC_CD} |
|
1782
|
100
|
50
|
|
|
|
169
|
and $dict{$datum->{SPADOC_CD}} = $datum->{COUNTRY}; |
|
1783
|
|
|
|
|
|
|
} |
|
1784
|
|
|
|
|
|
|
|
|
1785
|
1
|
50
|
|
|
|
13
|
if ( $opt->{json} ) { |
|
1786
|
|
|
|
|
|
|
|
|
1787
|
0
|
|
|
|
|
0
|
$resp->content( $json->encode( \%dict ) ); |
|
1788
|
|
|
|
|
|
|
|
|
1789
|
|
|
|
|
|
|
} else { |
|
1790
|
|
|
|
|
|
|
|
|
1791
|
|
|
|
|
|
|
$resp->content( |
|
1792
|
|
|
|
|
|
|
join '', |
|
1793
|
|
|
|
|
|
|
join( "\t", 'Abbreviation', 'Country/Organization' ) |
|
1794
|
|
|
|
|
|
|
. "\n", |
|
1795
|
1
|
|
|
|
|
10
|
map { "$_\t$dict{$_}\n" } sort keys %dict |
|
|
0
|
|
|
|
|
0
|
|
|
1796
|
|
|
|
|
|
|
); |
|
1797
|
|
|
|
|
|
|
|
|
1798
|
|
|
|
|
|
|
} |
|
1799
|
|
|
|
|
|
|
|
|
1800
|
1
|
|
|
|
|
56
|
return $resp; |
|
1801
|
|
|
|
|
|
|
} |
|
1802
|
|
|
|
|
|
|
|
|
1803
|
|
|
|
|
|
|
|
|
1804
|
|
|
|
|
|
|
=for html |
|
1805
|
|
|
|
|
|
|
|
|
1806
|
|
|
|
|
|
|
=item $resp = $st->favorite( $name ) |
|
1807
|
|
|
|
|
|
|
|
|
1808
|
|
|
|
|
|
|
This method returns an HTTP::Response object. If the request succeeds, |
|
1809
|
|
|
|
|
|
|
the content of the response will be TLE data specified by the named |
|
1810
|
|
|
|
|
|
|
favorite in the desired format. The named favorite must have previously |
|
1811
|
|
|
|
|
|
|
been set up by the user, or be one of the 'global' favorites (e.g. |
|
1812
|
|
|
|
|
|
|
C<'Navigation'>, C<'Weather'>, and so on). |
|
1813
|
|
|
|
|
|
|
|
|
1814
|
|
|
|
|
|
|
This method takes the following options, specified either command-style |
|
1815
|
|
|
|
|
|
|
or as a hash reference. |
|
1816
|
|
|
|
|
|
|
|
|
1817
|
|
|
|
|
|
|
C<-format> specifies the desired format of the retrieved data. Possible |
|
1818
|
|
|
|
|
|
|
values are C<'xml'>, C<'json'>, C<'html'>, C<'csv'>, and C<'legacy'>, |
|
1819
|
|
|
|
|
|
|
which is the default. The legacy format is tab-delimited text, such as |
|
1820
|
|
|
|
|
|
|
was returned by the version 1 interface. |
|
1821
|
|
|
|
|
|
|
|
|
1822
|
|
|
|
|
|
|
C<-json> specifies JSON format. If you specify both C<-json> and |
|
1823
|
|
|
|
|
|
|
C<-format> you will get an exception unless you specify C<-format=json>. |
|
1824
|
|
|
|
|
|
|
|
|
1825
|
|
|
|
|
|
|
This method requires a Space Track username and password. It |
|
1826
|
|
|
|
|
|
|
implicitly calls the C method if the session cookie is |
|
1827
|
|
|
|
|
|
|
missing or expired. If C fails, you will get the |
|
1828
|
|
|
|
|
|
|
HTTP::Response from C. |
|
1829
|
|
|
|
|
|
|
|
|
1830
|
|
|
|
|
|
|
=cut |
|
1831
|
|
|
|
|
|
|
|
|
1832
|
|
|
|
|
|
|
# Called dynamically |
|
1833
|
|
|
|
|
|
|
sub _favorite_opts { ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) |
|
1834
|
|
|
|
|
|
|
return [ |
|
1835
|
1
|
|
|
1
|
|
5
|
'json!' => 'Return data in JSON format', |
|
1836
|
|
|
|
|
|
|
'format=s' => 'Specify return format', |
|
1837
|
|
|
|
|
|
|
]; |
|
1838
|
|
|
|
|
|
|
} |
|
1839
|
|
|
|
|
|
|
|
|
1840
|
|
|
|
|
|
|
sub favorite { |
|
1841
|
1
|
|
|
1
|
1
|
4
|
my ($self, @args) = @_; |
|
1842
|
1
|
|
|
|
|
5
|
delete $self->{_pragmata}; |
|
1843
|
|
|
|
|
|
|
|
|
1844
|
1
|
|
|
|
|
4
|
( my $opt, @args ) = _parse_args( @args ); |
|
1845
|
|
|
|
|
|
|
|
|
1846
|
|
|
|
|
|
|
@args |
|
1847
|
1
|
50
|
33
|
|
|
13
|
and defined $args[0] |
|
1848
|
|
|
|
|
|
|
or Carp::croak 'Must specify a favorite'; |
|
1849
|
1
|
50
|
|
|
|
8
|
@args > 1 |
|
1850
|
|
|
|
|
|
|
and Carp::croak 'Can not specify more than one favorite'; |
|
1851
|
|
|
|
|
|
|
# https://beta.space-track.org/basicspacedata/query/class/tle_latest/favorites/Visible/ORDINAL/1/EPOCH/%3Enow-30/format/3le |
|
1852
|
|
|
|
|
|
|
|
|
1853
|
1
|
|
|
|
|
6
|
my $rest = $self->_convert_retrieve_options_to_rest( $opt ); |
|
1854
|
1
|
|
|
|
|
3
|
$rest->{favorites} = $args[0]; |
|
1855
|
1
|
|
|
|
|
3
|
$rest->{EPOCH} = '>now-30'; |
|
1856
|
1
|
|
|
|
|
2
|
delete $rest->{orderby}; |
|
1857
|
|
|
|
|
|
|
|
|
1858
|
1
|
|
|
|
|
13
|
my $resp = $self->spacetrack_query_v2( |
|
1859
|
|
|
|
|
|
|
basicspacedata => 'query', |
|
1860
|
|
|
|
|
|
|
_sort_rest_arguments( $rest ) |
|
1861
|
|
|
|
|
|
|
); |
|
1862
|
|
|
|
|
|
|
|
|
1863
|
1
|
50
|
|
|
|
7
|
$resp->is_success() |
|
1864
|
|
|
|
|
|
|
or return $resp; |
|
1865
|
|
|
|
|
|
|
|
|
1866
|
0
|
0
|
|
|
|
0
|
_spacetrack_v2_response_is_empty( $resp ) |
|
1867
|
|
|
|
|
|
|
and return HTTP::Response->new( |
|
1868
|
|
|
|
|
|
|
HTTP_NOT_FOUND, |
|
1869
|
|
|
|
|
|
|
"Favorite '$args[0]' not found" |
|
1870
|
|
|
|
|
|
|
); |
|
1871
|
|
|
|
|
|
|
|
|
1872
|
0
|
|
|
|
|
0
|
return $resp; |
|
1873
|
|
|
|
|
|
|
} |
|
1874
|
|
|
|
|
|
|
|
|
1875
|
|
|
|
|
|
|
|
|
1876
|
|
|
|
|
|
|
=for html |
|
1877
|
|
|
|
|
|
|
|
|
1878
|
|
|
|
|
|
|
=item $resp = $st->file ($name) |
|
1879
|
|
|
|
|
|
|
|
|
1880
|
|
|
|
|
|
|
This method takes the name of an observing list file, or a handle to an |
|
1881
|
|
|
|
|
|
|
open observing list file, and returns an HTTP::Response object whose |
|
1882
|
|
|
|
|
|
|
content is the relevant element sets, retrieved from the Space Track web |
|
1883
|
|
|
|
|
|
|
site. If called in list context, the first element of the list is the |
|
1884
|
|
|
|
|
|
|
aforementioned HTTP::Response object, and the second element is a list |
|
1885
|
|
|
|
|
|
|
reference to list references (i.e. a list of lists). Each of the list |
|
1886
|
|
|
|
|
|
|
references contains the catalog ID of a satellite or other orbiting body |
|
1887
|
|
|
|
|
|
|
and the common name of the body. |
|
1888
|
|
|
|
|
|
|
|
|
1889
|
|
|
|
|
|
|
This method requires a Space Track username and password. It implicitly |
|
1890
|
|
|
|
|
|
|
calls the C method if the session cookie is missing or expired. |
|
1891
|
|
|
|
|
|
|
If C fails, you will get the HTTP::Response from C. |
|
1892
|
|
|
|
|
|
|
|
|
1893
|
|
|
|
|
|
|
The observing list file is (how convenient!) in the Celestrak format, |
|
1894
|
|
|
|
|
|
|
with the first five characters of each line containing the object ID, |
|
1895
|
|
|
|
|
|
|
and the rest containing a name of the object. Lines whose first five |
|
1896
|
|
|
|
|
|
|
characters do not look like a right-justified number will be ignored. |
|
1897
|
|
|
|
|
|
|
|
|
1898
|
|
|
|
|
|
|
If this method succeeds, the response will contain headers |
|
1899
|
|
|
|
|
|
|
|
|
1900
|
|
|
|
|
|
|
Pragma: spacetrack-type = orbit |
|
1901
|
|
|
|
|
|
|
Pragma: spacetrack-source = spacetrack |
|
1902
|
|
|
|
|
|
|
|
|
1903
|
|
|
|
|
|
|
These can be accessed by C<< $st->content_type( $resp ) >> and |
|
1904
|
|
|
|
|
|
|
C<< $st->content_source( $resp ) >> respectively. |
|
1905
|
|
|
|
|
|
|
|
|
1906
|
|
|
|
|
|
|
You can specify the C options on this method as well. |
|
1907
|
|
|
|
|
|
|
|
|
1908
|
|
|
|
|
|
|
=cut |
|
1909
|
|
|
|
|
|
|
|
|
1910
|
|
|
|
|
|
|
# Called dynamically |
|
1911
|
|
|
|
|
|
|
sub _file_opts { ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) |
|
1912
|
0
|
|
|
0
|
|
0
|
return [ _get_retrieve_options() ]; |
|
1913
|
|
|
|
|
|
|
} |
|
1914
|
|
|
|
|
|
|
|
|
1915
|
|
|
|
|
|
|
sub file { |
|
1916
|
1
|
|
|
1
|
1
|
5
|
my ($self, @args) = @_; |
|
1917
|
|
|
|
|
|
|
|
|
1918
|
1
|
|
|
|
|
6
|
my ( $opt, $file ) = $self->_parse_retrieve_args( @args ); |
|
1919
|
|
|
|
|
|
|
|
|
1920
|
1
|
|
|
|
|
4
|
delete $self->{_pragmata}; |
|
1921
|
|
|
|
|
|
|
|
|
1922
|
1
|
50
|
|
|
|
9
|
if ( ! Scalar::Util::openhandle( $file ) ) { |
|
1923
|
1
|
50
|
|
|
|
22
|
-e $file or return HTTP::Response->new ( |
|
1924
|
|
|
|
|
|
|
HTTP_NOT_FOUND, "Can't find file $file"); |
|
1925
|
1
|
50
|
|
|
|
13
|
my $fh = IO::File->new($file, '<') or |
|
1926
|
|
|
|
|
|
|
return HTTP::Response->new ( |
|
1927
|
|
|
|
|
|
|
HTTP_INTERNAL_SERVER_ERROR, "Can't open $file: $!"); |
|
1928
|
1
|
|
|
|
|
159
|
$file = $fh; |
|
1929
|
|
|
|
|
|
|
} |
|
1930
|
|
|
|
|
|
|
|
|
1931
|
1
|
|
|
|
|
5
|
local $/ = undef; |
|
1932
|
1
|
|
|
|
|
58
|
return $self->_handle_observing_list( $opt, <$file> ) |
|
1933
|
|
|
|
|
|
|
} |
|
1934
|
|
|
|
|
|
|
|
|
1935
|
|
|
|
|
|
|
|
|
1936
|
|
|
|
|
|
|
=for html |
|
1937
|
|
|
|
|
|
|
|
|
1938
|
|
|
|
|
|
|
=item $resp = $st->get (attrib) |
|
1939
|
|
|
|
|
|
|
|
|
1940
|
|
|
|
|
|
|
B whose content is the value |
|
1941
|
|
|
|
|
|
|
of the given attribute. If called in list context, the second element |
|
1942
|
|
|
|
|
|
|
of the list is just the value of the attribute, for those who don't want |
|
1943
|
|
|
|
|
|
|
to winkle it out of the response object. We croak on a bad attribute name. |
|
1944
|
|
|
|
|
|
|
|
|
1945
|
|
|
|
|
|
|
If this method succeeds, the response will contain header |
|
1946
|
|
|
|
|
|
|
|
|
1947
|
|
|
|
|
|
|
Pragma: spacetrack-type = get |
|
1948
|
|
|
|
|
|
|
|
|
1949
|
|
|
|
|
|
|
This can be accessed by C<< $st->content_type( $resp ) >>. |
|
1950
|
|
|
|
|
|
|
|
|
1951
|
|
|
|
|
|
|
See L for the names and functions of the attributes. |
|
1952
|
|
|
|
|
|
|
|
|
1953
|
|
|
|
|
|
|
=cut |
|
1954
|
|
|
|
|
|
|
|
|
1955
|
|
|
|
|
|
|
# Called dynamically |
|
1956
|
|
|
|
|
|
|
sub _readline_complete_command_get { ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) |
|
1957
|
|
|
|
|
|
|
# my ( $self, $text, $line, $start, $cmd_line ) = @_; |
|
1958
|
0
|
|
|
0
|
|
0
|
my ( $self, $text ) = @_; |
|
1959
|
0
|
0
|
|
|
|
0
|
$text eq '' |
|
1960
|
|
|
|
|
|
|
and return( $self->attribute_names() ); |
|
1961
|
0
|
|
|
|
|
0
|
my $re = qr/ \A \Q$text\E /smx; |
|
1962
|
0
|
|
|
|
|
0
|
return( sort grep { $_ =~ $re } $self->attribute_names() ); |
|
|
0
|
|
|
|
|
0
|
|
|
1963
|
|
|
|
|
|
|
} |
|
1964
|
|
|
|
|
|
|
|
|
1965
|
|
|
|
|
|
|
sub get { |
|
1966
|
1
|
|
|
1
|
1
|
4
|
my ( $self, $name ) = @_; |
|
1967
|
1
|
|
|
|
|
4
|
delete $self->{_pragmata}; |
|
1968
|
1
|
|
33
|
|
|
15
|
my $code = $self->can( "_get_attr_$name" ) || $self->can( 'getv' ); |
|
1969
|
1
|
|
|
|
|
5
|
my $value = $code->( $self, $name ); |
|
1970
|
1
|
|
|
|
|
23
|
my $resp = HTTP::Response->new( HTTP_OK, COPACETIC, undef, $value ); |
|
1971
|
1
|
|
|
|
|
51
|
$self->_add_pragmata( $resp, |
|
1972
|
|
|
|
|
|
|
'spacetrack-type' => 'get', |
|
1973
|
|
|
|
|
|
|
); |
|
1974
|
1
|
|
|
|
|
3
|
$self->__dump_response( $resp ); |
|
1975
|
1
|
50
|
|
|
|
6
|
return wantarray ? ($resp, $value ) : $resp; |
|
1976
|
|
|
|
|
|
|
} |
|
1977
|
|
|
|
|
|
|
|
|
1978
|
|
|
|
|
|
|
# Called dynamically |
|
1979
|
|
|
|
|
|
|
sub _get_attr_dump_headers { ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) |
|
1980
|
0
|
|
|
0
|
|
0
|
my ( $self, $name ) = @_; |
|
1981
|
0
|
|
|
|
|
0
|
my $value = $self->getv( $name ); |
|
1982
|
0
|
|
|
|
|
0
|
my @opts = ( $value, '#' ); |
|
1983
|
0
|
0
|
|
|
|
0
|
if ( $value ) { |
|
1984
|
0
|
|
|
|
|
0
|
foreach my $key ( @dump_options ) { |
|
1985
|
0
|
|
|
|
|
0
|
my $const = "DUMP_\U$key"; |
|
1986
|
0
|
|
|
|
|
0
|
my $mask = __PACKAGE__->$const(); |
|
1987
|
0
|
0
|
|
|
|
0
|
$value & $mask |
|
1988
|
|
|
|
|
|
|
and push @opts, "--$key"; |
|
1989
|
|
|
|
|
|
|
} |
|
1990
|
|
|
|
|
|
|
} else { |
|
1991
|
0
|
|
|
|
|
0
|
push @opts, '--none'; |
|
1992
|
|
|
|
|
|
|
} |
|
1993
|
0
|
|
|
|
|
0
|
return "@opts"; |
|
1994
|
|
|
|
|
|
|
} |
|
1995
|
|
|
|
|
|
|
|
|
1996
|
|
|
|
|
|
|
|
|
1997
|
|
|
|
|
|
|
=for html |
|
1998
|
|
|
|
|
|
|
|
|
1999
|
|
|
|
|
|
|
=item $value = $st->getv (attrib) |
|
2000
|
|
|
|
|
|
|
|
|
2001
|
|
|
|
|
|
|
This method returns the value of the given attribute, which is what |
|
2002
|
|
|
|
|
|
|
C should have done. |
|
2003
|
|
|
|
|
|
|
|
|
2004
|
|
|
|
|
|
|
See L for the names and functions of the attributes. |
|
2005
|
|
|
|
|
|
|
|
|
2006
|
|
|
|
|
|
|
=cut |
|
2007
|
|
|
|
|
|
|
|
|
2008
|
|
|
|
|
|
|
sub getv { |
|
2009
|
66
|
|
|
66
|
1
|
924
|
my ( $self, $name ) = @_; |
|
2010
|
66
|
50
|
|
|
|
185
|
defined $name |
|
2011
|
|
|
|
|
|
|
or Carp::croak 'No attribute name specified'; |
|
2012
|
66
|
50
|
|
|
|
209
|
my $code = $accessor{$name} |
|
2013
|
|
|
|
|
|
|
or Carp::croak "No such attribute as '$name'"; |
|
2014
|
66
|
|
|
|
|
179
|
return $code->( $self, $name ); |
|
2015
|
|
|
|
|
|
|
} |
|
2016
|
|
|
|
|
|
|
|
|
2017
|
|
|
|
|
|
|
|
|
2018
|
|
|
|
|
|
|
=for html |
|
2019
|
|
|
|
|
|
|
|
|
2020
|
|
|
|
|
|
|
=item $resp = $st->help () |
|
2021
|
|
|
|
|
|
|
|
|
2022
|
|
|
|
|
|
|
This method exists for the convenience of the shell () method. It |
|
2023
|
|
|
|
|
|
|
always returns success, with the content being whatever it's |
|
2024
|
|
|
|
|
|
|
convenient (to the author) to include. |
|
2025
|
|
|
|
|
|
|
|
|
2026
|
|
|
|
|
|
|
If the C attribute is set, the L |
|
2027
|
|
|
|
|
|
|
web page for Astro::Satpass is launched. |
|
2028
|
|
|
|
|
|
|
|
|
2029
|
|
|
|
|
|
|
If this method succeeds B the webcmd attribute is not set, the |
|
2030
|
|
|
|
|
|
|
response will contain header |
|
2031
|
|
|
|
|
|
|
|
|
2032
|
|
|
|
|
|
|
Pragma: spacetrack-type = help |
|
2033
|
|
|
|
|
|
|
|
|
2034
|
|
|
|
|
|
|
This can be accessed by C<< $st->content_type( $resp ) >>. |
|
2035
|
|
|
|
|
|
|
|
|
2036
|
|
|
|
|
|
|
Otherwise (i.e. in any case where the response does B contain |
|
2037
|
|
|
|
|
|
|
actual help text) this header will be absent. |
|
2038
|
|
|
|
|
|
|
|
|
2039
|
|
|
|
|
|
|
=cut |
|
2040
|
|
|
|
|
|
|
|
|
2041
|
|
|
|
|
|
|
sub help { |
|
2042
|
1
|
|
|
1
|
1
|
3
|
my $self = shift; |
|
2043
|
1
|
|
|
|
|
41
|
delete $self->{_pragmata}; |
|
2044
|
1
|
50
|
|
|
|
7
|
if ($self->{webcmd}) { |
|
2045
|
0
|
|
|
|
|
0
|
my $cmd = $self->{webcmd}; |
|
2046
|
0
|
0
|
|
|
|
0
|
if ( '1' eq $cmd ) { |
|
2047
|
0
|
|
|
|
|
0
|
require Browser::Open; |
|
2048
|
0
|
|
|
|
|
0
|
$cmd = Browser::Open::open_browser_cmd(); |
|
2049
|
|
|
|
|
|
|
} |
|
2050
|
|
|
|
|
|
|
# TODO just use open_browser() once webcmd becomes Boolean. |
|
2051
|
0
|
|
|
|
|
0
|
system { $cmd } $cmd, |
|
|
0
|
|
|
|
|
0
|
|
|
2052
|
|
|
|
|
|
|
'https://metacpan.org/release/Astro-SpaceTrack'; |
|
2053
|
0
|
|
|
|
|
0
|
return HTTP::Response->new (HTTP_OK, undef, undef, 'OK'); |
|
2054
|
|
|
|
|
|
|
} else { |
|
2055
|
1
|
|
|
|
|
5
|
my $resp = HTTP::Response->new (HTTP_OK, undef, undef, <<'EOD'); |
|
2056
|
|
|
|
|
|
|
The following commands are defined: |
|
2057
|
|
|
|
|
|
|
box_score |
|
2058
|
|
|
|
|
|
|
Retrieve the SATCAT box score. A Space Track login is needed. |
|
2059
|
|
|
|
|
|
|
celestrak name |
|
2060
|
|
|
|
|
|
|
Retrieves the named catalog of IDs from Celestrak. If the |
|
2061
|
|
|
|
|
|
|
direct attribute is false (the default), the corresponding |
|
2062
|
|
|
|
|
|
|
orbital elements come from Space Track. If true, they come |
|
2063
|
|
|
|
|
|
|
from Celestrak, and no login is needed. |
|
2064
|
|
|
|
|
|
|
exit (or bye) |
|
2065
|
|
|
|
|
|
|
Terminate the shell. End-of-file also works. |
|
2066
|
|
|
|
|
|
|
file filename |
|
2067
|
|
|
|
|
|
|
Retrieve the catalog IDs given in the named file (one per |
|
2068
|
|
|
|
|
|
|
line, with the first five characters being the ID). |
|
2069
|
|
|
|
|
|
|
get |
|
2070
|
|
|
|
|
|
|
Get the value of a single attribute. |
|
2071
|
|
|
|
|
|
|
help |
|
2072
|
|
|
|
|
|
|
Display this help text. |
|
2073
|
|
|
|
|
|
|
iridium_status |
|
2074
|
|
|
|
|
|
|
Status of Iridium satellites, from Rod Sladen and/or T. S. Kelso. |
|
2075
|
|
|
|
|
|
|
login |
|
2076
|
|
|
|
|
|
|
Acquire a session cookie. You must have already set the |
|
2077
|
|
|
|
|
|
|
username and password attributes. This will be called |
|
2078
|
|
|
|
|
|
|
implicitly if needed by any method that accesses data. |
|
2079
|
|
|
|
|
|
|
names source |
|
2080
|
|
|
|
|
|
|
Lists the catalog names from the given source. |
|
2081
|
|
|
|
|
|
|
retrieve number ... |
|
2082
|
|
|
|
|
|
|
Retieves the latest orbital elements for the given |
|
2083
|
|
|
|
|
|
|
catalog numbers. |
|
2084
|
|
|
|
|
|
|
search_date date ... |
|
2085
|
|
|
|
|
|
|
Retrieves orbital elements by launch date. |
|
2086
|
|
|
|
|
|
|
search_decay date ... |
|
2087
|
|
|
|
|
|
|
Retrieves orbital elements by decay date. |
|
2088
|
|
|
|
|
|
|
search_id id ... |
|
2089
|
|
|
|
|
|
|
Retrieves orbital elements by international designator. |
|
2090
|
|
|
|
|
|
|
search_name name ... |
|
2091
|
|
|
|
|
|
|
Retrieves orbital elements by satellite common name. |
|
2092
|
|
|
|
|
|
|
set attribute value ... |
|
2093
|
|
|
|
|
|
|
Sets the given attributes. Legal attributes are |
|
2094
|
|
|
|
|
|
|
addendum = extra text for the shell () banner; |
|
2095
|
|
|
|
|
|
|
banner = false to supress the shell () banner; |
|
2096
|
|
|
|
|
|
|
cookie_expires = Perl date the session cookie expires; |
|
2097
|
|
|
|
|
|
|
direct = true to fetch orbital elements directly |
|
2098
|
|
|
|
|
|
|
from a redistributer. Currently this only affects the |
|
2099
|
|
|
|
|
|
|
celestrak() method. The default is true, and it is |
|
2100
|
|
|
|
|
|
|
deprecated. |
|
2101
|
|
|
|
|
|
|
filter = true supresses all output to stdout except |
|
2102
|
|
|
|
|
|
|
orbital elements; |
|
2103
|
|
|
|
|
|
|
identity = load username and password from identity file |
|
2104
|
|
|
|
|
|
|
if true and Config::Identity can be loaded; |
|
2105
|
|
|
|
|
|
|
max_range = largest range of numbers that can be re- |
|
2106
|
|
|
|
|
|
|
trieved (default: 500); |
|
2107
|
|
|
|
|
|
|
password = the Space-Track password; |
|
2108
|
|
|
|
|
|
|
session_cookie = the text of the session cookie; |
|
2109
|
|
|
|
|
|
|
username = the Space-Track username; |
|
2110
|
|
|
|
|
|
|
verbose = true for verbose catalog error messages; |
|
2111
|
|
|
|
|
|
|
webcmd = command to launch a URL (for web-based help); |
|
2112
|
|
|
|
|
|
|
with_name = true to retrieve common names as well. |
|
2113
|
|
|
|
|
|
|
The session_cookie and cookie_expires attributes should |
|
2114
|
|
|
|
|
|
|
only be set to previously-retrieved, matching values. |
|
2115
|
|
|
|
|
|
|
source filename |
|
2116
|
|
|
|
|
|
|
Executes the contents of the given file as shell commands. |
|
2117
|
|
|
|
|
|
|
spacetrack name |
|
2118
|
|
|
|
|
|
|
Retrieves the named catalog of orbital elements from |
|
2119
|
|
|
|
|
|
|
Space Track. |
|
2120
|
|
|
|
|
|
|
The shell supports a pseudo-redirection of standard output, |
|
2121
|
|
|
|
|
|
|
using the usual Unix shell syntax (i.e. '>output_file'). |
|
2122
|
|
|
|
|
|
|
EOD |
|
2123
|
1
|
|
|
|
|
51
|
$self->_add_pragmata($resp, |
|
2124
|
|
|
|
|
|
|
'spacetrack-type' => 'help', |
|
2125
|
|
|
|
|
|
|
); |
|
2126
|
1
|
|
|
|
|
3
|
$self->__dump_response( $resp ); |
|
2127
|
1
|
|
|
|
|
5
|
return $resp; |
|
2128
|
|
|
|
|
|
|
} |
|
2129
|
|
|
|
|
|
|
} |
|
2130
|
|
|
|
|
|
|
|
|
2131
|
|
|
|
|
|
|
|
|
2132
|
|
|
|
|
|
|
=for html |
|
2133
|
|
|
|
|
|
|
|
|
2134
|
|
|
|
|
|
|
=item $resp = $st->iridium_status ($format); |
|
2135
|
|
|
|
|
|
|
|
|
2136
|
|
|
|
|
|
|
This method queries its sources of Iridium status, returning an |
|
2137
|
|
|
|
|
|
|
HTTP::Response object containing the relevant data (if all queries |
|
2138
|
|
|
|
|
|
|
succeeded) or the status of the first failure. If the queries succeed, |
|
2139
|
|
|
|
|
|
|
the content is a series of lines formatted by "%6d %-15s%-8s %s\n", |
|
2140
|
|
|
|
|
|
|
with NORAD ID, name, status, and comment substituted in. |
|
2141
|
|
|
|
|
|
|
|
|
2142
|
|
|
|
|
|
|
If no format is specified, the format specified in the |
|
2143
|
|
|
|
|
|
|
C attribute is used. |
|
2144
|
|
|
|
|
|
|
|
|
2145
|
|
|
|
|
|
|
There is one option, C<'raw'>, which can be specified either |
|
2146
|
|
|
|
|
|
|
command-line style (i.e. C<-raw>) or as a leading hash reference. |
|
2147
|
|
|
|
|
|
|
Asserting this option causes status information from sources other than |
|
2148
|
|
|
|
|
|
|
Celestrak and Rod Sladen not to be supplemented by Celestrak data. In |
|
2149
|
|
|
|
|
|
|
addition, it prevents all sources from being supplemented by canned data |
|
2150
|
|
|
|
|
|
|
that includes all original-design Iridium satellites, including those |
|
2151
|
|
|
|
|
|
|
that have decayed. By default this option is not asserted. |
|
2152
|
|
|
|
|
|
|
|
|
2153
|
|
|
|
|
|
|
Format C<'mccants'> is B, and throws an exception as of |
|
2154
|
|
|
|
|
|
|
version 0.137. This entire method will be deprecated and removed once |
|
2155
|
|
|
|
|
|
|
the last flaring Iridium satellite is removed from service. |
|
2156
|
|
|
|
|
|
|
|
|
2157
|
|
|
|
|
|
|
A Space Track username and password are required only if the format is |
|
2158
|
|
|
|
|
|
|
C<'spacetrack'>. |
|
2159
|
|
|
|
|
|
|
|
|
2160
|
|
|
|
|
|
|
If this method succeeds, the response will contain headers |
|
2161
|
|
|
|
|
|
|
|
|
2162
|
|
|
|
|
|
|
Pragma: spacetrack-type = iridium_status |
|
2163
|
|
|
|
|
|
|
Pragma: spacetrack-source = |
|
2164
|
|
|
|
|
|
|
|
|
2165
|
|
|
|
|
|
|
The spacetrack-source will be C<'kelso'>, C<'sladen'>, or |
|
2166
|
|
|
|
|
|
|
C<'spacetrack'>, depending on the format requested. |
|
2167
|
|
|
|
|
|
|
|
|
2168
|
|
|
|
|
|
|
These can be accessed by C<< $st->content_type( $resp ) >> and |
|
2169
|
|
|
|
|
|
|
C<< $st->content_source( $resp ) >> respectively. |
|
2170
|
|
|
|
|
|
|
|
|
2171
|
|
|
|
|
|
|
The source of the data and, to a certain extent, the format of the |
|
2172
|
|
|
|
|
|
|
results is determined by the optional $format argument, which defaults |
|
2173
|
|
|
|
|
|
|
to the value of the C attribute. |
|
2174
|
|
|
|
|
|
|
|
|
2175
|
|
|
|
|
|
|
If the format is 'kelso', only Dr. Kelso's Celestrak web site |
|
2176
|
|
|
|
|
|
|
(L) is queried for |
|
2177
|
|
|
|
|
|
|
the data. The possible status values are documented at |
|
2178
|
|
|
|
|
|
|
L, and repeated here for |
|
2179
|
|
|
|
|
|
|
convenience: |
|
2180
|
|
|
|
|
|
|
|
|
2181
|
|
|
|
|
|
|
'[+]' - Operational |
|
2182
|
|
|
|
|
|
|
'[-]' - Nonoperational |
|
2183
|
|
|
|
|
|
|
'[P]' - Partially Operational |
|
2184
|
|
|
|
|
|
|
'[B]' - Backup/Standby |
|
2185
|
|
|
|
|
|
|
'[S]' - Spare |
|
2186
|
|
|
|
|
|
|
'[X]' - Extended Mission |
|
2187
|
|
|
|
|
|
|
'[D]' - Decayed |
|
2188
|
|
|
|
|
|
|
'[?]' - Unknown |
|
2189
|
|
|
|
|
|
|
|
|
2190
|
|
|
|
|
|
|
The comment will be 'Spare', 'Tumbling', or '' depending on the status. |
|
2191
|
|
|
|
|
|
|
|
|
2192
|
|
|
|
|
|
|
In addition, the data from Celestrak may contain the following |
|
2193
|
|
|
|
|
|
|
status: |
|
2194
|
|
|
|
|
|
|
|
|
2195
|
|
|
|
|
|
|
'dum' - Dummy mass |
|
2196
|
|
|
|
|
|
|
|
|
2197
|
|
|
|
|
|
|
A blank status indicates that the satellite is in service and |
|
2198
|
|
|
|
|
|
|
therefore capable of producing flares. |
|
2199
|
|
|
|
|
|
|
|
|
2200
|
|
|
|
|
|
|
If the format is 'sladen', the primary source of information will be Rod |
|
2201
|
|
|
|
|
|
|
Sladen's "Iridium Constellation Status" web page, |
|
2202
|
|
|
|
|
|
|
L, which gives status on all |
|
2203
|
|
|
|
|
|
|
Iridium satellites, but no OID. The Celestrak list will be used to |
|
2204
|
|
|
|
|
|
|
provide OIDs for Iridium satellite numbers, so that a complete list is |
|
2205
|
|
|
|
|
|
|
generated. Mr. Sladen's page simply lists operational and failed |
|
2206
|
|
|
|
|
|
|
satellites in each plane, so this software imposes Kelso-style statuses |
|
2207
|
|
|
|
|
|
|
on the data. That is to say, operational satellites will be marked |
|
2208
|
|
|
|
|
|
|
'[+]', spares will be marked '[S]', and failed satellites will be |
|
2209
|
|
|
|
|
|
|
marked '[-]', with the corresponding portable statuses. As of version |
|
2210
|
|
|
|
|
|
|
0.035, all failed satellites will be marked '[-]'. Previous to this |
|
2211
|
|
|
|
|
|
|
release, failed satellites not specifically marked as tumbling were |
|
2212
|
|
|
|
|
|
|
considered spares. |
|
2213
|
|
|
|
|
|
|
|
|
2214
|
|
|
|
|
|
|
The comment field in 'sladen' format data will contain the orbital plane |
|
2215
|
|
|
|
|
|
|
designation for the satellite, 'Plane n' with 'n' being a number from 1 |
|
2216
|
|
|
|
|
|
|
to 6. If the satellite is failed but not tumbling, the text ' - Failed |
|
2217
|
|
|
|
|
|
|
on station?' will be appended to the comment. The dummy masses will be |
|
2218
|
|
|
|
|
|
|
included from the Kelso data, with status '[-]' but comment 'Dummy'. |
|
2219
|
|
|
|
|
|
|
|
|
2220
|
|
|
|
|
|
|
If the format is 'spacetrack', the data come from both Celestrak and |
|
2221
|
|
|
|
|
|
|
Space Track. For any given OID, we take the Space Track data if it shows |
|
2222
|
|
|
|
|
|
|
the OID as being decayed, or if the OID does not appear in the Celestrak |
|
2223
|
|
|
|
|
|
|
data; otherwise we take the Celestrak data. The idea here is to get a |
|
2224
|
|
|
|
|
|
|
list of statuses that include decayed satellites dropped from the |
|
2225
|
|
|
|
|
|
|
Celestrak list. You will need a Space Track username and password for |
|
2226
|
|
|
|
|
|
|
this. The format of the returned data is the same as for Celestrak data. |
|
2227
|
|
|
|
|
|
|
|
|
2228
|
|
|
|
|
|
|
If the method is called in list context, the first element of the |
|
2229
|
|
|
|
|
|
|
returned list will be the HTTP::Response object, and the second |
|
2230
|
|
|
|
|
|
|
element will be a reference to a list of anonymous lists, each |
|
2231
|
|
|
|
|
|
|
containing [$id, $name, $status, $comment, $portable_status] for |
|
2232
|
|
|
|
|
|
|
an Iridium satellite. The portable statuses are: |
|
2233
|
|
|
|
|
|
|
|
|
2234
|
|
|
|
|
|
|
0 = BODY_STATUS_IS_OPERATIONAL means object is operational, |
|
2235
|
|
|
|
|
|
|
and capable of producing predictable flares; |
|
2236
|
|
|
|
|
|
|
1 = BODY_STATUS_IS_SPARE means object is a spare or |
|
2237
|
|
|
|
|
|
|
otherwise not in regular service, but is controlled |
|
2238
|
|
|
|
|
|
|
and may be capable of producing predictable flares; |
|
2239
|
|
|
|
|
|
|
2 = BODY_STATUS_IS_TUMBLING means object is tumbling |
|
2240
|
|
|
|
|
|
|
or otherwise unservicable, and incapable of producing |
|
2241
|
|
|
|
|
|
|
predictable flares |
|
2242
|
|
|
|
|
|
|
3 - BODY_STATUS_IS_DECAYED neans that the object is decayed. |
|
2243
|
|
|
|
|
|
|
|
|
2244
|
|
|
|
|
|
|
In terms of the Kelso statuses, the mapping is: |
|
2245
|
|
|
|
|
|
|
|
|
2246
|
|
|
|
|
|
|
'[+]' - BODY_STATUS_IS_OPERATIONAL |
|
2247
|
|
|
|
|
|
|
'[-]' - BODY_STATUS_IS_TUMBLING |
|
2248
|
|
|
|
|
|
|
'[P]' - BODY_STATUS_IS_SPARE |
|
2249
|
|
|
|
|
|
|
'[B]' - BODY_STATUS_IS_SPARE |
|
2250
|
|
|
|
|
|
|
'[S]' - BODY_STATUS_IS_SPARE |
|
2251
|
|
|
|
|
|
|
'[X]' - BODY_STATUS_IS_SPARE |
|
2252
|
|
|
|
|
|
|
'[D]' - BODY_STATUS_IS_DECAYED |
|
2253
|
|
|
|
|
|
|
'[?]' - BODY_STATUS_IS_TUMBLING |
|
2254
|
|
|
|
|
|
|
|
|
2255
|
|
|
|
|
|
|
The BODY_STATUS constants are exportable using the :status tag. |
|
2256
|
|
|
|
|
|
|
|
|
2257
|
|
|
|
|
|
|
=cut |
|
2258
|
|
|
|
|
|
|
|
|
2259
|
|
|
|
|
|
|
{ # Begin local symbol block. |
|
2260
|
|
|
|
|
|
|
|
|
2261
|
10
|
|
|
10
|
|
96
|
use constant BODY_STATUS_IS_OPERATIONAL => 0; |
|
|
10
|
|
|
|
|
23
|
|
|
|
10
|
|
|
|
|
586
|
|
|
2262
|
10
|
|
|
10
|
|
69
|
use constant BODY_STATUS_IS_SPARE => 1; |
|
|
10
|
|
|
|
|
22
|
|
|
|
10
|
|
|
|
|
569
|
|
|
2263
|
10
|
|
|
10
|
|
69
|
use constant BODY_STATUS_IS_TUMBLING => 2; |
|
|
10
|
|
|
|
|
19
|
|
|
|
10
|
|
|
|
|
580
|
|
|
2264
|
10
|
|
|
10
|
|
69
|
use constant BODY_STATUS_IS_DECAYED => 3; |
|
|
10
|
|
|
|
|
19
|
|
|
|
10
|
|
|
|
|
81729
|
|
|
2265
|
|
|
|
|
|
|
|
|
2266
|
|
|
|
|
|
|
my %kelso_comment = ( # Expand Kelso status. |
|
2267
|
|
|
|
|
|
|
'[S]' => 'Spare', |
|
2268
|
|
|
|
|
|
|
'[-]' => 'Tumbling', |
|
2269
|
|
|
|
|
|
|
'[D]' => 'Decayed', |
|
2270
|
|
|
|
|
|
|
); |
|
2271
|
|
|
|
|
|
|
my %status_portable = ( # Map statuses to portable. |
|
2272
|
|
|
|
|
|
|
kelso => { |
|
2273
|
|
|
|
|
|
|
'' => BODY_STATUS_IS_OPERATIONAL, |
|
2274
|
|
|
|
|
|
|
'[+]' => BODY_STATUS_IS_OPERATIONAL, # Operational |
|
2275
|
|
|
|
|
|
|
'[-]' => BODY_STATUS_IS_TUMBLING, # Nonoperational |
|
2276
|
|
|
|
|
|
|
'[P]' => BODY_STATUS_IS_SPARE, # Partially Operational |
|
2277
|
|
|
|
|
|
|
'[B]' => BODY_STATUS_IS_SPARE, # Backup/Standby |
|
2278
|
|
|
|
|
|
|
'[S]' => BODY_STATUS_IS_SPARE, # Spare |
|
2279
|
|
|
|
|
|
|
'[X]' => BODY_STATUS_IS_SPARE, # Extended Mission |
|
2280
|
|
|
|
|
|
|
'[D]' => BODY_STATUS_IS_DECAYED, # Decayed |
|
2281
|
|
|
|
|
|
|
'[?]' => BODY_STATUS_IS_TUMBLING, # Unknown |
|
2282
|
|
|
|
|
|
|
}, |
|
2283
|
|
|
|
|
|
|
# sladen => undef, # Not needed; done programmatically. |
|
2284
|
|
|
|
|
|
|
); |
|
2285
|
|
|
|
|
|
|
|
|
2286
|
|
|
|
|
|
|
$status_portable{kelso_inverse} = { |
|
2287
|
|
|
|
|
|
|
map { $status_portable{kelso}{$_} => $_ } qw{ [-] [S] [+] } }; |
|
2288
|
|
|
|
|
|
|
|
|
2289
|
|
|
|
|
|
|
# All Iridium Classic satellites. The order of the data is: |
|
2290
|
|
|
|
|
|
|
# OID, name, status string, comment, portable status. |
|
2291
|
|
|
|
|
|
|
# |
|
2292
|
|
|
|
|
|
|
# Generated by tools/all_iridium_classic -indent=4 |
|
2293
|
|
|
|
|
|
|
# on Sun May 31 12:27:10 2020 GMT |
|
2294
|
|
|
|
|
|
|
|
|
2295
|
|
|
|
|
|
|
my @all_iridium_classic = ( |
|
2296
|
|
|
|
|
|
|
[ 24792, 'Iridium 8', '[D]', 'Decayed 2017-11-24', 3 ], |
|
2297
|
|
|
|
|
|
|
[ 24793, 'Iridium 7', '[?]', 'SpaceTrack', 2 ], |
|
2298
|
|
|
|
|
|
|
[ 24794, 'Iridium 6', '[D]', 'Decayed 2017-12-23', 3 ], |
|
2299
|
|
|
|
|
|
|
[ 24795, 'Iridium 5', '[?]', 'SpaceTrack', 2 ], |
|
2300
|
|
|
|
|
|
|
[ 24796, 'Iridium 4', '[?]', 'SpaceTrack', 2 ], |
|
2301
|
|
|
|
|
|
|
[ 24836, 'Iridium 914', '[?]', 'SpaceTrack', 2 ], |
|
2302
|
|
|
|
|
|
|
[ 24837, 'Iridium 12', '[D]', 'Decayed 2018-09-02', 3 ], |
|
2303
|
|
|
|
|
|
|
[ 24838, 'Iridium 9', '[D]', 'Decayed 2003-03-11', 3 ], |
|
2304
|
|
|
|
|
|
|
[ 24839, 'Iridium 10', '[D]', 'Decayed 2018-10-06', 3 ], |
|
2305
|
|
|
|
|
|
|
[ 24840, 'Iridium 13', '[D]', 'Decayed 2018-04-29', 3 ], |
|
2306
|
|
|
|
|
|
|
[ 24841, 'Iridium 16', '[?]', 'SpaceTrack', 2 ], |
|
2307
|
|
|
|
|
|
|
[ 24842, 'Iridium 911', '[?]', 'SpaceTrack', 2 ], |
|
2308
|
|
|
|
|
|
|
[ 24869, 'Iridium 15', '[D]', 'Decayed 2018-10-14', 3 ], |
|
2309
|
|
|
|
|
|
|
[ 24870, 'Iridium 17', '[?]', 'SpaceTrack', 2 ], |
|
2310
|
|
|
|
|
|
|
[ 24871, 'Iridium 920', '[?]', 'SpaceTrack', 2 ], |
|
2311
|
|
|
|
|
|
|
[ 24872, 'Iridium 18', '[D]', 'Decayed 2018-08-19', 3 ], |
|
2312
|
|
|
|
|
|
|
[ 24873, 'Iridium 921', '[?]', 'SpaceTrack', 2 ], |
|
2313
|
|
|
|
|
|
|
[ 24903, 'Iridium 26', '[?]', 'SpaceTrack', 2 ], |
|
2314
|
|
|
|
|
|
|
[ 24904, 'Iridium 25', '[D]', 'Decayed 2018-05-14', 3 ], |
|
2315
|
|
|
|
|
|
|
[ 24905, 'Iridium 46', '[D]', 'Decayed 2019-05-11', 3 ], |
|
2316
|
|
|
|
|
|
|
[ 24906, 'Iridium 23', '[D]', 'Decayed 2018-03-28', 3 ], |
|
2317
|
|
|
|
|
|
|
[ 24907, 'Iridium 22', '[?]', 'SpaceTrack', 2 ], |
|
2318
|
|
|
|
|
|
|
[ 24944, 'Iridium 29', '[?]', 'SpaceTrack', 2 ], |
|
2319
|
|
|
|
|
|
|
[ 24945, 'Iridium 32', '[D]', 'Decayed 2019-03-10', 3 ], |
|
2320
|
|
|
|
|
|
|
[ 24946, 'Iridium 33', '[?]', 'SpaceTrack', 2 ], |
|
2321
|
|
|
|
|
|
|
[ 24947, 'Iridium 27', '[D]', 'Decayed 2002-02-01', 3 ], |
|
2322
|
|
|
|
|
|
|
[ 24948, 'Iridium 28', '[?]', 'SpaceTrack', 2 ], |
|
2323
|
|
|
|
|
|
|
[ 24949, 'Iridium 30', '[D]', 'Decayed 2017-09-28', 3 ], |
|
2324
|
|
|
|
|
|
|
[ 24950, 'Iridium 31', '[D]', 'Decayed 2018-12-20', 3 ], |
|
2325
|
|
|
|
|
|
|
[ 24965, 'Iridium 19', '[D]', 'Decayed 2018-04-07', 3 ], |
|
2326
|
|
|
|
|
|
|
[ 24966, 'Iridium 35', '[D]', 'Decayed 2018-12-26', 3 ], |
|
2327
|
|
|
|
|
|
|
[ 24967, 'Iridium 36', '[?]', 'SpaceTrack', 2 ], |
|
2328
|
|
|
|
|
|
|
[ 24968, 'Iridium 37', '[D]', 'Decayed 2018-05-26', 3 ], |
|
2329
|
|
|
|
|
|
|
[ 24969, 'Iridium 34', '[D]', 'Decayed 2018-01-08', 3 ], |
|
2330
|
|
|
|
|
|
|
[ 25039, 'Iridium 43', '[D]', 'Decayed 2018-02-11', 3 ], |
|
2331
|
|
|
|
|
|
|
[ 25040, 'Iridium 41', '[D]', 'Decayed 2018-07-28', 3 ], |
|
2332
|
|
|
|
|
|
|
[ 25041, 'Iridium 40', '[D]', 'Decayed 2018-09-23', 3 ], |
|
2333
|
|
|
|
|
|
|
[ 25042, 'Iridium 39', '[?]', 'SpaceTrack', 2 ], |
|
2334
|
|
|
|
|
|
|
[ 25043, 'Iridium 38', '[?]', 'SpaceTrack', 2 ], |
|
2335
|
|
|
|
|
|
|
[ 25077, 'Iridium 42', '[?]', 'SpaceTrack', 2 ], |
|
2336
|
|
|
|
|
|
|
[ 25078, 'Iridium 44', '[?]', 'SpaceTrack', 2 ], |
|
2337
|
|
|
|
|
|
|
[ 25104, 'Iridium 45', '[?]', 'SpaceTrack', 2 ], |
|
2338
|
|
|
|
|
|
|
[ 25105, 'Iridium 24', '[?]', 'SpaceTrack', 2 ], |
|
2339
|
|
|
|
|
|
|
[ 25106, 'Iridium 47', '[D]', 'Decayed 2018-09-01', 3 ], |
|
2340
|
|
|
|
|
|
|
[ 25107, 'Iridium 48', '[D]', 'Decayed 2001-05-05', 3 ], |
|
2341
|
|
|
|
|
|
|
[ 25108, 'Iridium 49', '[D]', 'Decayed 2018-02-13', 3 ], |
|
2342
|
|
|
|
|
|
|
[ 25169, 'Iridium 52', '[D]', 'Decayed 2018-11-05', 3 ], |
|
2343
|
|
|
|
|
|
|
[ 25170, 'Iridium 56', '[D]', 'Decayed 2018-10-11', 3 ], |
|
2344
|
|
|
|
|
|
|
[ 25171, 'Iridium 54', '[D]', 'Decayed 2019-05-11', 3 ], |
|
2345
|
|
|
|
|
|
|
[ 25172, 'Iridium 50', '[D]', 'Decayed 2018-09-23', 3 ], |
|
2346
|
|
|
|
|
|
|
[ 25173, 'Iridium 53', '[D]', 'Decayed 2018-09-30', 3 ], |
|
2347
|
|
|
|
|
|
|
[ 25262, 'Iridium 51', '[?]', 'SpaceTrack', 2 ], |
|
2348
|
|
|
|
|
|
|
[ 25263, 'Iridium 61', '[D]', 'Decayed 2019-07-23', 3 ], |
|
2349
|
|
|
|
|
|
|
[ 25272, 'Iridium 55', '[D]', 'Decayed 2019-03-31', 3 ], |
|
2350
|
|
|
|
|
|
|
[ 25273, 'Iridium 57', '[?]', 'SpaceTrack', 2 ], |
|
2351
|
|
|
|
|
|
|
[ 25274, 'Iridium 58', '[D]', 'Decayed 2019-04-07', 3 ], |
|
2352
|
|
|
|
|
|
|
[ 25275, 'Iridium 59', '[D]', 'Decayed 2019-03-11', 3 ], |
|
2353
|
|
|
|
|
|
|
[ 25276, 'Iridium 60', '[D]', 'Decayed 2019-03-17', 3 ], |
|
2354
|
|
|
|
|
|
|
[ 25285, 'Iridium 62', '[D]', 'Decayed 2018-11-07', 3 ], |
|
2355
|
|
|
|
|
|
|
[ 25286, 'Iridium 63', '[?]', 'SpaceTrack', 2 ], |
|
2356
|
|
|
|
|
|
|
[ 25287, 'Iridium 64', '[D]', 'Decayed 2019-04-01', 3 ], |
|
2357
|
|
|
|
|
|
|
[ 25288, 'Iridium 65', '[D]', 'Decayed 2018-07-19', 3 ], |
|
2358
|
|
|
|
|
|
|
[ 25289, 'Iridium 66', '[D]', 'Decayed 2018-08-23', 3 ], |
|
2359
|
|
|
|
|
|
|
[ 25290, 'Iridium 67', '[D]', 'Decayed 2018-07-02', 3 ], |
|
2360
|
|
|
|
|
|
|
[ 25291, 'Iridium 68', '[D]', 'Decayed 2018-06-06', 3 ], |
|
2361
|
|
|
|
|
|
|
[ 25319, 'Iridium 69', '[?]', 'SpaceTrack', 2 ], |
|
2362
|
|
|
|
|
|
|
[ 25320, 'Iridium 71', '[?]', 'SpaceTrack', 2 ], |
|
2363
|
|
|
|
|
|
|
[ 25342, 'Iridium 70', '[D]', 'Decayed 2018-10-11', 3 ], |
|
2364
|
|
|
|
|
|
|
[ 25343, 'Iridium 72', '[D]', 'Decayed 2018-05-14', 3 ], |
|
2365
|
|
|
|
|
|
|
[ 25344, 'Iridium 73', '[?]', 'SpaceTrack', 2 ], |
|
2366
|
|
|
|
|
|
|
[ 25345, 'Iridium 74', '[D]', 'Decayed 2017-06-11', 3 ], |
|
2367
|
|
|
|
|
|
|
[ 25346, 'Iridium 75', '[D]', 'Decayed 2018-07-10', 3 ], |
|
2368
|
|
|
|
|
|
|
[ 25431, 'Iridium 3', '[D]', 'Decayed 2018-02-08', 3 ], |
|
2369
|
|
|
|
|
|
|
[ 25432, 'Iridium 76', '[D]', 'Decayed 2018-08-28', 3 ], |
|
2370
|
|
|
|
|
|
|
[ 25467, 'Iridium 82', '[?]', 'SpaceTrack', 2 ], |
|
2371
|
|
|
|
|
|
|
[ 25468, 'Iridium 81', '[D]', 'Decayed 2018-07-17', 3 ], |
|
2372
|
|
|
|
|
|
|
[ 25469, 'Iridium 80', '[D]', 'Decayed 2018-08-12', 3 ], |
|
2373
|
|
|
|
|
|
|
[ 25470, 'Iridium 79', '[D]', 'Decayed 2000-11-29', 3 ], |
|
2374
|
|
|
|
|
|
|
[ 25471, 'Iridium 77', '[D]', 'Decayed 2017-09-22', 3 ], |
|
2375
|
|
|
|
|
|
|
[ 25527, 'Iridium 2', '[?]', 'SpaceTrack', 2 ], |
|
2376
|
|
|
|
|
|
|
[ 25528, 'Iridium 86', '[D]', 'Decayed 2018-10-05', 3 ], |
|
2377
|
|
|
|
|
|
|
[ 25529, 'Iridium 85', '[D]', 'Decayed 2000-12-30', 3 ], |
|
2378
|
|
|
|
|
|
|
[ 25530, 'Iridium 84', '[D]', 'Decayed 2018-11-04', 3 ], |
|
2379
|
|
|
|
|
|
|
[ 25531, 'Iridium 83', '[D]', 'Decayed 2018-11-05', 3 ], |
|
2380
|
|
|
|
|
|
|
[ 25577, 'Iridium 20', '[D]', 'Decayed 2018-10-22', 3 ], |
|
2381
|
|
|
|
|
|
|
[ 25578, 'Iridium 11', '[D]', 'Decayed 2018-10-22', 3 ], |
|
2382
|
|
|
|
|
|
|
[ 25777, 'Iridium 14', '[D]', 'Decayed 2019-03-15', 3 ], |
|
2383
|
|
|
|
|
|
|
[ 25778, 'Iridium 21', '[D]', 'Decayed 2018-05-24', 3 ], |
|
2384
|
|
|
|
|
|
|
[ 27372, 'Iridium 91', '[D]', 'Decayed 2019-03-13', 3 ], |
|
2385
|
|
|
|
|
|
|
[ 27373, 'Iridium 90', '[D]', 'Decayed 2019-01-23', 3 ], |
|
2386
|
|
|
|
|
|
|
[ 27374, 'Iridium 94', '[D]', 'Decayed 2018-04-18', 3 ], |
|
2387
|
|
|
|
|
|
|
[ 27375, 'Iridium 95', '[D]', 'Decayed 2019-03-25', 3 ], |
|
2388
|
|
|
|
|
|
|
[ 27376, 'Iridium 96', '[D]', 'Decayed 2020-05-30', 3 ], |
|
2389
|
|
|
|
|
|
|
[ 27450, 'Iridium 97', '[D]', 'Decayed 2019-12-27', 3 ], |
|
2390
|
|
|
|
|
|
|
[ 27451, 'Iridium 98', '[D]', 'Decayed 2018-08-24', 3 ], |
|
2391
|
|
|
|
|
|
|
); |
|
2392
|
|
|
|
|
|
|
|
|
2393
|
|
|
|
|
|
|
my %ignore_raw = map { $_ => 1 } qw{ kelso sladen }; |
|
2394
|
|
|
|
|
|
|
|
|
2395
|
|
|
|
|
|
|
# Called dynamically |
|
2396
|
|
|
|
|
|
|
sub _iridium_status_opts { ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) |
|
2397
|
|
|
|
|
|
|
return [ |
|
2398
|
2
|
|
|
2
|
|
12
|
'raw!' => 'Do not supplement with kelso data' |
|
2399
|
|
|
|
|
|
|
]; |
|
2400
|
|
|
|
|
|
|
} |
|
2401
|
|
|
|
|
|
|
|
|
2402
|
|
|
|
|
|
|
sub iridium_status { |
|
2403
|
2
|
|
|
2
|
1
|
12
|
my ( $self, @args ) = @_; |
|
2404
|
2
|
|
|
|
|
13
|
my ( $opt, $fmt ) = _parse_args( @args ); |
|
2405
|
|
|
|
|
|
|
defined $fmt |
|
2406
|
2
|
50
|
|
|
|
14
|
or $fmt = $self->{iridium_status_format}; |
|
2407
|
2
|
|
|
|
|
13
|
$self->_deprecation_notice( iridium_status => $fmt ); |
|
2408
|
2
|
|
|
|
|
8
|
delete $self->{_pragmata}; |
|
2409
|
2
|
|
|
|
|
7
|
my %rslt; |
|
2410
|
|
|
|
|
|
|
my $resp; |
|
2411
|
|
|
|
|
|
|
|
|
2412
|
2
|
50
|
33
|
|
|
14
|
if ( ! $opt->{raw} || $ignore_raw{$fmt} ) { |
|
2413
|
2
|
|
|
|
|
13
|
$resp = $self->_iridium_status_kelso( $fmt, \%rslt ); |
|
2414
|
2
|
50
|
|
|
|
15
|
$resp->is_success() |
|
2415
|
|
|
|
|
|
|
or return $resp; |
|
2416
|
|
|
|
|
|
|
} |
|
2417
|
|
|
|
|
|
|
|
|
2418
|
2
|
100
|
|
|
|
39
|
unless ( 'kelso' eq $fmt ) { |
|
2419
|
1
|
50
|
|
|
|
19
|
my $code = $self->can( "_iridium_status_$fmt" ) |
|
2420
|
|
|
|
|
|
|
or Carp::croak "Bad iridium_status format '$fmt'"; |
|
2421
|
1
|
50
|
|
|
|
9
|
( $resp = $code->( $self, $fmt, \%rslt ) )->is_success() |
|
2422
|
|
|
|
|
|
|
or return $resp; |
|
2423
|
|
|
|
|
|
|
} |
|
2424
|
|
|
|
|
|
|
|
|
2425
|
2
|
50
|
|
|
|
25
|
unless ( $opt->{raw} ) { |
|
2426
|
2
|
|
|
|
|
11
|
foreach my $body ( @all_iridium_classic ) { |
|
2427
|
190
|
100
|
66
|
|
|
512
|
$rslt{$body->[0]} |
|
2428
|
|
|
|
|
|
|
and $body->[4] != BODY_STATUS_IS_DECAYED |
|
2429
|
|
|
|
|
|
|
and next; |
|
2430
|
132
|
|
|
|
|
184
|
$rslt{$body->[0]} = [ @{ $body } ]; # shallow clone |
|
|
132
|
|
|
|
|
497
|
|
|
2431
|
|
|
|
|
|
|
} |
|
2432
|
|
|
|
|
|
|
} |
|
2433
|
|
|
|
|
|
|
|
|
2434
|
|
|
|
|
|
|
$resp->content (join '', map { |
|
2435
|
194
|
|
|
|
|
302
|
sprintf "%6d %-15s%-8s %s\n", @{$rslt{$_}}[0 .. 3]} |
|
|
194
|
|
|
|
|
666
|
|
|
2436
|
2
|
|
|
|
|
38
|
sort {$a <=> $b} keys %rslt); |
|
|
1065
|
|
|
|
|
1364
|
|
|
2437
|
2
|
|
|
|
|
90
|
$self->_add_pragmata($resp, |
|
2438
|
|
|
|
|
|
|
'spacetrack-type' => 'iridium-status', |
|
2439
|
|
|
|
|
|
|
'spacetrack-source' => $fmt, |
|
2440
|
|
|
|
|
|
|
); |
|
2441
|
2
|
|
|
|
|
12
|
$self->__dump_response( $resp ); |
|
2442
|
|
|
|
|
|
|
return wantarray ? ($resp, [ |
|
2443
|
2
|
50
|
|
|
|
84
|
sort { $a->[0] <=> $b->[0] } |
|
|
0
|
|
|
|
|
0
|
|
|
2444
|
|
|
|
|
|
|
values %rslt |
|
2445
|
|
|
|
|
|
|
]) : $resp; |
|
2446
|
|
|
|
|
|
|
} |
|
2447
|
|
|
|
|
|
|
|
|
2448
|
|
|
|
|
|
|
# Get Iridium data from Celestrak. |
|
2449
|
|
|
|
|
|
|
sub _iridium_status_kelso { |
|
2450
|
|
|
|
|
|
|
# my ( $self, $fmt, $rslt ) = @_; |
|
2451
|
2
|
|
|
2
|
|
9
|
my ( $self, undef, $rslt ) = @_; # $fmt only relevant to mccants |
|
2452
|
2
|
|
|
|
|
14
|
my $resp = $self->_get_agent()->get( |
|
2453
|
|
|
|
|
|
|
$self->getv( 'url_iridium_status_kelso' ) |
|
2454
|
|
|
|
|
|
|
); |
|
2455
|
2
|
50
|
|
|
|
1166603
|
$resp->is_success or return $resp; |
|
2456
|
2
|
|
|
|
|
74
|
foreach my $buffer (split '\n', $resp->content) { |
|
2457
|
62
|
|
|
|
|
378
|
$buffer =~ s/ \s+ \z //smx; |
|
2458
|
62
|
|
|
|
|
355
|
my $id = substr ($buffer, 0, 5) + 0; |
|
2459
|
62
|
|
|
|
|
149
|
my $name = substr ($buffer, 5); |
|
2460
|
62
|
|
|
|
|
132
|
my $status = ''; |
|
2461
|
62
|
50
|
|
|
|
383
|
$name =~ s/ \s+ ( [[] .+? []] ) \s* \z //smx |
|
2462
|
|
|
|
|
|
|
and $status = $1; |
|
2463
|
62
|
|
|
|
|
182
|
my $portable_status = $status_portable{kelso}{$status}; |
|
2464
|
62
|
|
50
|
|
|
176
|
my $comment = $kelso_comment{$status} || ''; |
|
2465
|
62
|
|
|
|
|
151
|
$name = ucfirst lc $name; |
|
2466
|
62
|
|
|
|
|
357
|
$rslt->{$id} = [ $id, $name, $status, $comment, |
|
2467
|
|
|
|
|
|
|
$portable_status ]; |
|
2468
|
|
|
|
|
|
|
} |
|
2469
|
2
|
|
|
|
|
18
|
return $resp; |
|
2470
|
|
|
|
|
|
|
} |
|
2471
|
|
|
|
|
|
|
|
|
2472
|
|
|
|
|
|
|
# Mung an Iridium status hash to assume all actual Iridium |
|
2473
|
|
|
|
|
|
|
# satellites are good. This is used to prevent bleed-through from |
|
2474
|
|
|
|
|
|
|
# Kelso to McCants, since the latter only reports by exception. |
|
2475
|
|
|
|
|
|
|
sub _iridium_status_assume_good { |
|
2476
|
1
|
|
|
1
|
|
5
|
my ( undef, $rslt ) = @_; # Invocant unused |
|
2477
|
|
|
|
|
|
|
|
|
2478
|
1
|
|
|
|
|
4
|
foreach my $val ( values %{ $rslt } ) { |
|
|
1
|
|
|
|
|
9
|
|
|
2479
|
31
|
100
|
|
|
|
135
|
$val->[1] =~ m/ \A iridium \b /smxi |
|
2480
|
|
|
|
|
|
|
or next; |
|
2481
|
29
|
|
|
|
|
82
|
$val->[2] = ''; |
|
2482
|
29
|
|
|
|
|
75
|
$val->[4] = BODY_STATUS_IS_OPERATIONAL; |
|
2483
|
|
|
|
|
|
|
} |
|
2484
|
|
|
|
|
|
|
|
|
2485
|
1
|
|
|
|
|
5
|
return; |
|
2486
|
|
|
|
|
|
|
} |
|
2487
|
|
|
|
|
|
|
|
|
2488
|
|
|
|
|
|
|
my %sladen_interpret_detail = ( |
|
2489
|
|
|
|
|
|
|
'' => sub { |
|
2490
|
|
|
|
|
|
|
my ( $rslt, $id, $name, $plane ) = @_; |
|
2491
|
|
|
|
|
|
|
$rslt->{$id} = [ $id, $name, '[-]', |
|
2492
|
|
|
|
|
|
|
"$plane - Failed on station?", |
|
2493
|
|
|
|
|
|
|
BODY_STATUS_IS_TUMBLING ]; |
|
2494
|
|
|
|
|
|
|
return; |
|
2495
|
|
|
|
|
|
|
}, |
|
2496
|
|
|
|
|
|
|
d => sub { |
|
2497
|
|
|
|
|
|
|
return; |
|
2498
|
|
|
|
|
|
|
}, |
|
2499
|
|
|
|
|
|
|
t => sub { |
|
2500
|
|
|
|
|
|
|
my ( $rslt, $id, $name, $plane ) = @_; |
|
2501
|
|
|
|
|
|
|
$rslt->{$id} = [ $id, $name, '[-]', $plane, |
|
2502
|
|
|
|
|
|
|
BODY_STATUS_IS_TUMBLING ]; |
|
2503
|
|
|
|
|
|
|
}, |
|
2504
|
|
|
|
|
|
|
); |
|
2505
|
|
|
|
|
|
|
|
|
2506
|
|
|
|
|
|
|
# Get Iridium status from Rod Sladen. Called dynamically |
|
2507
|
|
|
|
|
|
|
sub _iridium_status_sladen { ## no critic (ProhibitUnusedPrivateSubroutines) |
|
2508
|
1
|
|
|
1
|
|
7
|
my ( $self, undef, $rslt ) = @_; # $fmt arg not used |
|
2509
|
|
|
|
|
|
|
|
|
2510
|
1
|
|
|
|
|
9
|
$self->_iridium_status_assume_good( $rslt ); |
|
2511
|
1
|
|
|
|
|
11
|
my $resp = $self->_get_agent()->get( |
|
2512
|
|
|
|
|
|
|
$self->getv( 'url_iridium_status_sladen' ) |
|
2513
|
|
|
|
|
|
|
); |
|
2514
|
1
|
50
|
|
|
|
109705
|
$resp->is_success or return $resp; |
|
2515
|
1
|
|
|
|
|
16
|
my %oid; |
|
2516
|
|
|
|
|
|
|
my %dummy; |
|
2517
|
1
|
|
|
|
|
4
|
foreach my $id (keys %{ $rslt } ) { |
|
|
1
|
|
|
|
|
11
|
|
|
2518
|
31
|
100
|
|
|
|
93
|
$rslt->{$id}[1] =~ m/ dummy /smxi and do { |
|
2519
|
2
|
|
|
|
|
7
|
$dummy{$id} = $rslt->{$id}; |
|
2520
|
2
|
|
|
|
|
6
|
$dummy{$id}[3] = 'Dummy'; |
|
2521
|
2
|
|
|
|
|
5
|
next; |
|
2522
|
|
|
|
|
|
|
}; |
|
2523
|
29
|
50
|
|
|
|
83
|
$rslt->{$id}[1] =~ m/ (\d+) /smx or next; |
|
2524
|
29
|
|
|
|
|
88
|
$oid{+$1} = $id; |
|
2525
|
|
|
|
|
|
|
} |
|
2526
|
1
|
|
|
|
|
6
|
%{ $rslt } = %dummy; |
|
|
1
|
|
|
|
|
26
|
|
|
2527
|
|
|
|
|
|
|
|
|
2528
|
1
|
|
|
|
|
3
|
my $fail; |
|
2529
|
1
|
|
|
|
|
9
|
my $re = qr{ ( [\d/]+) }smx; |
|
2530
|
1
|
|
|
|
|
7
|
local $_ = $resp->content; |
|
2531
|
|
|
|
|
|
|
#### s{ .*? }{}smxgi; # Strip emphasis notes |
|
2532
|
1
|
|
|
|
|
876
|
s/ < .*? > //smxg; # Strip markup |
|
2533
|
|
|
|
|
|
|
# Parenthesized numbers are assumed to represent tumbling |
|
2534
|
|
|
|
|
|
|
# satellites in the in-service or spare grids. |
|
2535
|
1
|
|
|
|
|
7
|
my %exception; |
|
2536
|
|
|
|
|
|
|
{ |
|
2537
|
|
|
|
|
|
|
# 23-Nov-2017 update double-parenthesized 6. |
|
2538
|
1
|
|
|
|
|
5
|
s< [(]+ (\d+) [)]+ > |
|
|
1
|
|
|
|
|
286
|
|
|
|
0
|
|
|
|
|
0
|
|
|
|
0
|
|
|
|
|
0
|
|
|
2539
|
|
|
|
|
|
|
< $exception{$1} = BODY_STATUS_IS_TUMBLING; $1>smxge; |
|
2540
|
1
|
|
|
|
|
772
|
} |
|
2541
|
1
|
|
|
|
|
339
|
s/ [(] .*? [)\n] //smxg; # Strip parenthetical comments |
|
2542
|
81
|
100
|
|
|
|
255
|
foreach ( split qr{ \n }smx ) { |
|
|
|
100
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
2543
|
1
|
|
|
|
|
2
|
if (m/ < -+ \s+ failed \s+ (?: or \s+ retired \s+ )? -+ > /smxi) { |
|
2544
|
1
|
|
|
|
|
6
|
$fail++; |
|
2545
|
|
|
|
|
|
|
$re = qr{ (\d+) (\w?) }smx; |
|
2546
|
12
|
|
|
|
|
29
|
} elsif ( s/ \A \s* ( plane \s+ \d+ ) \s* : \s* //smxi ) { |
|
2547
|
|
|
|
|
|
|
my $plane = $1; |
|
2548
|
12
|
|
|
|
|
69
|
## s/ \A \D+ //smx; # Strip leading non-digits |
|
2549
|
12
|
|
|
|
|
65
|
s/ \b [[:alpha:]] .* //smx; # Strip trailing comments |
|
2550
|
12
|
|
|
|
|
23
|
s/ \s+ \z //smx; # Strip trailing whitespace |
|
2551
|
12
|
|
|
|
|
129
|
my $inx = 0; # First 11 functional are in service |
|
2552
|
169
|
|
|
|
|
343
|
while (m/ $re /smxg) { |
|
2553
|
169
|
|
|
|
|
245
|
my $num_list = $1; |
|
2554
|
169
|
|
|
|
|
566
|
my $detail = $2; |
|
2555
|
170
|
|
|
|
|
363
|
foreach my $num ( split qr{ / }smx, $num_list ) { |
|
2556
|
170
|
100
|
|
|
|
366
|
$num = $num + 0; # Numify. |
|
2557
|
|
|
|
|
|
|
my $id = $oid{$num} or do { |
|
2558
|
|
|
|
|
|
|
# This is normal for decayed satellites or Iridium |
|
2559
|
|
|
|
|
|
|
# NEXT. |
|
2560
|
141
|
|
|
|
|
258
|
# warn "No oid for Iridium $num\n"; |
|
2561
|
|
|
|
|
|
|
next; |
|
2562
|
29
|
|
|
|
|
54
|
}; |
|
2563
|
29
|
50
|
|
|
|
52
|
my $name = "Iridium $num"; |
|
2564
|
|
|
|
|
|
|
if ($fail) { |
|
2565
|
29
|
|
33
|
|
|
58
|
my $interp = $sladen_interpret_detail{$detail} |
|
2566
|
29
|
|
|
|
|
57
|
|| $sladen_interpret_detail{''}; |
|
2567
|
|
|
|
|
|
|
$interp->( $rslt, $id, $name, $plane ); |
|
2568
|
0
|
0
|
|
|
|
0
|
} else { |
|
2569
|
|
|
|
|
|
|
my $status = $inx > 10 ? |
|
2570
|
|
|
|
|
|
|
BODY_STATUS_IS_SPARE : |
|
2571
|
|
|
|
|
|
|
BODY_STATUS_IS_OPERATIONAL; |
|
2572
|
0
|
0
|
|
|
|
0
|
exists $exception{$num} |
|
2573
|
|
|
|
|
|
|
and $status = $exception{$num}; |
|
2574
|
0
|
|
|
|
|
0
|
$rslt->{$id} = [ $id, $name, |
|
2575
|
|
|
|
|
|
|
$status_portable{kelso_inverse}{$status}, |
|
2576
|
|
|
|
|
|
|
$plane, $status ]; |
|
2577
|
|
|
|
|
|
|
} |
|
2578
|
|
|
|
|
|
|
} |
|
2579
|
169
|
|
|
|
|
730
|
} continue { |
|
2580
|
|
|
|
|
|
|
$inx++; |
|
2581
|
|
|
|
|
|
|
} |
|
2582
|
1
|
|
|
|
|
2
|
} elsif ( m/ Notes: /smx ) { |
|
2583
|
|
|
|
|
|
|
last; |
|
2584
|
67
|
|
|
|
|
99
|
} else { # TODO this is just for debugging. |
|
2585
|
|
|
|
|
|
|
0; |
|
2586
|
|
|
|
|
|
|
} |
|
2587
|
|
|
|
|
|
|
} |
|
2588
|
1
|
|
|
|
|
102
|
|
|
2589
|
|
|
|
|
|
|
return $resp; |
|
2590
|
|
|
|
|
|
|
} |
|
2591
|
|
|
|
|
|
|
|
|
2592
|
|
|
|
|
|
|
# FIXME in the last couple days this has started returning nothing. |
|
2593
|
|
|
|
|
|
|
# It looks like -exclude debris excludes everything, as does |
|
2594
|
|
|
|
|
|
|
# -exclude rocket. |
|
2595
|
|
|
|
|
|
|
|
|
2596
|
|
|
|
|
|
|
# Get Iridium status from Space Track. Unlike the other sources, |
|
2597
|
|
|
|
|
|
|
# Space Track does not know whether satellites are in service or |
|
2598
|
|
|
|
|
|
|
# not, but it does know about all of them, and whether or not they |
|
2599
|
|
|
|
|
|
|
# are on orbit. So the statuses we report are unknown and decayed. |
|
2600
|
|
|
|
|
|
|
# Note that the portable status for unknown is |
|
2601
|
|
|
|
|
|
|
# BODY_STATUS_IS_TUMBLING. Called dynamically |
|
2602
|
0
|
|
|
0
|
|
0
|
sub _iridium_status_spacetrack { ## no critic (ProhibitUnusedPrivateSubroutines) |
|
2603
|
|
|
|
|
|
|
my ( $self, undef, $rslt ) = @_; # $fmt arg not used |
|
2604
|
0
|
|
|
|
|
0
|
|
|
2605
|
|
|
|
|
|
|
my ( $resp, $data ) = $self->search_name( { |
|
2606
|
|
|
|
|
|
|
tle => 0, |
|
2607
|
|
|
|
|
|
|
status => 'all', |
|
2608
|
|
|
|
|
|
|
include => [ qw{ payload } ], |
|
2609
|
|
|
|
|
|
|
format => 'legacy', |
|
2610
|
0
|
0
|
|
|
|
0
|
}, 'iridium' ); |
|
2611
|
|
|
|
|
|
|
$resp->is_success() |
|
2612
|
0
|
|
|
|
|
0
|
or return $resp; |
|
|
0
|
|
|
|
|
0
|
|
|
2613
|
|
|
|
|
|
|
foreach my $body ( @{ $data } ) { |
|
2614
|
|
|
|
|
|
|
# Starting in 2017, the launches were Iridium Next |
|
2615
|
0
|
0
|
|
|
|
0
|
# satellites, which do not flare. |
|
2616
|
|
|
|
|
|
|
$body->{LAUNCH_YEAR} < 2017 |
|
2617
|
0
|
|
|
|
|
0
|
or next; |
|
2618
|
|
|
|
|
|
|
my $oid = $body->{OBJECT_NUMBER}; |
|
2619
|
|
|
|
|
|
|
$rslt->{$oid} |
|
2620
|
0
|
0
|
0
|
|
|
0
|
and not $body->{DECAY} |
|
2621
|
|
|
|
|
|
|
and next; |
|
2622
|
|
|
|
|
|
|
$rslt->{$oid} = [ |
|
2623
|
|
|
|
|
|
|
$oid, |
|
2624
|
|
|
|
|
|
|
ucfirst lc $body->{OBJECT_NAME}, |
|
2625
|
0
|
0
|
|
|
|
0
|
defined $body->{DECAY} ? |
|
2626
|
|
|
|
|
|
|
( '[D]', "Decayed $body->{DECAY}", BODY_STATUS_IS_DECAYED ) : |
|
2627
|
|
|
|
|
|
|
( '[?]', 'SpaceTrack', BODY_STATUS_IS_TUMBLING ) |
|
2628
|
|
|
|
|
|
|
]; |
|
2629
|
|
|
|
|
|
|
} |
|
2630
|
0
|
|
|
|
|
0
|
$resp->content( join '', |
|
2631
|
0
|
|
|
|
|
0
|
map { "$_->[0]\t$_->[1]\t$_->[2]\t$_->[3]\n" } |
|
2632
|
0
|
|
|
|
|
0
|
sort { $a->[0] <=> $b->[0] } |
|
|
0
|
|
|
|
|
0
|
|
|
2633
|
|
|
|
|
|
|
values %{ $rslt } |
|
2634
|
0
|
|
|
|
|
0
|
); |
|
2635
|
|
|
|
|
|
|
return $resp; |
|
2636
|
|
|
|
|
|
|
} |
|
2637
|
|
|
|
|
|
|
|
|
2638
|
|
|
|
|
|
|
} # End of local symbol block. |
|
2639
|
|
|
|
|
|
|
|
|
2640
|
|
|
|
|
|
|
=for html |
|
2641
|
|
|
|
|
|
|
|
|
2642
|
|
|
|
|
|
|
=item $resp = $st->launch_sites() |
|
2643
|
|
|
|
|
|
|
|
|
2644
|
|
|
|
|
|
|
This method returns an HTTP::Response object. If the request succeeds, |
|
2645
|
|
|
|
|
|
|
the content of the object will be the known launch sites and their |
|
2646
|
|
|
|
|
|
|
abbreviations in the desired format. If the desired format is |
|
2647
|
|
|
|
|
|
|
C<'legacy'> or C<'json'> and the method is called in list context, the |
|
2648
|
|
|
|
|
|
|
second returned item will be a reference to an array containing the |
|
2649
|
|
|
|
|
|
|
parsed data. |
|
2650
|
|
|
|
|
|
|
|
|
2651
|
|
|
|
|
|
|
This method takes the following options, specified either command-style |
|
2652
|
|
|
|
|
|
|
or as a hash reference. |
|
2653
|
|
|
|
|
|
|
|
|
2654
|
|
|
|
|
|
|
C<-format> specifies the desired format of the retrieved data. Possible |
|
2655
|
|
|
|
|
|
|
values are C<'xml'>, C<'json'>, C<'html'>, C<'csv'>, and C<'legacy'>, |
|
2656
|
|
|
|
|
|
|
which is the default. The legacy format is tab-delimited text, such as |
|
2657
|
|
|
|
|
|
|
was returned by the version 1 interface. |
|
2658
|
|
|
|
|
|
|
|
|
2659
|
|
|
|
|
|
|
C<-json> specifies JSON format. If you specify both C<-json> and |
|
2660
|
|
|
|
|
|
|
C<-format> you will get an exception unless you specify C<-format=json>. |
|
2661
|
|
|
|
|
|
|
|
|
2662
|
|
|
|
|
|
|
This method requires a Space Track username and password. It |
|
2663
|
|
|
|
|
|
|
implicitly calls the C method if the session cookie is |
|
2664
|
|
|
|
|
|
|
missing or expired. If C fails, you will get the |
|
2665
|
|
|
|
|
|
|
HTTP::Response from C. |
|
2666
|
|
|
|
|
|
|
|
|
2667
|
|
|
|
|
|
|
If this method succeeds, the response will contain headers |
|
2668
|
|
|
|
|
|
|
|
|
2669
|
|
|
|
|
|
|
Pragma: spacetrack-type = launch_sites |
|
2670
|
|
|
|
|
|
|
Pragma: spacetrack-source = spacetrack |
|
2671
|
|
|
|
|
|
|
|
|
2672
|
|
|
|
|
|
|
There are no arguments. |
|
2673
|
|
|
|
|
|
|
|
|
2674
|
|
|
|
|
|
|
=cut |
|
2675
|
|
|
|
|
|
|
|
|
2676
|
|
|
|
|
|
|
{ |
|
2677
|
|
|
|
|
|
|
my @headings = ( 'Abbreviation', 'Launch Site' ); |
|
2678
|
|
|
|
|
|
|
|
|
2679
|
|
|
|
|
|
|
# Called dynamically |
|
2680
|
|
|
|
|
|
|
sub _launch_sites_opts { ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) |
|
2681
|
1
|
|
|
1
|
|
5
|
return [ |
|
2682
|
|
|
|
|
|
|
'json!' => 'Return data in JSON format', |
|
2683
|
|
|
|
|
|
|
'format=s' => 'Specify return format', |
|
2684
|
|
|
|
|
|
|
]; |
|
2685
|
|
|
|
|
|
|
} |
|
2686
|
|
|
|
|
|
|
|
|
2687
|
1
|
|
|
1
|
1
|
7
|
sub launch_sites { |
|
2688
|
|
|
|
|
|
|
my ( $self, @args ) = @_; |
|
2689
|
1
|
|
|
|
|
4
|
|
|
2690
|
1
|
|
|
|
|
4
|
( my $opt, @args ) = _parse_args( @args ); |
|
2691
|
|
|
|
|
|
|
my $format = _retrieval_format( launch_sites => $opt ); |
|
2692
|
1
|
|
|
|
|
7
|
|
|
2693
|
|
|
|
|
|
|
my $resp = $self->spacetrack_query_v2( qw{ |
|
2694
|
|
|
|
|
|
|
basicspacedata query class launch_site }, |
|
2695
|
|
|
|
|
|
|
format => $format, |
|
2696
|
|
|
|
|
|
|
orderby => 'SITE_CODE asc', |
|
2697
|
|
|
|
|
|
|
qw{ predicates all |
|
2698
|
1
|
50
|
|
|
|
4
|
} ); |
|
2699
|
|
|
|
|
|
|
$resp->is_success() |
|
2700
|
|
|
|
|
|
|
or return $resp; |
|
2701
|
1
|
|
|
|
|
12
|
|
|
2702
|
|
|
|
|
|
|
$self->_add_pragmata($resp, |
|
2703
|
|
|
|
|
|
|
'spacetrack-type' => 'launch_sites', |
|
2704
|
|
|
|
|
|
|
'spacetrack-source' => 'spacetrack', |
|
2705
|
|
|
|
|
|
|
'spacetrack-interface' => 2, |
|
2706
|
|
|
|
|
|
|
); |
|
2707
|
1
|
50
|
|
|
|
5
|
|
|
2708
|
|
|
|
|
|
|
'json' ne $format |
|
2709
|
|
|
|
|
|
|
and return $resp; |
|
2710
|
1
|
|
|
|
|
7
|
|
|
2711
|
|
|
|
|
|
|
my $json = $self->_get_json_object(); |
|
2712
|
1
|
|
|
|
|
4
|
|
|
2713
|
|
|
|
|
|
|
my $data = $json->decode( $resp->content() ); |
|
2714
|
1
|
|
|
|
|
23
|
|
|
2715
|
1
|
|
|
|
|
2
|
my %dict; |
|
|
1
|
|
|
|
|
4
|
|
|
2716
|
|
|
|
|
|
|
foreach my $datum ( @{ $data } ) { |
|
2717
|
34
|
50
|
|
|
|
61
|
defined $datum->{SITE_CODE} |
|
2718
|
|
|
|
|
|
|
and $dict{$datum->{SITE_CODE}} = $datum->{LAUNCH_SITE}; |
|
2719
|
|
|
|
|
|
|
} |
|
2720
|
1
|
50
|
|
|
|
7
|
|
|
2721
|
|
|
|
|
|
|
if ( $opt->{json} ) { |
|
2722
|
0
|
|
|
|
|
0
|
|
|
2723
|
|
|
|
|
|
|
$resp->content( $json->encode( \%dict ) ); |
|
2724
|
|
|
|
|
|
|
|
|
2725
|
|
|
|
|
|
|
} else { |
|
2726
|
|
|
|
|
|
|
|
|
2727
|
|
|
|
|
|
|
$resp->content( |
|
2728
|
|
|
|
|
|
|
join '', |
|
2729
|
1
|
|
|
|
|
11
|
join( "\t", @headings ) . "\n", |
|
|
0
|
|
|
|
|
0
|
|
|
2730
|
|
|
|
|
|
|
map { "$_\t$dict{$_}\n" } sort keys %dict |
|
2731
|
|
|
|
|
|
|
); |
|
2732
|
|
|
|
|
|
|
|
|
2733
|
|
|
|
|
|
|
} |
|
2734
|
|
|
|
|
|
|
|
|
2735
|
1
|
50
|
|
|
|
34
|
wantarray |
|
2736
|
|
|
|
|
|
|
or return $resp; |
|
2737
|
0
|
|
|
|
|
0
|
|
|
2738
|
0
|
|
|
|
|
0
|
my @table; |
|
2739
|
0
|
|
|
|
|
0
|
push @table, [ @headings ]; |
|
2740
|
0
|
|
|
|
|
0
|
foreach my $key ( sort keys %dict ) { |
|
2741
|
|
|
|
|
|
|
push @table, [ $key, $dict{$key} ]; |
|
2742
|
0
|
|
|
|
|
0
|
} |
|
2743
|
|
|
|
|
|
|
return ( $resp, \@table ); |
|
2744
|
|
|
|
|
|
|
} |
|
2745
|
|
|
|
|
|
|
} |
|
2746
|
|
|
|
|
|
|
|
|
2747
|
|
|
|
|
|
|
|
|
2748
|
|
|
|
|
|
|
=for html |
|
2749
|
|
|
|
|
|
|
|
|
2750
|
|
|
|
|
|
|
=item $resp = $st->login ( ... ) |
|
2751
|
|
|
|
|
|
|
|
|
2752
|
|
|
|
|
|
|
If any arguments are given, this method passes them to the set () |
|
2753
|
|
|
|
|
|
|
method. Then it executes a login to the Space Track web site. The return |
|
2754
|
|
|
|
|
|
|
is normally the HTTP::Response object from the login. But if no session |
|
2755
|
|
|
|
|
|
|
cookie was obtained, the return is an HTTP::Response with an appropriate |
|
2756
|
|
|
|
|
|
|
message and the code set to HTTP_UNAUTHORIZED from HTTP::Status (a.k.a. |
|
2757
|
|
|
|
|
|
|
401). If a login is attempted without the username and password being |
|
2758
|
|
|
|
|
|
|
set, the return is an HTTP::Response with an appropriate message and the |
|
2759
|
|
|
|
|
|
|
code set to HTTP_PRECONDITION_FAILED from HTTP::Status (a.k.a. 412). |
|
2760
|
|
|
|
|
|
|
|
|
2761
|
|
|
|
|
|
|
A Space Track username and password are required to use this method. |
|
2762
|
|
|
|
|
|
|
|
|
2763
|
|
|
|
|
|
|
=cut |
|
2764
|
|
|
|
|
|
|
|
|
2765
|
2
|
|
|
2
|
1
|
7
|
sub login { |
|
2766
|
2
|
|
|
|
|
5
|
my ( $self, @args ) = @_; |
|
2767
|
2
|
50
|
|
|
|
7
|
delete $self->{_pragmata}; |
|
2768
|
2
|
50
|
33
|
|
|
30
|
@args and $self->set( @args ); |
|
2769
|
|
|
|
|
|
|
( $self->{username} && $self->{password} ) or |
|
2770
|
|
|
|
|
|
|
return HTTP::Response->new ( |
|
2771
|
2
|
50
|
|
|
|
12
|
HTTP_PRECONDITION_FAILED, NO_CREDENTIALS); |
|
2772
|
|
|
|
|
|
|
$self->{dump_headers} & DUMP_TRACE and warn <<"EOD"; |
|
2773
|
|
|
|
|
|
|
Logging in as $self->{username}. |
|
2774
|
|
|
|
|
|
|
EOD |
|
2775
|
|
|
|
|
|
|
|
|
2776
|
|
|
|
|
|
|
# Do not use the spacetrack_query_v2 method to retrieve the session |
|
2777
|
2
|
|
|
|
|
8
|
# cookie, unless you like bottomless recursions. |
|
2778
|
|
|
|
|
|
|
my $url = $self->_make_space_track_base_url( 2 ) . |
|
2779
|
|
|
|
|
|
|
'/ajaxauth/login'; |
|
2780
|
|
|
|
|
|
|
$self->_dump_request( |
|
2781
|
|
|
|
|
|
|
arg => [ |
|
2782
|
|
|
|
|
|
|
identity => $self->{username}, |
|
2783
|
2
|
|
|
|
|
27
|
password => $self->{password}, |
|
2784
|
|
|
|
|
|
|
], |
|
2785
|
|
|
|
|
|
|
method => 'POST', |
|
2786
|
|
|
|
|
|
|
url => $url, |
|
2787
|
|
|
|
|
|
|
); |
|
2788
|
|
|
|
|
|
|
my $resp = $self->_get_agent()->post( |
|
2789
|
|
|
|
|
|
|
$url, [ |
|
2790
|
|
|
|
|
|
|
identity => $self->{username}, |
|
2791
|
2
|
|
|
|
|
11
|
password => $self->{password}, |
|
2792
|
|
|
|
|
|
|
] ); |
|
2793
|
2
|
50
|
|
|
|
22
|
|
|
2794
|
|
|
|
|
|
|
$resp->is_success() |
|
2795
|
2
|
|
|
|
|
41
|
or return _mung_login_status( $resp ); |
|
2796
|
|
|
|
|
|
|
$self->__dump_response( $resp ); |
|
2797
|
2
|
50
|
|
|
|
14
|
|
|
2798
|
|
|
|
|
|
|
$resp->content() =~ m/ \b failed \b /smxi |
|
2799
|
|
|
|
|
|
|
and return HTTP::Response->new( HTTP_UNAUTHORIZED, LOGIN_FAILED ); |
|
2800
|
2
|
50
|
|
|
|
85
|
|
|
2801
|
|
|
|
|
|
|
$self->_record_cookie_generic( 2 ) |
|
2802
|
|
|
|
|
|
|
or return HTTP::Response->new( HTTP_UNAUTHORIZED, LOGIN_FAILED ); |
|
2803
|
2
|
50
|
|
|
|
10
|
|
|
2804
|
|
|
|
|
|
|
$self->{dump_headers} & DUMP_TRACE and warn <<'EOD'; |
|
2805
|
|
|
|
|
|
|
Login successful. |
|
2806
|
2
|
|
|
|
|
11
|
EOD |
|
2807
|
|
|
|
|
|
|
return HTTP::Response->new (HTTP_OK, undef, undef, "Login successful.\n"); |
|
2808
|
|
|
|
|
|
|
} |
|
2809
|
|
|
|
|
|
|
|
|
2810
|
|
|
|
|
|
|
=for html |
|
2811
|
|
|
|
|
|
|
|
|
2812
|
|
|
|
|
|
|
=item $st->logout() |
|
2813
|
|
|
|
|
|
|
|
|
2814
|
|
|
|
|
|
|
This method deletes all session cookies. It returns an HTTP::Response |
|
2815
|
|
|
|
|
|
|
object that indicates success. |
|
2816
|
|
|
|
|
|
|
|
|
2817
|
|
|
|
|
|
|
=cut |
|
2818
|
|
|
|
|
|
|
|
|
2819
|
4
|
|
|
4
|
1
|
10
|
sub logout { |
|
2820
|
4
|
|
|
|
|
6
|
my ( $self ) = @_; |
|
2821
|
4
|
|
|
|
|
13
|
foreach my $spacetrack_interface_info ( |
|
2822
|
12
|
100
|
|
|
|
32
|
@{ $self->{_space_track_interface} } ) { |
|
2823
|
|
|
|
|
|
|
$spacetrack_interface_info |
|
2824
|
|
|
|
|
|
|
or next; |
|
2825
|
4
|
50
|
|
|
|
38
|
exists $spacetrack_interface_info->{session_cookie} |
|
2826
|
|
|
|
|
|
|
and $spacetrack_interface_info->{session_cookie} = undef; |
|
2827
|
4
|
50
|
|
|
|
18
|
exists $spacetrack_interface_info->{cookie_expires} |
|
2828
|
|
|
|
|
|
|
and $spacetrack_interface_info->{cookie_expires} = 0; |
|
2829
|
4
|
|
|
|
|
19
|
} |
|
2830
|
|
|
|
|
|
|
return HTTP::Response->new( |
|
2831
|
|
|
|
|
|
|
HTTP_OK, undef, undef, "Logout successful.\n" ); |
|
2832
|
|
|
|
|
|
|
} |
|
2833
|
|
|
|
|
|
|
|
|
2834
|
|
|
|
|
|
|
=for html |
|
2835
|
|
|
|
|
|
|
|
|
2836
|
|
|
|
|
|
|
=item $resp = $st->mccants( catalog ) |
|
2837
|
|
|
|
|
|
|
|
|
2838
|
|
|
|
|
|
|
This method retrieves one of several pieces of data that Mike McCants |
|
2839
|
|
|
|
|
|
|
makes available on his web site. The return is the |
|
2840
|
|
|
|
|
|
|
L object from the retrieval. Valid |
|
2841
|
|
|
|
|
|
|
catalog names are: |
|
2842
|
|
|
|
|
|
|
|
|
2843
|
|
|
|
|
|
|
classified: Classified TLE file (classfd.zip) |
|
2844
|
|
|
|
|
|
|
integrated: Integrated TLE file (inttles.zip) |
|
2845
|
|
|
|
|
|
|
mcnames: Molczan-format magnitude file (mcnames.zip) |
|
2846
|
|
|
|
|
|
|
quicksat: Quicksat-format magnitude file (qsmag.zip) |
|
2847
|
|
|
|
|
|
|
rcs: McCants-format RCS file (rcs.zip) |
|
2848
|
|
|
|
|
|
|
vsnames: Molczan-format magnitudes of visual bodies (vsnames.zip) |
|
2849
|
|
|
|
|
|
|
|
|
2850
|
|
|
|
|
|
|
You can specify options as either command-type options (e.g. C<< |
|
2851
|
|
|
|
|
|
|
mccants( '-file', 'foo.dat', ... ) >>) or as a leading hash reference |
|
2852
|
|
|
|
|
|
|
(e.g. C<< mccants( { file => 'foo.dat' }, ...) >>). If you specify the |
|
2853
|
|
|
|
|
|
|
hash reference, option names must be specified in full, without the |
|
2854
|
|
|
|
|
|
|
leading '-', and the argument list will not be parsed for command-type |
|
2855
|
|
|
|
|
|
|
options. If you specify command-type options, they may be abbreviated, |
|
2856
|
|
|
|
|
|
|
as long as the abbreviation is unique. Errors in either sort result in |
|
2857
|
|
|
|
|
|
|
an exception being thrown. |
|
2858
|
|
|
|
|
|
|
|
|
2859
|
|
|
|
|
|
|
The legal options are: |
|
2860
|
|
|
|
|
|
|
|
|
2861
|
|
|
|
|
|
|
-file |
|
2862
|
|
|
|
|
|
|
specifies the name of the cache file. If the data |
|
2863
|
|
|
|
|
|
|
on line are newer than the modification date of |
|
2864
|
|
|
|
|
|
|
the cache file, the cache file will be updated. |
|
2865
|
|
|
|
|
|
|
Otherwise the data will be returned from the file. |
|
2866
|
|
|
|
|
|
|
Either way the content of the file and the content |
|
2867
|
|
|
|
|
|
|
of the returned HTTP::Response object end up the |
|
2868
|
|
|
|
|
|
|
same. |
|
2869
|
|
|
|
|
|
|
|
|
2870
|
|
|
|
|
|
|
On success, the content of the returned object is the actual data, |
|
2871
|
|
|
|
|
|
|
unzipped and with line endings normalized for the current system. |
|
2872
|
|
|
|
|
|
|
|
|
2873
|
|
|
|
|
|
|
If this method succeeds, the response will contain headers |
|
2874
|
|
|
|
|
|
|
|
|
2875
|
|
|
|
|
|
|
Pragma: spacetrack-type = (see below) |
|
2876
|
|
|
|
|
|
|
Pragma: spacetrack-source = mccants |
|
2877
|
|
|
|
|
|
|
|
|
2878
|
|
|
|
|
|
|
The content of the spacetrack-type pragma depends on the catalog |
|
2879
|
|
|
|
|
|
|
fetched, as follows: |
|
2880
|
|
|
|
|
|
|
|
|
2881
|
|
|
|
|
|
|
classified: 'orbit' |
|
2882
|
|
|
|
|
|
|
integrated: 'orbit' |
|
2883
|
|
|
|
|
|
|
mcnames: 'molczan' |
|
2884
|
|
|
|
|
|
|
quicksat: 'quicksat' |
|
2885
|
|
|
|
|
|
|
rcs: 'rcs.mccants' |
|
2886
|
|
|
|
|
|
|
vsnames: 'molczan' |
|
2887
|
|
|
|
|
|
|
|
|
2888
|
|
|
|
|
|
|
If the C option was passed, the following additional header will |
|
2889
|
|
|
|
|
|
|
be provided: |
|
2890
|
|
|
|
|
|
|
|
|
2891
|
|
|
|
|
|
|
Pragma: spacetrack-cache-hit = (either true or false) |
|
2892
|
|
|
|
|
|
|
|
|
2893
|
|
|
|
|
|
|
This can be accessed by the C method. If this pragma is |
|
2894
|
|
|
|
|
|
|
true, the C header of the response will contain the |
|
2895
|
|
|
|
|
|
|
modification time of the file. |
|
2896
|
|
|
|
|
|
|
|
|
2897
|
|
|
|
|
|
|
No Space Track username and password are required to use this method. |
|
2898
|
|
|
|
|
|
|
|
|
2899
|
|
|
|
|
|
|
=cut |
|
2900
|
|
|
|
|
|
|
|
|
2901
|
|
|
|
|
|
|
# Called dynamically |
|
2902
|
|
|
|
|
|
|
sub _mccants_opts { ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) |
|
2903
|
6
|
|
|
6
|
|
26
|
return [ |
|
2904
|
|
|
|
|
|
|
'file=s' => 'Name of cache file', |
|
2905
|
|
|
|
|
|
|
]; |
|
2906
|
|
|
|
|
|
|
} |
|
2907
|
|
|
|
|
|
|
|
|
2908
|
6
|
|
|
6
|
1
|
23
|
sub mccants { |
|
2909
|
|
|
|
|
|
|
my ( $self, @args ) = @_; |
|
2910
|
6
|
|
|
|
|
27
|
|
|
2911
|
|
|
|
|
|
|
( my $opt, @args ) = _parse_args( @args ); |
|
2912
|
|
|
|
|
|
|
|
|
2913
|
6
|
|
|
|
|
71
|
return $self->_get_from_net( |
|
2914
|
|
|
|
|
|
|
%{ $opt }, |
|
2915
|
|
|
|
|
|
|
catalog => $args[0], |
|
2916
|
6
|
|
|
6
|
|
135
|
post_process => sub { |
|
2917
|
6
|
|
|
|
|
14
|
my ( undef, $resp, $info ) = @_; # Invocant unused |
|
2918
|
|
|
|
|
|
|
my ( $content, @zip_opt ); |
|
2919
|
6
|
50
|
|
|
|
35
|
defined $info->{member} |
|
2920
|
6
|
50
|
|
|
|
33
|
and push @zip_opt, Name => $info->{member}; |
|
2921
|
|
|
|
|
|
|
IO::Uncompress::Unzip::unzip( \( $resp->content() ), |
|
2922
|
|
|
|
|
|
|
\$content, @zip_opt ) |
|
2923
|
|
|
|
|
|
|
or return HTTP::Response->new( |
|
2924
|
|
|
|
|
|
|
HTTP_NOT_FOUND, |
|
2925
|
6
|
|
|
|
|
42804
|
$IO::Uncompress::Unzip::UnzipError ); |
|
2926
|
6
|
|
|
|
|
927
|
$resp->content( $content ); |
|
2927
|
|
|
|
|
|
|
return $resp; |
|
2928
|
6
|
|
|
|
|
14
|
}, |
|
2929
|
|
|
|
|
|
|
); |
|
2930
|
|
|
|
|
|
|
} |
|
2931
|
|
|
|
|
|
|
|
|
2932
|
|
|
|
|
|
|
=for html |
|
2933
|
|
|
|
|
|
|
|
|
2934
|
|
|
|
|
|
|
=item $resp = $st->names (source) |
|
2935
|
|
|
|
|
|
|
|
|
2936
|
|
|
|
|
|
|
This method retrieves the names of the catalogs for the given source, |
|
2937
|
|
|
|
|
|
|
either C<'celestrak'>, C<'celestrak_supplemental'>, C<'iridium_status'>, |
|
2938
|
|
|
|
|
|
|
C<'mccants'>, or C<'spacetrack'>, in the content of |
|
2939
|
|
|
|
|
|
|
the given HTTP::Response object. If the argument is not one of the |
|
2940
|
|
|
|
|
|
|
supported values, the C<$resp> object represents a 404 (Not found) |
|
2941
|
|
|
|
|
|
|
error. |
|
2942
|
|
|
|
|
|
|
|
|
2943
|
|
|
|
|
|
|
In list context, you also get a reference to a list of two-element |
|
2944
|
|
|
|
|
|
|
lists; each inner list contains the description and the catalog name, in |
|
2945
|
|
|
|
|
|
|
that order (suitable for inserting into a Tk Optionmenu). If the |
|
2946
|
|
|
|
|
|
|
argument is not one of the supported values, the second return will be |
|
2947
|
|
|
|
|
|
|
C. |
|
2948
|
|
|
|
|
|
|
|
|
2949
|
|
|
|
|
|
|
No Space Track username and password are required to use this method, |
|
2950
|
|
|
|
|
|
|
since all it is doing is returning data kept by this module. |
|
2951
|
|
|
|
|
|
|
|
|
2952
|
|
|
|
|
|
|
=cut |
|
2953
|
|
|
|
|
|
|
|
|
2954
|
2
|
|
|
2
|
1
|
6
|
sub names { |
|
2955
|
2
|
|
|
|
|
5
|
my ( $self, $name ) = @_; |
|
2956
|
2
|
|
|
|
|
5
|
$name = lc $name; |
|
2957
|
|
|
|
|
|
|
delete $self->{_pragmata}; |
|
2958
|
2
|
100
|
|
|
|
13
|
|
|
2959
|
|
|
|
|
|
|
$catalogs{$name} or return HTTP::Response->new( |
|
2960
|
1
|
|
|
|
|
2
|
HTTP_NOT_FOUND, "Data source '$name' not found."); |
|
2961
|
1
|
50
|
|
|
|
4
|
my $src = $catalogs{$name}; |
|
2962
|
|
|
|
|
|
|
$name eq 'spacetrack' |
|
2963
|
1
|
|
|
|
|
2
|
and $src = $src->[ $self->getv( 'space_track_version' ) ]; |
|
2964
|
1
|
|
|
|
|
32
|
my @list; |
|
2965
|
53
|
50
|
|
|
|
178
|
foreach my $cat (sort keys %$src) { |
|
2966
|
|
|
|
|
|
|
push @list, defined ($src->{$cat}{number}) ? |
|
2967
|
|
|
|
|
|
|
"$cat ($src->{$cat}{number}): $src->{$cat}{name}\n" : |
|
2968
|
|
|
|
|
|
|
"$cat: $src->{$cat}{name}\n"; |
|
2969
|
1
|
|
|
|
|
13
|
} |
|
2970
|
1
|
50
|
|
|
|
55
|
my $resp = HTTP::Response->new (HTTP_OK, undef, undef, join ('', @list)); |
|
2971
|
0
|
|
|
|
|
0
|
return $resp unless wantarray; |
|
2972
|
0
|
|
|
|
|
0
|
@list = (); |
|
|
0
|
|
|
|
|
0
|
|
|
2973
|
|
|
|
|
|
|
foreach my $cat (sort {$src->{$a}{name} cmp $src->{$b}{name}} |
|
2974
|
0
|
|
|
|
|
0
|
keys %$src) { |
|
2975
|
|
|
|
|
|
|
push @list, [$src->{$cat}{name}, $cat]; |
|
2976
|
0
|
|
|
|
|
0
|
} |
|
2977
|
|
|
|
|
|
|
return ($resp, \@list); |
|
2978
|
|
|
|
|
|
|
} |
|
2979
|
|
|
|
|
|
|
|
|
2980
|
|
|
|
|
|
|
=for html |
|
2981
|
|
|
|
|
|
|
|
|
2982
|
|
|
|
|
|
|
=item $resp = $st->retrieve (number_or_range ...) |
|
2983
|
|
|
|
|
|
|
|
|
2984
|
|
|
|
|
|
|
This method retrieves the latest element set for each of the given |
|
2985
|
|
|
|
|
|
|
satellite ID numbers (also known as SATCAT IDs, NORAD IDs, or OIDs) from |
|
2986
|
|
|
|
|
|
|
The Space Track web site. Non-numeric catalog numbers are ignored, as |
|
2987
|
|
|
|
|
|
|
are (at a later stage) numbers that do not actually represent a |
|
2988
|
|
|
|
|
|
|
satellite. |
|
2989
|
|
|
|
|
|
|
|
|
2990
|
|
|
|
|
|
|
A Space Track username and password are required to use this method. |
|
2991
|
|
|
|
|
|
|
|
|
2992
|
|
|
|
|
|
|
If this method succeeds, the response will contain headers |
|
2993
|
|
|
|
|
|
|
|
|
2994
|
|
|
|
|
|
|
Pragma: spacetrack-type = orbit |
|
2995
|
|
|
|
|
|
|
Pragma: spacetrack-source = spacetrack |
|
2996
|
|
|
|
|
|
|
|
|
2997
|
|
|
|
|
|
|
These can be accessed by C<< $st->content_type( $resp ) >> and |
|
2998
|
|
|
|
|
|
|
C<< $st->content_source( $resp ) >> respectively. |
|
2999
|
|
|
|
|
|
|
|
|
3000
|
|
|
|
|
|
|
Number ranges are represented as 'start-end', where both 'start' and |
|
3001
|
|
|
|
|
|
|
'end' are catalog numbers. If 'start' > 'end', the numbers will be |
|
3002
|
|
|
|
|
|
|
taken in the reverse order. Non-numeric ranges are ignored. |
|
3003
|
|
|
|
|
|
|
|
|
3004
|
|
|
|
|
|
|
You can specify options for the retrieval as either command-type options |
|
3005
|
|
|
|
|
|
|
(e.g. C<< retrieve ('-last5', ...) >>) or as a leading hash reference |
|
3006
|
|
|
|
|
|
|
(e.g. C<< retrieve ({last5 => 1}, ...) >>). If you specify the hash |
|
3007
|
|
|
|
|
|
|
reference, option names must be specified in full, without the leading |
|
3008
|
|
|
|
|
|
|
'-', and the argument list will not be parsed for command-type options. |
|
3009
|
|
|
|
|
|
|
If you specify command-type options, they may be abbreviated, as long as |
|
3010
|
|
|
|
|
|
|
the abbreviation is unique. Errors in either sort result in an exception |
|
3011
|
|
|
|
|
|
|
being thrown. |
|
3012
|
|
|
|
|
|
|
|
|
3013
|
|
|
|
|
|
|
The legal options are: |
|
3014
|
|
|
|
|
|
|
|
|
3015
|
|
|
|
|
|
|
-descending |
|
3016
|
|
|
|
|
|
|
specifies the data be returned in descending order. |
|
3017
|
|
|
|
|
|
|
-end_epoch date |
|
3018
|
|
|
|
|
|
|
specifies the end epoch for the desired data. |
|
3019
|
|
|
|
|
|
|
-format format_name |
|
3020
|
|
|
|
|
|
|
specifies the format in which the data are retrieved. |
|
3021
|
|
|
|
|
|
|
-json |
|
3022
|
|
|
|
|
|
|
specifies the TLE be returned in JSON format. |
|
3023
|
|
|
|
|
|
|
-last5 |
|
3024
|
|
|
|
|
|
|
specifies the last 5 element sets be retrieved. |
|
3025
|
|
|
|
|
|
|
Ignored if start_epoch, end_epoch or since_file is |
|
3026
|
|
|
|
|
|
|
specified. |
|
3027
|
|
|
|
|
|
|
-start_epoch date |
|
3028
|
|
|
|
|
|
|
specifies the start epoch for the desired data. |
|
3029
|
|
|
|
|
|
|
-since_file number |
|
3030
|
|
|
|
|
|
|
specifies that only data since the given Space Track |
|
3031
|
|
|
|
|
|
|
file number be retrieved. |
|
3032
|
|
|
|
|
|
|
-sort type |
|
3033
|
|
|
|
|
|
|
specifies how to sort the data. Legal types are |
|
3034
|
|
|
|
|
|
|
'catnum' and 'epoch', with 'catnum' the default. |
|
3035
|
|
|
|
|
|
|
|
|
3036
|
|
|
|
|
|
|
The C<-format> option takes any argument supported by the Space Track |
|
3037
|
|
|
|
|
|
|
interface: C, C<3le>, C, C, C, or C. |
|
3038
|
|
|
|
|
|
|
Specifying C<-json> is equivalent to specifying C<-format json>, and if |
|
3039
|
|
|
|
|
|
|
you specify C<-json>, specifying C<-format> with any other value than |
|
3040
|
|
|
|
|
|
|
C<'json'> results in an exception being thrown. In addition, you can |
|
3041
|
|
|
|
|
|
|
specify format C<'legacy'> which is equivalent to C<'tle'> if the |
|
3042
|
|
|
|
|
|
|
C attribute is false, or C<'3le'> (but without the leading |
|
3043
|
|
|
|
|
|
|
C<'0 '> before the common name) if C is true. The default is |
|
3044
|
|
|
|
|
|
|
C<'legacy'> unless C<-json> is specified. |
|
3045
|
|
|
|
|
|
|
|
|
3046
|
|
|
|
|
|
|
If you specify either start_epoch or end_epoch, you get data with epochs |
|
3047
|
|
|
|
|
|
|
at least equal to the start epoch, but less than the end epoch (i.e. the |
|
3048
|
|
|
|
|
|
|
interval is closed at the beginning but open at the end). If you specify |
|
3049
|
|
|
|
|
|
|
only one of these, you get a one-day interval. Dates are specified |
|
3050
|
|
|
|
|
|
|
either numerically (as a Perl date) or as numeric year-month-day (and |
|
3051
|
|
|
|
|
|
|
optional hour, hour:minute, or hour:minute:second), punctuated by any |
|
3052
|
|
|
|
|
|
|
non-numeric string. It is an error to specify an end_epoch before the |
|
3053
|
|
|
|
|
|
|
start_epoch. |
|
3054
|
|
|
|
|
|
|
|
|
3055
|
|
|
|
|
|
|
If you are passing the options as a hash reference, you must specify |
|
3056
|
|
|
|
|
|
|
a value for the Boolean options 'descending' and 'last5'. This value is |
|
3057
|
|
|
|
|
|
|
interpreted in the Perl sense - that is, undef, 0, and '' are false, |
|
3058
|
|
|
|
|
|
|
and anything else is true. |
|
3059
|
|
|
|
|
|
|
|
|
3060
|
|
|
|
|
|
|
In order not to load the Space Track web site too heavily, data are |
|
3061
|
|
|
|
|
|
|
retrieved in batches of 200. Ranges will be subdivided and handled in |
|
3062
|
|
|
|
|
|
|
more than one retrieval if necessary. To limit the damage done by a |
|
3063
|
|
|
|
|
|
|
pernicious range, ranges greater than the max_range setting (which |
|
3064
|
|
|
|
|
|
|
defaults to 500) will be ignored with a warning to STDERR. |
|
3065
|
|
|
|
|
|
|
|
|
3066
|
|
|
|
|
|
|
If you specify C<-json> and more than one retrieval is needed, data from |
|
3067
|
|
|
|
|
|
|
retrievals after the first B have field C<_file_of_record> added. |
|
3068
|
|
|
|
|
|
|
This is because of the theoretical possibility that the database may be |
|
3069
|
|
|
|
|
|
|
updated between the first and last queries, and therefore taking the |
|
3070
|
|
|
|
|
|
|
maximum C from queries after the first may cause updates to be |
|
3071
|
|
|
|
|
|
|
skipped. The C<_file_of_record> key will appear only in data having a |
|
3072
|
|
|
|
|
|
|
C value greater than the largest C in the first retrieval. |
|
3073
|
|
|
|
|
|
|
|
|
3074
|
|
|
|
|
|
|
This method implicitly calls the C method if the session cookie |
|
3075
|
|
|
|
|
|
|
is missing or expired. If C fails, you will get the |
|
3076
|
|
|
|
|
|
|
HTTP::Response from C. |
|
3077
|
|
|
|
|
|
|
|
|
3078
|
|
|
|
|
|
|
If this method succeeds, a 'Pragma: spacetrack-type = orbit' header is |
|
3079
|
|
|
|
|
|
|
added to the HTTP::Response object returned. |
|
3080
|
|
|
|
|
|
|
|
|
3081
|
|
|
|
|
|
|
=cut |
|
3082
|
|
|
|
|
|
|
|
|
3083
|
|
|
|
|
|
|
# Called dynamically |
|
3084
|
|
|
|
|
|
|
sub _retrieve_opts { ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) |
|
3085
|
0
|
|
|
0
|
|
0
|
return [ |
|
3086
|
|
|
|
|
|
|
_get_retrieve_options(), |
|
3087
|
|
|
|
|
|
|
]; |
|
3088
|
|
|
|
|
|
|
} |
|
3089
|
|
|
|
|
|
|
|
|
3090
|
34
|
|
|
34
|
1
|
11210
|
sub retrieve { |
|
3091
|
34
|
|
|
|
|
96
|
my ( $self, @args ) = @_; |
|
3092
|
|
|
|
|
|
|
delete $self->{_pragmata}; |
|
3093
|
34
|
|
|
|
|
103
|
|
|
3094
|
34
|
|
|
|
|
90
|
@args = $self->_parse_retrieve_args( @args ); |
|
3095
|
|
|
|
|
|
|
my $opt = _parse_retrieve_dates( shift @args ); |
|
3096
|
34
|
|
|
|
|
95
|
|
|
3097
|
|
|
|
|
|
|
my $rest = $self->_convert_retrieve_options_to_rest( $opt ); |
|
3098
|
34
|
100
|
|
|
|
95
|
|
|
3099
|
|
|
|
|
|
|
@args = $self->_expand_oid_list( @args ) |
|
3100
|
|
|
|
|
|
|
or return HTTP::Response->new( HTTP_PRECONDITION_FAILED, NO_CAT_ID ); |
|
3101
|
33
|
|
|
|
|
84
|
|
|
3102
|
|
|
|
|
|
|
my $no_execute = $self->getv( 'dump_headers' ) & DUMP_DRY_RUN; |
|
3103
|
|
|
|
|
|
|
|
|
3104
|
|
|
|
|
|
|
## $rest->{orderby} = 'EPOCH desc'; |
|
3105
|
|
|
|
|
|
|
|
|
3106
|
|
|
|
|
|
|
my $accumulator = _accumulator_for ( |
|
3107
|
|
|
|
|
|
|
$no_execute ? |
|
3108
|
|
|
|
|
|
|
( json => { pretty => 1 } ) : |
|
3109
|
33
|
100
|
|
|
|
170
|
( $rest->{format}, { |
|
3110
|
|
|
|
|
|
|
file => 1, |
|
3111
|
|
|
|
|
|
|
pretty => $self->getv( 'pretty' ) |
|
3112
|
|
|
|
|
|
|
}, |
|
3113
|
|
|
|
|
|
|
) |
|
3114
|
|
|
|
|
|
|
); |
|
3115
|
33
|
|
|
|
|
95
|
|
|
3116
|
|
|
|
|
|
|
while ( @args ) { |
|
3117
|
35
|
|
|
|
|
92
|
|
|
3118
|
35
|
|
|
|
|
131
|
my @batch = splice @args, 0, $RETRIEVAL_SIZE; |
|
3119
|
|
|
|
|
|
|
$rest->{OBJECT_NUMBER} = _stringify_oid_list( { |
|
3120
|
|
|
|
|
|
|
separator => ',', |
|
3121
|
|
|
|
|
|
|
range_operator => '--', |
|
3122
|
|
|
|
|
|
|
}, @batch ); |
|
3123
|
35
|
|
|
|
|
118
|
|
|
3124
|
|
|
|
|
|
|
my $resp = $self->spacetrack_query_v2( |
|
3125
|
|
|
|
|
|
|
basicspacedata => 'query', |
|
3126
|
|
|
|
|
|
|
_sort_rest_arguments( $rest ) |
|
3127
|
|
|
|
|
|
|
); |
|
3128
|
35
|
50
|
66
|
|
|
124
|
|
|
3129
|
|
|
|
|
|
|
$resp->is_success() |
|
3130
|
|
|
|
|
|
|
or $resp->code() == HTTP_I_AM_A_TEAPOT |
|
3131
|
|
|
|
|
|
|
or return $resp; |
|
3132
|
35
|
|
|
|
|
438
|
|
|
3133
|
|
|
|
|
|
|
$accumulator->( $self, $resp ); |
|
3134
|
|
|
|
|
|
|
|
|
3135
|
|
|
|
|
|
|
} |
|
3136
|
33
|
50
|
|
|
|
67
|
|
|
3137
|
|
|
|
|
|
|
( my $data = $accumulator->( $self ) ) |
|
3138
|
|
|
|
|
|
|
or return HTTP::Response->new ( HTTP_NOT_FOUND, NO_RECORDS ); |
|
3139
|
33
|
50
|
|
|
|
83
|
|
|
3140
|
|
|
|
|
|
|
ref $data |
|
3141
|
|
|
|
|
|
|
and $data = $self->_get_json_object()->encode( $data ); |
|
3142
|
33
|
100
|
|
|
|
88
|
|
|
3143
|
|
|
|
|
|
|
$no_execute |
|
3144
|
|
|
|
|
|
|
and return HTTP::Response->new( |
|
3145
|
|
|
|
|
|
|
HTTP_I_AM_A_TEAPOT, undef, undef, $data ); |
|
3146
|
21
|
|
|
|
|
74
|
|
|
3147
|
|
|
|
|
|
|
my $resp = HTTP::Response->new( HTTP_OK, COPACETIC, undef, |
|
3148
|
|
|
|
|
|
|
$data ); |
|
3149
|
21
|
|
|
|
|
1015
|
|
|
3150
|
21
|
|
|
|
|
81
|
$self->_convert_content( $resp ); |
|
3151
|
|
|
|
|
|
|
$self->_add_pragmata( $resp, |
|
3152
|
|
|
|
|
|
|
'spacetrack-type' => 'orbit', |
|
3153
|
|
|
|
|
|
|
'spacetrack-source' => 'spacetrack', |
|
3154
|
|
|
|
|
|
|
'spacetrack-interface' => 2, |
|
3155
|
21
|
|
|
|
|
248
|
); |
|
3156
|
|
|
|
|
|
|
return $resp; |
|
3157
|
|
|
|
|
|
|
} |
|
3158
|
|
|
|
|
|
|
|
|
3159
|
|
|
|
|
|
|
{ |
|
3160
|
|
|
|
|
|
|
|
|
3161
|
|
|
|
|
|
|
my %rest_sort_map = ( |
|
3162
|
|
|
|
|
|
|
catnum => 'OBJECT_NUMBER', |
|
3163
|
|
|
|
|
|
|
epoch => 'EPOCH', |
|
3164
|
|
|
|
|
|
|
); |
|
3165
|
|
|
|
|
|
|
|
|
3166
|
38
|
|
|
38
|
|
82
|
sub _convert_retrieve_options_to_rest { |
|
3167
|
|
|
|
|
|
|
my ( $self, $opt ) = @_; |
|
3168
|
38
|
|
|
|
|
97
|
|
|
3169
|
|
|
|
|
|
|
my %rest = ( |
|
3170
|
|
|
|
|
|
|
class => 'tle_latest', |
|
3171
|
|
|
|
|
|
|
); |
|
3172
|
38
|
100
|
66
|
|
|
147
|
|
|
3173
|
5
|
|
|
|
|
12
|
if ( $opt->{start_epoch} || $opt->{end_epoch} ) { |
|
|
10
|
|
|
|
|
29
|
|
|
3174
|
|
|
|
|
|
|
$rest{EPOCH} = join '--', map { _rest_date( $opt->{$_} ) } |
|
3175
|
5
|
|
|
|
|
13
|
qw{ _start_epoch _end_epoch }; |
|
3176
|
|
|
|
|
|
|
$rest{class} = 'tle'; |
|
3177
|
|
|
|
|
|
|
} |
|
3178
|
|
|
|
|
|
|
|
|
3179
|
|
|
|
|
|
|
$rest{orderby} = ( $rest_sort_map{$opt->{sort} || 'catnum'} || |
|
3180
|
38
|
100
|
50
|
|
|
190
|
'OBJECT_NUMBER' ) |
|
3181
|
|
|
|
|
|
|
. ( $opt->{descending} ? ' desc' : ' asc' ); |
|
3182
|
38
|
100
|
|
|
|
95
|
|
|
3183
|
1
|
|
|
|
|
4
|
if ( $opt->{since_file} ) { |
|
3184
|
1
|
|
|
|
|
2
|
$rest{FILE} = ">$opt->{since_file}"; |
|
3185
|
|
|
|
|
|
|
$rest{class} = 'tle'; |
|
3186
|
|
|
|
|
|
|
} |
|
3187
|
38
|
50
|
33
|
|
|
97
|
|
|
3188
|
0
|
|
|
|
|
0
|
if ( $opt->{status} && $opt->{status} ne 'onorbit' ) { |
|
3189
|
|
|
|
|
|
|
$rest{class} = 'tle'; |
|
3190
|
|
|
|
|
|
|
} |
|
3191
|
38
|
|
|
|
|
72
|
|
|
3192
|
|
|
|
|
|
|
foreach my $name ( |
|
3193
|
|
|
|
|
|
|
qw{ class format }, |
|
3194
|
|
|
|
|
|
|
qw{ ECCENTRICITY FILE MEAN_MOTION OBJECT_NAME }, |
|
3195
|
|
|
|
|
|
|
) { |
|
3196
|
228
|
100
|
|
|
|
479
|
defined $opt->{$name} |
|
3197
|
|
|
|
|
|
|
and $rest{$name} = $opt->{$name}; |
|
3198
|
|
|
|
|
|
|
} |
|
3199
|
38
|
100
|
|
|
|
130
|
|
|
3200
|
34
|
100
|
|
|
|
81
|
if ( 'legacy' eq $rest{format} ) { |
|
3201
|
9
|
|
|
|
|
17
|
if ( $self->{with_name} ) { |
|
3202
|
|
|
|
|
|
|
$rest{format} = '3le'; |
|
3203
|
9
|
50
|
|
|
|
29
|
defined $rest{predicates} |
|
3204
|
|
|
|
|
|
|
or $rest{predicates} = 'OBJECT_NAME,TLE_LINE1,TLE_LINE2'; |
|
3205
|
25
|
|
|
|
|
56
|
} else { |
|
3206
|
|
|
|
|
|
|
$rest{format} = 'tle'; |
|
3207
|
|
|
|
|
|
|
} |
|
3208
|
|
|
|
|
|
|
} |
|
3209
|
|
|
|
|
|
|
|
|
3210
|
38
|
100
|
|
|
|
102
|
$rest{class} eq 'tle_latest' |
|
|
|
100
|
|
|
|
|
|
|
3211
|
|
|
|
|
|
|
and $rest{ORDINAL} = $opt->{last5} ? '1--5' : 1; |
|
3212
|
38
|
|
|
|
|
103
|
|
|
3213
|
|
|
|
|
|
|
return \%rest; |
|
3214
|
|
|
|
|
|
|
} |
|
3215
|
|
|
|
|
|
|
|
|
3216
|
|
|
|
|
|
|
} |
|
3217
|
|
|
|
|
|
|
|
|
3218
|
|
|
|
|
|
|
{ |
|
3219
|
|
|
|
|
|
|
my @heading_info = ( |
|
3220
|
|
|
|
|
|
|
[ undef, OBJECT_NUMBER => 'Catalog Number' ], |
|
3221
|
|
|
|
|
|
|
[ undef, OBJECT_NAME => 'Common Name' ], |
|
3222
|
|
|
|
|
|
|
[ undef, OBJECT_ID => 'International Designator' ], |
|
3223
|
|
|
|
|
|
|
[ undef, COUNTRY => 'Country' ], |
|
3224
|
|
|
|
|
|
|
[ undef, LAUNCH => 'Launch Date' ], |
|
3225
|
|
|
|
|
|
|
[ undef, SITE => 'Launch Site' ], |
|
3226
|
|
|
|
|
|
|
[ undef, DECAY => 'Decay Date' ], |
|
3227
|
|
|
|
|
|
|
[ undef, PERIOD => 'Period' ], |
|
3228
|
|
|
|
|
|
|
[ undef, APOGEE => 'Apogee' ], |
|
3229
|
|
|
|
|
|
|
[ undef, PERIGEE => 'Perigee' ], |
|
3230
|
|
|
|
|
|
|
[ 'comment', COMMENT => 'Comment' ], |
|
3231
|
|
|
|
|
|
|
[ undef, RCSVALUE => 'RCS' ], |
|
3232
|
|
|
|
|
|
|
); |
|
3233
|
|
|
|
|
|
|
|
|
3234
|
50
|
|
|
50
|
|
80
|
sub _search_heading_order { |
|
3235
|
50
|
|
|
|
|
87
|
my ( $opt ) = @_; |
|
|
550
|
|
|
|
|
829
|
|
|
3236
|
|
|
|
|
|
|
return ( map { $_->[1] } |
|
3237
|
|
|
|
|
|
|
_search_heading_relevant( $opt ) |
|
3238
|
|
|
|
|
|
|
); |
|
3239
|
|
|
|
|
|
|
} |
|
3240
|
|
|
|
|
|
|
|
|
3241
|
100
|
|
|
100
|
|
147
|
sub _search_heading_relevant { |
|
3242
|
|
|
|
|
|
|
my ( $opt ) = @_; |
|
3243
|
100
|
100
|
|
|
|
172
|
return ( |
|
|
1200
|
|
|
|
|
2558
|
|
|
3244
|
|
|
|
|
|
|
grep { ! defined $_->[0] || $opt->{$_->[0]} } |
|
3245
|
|
|
|
|
|
|
@heading_info |
|
3246
|
|
|
|
|
|
|
); |
|
3247
|
|
|
|
|
|
|
} |
|
3248
|
|
|
|
|
|
|
|
|
3249
|
50
|
|
|
50
|
|
92
|
sub _search_heading_hash_ref { |
|
3250
|
|
|
|
|
|
|
my ( $opt ) = @_; |
|
3251
|
50
|
|
|
|
|
96
|
return { |
|
|
550
|
|
|
|
|
1184
|
|
|
3252
|
|
|
|
|
|
|
map { $_->[1] => $_->[2] } |
|
3253
|
|
|
|
|
|
|
_search_heading_relevant( $opt ) |
|
3254
|
|
|
|
|
|
|
}; |
|
3255
|
|
|
|
|
|
|
} |
|
3256
|
|
|
|
|
|
|
|
|
3257
|
|
|
|
|
|
|
} |
|
3258
|
|
|
|
|
|
|
|
|
3259
|
50
|
|
|
50
|
|
139
|
sub _search_rest { |
|
3260
|
50
|
|
|
|
|
150
|
my ( $self, $pred, $xfrm, @args ) = @_; |
|
3261
|
|
|
|
|
|
|
delete $self->{_pragmata}; |
|
3262
|
50
|
|
|
|
|
132
|
|
|
3263
|
|
|
|
|
|
|
( my $opt, @args ) = $self->_parse_search_args( @args ); |
|
3264
|
50
|
|
|
|
|
113
|
|
|
3265
|
50
|
|
|
|
|
147
|
my $headings = _search_heading_hash_ref( $opt ); |
|
3266
|
|
|
|
|
|
|
my @heading_order = _search_heading_order( $opt ); |
|
3267
|
50
|
100
|
|
|
|
135
|
|
|
3268
|
|
|
|
|
|
|
if ( $pred eq 'OBJECT_NUMBER' ) { |
|
3269
|
12
|
50
|
|
|
|
37
|
|
|
3270
|
|
|
|
|
|
|
@args = $self->_expand_oid_list( @args ) |
|
3271
|
|
|
|
|
|
|
or return HTTP::Response->new( |
|
3272
|
|
|
|
|
|
|
HTTP_PRECONDITION_FAILED, NO_CAT_ID ); |
|
3273
|
12
|
|
|
|
|
48
|
|
|
3274
|
|
|
|
|
|
|
@args = ( |
|
3275
|
|
|
|
|
|
|
_stringify_oid_list( { |
|
3276
|
|
|
|
|
|
|
separator => ',', |
|
3277
|
|
|
|
|
|
|
range_operator => '--', |
|
3278
|
|
|
|
|
|
|
}, |
|
3279
|
|
|
|
|
|
|
@args |
|
3280
|
|
|
|
|
|
|
) |
|
3281
|
|
|
|
|
|
|
); |
|
3282
|
|
|
|
|
|
|
|
|
3283
|
|
|
|
|
|
|
} |
|
3284
|
50
|
|
|
|
|
135
|
|
|
3285
|
50
|
50
|
66
|
|
|
148
|
my $rest_args = $self->_convert_search_options_to_rest( $opt ); |
|
3286
|
50
|
|
|
|
|
97
|
if ( $opt->{tle} || 'legacy' eq $opt->{format} ) { |
|
3287
|
|
|
|
|
|
|
$rest_args->{format} = 'json' |
|
3288
|
0
|
|
|
|
|
0
|
} else { |
|
3289
|
|
|
|
|
|
|
$rest_args->{format} = $opt->{format}; |
|
3290
|
|
|
|
|
|
|
} |
|
3291
|
|
|
|
|
|
|
|
|
3292
|
|
|
|
|
|
|
my $class = defined $rest_args->{class} ? |
|
3293
|
50
|
50
|
|
|
|
118
|
$rest_args->{class} : |
|
3294
|
|
|
|
|
|
|
DEFAULT_SPACE_TRACK_REST_SEARCH_CLASS; |
|
3295
|
50
|
|
|
|
|
111
|
|
|
3296
|
|
|
|
|
|
|
my $accumulator = _accumulator_for( $rest_args->{format} ); |
|
3297
|
50
|
|
|
|
|
114
|
|
|
|
50
|
|
|
|
|
126
|
|
|
3298
|
|
|
|
|
|
|
foreach my $search_for ( map { $xfrm->( $_, $class ) } @args ) { |
|
3299
|
50
|
|
|
|
|
84
|
|
|
3300
|
|
|
|
|
|
|
my $rslt; |
|
3301
|
50
|
|
|
|
|
78
|
{ |
|
|
50
|
|
|
|
|
124
|
|
|
3302
|
50
|
|
|
|
|
74
|
local $self->{pretty} = 0; |
|
|
50
|
|
|
|
|
204
|
|
|
3303
|
|
|
|
|
|
|
$rslt = $self->__search_rest_raw( %{ $rest_args }, |
|
3304
|
|
|
|
|
|
|
$pred, $search_for ); |
|
3305
|
|
|
|
|
|
|
} |
|
3306
|
|
|
|
|
|
|
|
|
3307
|
50
|
100
|
|
|
|
150
|
$rslt->is_success() |
|
3308
|
|
|
|
|
|
|
or return $rslt; |
|
3309
|
19
|
|
|
|
|
166
|
|
|
3310
|
|
|
|
|
|
|
$accumulator->( $self, $rslt ); |
|
3311
|
|
|
|
|
|
|
|
|
3312
|
|
|
|
|
|
|
} |
|
3313
|
19
|
|
|
|
|
54
|
|
|
3314
|
|
|
|
|
|
|
my ( $content, $data ) = $accumulator->( $self ); |
|
3315
|
19
|
100
|
|
|
|
56
|
|
|
3316
|
|
|
|
|
|
|
if ( $opt->{tle} ) { |
|
3317
|
14
|
50
|
|
|
|
44
|
defined $opt->{format} |
|
3318
|
14
|
50
|
|
|
|
37
|
or $opt->{format} = 'tle'; |
|
3319
|
|
|
|
|
|
|
ARRAY_REF eq ref $data |
|
3320
|
14
|
|
|
|
|
35
|
or Carp::croak "Format $rest_args->{format} does not support TLE retrieval"; |
|
3321
|
|
|
|
|
|
|
my $ropt = _remove_search_options( $opt ); |
|
3322
|
|
|
|
|
|
|
|
|
3323
|
14
|
|
|
|
|
29
|
my $rslt = $self->retrieve( $ropt, |
|
|
48
|
|
|
|
|
108
|
|
|
|
14
|
|
|
|
|
27
|
|
|
3324
|
|
|
|
|
|
|
map { $_->{OBJECT_NUMBER} } @{ $data } ); |
|
3325
|
14
|
|
|
|
|
351
|
|
|
3326
|
|
|
|
|
|
|
return $rslt; |
|
3327
|
|
|
|
|
|
|
|
|
3328
|
|
|
|
|
|
|
} else { |
|
3329
|
5
|
50
|
|
|
|
18
|
|
|
3330
|
5
|
|
|
|
|
10
|
if ( 'legacy' eq $opt->{format} ) { |
|
3331
|
5
|
|
|
|
|
9
|
$content = ''; |
|
3332
|
|
|
|
|
|
|
foreach my $datum ( |
|
3333
|
5
|
|
|
|
|
11
|
$headings, |
|
3334
|
|
|
|
|
|
|
@{ $data } |
|
3335
|
|
|
|
|
|
|
) { |
|
3336
|
12
|
100
|
|
|
|
22
|
$content .= join( "\t", |
|
|
132
|
|
|
|
|
298
|
|
|
3337
|
|
|
|
|
|
|
map { defined $datum->{$_} ? $datum->{$_} : '' } |
|
3338
|
|
|
|
|
|
|
@heading_order |
|
3339
|
|
|
|
|
|
|
) . "\n"; |
|
3340
|
|
|
|
|
|
|
} |
|
3341
|
|
|
|
|
|
|
} |
|
3342
|
5
|
|
|
|
|
22
|
|
|
3343
|
5
|
|
|
|
|
257
|
my $rslt = HTTP::Response->new( HTTP_OK, undef, undef, $content ); |
|
3344
|
|
|
|
|
|
|
$self->_add_pragmata( $rslt, |
|
3345
|
|
|
|
|
|
|
'spacetrack-type' => 'search', |
|
3346
|
|
|
|
|
|
|
'spacetrack-source' => 'spacetrack', |
|
3347
|
|
|
|
|
|
|
'spacetrack-interface' => 2, |
|
3348
|
|
|
|
|
|
|
); |
|
3349
|
5
|
50
|
33
|
|
|
17
|
wantarray |
|
3350
|
|
|
|
|
|
|
and $data |
|
3351
|
5
|
|
|
|
|
109
|
and return ( $rslt, $data ); |
|
3352
|
|
|
|
|
|
|
return $rslt; |
|
3353
|
|
|
|
|
|
|
} |
|
3354
|
|
|
|
|
|
|
|
|
3355
|
|
|
|
|
|
|
# Note - if we're doing the tab output, the names and order are: |
|
3356
|
|
|
|
|
|
|
# Catalog Number: OBJECT_NUMBER |
|
3357
|
|
|
|
|
|
|
# Common Name: OBJECT_NAME |
|
3358
|
|
|
|
|
|
|
# International Designator: OBJECT_ID |
|
3359
|
|
|
|
|
|
|
# Country: COUNTRY |
|
3360
|
|
|
|
|
|
|
# Launch Date: LAUNCH (yyyy-mm-dd) |
|
3361
|
|
|
|
|
|
|
# Launch Site: SITE |
|
3362
|
|
|
|
|
|
|
# Decay Date: DECAY |
|
3363
|
|
|
|
|
|
|
# Period: PERIOD |
|
3364
|
|
|
|
|
|
|
# Incl.: INCLINATION |
|
3365
|
|
|
|
|
|
|
# Apogee: APOGEE |
|
3366
|
|
|
|
|
|
|
# Perigee: PERIGEE |
|
3367
|
|
|
|
|
|
|
# RCS: RCSVALUE |
|
3368
|
|
|
|
|
|
|
|
|
3369
|
|
|
|
|
|
|
} |
|
3370
|
|
|
|
|
|
|
|
|
3371
|
50
|
|
|
50
|
|
189
|
sub __search_rest_raw { |
|
3372
|
50
|
|
|
|
|
100
|
my ( $self, %args ) = @_; |
|
3373
|
|
|
|
|
|
|
delete $self->{_pragmata}; |
|
3374
|
|
|
|
|
|
|
# https://beta.space-track.org/basicspacedata/query/class/satcat/CURRENT/Y/OBJECT_NUMBER/25544/predicates/all/limit/10,0/metadata/true |
|
3375
|
50
|
50
|
|
|
|
103
|
|
|
3376
|
|
|
|
|
|
|
%args |
|
3377
|
|
|
|
|
|
|
or return HTTP::Response->new( HTTP_PRECONDITION_FAILED, NO_CAT_ID ); |
|
3378
|
|
|
|
|
|
|
|
|
3379
|
50
|
50
|
|
|
|
162
|
exists $args{class} |
|
3380
|
|
|
|
|
|
|
or $args{class} = DEFAULT_SPACE_TRACK_REST_SEARCH_CLASS; |
|
3381
|
|
|
|
|
|
|
$args{class} ne 'satcat' |
|
3382
|
50
|
50
|
33
|
|
|
203
|
or exists $args{CURRENT} |
|
3383
|
|
|
|
|
|
|
or $args{CURRENT} = 'Y'; |
|
3384
|
50
|
50
|
|
|
|
100
|
exists $args{format} |
|
3385
|
|
|
|
|
|
|
or $args{format} = 'json'; |
|
3386
|
50
|
50
|
|
|
|
113
|
exists $args{predicates} |
|
3387
|
|
|
|
|
|
|
or $args{predicates} = 'all'; |
|
3388
|
50
|
50
|
|
|
|
111
|
exists $args{orderby} |
|
3389
|
|
|
|
|
|
|
or $args{orderby} = 'OBJECT_NUMBER asc'; |
|
3390
|
|
|
|
|
|
|
# exists $args{limit} |
|
3391
|
|
|
|
|
|
|
# or $args{limit} = 1000; |
|
3392
|
50
|
|
|
|
|
113
|
|
|
3393
|
|
|
|
|
|
|
my $resp = $self->spacetrack_query_v2( |
|
3394
|
|
|
|
|
|
|
basicspacedata => 'query', |
|
3395
|
|
|
|
|
|
|
_sort_rest_arguments( \%args ), |
|
3396
|
|
|
|
|
|
|
); |
|
3397
|
|
|
|
|
|
|
# $resp->content( $content ); |
|
3398
|
50
|
|
|
|
|
235
|
# $self->_convert_content( $resp ); |
|
3399
|
|
|
|
|
|
|
$self->_add_pragmata( $resp, |
|
3400
|
|
|
|
|
|
|
'spacetrack-type' => 'orbit', |
|
3401
|
|
|
|
|
|
|
'spacetrack-source' => 'spacetrack', |
|
3402
|
|
|
|
|
|
|
'spacetrack-interface' => 2, |
|
3403
|
50
|
|
|
|
|
184
|
); |
|
3404
|
|
|
|
|
|
|
return $resp; |
|
3405
|
|
|
|
|
|
|
} |
|
3406
|
|
|
|
|
|
|
|
|
3407
|
|
|
|
|
|
|
=for html |
|
3408
|
|
|
|
|
|
|
|
|
3409
|
|
|
|
|
|
|
=item $resp = $st->search_date (date ...) |
|
3410
|
|
|
|
|
|
|
|
|
3411
|
|
|
|
|
|
|
This method searches the Space Track database for objects launched on |
|
3412
|
|
|
|
|
|
|
the given date. The date is specified as year-month-day, with any |
|
3413
|
|
|
|
|
|
|
non-digit being legal as the separator. You can omit -day or specify it |
|
3414
|
|
|
|
|
|
|
as 0 to get all launches for the given month. You can omit -month (or |
|
3415
|
|
|
|
|
|
|
specify it as 0) as well to get all launches for the given year. |
|
3416
|
|
|
|
|
|
|
|
|
3417
|
|
|
|
|
|
|
A Space Track username and password are required to use this method. |
|
3418
|
|
|
|
|
|
|
|
|
3419
|
|
|
|
|
|
|
You can specify options for the search as either command-type options |
|
3420
|
|
|
|
|
|
|
(e.g. C<< $st->search_date (-status => 'onorbit', ...) >>) or as a |
|
3421
|
|
|
|
|
|
|
leading hash reference (e.g. |
|
3422
|
|
|
|
|
|
|
C<< $st->search_date ({status => onorbit}, ...) >>). If you specify the |
|
3423
|
|
|
|
|
|
|
hash reference, option names must be specified in full, without the |
|
3424
|
|
|
|
|
|
|
leading '-', and the argument list will not be parsed for command-type |
|
3425
|
|
|
|
|
|
|
options. Options that take multiple values (i.e. 'exclude') must have |
|
3426
|
|
|
|
|
|
|
their values specified as a hash reference, even if you only specify one |
|
3427
|
|
|
|
|
|
|
value - or none at all. |
|
3428
|
|
|
|
|
|
|
|
|
3429
|
|
|
|
|
|
|
If you specify command-type options, they may be abbreviated, as long as |
|
3430
|
|
|
|
|
|
|
the abbreviation is unique. Errors in either sort of specification |
|
3431
|
|
|
|
|
|
|
result in an exception being thrown. |
|
3432
|
|
|
|
|
|
|
|
|
3433
|
|
|
|
|
|
|
In addition to the options available for C, the following |
|
3434
|
|
|
|
|
|
|
options may be specified: |
|
3435
|
|
|
|
|
|
|
|
|
3436
|
|
|
|
|
|
|
-exclude |
|
3437
|
|
|
|
|
|
|
specifies the types of bodies to exclude. The |
|
3438
|
|
|
|
|
|
|
value is one or more of 'payload', 'debris', 'rocket', |
|
3439
|
|
|
|
|
|
|
'unknown', 'tba', or 'other'. If you specify this as a |
|
3440
|
|
|
|
|
|
|
command-line option you may either specify this more |
|
3441
|
|
|
|
|
|
|
than once or specify the values comma-separated. |
|
3442
|
|
|
|
|
|
|
-include |
|
3443
|
|
|
|
|
|
|
specifies the types of bodies to include. The possible |
|
3444
|
|
|
|
|
|
|
values are the same as for -exclude. If you specify a |
|
3445
|
|
|
|
|
|
|
given body as both included and excluded it is included. |
|
3446
|
|
|
|
|
|
|
-rcs |
|
3447
|
|
|
|
|
|
|
used to specify that the radar cross-section returned |
|
3448
|
|
|
|
|
|
|
by the search was to be appended to the name, in the form |
|
3449
|
|
|
|
|
|
|
--rcs radar_cross_section. Beginning with version 0.086_02 |
|
3450
|
|
|
|
|
|
|
it does nothing, since as of August 18 2014 Space Track |
|
3451
|
|
|
|
|
|
|
no longer provides quantitative RCS data. |
|
3452
|
|
|
|
|
|
|
-status |
|
3453
|
|
|
|
|
|
|
specifies the desired status of the returned body (or |
|
3454
|
|
|
|
|
|
|
bodies). Must be 'onorbit', 'decayed', or 'all'. The |
|
3455
|
|
|
|
|
|
|
default is 'onorbit'. Specifying a value other than the |
|
3456
|
|
|
|
|
|
|
default will cause the -last5 option to be ignored. |
|
3457
|
|
|
|
|
|
|
Note that this option represents status at the time the |
|
3458
|
|
|
|
|
|
|
search was done; you can not combine it with the |
|
3459
|
|
|
|
|
|
|
retrieve() date options to find bodies onorbit as of a |
|
3460
|
|
|
|
|
|
|
given date in the past. |
|
3461
|
|
|
|
|
|
|
-tle |
|
3462
|
|
|
|
|
|
|
specifies that you want TLE data retrieved for all |
|
3463
|
|
|
|
|
|
|
bodies that satisfy the search criteria. This is |
|
3464
|
|
|
|
|
|
|
true by default, but may be negated by specifying |
|
3465
|
|
|
|
|
|
|
-notle ( or { tle => 0 } ). If negated, the content |
|
3466
|
|
|
|
|
|
|
of the response object is the results of the search, |
|
3467
|
|
|
|
|
|
|
one line per body found, with the fields tab- |
|
3468
|
|
|
|
|
|
|
delimited. |
|
3469
|
|
|
|
|
|
|
-comment |
|
3470
|
|
|
|
|
|
|
specifies that you want the comment field. This will |
|
3471
|
|
|
|
|
|
|
not appear in the TLE data, but in the satcat data |
|
3472
|
|
|
|
|
|
|
returned in array context, or if C<-notle> is |
|
3473
|
|
|
|
|
|
|
specified. The default is C<-nocomment> for backward |
|
3474
|
|
|
|
|
|
|
compatibility. |
|
3475
|
|
|
|
|
|
|
|
|
3476
|
|
|
|
|
|
|
The C<-rcs> option does not work with all values of C<-format>. An |
|
3477
|
|
|
|
|
|
|
exception will be thrown unless C<-format> is C<'tle'>, C<'3le'>, |
|
3478
|
|
|
|
|
|
|
C<'legacy'>, or C<'json'>. |
|
3479
|
|
|
|
|
|
|
|
|
3480
|
|
|
|
|
|
|
Examples: |
|
3481
|
|
|
|
|
|
|
|
|
3482
|
|
|
|
|
|
|
search_date (-status => 'onorbit', -exclude => |
|
3483
|
|
|
|
|
|
|
'debris,rocket', -last5 '2005-12-25'); |
|
3484
|
|
|
|
|
|
|
search_date (-exclude => 'debris', |
|
3485
|
|
|
|
|
|
|
-exclude => 'rocket', '2005/12/25'); |
|
3486
|
|
|
|
|
|
|
search_date ({exclude => ['debris', 'rocket']}, |
|
3487
|
|
|
|
|
|
|
'2005-12-25'); |
|
3488
|
|
|
|
|
|
|
search_date ({exclude => 'debris,rocket'}, # INVALID! |
|
3489
|
|
|
|
|
|
|
'2005-12-25'); |
|
3490
|
|
|
|
|
|
|
search_date ( '-notle', '2005-12-25' ); |
|
3491
|
|
|
|
|
|
|
|
|
3492
|
|
|
|
|
|
|
The C<-exclude> option is implemented in terms of the C |
|
3493
|
|
|
|
|
|
|
predicate, which is one of the values C<'PAYLOAD'>, C<'ROCKET BODY'>, |
|
3494
|
|
|
|
|
|
|
C<'DEBRIS'>, C<'UNKNOWN'>, C<'TBA'>, or C<'OTHER'>. It works by |
|
3495
|
|
|
|
|
|
|
selecting all values other than the ones specifically excluded. The |
|
3496
|
|
|
|
|
|
|
C<'TBA'> status was introduced October 1 2013, supposedly replacing |
|
3497
|
|
|
|
|
|
|
C<'UNKNOWN'>, but I have retained both. |
|
3498
|
|
|
|
|
|
|
|
|
3499
|
|
|
|
|
|
|
This method implicitly calls the C method if the session cookie |
|
3500
|
|
|
|
|
|
|
is missing or expired. If C fails, you will get the |
|
3501
|
|
|
|
|
|
|
HTTP::Response from C. |
|
3502
|
|
|
|
|
|
|
|
|
3503
|
|
|
|
|
|
|
What you get on success depends on the value specified for the -tle |
|
3504
|
|
|
|
|
|
|
option. |
|
3505
|
|
|
|
|
|
|
|
|
3506
|
|
|
|
|
|
|
Unless you explicitly specified C<-notle> (or C<< { tle => 0 } >>), this |
|
3507
|
|
|
|
|
|
|
method returns an HTTP::Response object whose content is the relevant |
|
3508
|
|
|
|
|
|
|
element sets. It will also have the following headers set: |
|
3509
|
|
|
|
|
|
|
|
|
3510
|
|
|
|
|
|
|
Pragma: spacetrack-type = orbit |
|
3511
|
|
|
|
|
|
|
Pragma: spacetrack-source = spacetrack |
|
3512
|
|
|
|
|
|
|
|
|
3513
|
|
|
|
|
|
|
These can be accessed by C<< $st->content_type( $resp ) >> and |
|
3514
|
|
|
|
|
|
|
C<< $st->content_source( $resp ) >> respectively. |
|
3515
|
|
|
|
|
|
|
|
|
3516
|
|
|
|
|
|
|
If you explicitly specified C<-notle> (or C<< { tle => 0 } >>), this |
|
3517
|
|
|
|
|
|
|
method returns an HTTP::Response object whose content is in the format |
|
3518
|
|
|
|
|
|
|
specified by the C<-format> retrieval option (q.v.). If the format is |
|
3519
|
|
|
|
|
|
|
C<'legacy'> (the default if C<-json> is not specified) the content |
|
3520
|
|
|
|
|
|
|
mimics what was returned under the version 1 interface; that is, it is |
|
3521
|
|
|
|
|
|
|
the results of the relevant search, one line per object found. Within a |
|
3522
|
|
|
|
|
|
|
line the fields are tab-delimited, and occur in the same order as the |
|
3523
|
|
|
|
|
|
|
underlying web page. The first line of the content is the header lines |
|
3524
|
|
|
|
|
|
|
from the underlying web page. |
|
3525
|
|
|
|
|
|
|
|
|
3526
|
|
|
|
|
|
|
The returned object will also have the following headers set if |
|
3527
|
|
|
|
|
|
|
C<-notle> is specified: |
|
3528
|
|
|
|
|
|
|
|
|
3529
|
|
|
|
|
|
|
Pragma: spacetrack-type = search |
|
3530
|
|
|
|
|
|
|
Pragma: spacetrack-source = spacetrack |
|
3531
|
|
|
|
|
|
|
|
|
3532
|
|
|
|
|
|
|
If you call this method in list context, the first element of the |
|
3533
|
|
|
|
|
|
|
returned object is the aforementioned HTTP::Response object, and the |
|
3534
|
|
|
|
|
|
|
second is a reference to an array containing the search results. The |
|
3535
|
|
|
|
|
|
|
first element is a reference to an array containing the header lines |
|
3536
|
|
|
|
|
|
|
from the web page. Subsequent elements are references to arrays |
|
3537
|
|
|
|
|
|
|
containing the actual search results. |
|
3538
|
|
|
|
|
|
|
|
|
3539
|
|
|
|
|
|
|
=cut |
|
3540
|
|
|
|
|
|
|
|
|
3541
|
|
|
|
|
|
|
*_search_date_opts = \&_get_search_options; |
|
3542
|
|
|
|
|
|
|
|
|
3543
|
12
|
|
|
12
|
1
|
8273
|
sub search_date { ## no critic (RequireArgUnpacking) |
|
3544
|
12
|
|
|
|
|
43
|
splice @_, 1, 0, LAUNCH => \&_format_launch_date_rest; |
|
3545
|
|
|
|
|
|
|
goto &_search_rest; |
|
3546
|
|
|
|
|
|
|
} |
|
3547
|
|
|
|
|
|
|
|
|
3548
|
|
|
|
|
|
|
|
|
3549
|
|
|
|
|
|
|
=for html |
|
3550
|
|
|
|
|
|
|
|
|
3551
|
|
|
|
|
|
|
=item $resp = $st->search_decay (decay ...) |
|
3552
|
|
|
|
|
|
|
|
|
3553
|
|
|
|
|
|
|
This method searches the Space Track database for objects decayed on |
|
3554
|
|
|
|
|
|
|
the given date. The date is specified as year-month-day, with any |
|
3555
|
|
|
|
|
|
|
non-digit being legal as the separator. You can omit -day or specify it |
|
3556
|
|
|
|
|
|
|
as 0 to get all decays for the given month. You can omit -month (or |
|
3557
|
|
|
|
|
|
|
specify it as 0) as well to get all decays for the given year. |
|
3558
|
|
|
|
|
|
|
|
|
3559
|
|
|
|
|
|
|
The options are the same as for C. |
|
3560
|
|
|
|
|
|
|
|
|
3561
|
|
|
|
|
|
|
A Space Track username and password are required to use this method. |
|
3562
|
|
|
|
|
|
|
|
|
3563
|
|
|
|
|
|
|
What you get on success depends on the value specified for the -tle |
|
3564
|
|
|
|
|
|
|
option. |
|
3565
|
|
|
|
|
|
|
|
|
3566
|
|
|
|
|
|
|
Unless you explicitly specified C<-notle> (or C<< { tle => 0 } >>), this |
|
3567
|
|
|
|
|
|
|
method returns an HTTP::Response object whose content is the relevant |
|
3568
|
|
|
|
|
|
|
element sets. It will also have the following headers set: |
|
3569
|
|
|
|
|
|
|
|
|
3570
|
|
|
|
|
|
|
Pragma: spacetrack-type = orbit |
|
3571
|
|
|
|
|
|
|
Pragma: spacetrack-source = spacetrack |
|
3572
|
|
|
|
|
|
|
|
|
3573
|
|
|
|
|
|
|
These can be accessed by C<< $st->content_type( $resp ) >> and |
|
3574
|
|
|
|
|
|
|
C<< $st->content_source( $resp ) >> respectively. |
|
3575
|
|
|
|
|
|
|
|
|
3576
|
|
|
|
|
|
|
If you explicitly specified C<-notle> (or C<< { tle => 0 } >>), this |
|
3577
|
|
|
|
|
|
|
method returns an HTTP::Response object whose content is the results of |
|
3578
|
|
|
|
|
|
|
the relevant search, one line per object found. Within a line the fields |
|
3579
|
|
|
|
|
|
|
are tab-delimited, and occur in the same order as the underlying web |
|
3580
|
|
|
|
|
|
|
page. The first line of the content is the header lines from the |
|
3581
|
|
|
|
|
|
|
underlying web page. It will also have the following headers set: |
|
3582
|
|
|
|
|
|
|
|
|
3583
|
|
|
|
|
|
|
Pragma: spacetrack-type = search |
|
3584
|
|
|
|
|
|
|
Pragma: spacetrack-source = spacetrack |
|
3585
|
|
|
|
|
|
|
|
|
3586
|
|
|
|
|
|
|
If you call this method in list context, the first element of the |
|
3587
|
|
|
|
|
|
|
returned object is the aforementioned HTTP::Response object, and the |
|
3588
|
|
|
|
|
|
|
second is a reference to an array containing the search results. The |
|
3589
|
|
|
|
|
|
|
first element is a reference to an array containing the header lines |
|
3590
|
|
|
|
|
|
|
from the web page. Subsequent elements are references to arrays |
|
3591
|
|
|
|
|
|
|
containing the actual search results. |
|
3592
|
|
|
|
|
|
|
|
|
3593
|
|
|
|
|
|
|
=cut |
|
3594
|
|
|
|
|
|
|
|
|
3595
|
|
|
|
|
|
|
*_search_decay_opts = \&_get_search_options; |
|
3596
|
|
|
|
|
|
|
|
|
3597
|
2
|
|
|
2
|
1
|
11
|
sub search_decay { ## no critic (RequireArgUnpacking) |
|
3598
|
2
|
|
|
|
|
7
|
splice @_, 1, 0, DECAY => \&_format_launch_date_rest; |
|
3599
|
|
|
|
|
|
|
goto &_search_rest; |
|
3600
|
|
|
|
|
|
|
} |
|
3601
|
|
|
|
|
|
|
|
|
3602
|
|
|
|
|
|
|
|
|
3603
|
|
|
|
|
|
|
=for html |
|
3604
|
|
|
|
|
|
|
|
|
3605
|
|
|
|
|
|
|
=item $resp = $st->search_id (id ...) |
|
3606
|
|
|
|
|
|
|
|
|
3607
|
|
|
|
|
|
|
This method searches the Space Track database for objects having the |
|
3608
|
|
|
|
|
|
|
given international IDs. The international ID is the last two digits of |
|
3609
|
|
|
|
|
|
|
the launch year (in the range 1957 through 2056), the three-digit |
|
3610
|
|
|
|
|
|
|
sequence number of the launch within the year (with leading zeroes as |
|
3611
|
|
|
|
|
|
|
needed), and the piece (A through ZZZ, with A typically being the |
|
3612
|
|
|
|
|
|
|
payload). You can omit the piece and get all pieces of that launch, or |
|
3613
|
|
|
|
|
|
|
omit both the piece and the launch number and get all launches for the |
|
3614
|
|
|
|
|
|
|
year. There is no mechanism to restrict the search to a given on-orbit |
|
3615
|
|
|
|
|
|
|
status, or to filter out debris or rocket bodies. |
|
3616
|
|
|
|
|
|
|
|
|
3617
|
|
|
|
|
|
|
The options are the same as for C. |
|
3618
|
|
|
|
|
|
|
|
|
3619
|
|
|
|
|
|
|
A Space Track username and password are required to use this method. |
|
3620
|
|
|
|
|
|
|
|
|
3621
|
|
|
|
|
|
|
This method implicitly calls the C method if the session cookie |
|
3622
|
|
|
|
|
|
|
is missing or expired. If C fails, you will get the |
|
3623
|
|
|
|
|
|
|
HTTP::Response from C. |
|
3624
|
|
|
|
|
|
|
|
|
3625
|
|
|
|
|
|
|
What you get on success depends on the value specified for the C<-tle> |
|
3626
|
|
|
|
|
|
|
option. |
|
3627
|
|
|
|
|
|
|
|
|
3628
|
|
|
|
|
|
|
Unless you explicitly specified C<-notle> (or C<< { tle => 0 } >>), this |
|
3629
|
|
|
|
|
|
|
method returns an HTTP::Response object whose content is the relevant |
|
3630
|
|
|
|
|
|
|
element sets. It will also have the following headers set: |
|
3631
|
|
|
|
|
|
|
|
|
3632
|
|
|
|
|
|
|
Pragma: spacetrack-type = orbit |
|
3633
|
|
|
|
|
|
|
Pragma: spacetrack-source = spacetrack |
|
3634
|
|
|
|
|
|
|
|
|
3635
|
|
|
|
|
|
|
These can be accessed by C<< $st->content_type( $resp ) >> and |
|
3636
|
|
|
|
|
|
|
C<< $st->content_source( $resp ) >> respectively. |
|
3637
|
|
|
|
|
|
|
|
|
3638
|
|
|
|
|
|
|
If you explicitly specified C<-notle> (or C<< { tle => 0 } >>), this |
|
3639
|
|
|
|
|
|
|
method returns an HTTP::Response object whose content is the results of |
|
3640
|
|
|
|
|
|
|
the relevant search, one line per object found. Within a line the fields |
|
3641
|
|
|
|
|
|
|
are tab-delimited, and occur in the same order as the underlying web |
|
3642
|
|
|
|
|
|
|
page. The first line of the content is the header lines from the |
|
3643
|
|
|
|
|
|
|
underlying web page. It will also have the following headers set: |
|
3644
|
|
|
|
|
|
|
|
|
3645
|
|
|
|
|
|
|
Pragma: spacetrack-type = search |
|
3646
|
|
|
|
|
|
|
Pragma: spacetrack-source = spacetrack |
|
3647
|
|
|
|
|
|
|
|
|
3648
|
|
|
|
|
|
|
If you call this method in list context, the first element of the |
|
3649
|
|
|
|
|
|
|
returned object is the aforementioned HTTP::Response object, and the |
|
3650
|
|
|
|
|
|
|
second is a reference to an array containing the search results. The |
|
3651
|
|
|
|
|
|
|
first element is a reference to an array containing the header lines |
|
3652
|
|
|
|
|
|
|
from the web page. Subsequent elements are references to arrays |
|
3653
|
|
|
|
|
|
|
containing the actual search results. |
|
3654
|
|
|
|
|
|
|
|
|
3655
|
|
|
|
|
|
|
=cut |
|
3656
|
|
|
|
|
|
|
|
|
3657
|
|
|
|
|
|
|
*_search_id_opts = \&_get_search_options; |
|
3658
|
|
|
|
|
|
|
|
|
3659
|
14
|
|
|
14
|
1
|
9449
|
sub search_id { ## no critic (RequireArgUnpacking) |
|
3660
|
14
|
|
|
|
|
43
|
splice @_, 1, 0, OBJECT_ID => \&_format_international_id_rest; |
|
3661
|
|
|
|
|
|
|
goto &_search_rest; |
|
3662
|
|
|
|
|
|
|
} |
|
3663
|
|
|
|
|
|
|
|
|
3664
|
|
|
|
|
|
|
|
|
3665
|
|
|
|
|
|
|
=for html |
|
3666
|
|
|
|
|
|
|
|
|
3667
|
|
|
|
|
|
|
=item $resp = $st->search_name (name ...) |
|
3668
|
|
|
|
|
|
|
|
|
3669
|
|
|
|
|
|
|
This method searches the Space Track database for the named objects. |
|
3670
|
|
|
|
|
|
|
Matches are case-insensitive and all matches are returned. |
|
3671
|
|
|
|
|
|
|
|
|
3672
|
|
|
|
|
|
|
The options are the same as for C. The C<-status> option |
|
3673
|
|
|
|
|
|
|
is known to work, but I am not sure about the efficacy the C<-exclude> |
|
3674
|
|
|
|
|
|
|
option. |
|
3675
|
|
|
|
|
|
|
|
|
3676
|
|
|
|
|
|
|
A Space Track username and password are required to use this method. |
|
3677
|
|
|
|
|
|
|
|
|
3678
|
|
|
|
|
|
|
This method implicitly calls the C method if the session cookie |
|
3679
|
|
|
|
|
|
|
is missing or expired. If C fails, you will get the |
|
3680
|
|
|
|
|
|
|
HTTP::Response from C. |
|
3681
|
|
|
|
|
|
|
|
|
3682
|
|
|
|
|
|
|
What you get on success depends on the value specified for the -tle |
|
3683
|
|
|
|
|
|
|
option. |
|
3684
|
|
|
|
|
|
|
|
|
3685
|
|
|
|
|
|
|
Unless you explicitly specified C<-notle> (or C<< { tle => 0 } >>), this |
|
3686
|
|
|
|
|
|
|
method returns an HTTP::Response object whose content is the relevant |
|
3687
|
|
|
|
|
|
|
element sets. It will also have the following headers set: |
|
3688
|
|
|
|
|
|
|
|
|
3689
|
|
|
|
|
|
|
Pragma: spacetrack-type = orbit |
|
3690
|
|
|
|
|
|
|
Pragma: spacetrack-source = spacetrack |
|
3691
|
|
|
|
|
|
|
|
|
3692
|
|
|
|
|
|
|
These can be accessed by C<< $st->content_type( $resp ) >> and |
|
3693
|
|
|
|
|
|
|
C<< $st->content_source( $resp ) >> respectively. |
|
3694
|
|
|
|
|
|
|
|
|
3695
|
|
|
|
|
|
|
If you explicitly specified C<-notle> (or C<< { tle => 0 } >>), this |
|
3696
|
|
|
|
|
|
|
method returns an HTTP::Response object whose content is the results of |
|
3697
|
|
|
|
|
|
|
the relevant search, one line per object found. Within a line the fields |
|
3698
|
|
|
|
|
|
|
are tab-delimited, and occur in the same order as the underlying web |
|
3699
|
|
|
|
|
|
|
page. The first line of the content is the header lines from the |
|
3700
|
|
|
|
|
|
|
underlying web page. It will also have the following headers set: |
|
3701
|
|
|
|
|
|
|
|
|
3702
|
|
|
|
|
|
|
Pragma: spacetrack-type = search |
|
3703
|
|
|
|
|
|
|
Pragma: spacetrack-source = spacetrack |
|
3704
|
|
|
|
|
|
|
|
|
3705
|
|
|
|
|
|
|
If you call this method in list context, the first element of the |
|
3706
|
|
|
|
|
|
|
returned object is the aforementioned HTTP::Response object, and the |
|
3707
|
|
|
|
|
|
|
second is a reference to an array containing the search results. The |
|
3708
|
|
|
|
|
|
|
first element is a reference to an array containing the header lines |
|
3709
|
|
|
|
|
|
|
from the web page. Subsequent elements are references to arrays |
|
3710
|
|
|
|
|
|
|
containing the actual search results. |
|
3711
|
|
|
|
|
|
|
|
|
3712
|
|
|
|
|
|
|
=cut |
|
3713
|
|
|
|
|
|
|
|
|
3714
|
|
|
|
|
|
|
*_search_name_opts = \&_get_search_options; |
|
3715
|
|
|
|
|
|
|
|
|
3716
|
10
|
|
|
10
|
1
|
52
|
sub search_name { ## no critic (RequireArgUnpacking) |
|
|
10
|
|
|
10
|
|
9759
|
|
|
3717
|
10
|
|
|
|
|
40
|
splice @_, 1, 0, OBJECT_NAME => sub { return "~~$_[0]" }; |
|
3718
|
|
|
|
|
|
|
goto &_search_rest; |
|
3719
|
|
|
|
|
|
|
} |
|
3720
|
|
|
|
|
|
|
|
|
3721
|
|
|
|
|
|
|
|
|
3722
|
|
|
|
|
|
|
=for html |
|
3723
|
|
|
|
|
|
|
|
|
3724
|
|
|
|
|
|
|
=item $resp = $st->search_oid (name ...) |
|
3725
|
|
|
|
|
|
|
|
|
3726
|
|
|
|
|
|
|
This method searches the Space Track database for the given Space Track |
|
3727
|
|
|
|
|
|
|
IDs (also known as OIDs, hence the method name). |
|
3728
|
|
|
|
|
|
|
|
|
3729
|
|
|
|
|
|
|
B that in effect this is just a stupid, inefficient version of |
|
3730
|
|
|
|
|
|
|
C, which does not understand ranges. Unless you |
|
3731
|
|
|
|
|
|
|
assert C<-notle> or call it in list context to get the |
|
3732
|
|
|
|
|
|
|
search data, you should simply call |
|
3733
|
|
|
|
|
|
|
C instead. |
|
3734
|
|
|
|
|
|
|
|
|
3735
|
|
|
|
|
|
|
In addition to the options available for C, the following |
|
3736
|
|
|
|
|
|
|
option may be specified: |
|
3737
|
|
|
|
|
|
|
|
|
3738
|
|
|
|
|
|
|
rcs |
|
3739
|
|
|
|
|
|
|
Used to specify that the radar cross-section returned by |
|
3740
|
|
|
|
|
|
|
the search is to be appended to the name, in the form |
|
3741
|
|
|
|
|
|
|
--rcs radar_cross_section. Starting with version 0.086_02 |
|
3742
|
|
|
|
|
|
|
it does nothing, since as of August 18 2014 Space Track |
|
3743
|
|
|
|
|
|
|
no longer provides quantitative RCS data. |
|
3744
|
|
|
|
|
|
|
tle |
|
3745
|
|
|
|
|
|
|
specifies that you want TLE data retrieved for all |
|
3746
|
|
|
|
|
|
|
bodies that satisfy the search criteria. This is |
|
3747
|
|
|
|
|
|
|
true by default, but may be negated by specifying |
|
3748
|
|
|
|
|
|
|
-notle ( or { tle => 0 } ). If negated, the content |
|
3749
|
|
|
|
|
|
|
of the response object is the results of the search, |
|
3750
|
|
|
|
|
|
|
one line per body found, with the fields tab- |
|
3751
|
|
|
|
|
|
|
delimited. |
|
3752
|
|
|
|
|
|
|
|
|
3753
|
|
|
|
|
|
|
If you specify C<-notle>, all other options are ignored, except for |
|
3754
|
|
|
|
|
|
|
C<-descending>. |
|
3755
|
|
|
|
|
|
|
|
|
3756
|
|
|
|
|
|
|
A Space Track username and password are required to use this method. |
|
3757
|
|
|
|
|
|
|
|
|
3758
|
|
|
|
|
|
|
This method implicitly calls the C method if the session cookie |
|
3759
|
|
|
|
|
|
|
is missing or expired. If C fails, you will get the |
|
3760
|
|
|
|
|
|
|
HTTP::Response from C. |
|
3761
|
|
|
|
|
|
|
|
|
3762
|
|
|
|
|
|
|
What you get on success depends on the value specified for the -tle |
|
3763
|
|
|
|
|
|
|
option. |
|
3764
|
|
|
|
|
|
|
|
|
3765
|
|
|
|
|
|
|
Unless you explicitly specified C<-notle> (or C<< { tle => 0 } >>), this |
|
3766
|
|
|
|
|
|
|
method returns an HTTP::Response object whose content is the relevant |
|
3767
|
|
|
|
|
|
|
element sets. It will also have the following headers set: |
|
3768
|
|
|
|
|
|
|
|
|
3769
|
|
|
|
|
|
|
Pragma: spacetrack-type = orbit |
|
3770
|
|
|
|
|
|
|
Pragma: spacetrack-source = spacetrack |
|
3771
|
|
|
|
|
|
|
|
|
3772
|
|
|
|
|
|
|
If the C method returns C<'box_score'>, you can expect |
|
3773
|
|
|
|
|
|
|
a content-source value of C<'spacetrack'>. |
|
3774
|
|
|
|
|
|
|
|
|
3775
|
|
|
|
|
|
|
If you explicitly specified C<-notle> (or C<< { tle => 0 } >>), this |
|
3776
|
|
|
|
|
|
|
method returns an HTTP::Response object whose content is the results of |
|
3777
|
|
|
|
|
|
|
the relevant search, one line per object found. Within a line the fields |
|
3778
|
|
|
|
|
|
|
are tab-delimited, and occur in the same order as the underlying web |
|
3779
|
|
|
|
|
|
|
page. The first line of the content is the header lines from the |
|
3780
|
|
|
|
|
|
|
underlying web page. It will also have the following headers set: |
|
3781
|
|
|
|
|
|
|
|
|
3782
|
|
|
|
|
|
|
Pragma: spacetrack-type = search |
|
3783
|
|
|
|
|
|
|
Pragma: spacetrack-source = spacetrack |
|
3784
|
|
|
|
|
|
|
|
|
3785
|
|
|
|
|
|
|
If you call this method in list context, the first element of the |
|
3786
|
|
|
|
|
|
|
returned object is the aforementioned HTTP::Response object, and the |
|
3787
|
|
|
|
|
|
|
second is a reference to an array containing the search results. The |
|
3788
|
|
|
|
|
|
|
first element is a reference to an array containing the header lines |
|
3789
|
|
|
|
|
|
|
from the web page. Subsequent elements are references to arrays |
|
3790
|
|
|
|
|
|
|
containing the actual search results. |
|
3791
|
|
|
|
|
|
|
|
|
3792
|
|
|
|
|
|
|
=cut |
|
3793
|
|
|
|
|
|
|
|
|
3794
|
|
|
|
|
|
|
*_search_oid_opts = \&_get_search_options; |
|
3795
|
|
|
|
|
|
|
|
|
3796
|
|
|
|
|
|
|
sub search_oid { ## no critic (RequireArgUnpacking) |
|
3797
|
12
|
|
|
12
|
1
|
36
|
## my ( $self, @args ) = @_; |
|
|
12
|
|
|
12
|
|
1589
|
|
|
3798
|
12
|
|
|
|
|
42
|
splice @_, 1, 0, OBJECT_NUMBER => sub { return $_[0] }; |
|
3799
|
|
|
|
|
|
|
goto &_search_rest; |
|
3800
|
|
|
|
|
|
|
} |
|
3801
|
|
|
|
|
|
|
|
|
3802
|
1
|
|
|
1
|
|
4
|
sub _check_range { |
|
3803
|
1
|
50
|
|
|
|
6
|
my ( $self, $lo, $hi ) = @_; |
|
3804
|
1
|
50
|
|
|
|
5
|
($lo, $hi) = ($hi, $lo) if $lo > $hi; |
|
3805
|
1
|
50
|
|
|
|
5
|
$lo or $lo = 1; # 0 is illegal |
|
3806
|
0
|
|
|
|
|
0
|
$hi - $lo >= $self->{max_range} and do { |
|
3807
|
|
|
|
|
|
|
Carp::carp <<"EOD"; |
|
3808
|
|
|
|
|
|
|
Warning - Range $lo-$hi ignored because it is greater than the |
|
3809
|
|
|
|
|
|
|
currently-set maximum of $self->{max_range}. |
|
3810
|
0
|
|
|
|
|
0
|
EOD |
|
3811
|
|
|
|
|
|
|
return; |
|
3812
|
1
|
|
|
|
|
9
|
}; |
|
3813
|
|
|
|
|
|
|
return ( $lo, $hi ); |
|
3814
|
|
|
|
|
|
|
} |
|
3815
|
|
|
|
|
|
|
|
|
3816
|
|
|
|
|
|
|
=for html |
|
3817
|
|
|
|
|
|
|
|
|
3818
|
|
|
|
|
|
|
=item $st->set ( ... ) |
|
3819
|
|
|
|
|
|
|
|
|
3820
|
|
|
|
|
|
|
This is the mutator method for the object. It can be called explicitly, |
|
3821
|
|
|
|
|
|
|
but other methods as noted may call it implicitly also. It croaks if |
|
3822
|
|
|
|
|
|
|
you give it an odd number of arguments, or if given an attribute that |
|
3823
|
|
|
|
|
|
|
either does not exist or cannot be set. |
|
3824
|
|
|
|
|
|
|
|
|
3825
|
|
|
|
|
|
|
For the convenience of the shell method we return a HTTP::Response |
|
3826
|
|
|
|
|
|
|
object with a success status if all goes well. But if we encounter an |
|
3827
|
|
|
|
|
|
|
error we croak. |
|
3828
|
|
|
|
|
|
|
|
|
3829
|
|
|
|
|
|
|
See L for the names and functions of the attributes. |
|
3830
|
|
|
|
|
|
|
|
|
3831
|
|
|
|
|
|
|
=cut |
|
3832
|
|
|
|
|
|
|
|
|
3833
|
|
|
|
|
|
|
# Called dynamically |
|
3834
|
|
|
|
|
|
|
sub _readline_complete_command_set { ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) |
|
3835
|
0
|
|
|
0
|
|
0
|
# my ( $self, $text, $line, $start, $cmd_line ) = @_; |
|
3836
|
0
|
0
|
|
|
|
0
|
my ( undef, undef, undef, undef, $cmd_line ) = @_; |
|
|
0
|
|
|
|
|
0
|
|
|
3837
|
|
|
|
|
|
|
@{ $cmd_line } % 2 |
|
3838
|
0
|
|
|
|
|
0
|
or return; # Can't complete arguments |
|
3839
|
|
|
|
|
|
|
goto &_readline_complete_command_get; |
|
3840
|
|
|
|
|
|
|
} |
|
3841
|
|
|
|
|
|
|
|
|
3842
|
56
|
|
|
56
|
1
|
23691
|
sub set { ## no critic (ProhibitAmbiguousNames) |
|
3843
|
56
|
|
|
|
|
220
|
my ($self, @args) = @_; |
|
3844
|
56
|
|
|
|
|
172
|
delete $self->{_pragmata}; |
|
3845
|
62
|
|
|
|
|
132
|
while ( @args > 1 ) { |
|
3846
|
|
|
|
|
|
|
my $name = shift @args; |
|
3847
|
|
|
|
|
|
|
Carp::croak "Attribute $name may not be set. Legal attributes are ", |
|
3848
|
62
|
50
|
|
|
|
234
|
join (', ', sort keys %mutator), ".\n" |
|
3849
|
62
|
|
|
|
|
116
|
unless $mutator{$name}; |
|
3850
|
62
|
|
|
|
|
238
|
my $value = $args[0]; |
|
3851
|
62
|
|
|
|
|
184
|
$mutator{$name}->( $self, $name, $value, \@args ); |
|
3852
|
|
|
|
|
|
|
shift @args; |
|
3853
|
|
|
|
|
|
|
} |
|
3854
|
56
|
50
|
|
|
|
170
|
@args |
|
3855
|
56
|
|
|
|
|
235
|
and Carp::croak __PACKAGE__, "->set() specifies no value for @args"; |
|
3856
|
56
|
|
|
|
|
3033
|
my $resp = HTTP::Response->new( HTTP_OK, COPACETIC, undef, COPACETIC ); |
|
3857
|
|
|
|
|
|
|
$self->_add_pragmata( $resp, |
|
3858
|
|
|
|
|
|
|
'spacetrack-type' => 'set', |
|
3859
|
56
|
|
|
|
|
207
|
); |
|
3860
|
56
|
|
|
|
|
247
|
$self->__dump_response( $resp ); |
|
3861
|
|
|
|
|
|
|
return $resp; |
|
3862
|
|
|
|
|
|
|
} |
|
3863
|
|
|
|
|
|
|
|
|
3864
|
|
|
|
|
|
|
|
|
3865
|
|
|
|
|
|
|
=for html |
|
3866
|
|
|
|
|
|
|
|
|
3867
|
|
|
|
|
|
|
=item $st->shell () |
|
3868
|
|
|
|
|
|
|
|
|
3869
|
|
|
|
|
|
|
This method implements a simple shell. Any public method name except |
|
3870
|
|
|
|
|
|
|
'new' or 'shell' is a command, and its arguments if any are parameters. |
|
3871
|
|
|
|
|
|
|
We use L to parse the line, and blank |
|
3872
|
|
|
|
|
|
|
lines or lines beginning with a hash mark ('#') are ignored. Input is |
|
3873
|
|
|
|
|
|
|
via Term::ReadLine if that is available. If not, we do the best we can. |
|
3874
|
|
|
|
|
|
|
|
|
3875
|
|
|
|
|
|
|
We also recognize 'bye' and 'exit' as commands, which terminate the |
|
3876
|
|
|
|
|
|
|
method. In addition, 'show' is recognized as a synonym for 'get', and |
|
3877
|
|
|
|
|
|
|
'get' (or 'show') without arguments is special-cased to list all |
|
3878
|
|
|
|
|
|
|
attribute names and their values. Attributes listed without a value have |
|
3879
|
|
|
|
|
|
|
the undefined value. |
|
3880
|
|
|
|
|
|
|
|
|
3881
|
|
|
|
|
|
|
There are also a couple meta-commands, that in effect wrap other |
|
3882
|
|
|
|
|
|
|
commands. These are specified before the command, and can (depending on |
|
3883
|
|
|
|
|
|
|
the meta-command) have effect either right before the command is |
|
3884
|
|
|
|
|
|
|
executed, right after it is executed, or both. If more than one |
|
3885
|
|
|
|
|
|
|
meta-command is specified, the before-actions take place in the order |
|
3886
|
|
|
|
|
|
|
specified, and the after-actions in the reverse of the order specified. |
|
3887
|
|
|
|
|
|
|
|
|
3888
|
|
|
|
|
|
|
The 'time' meta-command times the command, and writes the timing to |
|
3889
|
|
|
|
|
|
|
standard error before any output from the command is written. |
|
3890
|
|
|
|
|
|
|
|
|
3891
|
|
|
|
|
|
|
The 'olist' meta-command turns TLE data into an observing list. This |
|
3892
|
|
|
|
|
|
|
only affects results with C of C<'orbit'>. If the |
|
3893
|
|
|
|
|
|
|
content is affected, the C will be changed to |
|
3894
|
|
|
|
|
|
|
C<'observing-list'>. This meta-command is experimental, and may change |
|
3895
|
|
|
|
|
|
|
function or be retracted. It is unsupported when applied to commands |
|
3896
|
|
|
|
|
|
|
that do not return TLE data. |
|
3897
|
|
|
|
|
|
|
|
|
3898
|
|
|
|
|
|
|
For commands that produce output, we allow a sort of pseudo-redirection |
|
3899
|
|
|
|
|
|
|
of the output to a file, using the syntax ">filename" or ">>filename". |
|
3900
|
|
|
|
|
|
|
If the ">" is by itself the next argument is the filename. In addition, |
|
3901
|
|
|
|
|
|
|
we do pseudo-tilde expansion by replacing a leading tilde with the |
|
3902
|
|
|
|
|
|
|
contents of environment variable HOME. Redirection can occur anywhere |
|
3903
|
|
|
|
|
|
|
on the line. For example, |
|
3904
|
|
|
|
|
|
|
|
|
3905
|
|
|
|
|
|
|
SpaceTrack> catalog special >special.txt |
|
3906
|
|
|
|
|
|
|
|
|
3907
|
|
|
|
|
|
|
sends the "Special Interest Satellites" to file special.txt. Line |
|
3908
|
|
|
|
|
|
|
terminations in the file should be appropriate to your OS. |
|
3909
|
|
|
|
|
|
|
|
|
3910
|
|
|
|
|
|
|
Redirections will not be recognized as such if quoted or escaped. That |
|
3911
|
|
|
|
|
|
|
is, both C<< >foo >> and C<< >'foo' >> (without the double quotes) are |
|
3912
|
|
|
|
|
|
|
redirections to file F, but both "C<< '>foo' >>" and C<< \>foo >> |
|
3913
|
|
|
|
|
|
|
are arguments whose value is C<< >foo >>. |
|
3914
|
|
|
|
|
|
|
|
|
3915
|
|
|
|
|
|
|
This method can also be called as a subroutine - i.e. as |
|
3916
|
|
|
|
|
|
|
|
|
3917
|
|
|
|
|
|
|
Astro::SpaceTrack::shell (...) |
|
3918
|
|
|
|
|
|
|
|
|
3919
|
|
|
|
|
|
|
Whether called as a method or as a subroutine, each argument passed |
|
3920
|
|
|
|
|
|
|
(if any) is parsed as though it were a valid command. After all such |
|
3921
|
|
|
|
|
|
|
have been executed, control passes to the user. Unless, of course, |
|
3922
|
|
|
|
|
|
|
one of the arguments was 'exit'. |
|
3923
|
|
|
|
|
|
|
|
|
3924
|
|
|
|
|
|
|
Unlike most of the other methods, this one returns nothing. |
|
3925
|
|
|
|
|
|
|
|
|
3926
|
|
|
|
|
|
|
=cut |
|
3927
|
|
|
|
|
|
|
|
|
3928
|
|
|
|
|
|
|
my $rdln; |
|
3929
|
|
|
|
|
|
|
my %known_meta = ( |
|
3930
|
|
|
|
|
|
|
olist => { |
|
3931
|
|
|
|
|
|
|
after => sub { |
|
3932
|
|
|
|
|
|
|
my ( $self, undef, $rslt ) = @_; # Context unused |
|
3933
|
|
|
|
|
|
|
|
|
3934
|
|
|
|
|
|
|
ARRAY_REF eq ref $rslt |
|
3935
|
|
|
|
|
|
|
and return; |
|
3936
|
|
|
|
|
|
|
$rslt->is_success() |
|
3937
|
|
|
|
|
|
|
and 'orbit' eq ( $self->content_type( $rslt ) || '' ) |
|
3938
|
|
|
|
|
|
|
or return; |
|
3939
|
|
|
|
|
|
|
|
|
3940
|
|
|
|
|
|
|
my $content = $rslt->content(); |
|
3941
|
|
|
|
|
|
|
my @lines; |
|
3942
|
|
|
|
|
|
|
|
|
3943
|
|
|
|
|
|
|
if ( $content =~ m/ \A [[]? [{] /smx ) { |
|
3944
|
|
|
|
|
|
|
my $data = $self->_get_json_object()->decode( $content ); |
|
3945
|
|
|
|
|
|
|
foreach my $datum ( @{ $data } ) { |
|
3946
|
|
|
|
|
|
|
push @lines, [ |
|
3947
|
|
|
|
|
|
|
sprintf '%05d', $datum->{OBJECT_NUMBER}, |
|
3948
|
|
|
|
|
|
|
defined $datum->{OBJECT_NAME} ? $datum->{OBJECT_NAME} : |
|
3949
|
|
|
|
|
|
|
(), |
|
3950
|
|
|
|
|
|
|
]; |
|
3951
|
|
|
|
|
|
|
} |
|
3952
|
|
|
|
|
|
|
} else { |
|
3953
|
|
|
|
|
|
|
|
|
3954
|
|
|
|
|
|
|
my @name; |
|
3955
|
|
|
|
|
|
|
|
|
3956
|
|
|
|
|
|
|
foreach ( split qr{ \n }smx, $content ) { |
|
3957
|
|
|
|
|
|
|
if ( m/ \A 1 \s+ ( \d+ ) /smx ) { |
|
3958
|
|
|
|
|
|
|
splice @name, 1; |
|
3959
|
|
|
|
|
|
|
push @lines, [ sprintf( '%05d', $1 ), @name ]; |
|
3960
|
|
|
|
|
|
|
@name = (); |
|
3961
|
|
|
|
|
|
|
} elsif ( m/ \A 2 \s+ \d+ /smx || m/ \A \s* [#] /smx ) { |
|
3962
|
|
|
|
|
|
|
} else { |
|
3963
|
|
|
|
|
|
|
push @name, $_; |
|
3964
|
|
|
|
|
|
|
} |
|
3965
|
|
|
|
|
|
|
} |
|
3966
|
|
|
|
|
|
|
} |
|
3967
|
|
|
|
|
|
|
|
|
3968
|
|
|
|
|
|
|
foreach ( $rslt->header( pragma => undef ) ) { |
|
3969
|
|
|
|
|
|
|
my ( $name, $value ) = split qr{ \s* = \s* }smx, $_, 2; |
|
3970
|
|
|
|
|
|
|
'spacetrack-type' eq $name |
|
3971
|
|
|
|
|
|
|
and $value = 'observing_list'; |
|
3972
|
|
|
|
|
|
|
$self->_add_pragmata( $rslt, $name, $value ); |
|
3973
|
|
|
|
|
|
|
} |
|
3974
|
|
|
|
|
|
|
|
|
3975
|
|
|
|
|
|
|
$rslt->content( join '', map { "$_\n" } @lines ); |
|
3976
|
|
|
|
|
|
|
|
|
3977
|
|
|
|
|
|
|
{ |
|
3978
|
|
|
|
|
|
|
local $" = ''; # Make "@a" equivalent to join '', @a. |
|
3979
|
|
|
|
|
|
|
$rslt->content( join '', |
|
3980
|
|
|
|
|
|
|
map { "@$_\n" } |
|
3981
|
|
|
|
|
|
|
sort { $a->[0] <=> $b->[0] } |
|
3982
|
|
|
|
|
|
|
@lines |
|
3983
|
|
|
|
|
|
|
); |
|
3984
|
|
|
|
|
|
|
} |
|
3985
|
|
|
|
|
|
|
$self->__dump_response( $rslt ); |
|
3986
|
|
|
|
|
|
|
return; |
|
3987
|
|
|
|
|
|
|
}, |
|
3988
|
|
|
|
|
|
|
}, |
|
3989
|
|
|
|
|
|
|
time => { |
|
3990
|
|
|
|
|
|
|
before => sub { |
|
3991
|
|
|
|
|
|
|
my ( undef, $context ) = @_; # Invocant unused |
|
3992
|
|
|
|
|
|
|
eval { |
|
3993
|
|
|
|
|
|
|
require Time::HiRes; |
|
3994
|
|
|
|
|
|
|
$context->{start_time} = Time::HiRes::time(); |
|
3995
|
|
|
|
|
|
|
1; |
|
3996
|
|
|
|
|
|
|
} or warn 'No timings available. Can not load Time::HiRes'; |
|
3997
|
|
|
|
|
|
|
return; |
|
3998
|
|
|
|
|
|
|
}, |
|
3999
|
|
|
|
|
|
|
after => sub { |
|
4000
|
|
|
|
|
|
|
my ( undef, $context ) = @_; # Invocant unused |
|
4001
|
|
|
|
|
|
|
$context->{start_time} |
|
4002
|
|
|
|
|
|
|
and warn sprintf "Elapsed time: %.2f seconds\n", |
|
4003
|
|
|
|
|
|
|
Time::HiRes::time() - $context->{start_time}; |
|
4004
|
|
|
|
|
|
|
return; |
|
4005
|
|
|
|
|
|
|
} |
|
4006
|
|
|
|
|
|
|
}, |
|
4007
|
|
|
|
|
|
|
); |
|
4008
|
|
|
|
|
|
|
|
|
4009
|
|
|
|
|
|
|
my $readline_word_break_re; |
|
4010
|
|
|
|
|
|
|
|
|
4011
|
|
|
|
|
|
|
{ |
|
4012
|
|
|
|
|
|
|
my %alias = ( |
|
4013
|
|
|
|
|
|
|
show => 'get', |
|
4014
|
|
|
|
|
|
|
); |
|
4015
|
|
|
|
|
|
|
|
|
4016
|
1
|
|
|
1
|
|
3
|
sub _verb_alias { |
|
4017
|
1
|
|
33
|
|
|
5
|
my ( $verb ) = @_; |
|
4018
|
|
|
|
|
|
|
return $alias{$verb} || $verb; |
|
4019
|
|
|
|
|
|
|
} |
|
4020
|
|
|
|
|
|
|
} |
|
4021
|
|
|
|
|
|
|
|
|
4022
|
1
|
|
|
1
|
1
|
4
|
sub shell { |
|
4023
|
1
|
50
|
|
|
|
4
|
my @args = @_; |
|
4024
|
|
|
|
|
|
|
my $self = _instance( $args[0], __PACKAGE__ ) ? shift @args : |
|
4025
|
|
|
|
|
|
|
Astro::SpaceTrack->new (addendum => <<'EOD'); |
|
4026
|
|
|
|
|
|
|
|
|
4027
|
|
|
|
|
|
|
'help' gets you a list of valid commands. |
|
4028
|
|
|
|
|
|
|
EOD |
|
4029
|
1
|
|
|
|
|
4
|
|
|
4030
|
1
|
|
|
|
|
1
|
my $stdout = \*STDOUT; |
|
4031
|
|
|
|
|
|
|
my $read; |
|
4032
|
1
|
50
|
33
|
|
|
5
|
|
|
4033
|
|
|
|
|
|
|
unshift @args, 'banner' if $self->{banner} && !$self->{filter}; |
|
4034
|
|
|
|
|
|
|
# Perl::Critic wants IO::Interactive::is_interactive() here. But |
|
4035
|
|
|
|
|
|
|
# that assumes we're using the *ARGV input mechanism, which we're |
|
4036
|
|
|
|
|
|
|
# not (command arguments are SpaceTrack commands.) Also, we would |
|
4037
|
|
|
|
|
|
|
# like to be prompted even if output is to a pipe, but the |
|
4038
|
|
|
|
|
|
|
# recommended module calls that non-interactive even if input is |
|
4039
|
1
|
|
|
|
|
10
|
# from a terminal. So: |
|
4040
|
1
|
|
|
|
|
12
|
my $interactive = -t STDIN; |
|
4041
|
4
|
|
|
|
|
7
|
while (1) { |
|
4042
|
4
|
50
|
|
|
|
10
|
my $buffer; |
|
4043
|
4
|
|
|
|
|
8
|
if (@args) { |
|
4044
|
|
|
|
|
|
|
$buffer = shift @args; |
|
4045
|
|
|
|
|
|
|
} else { |
|
4046
|
|
|
|
|
|
|
$read ||= $interactive ? ( eval { |
|
4047
|
0
|
|
|
0
|
|
0
|
$self->_get_readline( $stdout ) |
|
|
0
|
|
|
|
|
0
|
|
|
|
0
|
|
|
|
|
0
|
|
|
4048
|
0
|
0
|
0
|
0
|
|
0
|
} || sub { print { $stdout } $self->getv( 'prompt' ); return } ) : |
|
|
0
|
|
0
|
|
|
0
|
|
|
4049
|
0
|
|
|
|
|
0
|
sub { return }; |
|
4050
|
|
|
|
|
|
|
$buffer = $read->(); |
|
4051
|
4
|
50
|
|
|
|
10
|
} |
|
4052
|
|
|
|
|
|
|
last unless defined $buffer; |
|
4053
|
4
|
|
|
|
|
11
|
|
|
4054
|
4
|
|
|
|
|
10
|
$buffer =~ s/ \A \s+ //smx; |
|
4055
|
4
|
100
|
|
|
|
10
|
$buffer =~ s/ \s+ \z //smx; |
|
4056
|
3
|
100
|
|
|
|
10
|
next unless $buffer; |
|
4057
|
|
|
|
|
|
|
next if $buffer =~ m/ \A [#] /smx; |
|
4058
|
|
|
|
|
|
|
|
|
4059
|
|
|
|
|
|
|
# Break the buffer up into tokens, but leave quotes and escapes |
|
4060
|
|
|
|
|
|
|
# in place, so that (e.g.) '\>foo' is seen as an argument, not a |
|
4061
|
|
|
|
|
|
|
# redirection. |
|
4062
|
2
|
|
|
|
|
9
|
|
|
4063
|
|
|
|
|
|
|
my @cmdarg = Text::ParseWords::parse_line( '\s+', 1, $buffer ); |
|
4064
|
|
|
|
|
|
|
|
|
4065
|
|
|
|
|
|
|
# Pull off any redirections. |
|
4066
|
2
|
|
|
|
|
304
|
|
|
4067
|
|
|
|
|
|
|
my $redir = ''; |
|
4068
|
2
|
|
|
|
|
5
|
@cmdarg = map { |
|
|
0
|
|
|
|
|
0
|
|
|
|
0
|
|
|
|
|
0
|
|
|
4069
|
4
|
50
|
|
|
|
20
|
m/ \A > /smx ? do {$redir = $_; ()} : |
|
|
0
|
50
|
|
|
|
0
|
|
|
|
0
|
|
|
|
|
0
|
|
|
4070
|
|
|
|
|
|
|
$redir =~ m/ \A >+ \z /smx ? do {$redir .= $_; ()} : |
|
4071
|
|
|
|
|
|
|
$_ |
|
4072
|
|
|
|
|
|
|
} @cmdarg; |
|
4073
|
|
|
|
|
|
|
|
|
4074
|
|
|
|
|
|
|
# Rerun everything through parse_line again, but with the $keep |
|
4075
|
|
|
|
|
|
|
# argument false. This should not create any more tokens, it |
|
4076
|
|
|
|
|
|
|
# should just un-quote and un-escape the data. |
|
4077
|
2
|
|
|
|
|
7
|
|
|
|
4
|
|
|
|
|
154
|
|
|
4078
|
2
|
50
|
|
|
|
127
|
@cmdarg = map { Text::ParseWords::parse_line( qr{ \s+ }, 0, $_ ) } @cmdarg; |
|
4079
|
|
|
|
|
|
|
$redir ne '' |
|
4080
|
|
|
|
|
|
|
and ( $redir ) = Text::ParseWords::parse_line ( qr{ \s+ }, 0, $redir ); |
|
4081
|
2
|
|
|
|
|
4
|
|
|
4082
|
2
|
|
|
|
|
5
|
$redir =~ s/ \A (>+) ~ /$1$ENV{HOME}/smx; |
|
4083
|
|
|
|
|
|
|
my $verb = lc shift @cmdarg; |
|
4084
|
2
|
|
|
|
|
7
|
|
|
4085
|
|
|
|
|
|
|
my %meta_command = ( |
|
4086
|
|
|
|
|
|
|
before => [], |
|
4087
|
|
|
|
|
|
|
after => [], |
|
4088
|
|
|
|
|
|
|
); |
|
4089
|
2
|
|
|
|
|
8
|
|
|
4090
|
0
|
|
|
|
|
0
|
while ( my $def = $known_meta{$verb} ) { |
|
4091
|
0
|
|
|
|
|
0
|
my %context; |
|
4092
|
0
|
0
|
|
|
|
0
|
foreach my $key ( qw{ before after } ) { |
|
4093
|
|
|
|
|
|
|
$def->{$key} |
|
4094
|
0
|
|
|
|
|
0
|
or next; |
|
4095
|
0
|
|
|
0
|
|
0
|
push @{ $meta_command{$key} }, sub { |
|
4096
|
0
|
|
|
|
|
0
|
return $def->{$key}->( $self, \%context, @_ ); |
|
4097
|
|
|
|
|
|
|
}; |
|
4098
|
0
|
|
|
|
|
0
|
} |
|
4099
|
|
|
|
|
|
|
$verb = shift @cmdarg; |
|
4100
|
|
|
|
|
|
|
} |
|
4101
|
2
|
100
|
66
|
|
|
11
|
|
|
4102
|
1
|
|
|
|
|
5
|
last if $verb eq 'exit' || $verb eq 'bye'; |
|
4103
|
1
|
50
|
|
|
|
5
|
$verb = _verb_alias( $verb ); |
|
4104
|
0
|
0
|
0
|
|
|
0
|
$verb eq 'source' and do { |
|
4105
|
0
|
|
|
|
|
0
|
eval { |
|
4106
|
0
|
|
|
|
|
0
|
splice @args, 0, 0, $self->_source (shift @cmdarg); |
|
4107
|
|
|
|
|
|
|
1; |
|
4108
|
0
|
|
|
|
|
0
|
} or warn ( $@ || 'An unknown error occurred' ); ## no critic (RequireCarping) |
|
4109
|
|
|
|
|
|
|
next; |
|
4110
|
|
|
|
|
|
|
}; |
|
4111
|
|
|
|
|
|
|
|
|
4112
|
|
|
|
|
|
|
$verb ne 'new' |
|
4113
|
|
|
|
|
|
|
and $verb ne 'shell' |
|
4114
|
1
|
50
|
33
|
|
|
10
|
and $verb !~ m/ \A _ [^_] /smx |
|
|
|
|
33
|
|
|
|
|
|
4115
|
0
|
|
|
|
|
0
|
or do { |
|
4116
|
|
|
|
|
|
|
warn <<"EOD"; |
|
4117
|
|
|
|
|
|
|
Verb '$verb' undefined. Use 'help' to get help. |
|
4118
|
0
|
|
|
|
|
0
|
EOD |
|
4119
|
|
|
|
|
|
|
next; |
|
4120
|
1
|
|
|
|
|
1
|
}; |
|
4121
|
1
|
50
|
|
|
|
5
|
my $out; |
|
4122
|
0
|
0
|
|
|
|
0
|
if ( $redir ) { |
|
4123
|
0
|
|
|
|
|
0
|
$out = IO::File->new( $redir ) or do { |
|
4124
|
|
|
|
|
|
|
warn <<"EOD"; |
|
4125
|
|
|
|
|
|
|
Error - Failed to open $redir |
|
4126
|
|
|
|
|
|
|
$^E |
|
4127
|
0
|
|
|
|
|
0
|
EOD |
|
4128
|
|
|
|
|
|
|
next; |
|
4129
|
|
|
|
|
|
|
}; |
|
4130
|
1
|
|
|
|
|
2
|
} else { |
|
4131
|
|
|
|
|
|
|
$out = $stdout; |
|
4132
|
1
|
|
|
|
|
2
|
} |
|
4133
|
|
|
|
|
|
|
my $rslt; |
|
4134
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
4
|
|
|
4135
|
0
|
|
|
|
|
0
|
foreach my $pseudo ( @{ $meta_command{before} } ) { |
|
4136
|
|
|
|
|
|
|
$pseudo->(); |
|
4137
|
|
|
|
|
|
|
} |
|
4138
|
1
|
50
|
33
|
|
|
5
|
|
|
4139
|
0
|
|
|
|
|
0
|
if ($verb eq 'get' && @cmdarg == 0) { |
|
4140
|
0
|
|
|
|
|
0
|
$rslt = []; |
|
4141
|
0
|
|
|
|
|
0
|
foreach my $name ($self->attribute_names ()) { |
|
4142
|
0
|
0
|
|
|
|
0
|
my $val = $self->getv( $name ); |
|
4143
|
|
|
|
|
|
|
push @$rslt, defined $val ? "$name $val" : $name; |
|
4144
|
|
|
|
|
|
|
} |
|
4145
|
|
|
|
|
|
|
} else { |
|
4146
|
1
|
|
|
|
|
4
|
eval { |
|
4147
|
1
|
|
|
|
|
5
|
$rslt = $self->$verb (@cmdarg); |
|
4148
|
1
|
50
|
|
|
|
2
|
1; |
|
4149
|
0
|
|
|
|
|
0
|
} or do { |
|
4150
|
0
|
|
|
|
|
0
|
warn $@; ## no critic (RequireCarping) |
|
4151
|
|
|
|
|
|
|
next; |
|
4152
|
|
|
|
|
|
|
}; |
|
4153
|
|
|
|
|
|
|
} |
|
4154
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
4
|
|
|
4155
|
0
|
|
|
|
|
0
|
foreach my $pseudo ( reverse @{ $meta_command{after} } ) { |
|
4156
|
|
|
|
|
|
|
$pseudo->( $rslt ); |
|
4157
|
|
|
|
|
|
|
} |
|
4158
|
1
|
50
|
|
|
|
11
|
|
|
|
|
50
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
4159
|
0
|
|
|
|
|
0
|
if ( ARRAY_REF eq ref $rslt ) { |
|
|
0
|
|
|
|
|
0
|
|
|
|
0
|
|
|
|
|
0
|
|
|
4160
|
|
|
|
|
|
|
foreach (@$rslt) {print { $out } "$_\n"} |
|
4161
|
0
|
|
|
|
|
0
|
} elsif ( ! ref $rslt ) { |
|
|
0
|
|
|
|
|
0
|
|
|
4162
|
|
|
|
|
|
|
print { $out } "$rslt\n"; |
|
4163
|
|
|
|
|
|
|
} elsif ($rslt->is_success) { |
|
4164
|
|
|
|
|
|
|
$self->content_type() |
|
4165
|
1
|
50
|
33
|
|
|
9
|
or not $self->{filter} |
|
4166
|
1
|
|
|
|
|
8
|
or next; |
|
4167
|
1
|
|
|
|
|
16
|
my $content = $rslt->content; |
|
4168
|
1
|
|
|
|
|
2
|
chomp $content; |
|
|
1
|
|
|
|
|
31
|
|
|
4169
|
|
|
|
|
|
|
print { $out } "$content\n"; |
|
4170
|
0
|
|
|
|
|
0
|
} else { |
|
4171
|
0
|
|
|
|
|
0
|
my $status = $rslt->status_line; |
|
4172
|
0
|
|
|
|
|
0
|
chomp $status; |
|
4173
|
|
|
|
|
|
|
warn $status, "\n"; |
|
4174
|
0
|
0
|
|
|
|
0
|
$rslt->code() == HTTP_I_AM_A_TEAPOT |
|
|
0
|
|
|
|
|
0
|
|
|
4175
|
|
|
|
|
|
|
and print { $out } $rslt->content(), "\n"; |
|
4176
|
|
|
|
|
|
|
} |
|
4177
|
|
|
|
|
|
|
} |
|
4178
|
|
|
|
|
|
|
$interactive |
|
4179
|
1
|
50
|
33
|
|
|
10
|
and not $self->{filter} |
|
|
0
|
|
|
|
|
0
|
|
|
4180
|
1
|
|
|
|
|
3
|
and print { $stdout } "\n"; |
|
4181
|
|
|
|
|
|
|
return; |
|
4182
|
|
|
|
|
|
|
} |
|
4183
|
|
|
|
|
|
|
|
|
4184
|
1
|
|
|
1
|
|
13
|
sub _get_readline { ## no critic (Subroutines::RequireArgUnpacking) |
|
4185
|
1
|
|
|
|
|
545
|
my ( $self ) = @_; |
|
4186
|
1
|
|
33
|
|
|
2970
|
require Term::ReadLine; |
|
4187
|
|
|
|
|
|
|
$rdln ||= Term::ReadLine->new ( |
|
4188
|
1
|
50
|
0
|
|
|
21106
|
'SpaceTrack orbital element access'); |
|
4189
|
|
|
|
|
|
|
@_ > 1 |
|
4190
|
1
|
50
|
|
|
|
20
|
and $_[1] = ( $rdln->OUT || \*STDOUT ); # $stdout |
|
4191
|
0
|
|
|
|
|
0
|
if ( 'Term::ReadLine::Perl' eq $rdln->ReadLine() ) { |
|
4192
|
|
|
|
|
|
|
require File::Glob; |
|
4193
|
0
|
|
0
|
|
|
0
|
|
|
4194
|
|
|
|
|
|
|
$readline_word_break_re ||= qr< |
|
4195
|
|
|
|
|
|
|
[\Q$readline::rl_completer_word_break_characters\E]+ |
|
4196
|
|
|
|
|
|
|
>smx; |
|
4197
|
10
|
|
|
10
|
|
94
|
|
|
|
10
|
|
|
|
|
43
|
|
|
|
10
|
|
|
|
|
130047
|
|
|
4198
|
|
|
|
|
|
|
no warnings qw{ once }; |
|
4199
|
0
|
|
|
0
|
|
0
|
$readline::rl_completion_function = sub { |
|
4200
|
0
|
|
|
|
|
0
|
my ( $text, $line, $start ) = @_; |
|
4201
|
|
|
|
|
|
|
return $self->__readline_completer( |
|
4202
|
0
|
|
|
|
|
0
|
$text, $line, $start ); |
|
4203
|
|
|
|
|
|
|
}; |
|
4204
|
1
|
|
|
0
|
|
66
|
} |
|
|
0
|
|
|
|
|
0
|
|
|
4205
|
|
|
|
|
|
|
return sub { $rdln->readline ( $self->getv( 'prompt' ) ) }; |
|
4206
|
|
|
|
|
|
|
} |
|
4207
|
|
|
|
|
|
|
|
|
4208
|
|
|
|
|
|
|
|
|
4209
|
|
|
|
|
|
|
=for html |
|
4210
|
|
|
|
|
|
|
|
|
4211
|
|
|
|
|
|
|
=item $st->source ($filename); |
|
4212
|
|
|
|
|
|
|
|
|
4213
|
|
|
|
|
|
|
This convenience method reads the given file, and passes the individual |
|
4214
|
|
|
|
|
|
|
lines to the shell method. It croaks if the file is not provided or |
|
4215
|
|
|
|
|
|
|
cannot be read. |
|
4216
|
|
|
|
|
|
|
|
|
4217
|
|
|
|
|
|
|
=cut |
|
4218
|
|
|
|
|
|
|
|
|
4219
|
|
|
|
|
|
|
# We really just delegate to _source, which unpacks. |
|
4220
|
0
|
0
|
|
0
|
1
|
0
|
sub source { |
|
4221
|
|
|
|
|
|
|
my $self = _instance( $_[0], __PACKAGE__ ) ? shift : |
|
4222
|
0
|
|
|
|
|
0
|
Astro::SpaceTrack->new (); |
|
4223
|
0
|
|
|
|
|
0
|
$self->shell ($self->_source (@_), 'exit'); |
|
4224
|
|
|
|
|
|
|
return; |
|
4225
|
|
|
|
|
|
|
} |
|
4226
|
|
|
|
|
|
|
|
|
4227
|
|
|
|
|
|
|
|
|
4228
|
|
|
|
|
|
|
=for html |
|
4229
|
|
|
|
|
|
|
|
|
4230
|
|
|
|
|
|
|
=item $resp = $st->spacetrack ($name); |
|
4231
|
|
|
|
|
|
|
|
|
4232
|
|
|
|
|
|
|
This method returns predefined sets of data from the Space Track web |
|
4233
|
|
|
|
|
|
|
site, using either canned queries or global favorites. |
|
4234
|
|
|
|
|
|
|
|
|
4235
|
|
|
|
|
|
|
The following catalogs are available: |
|
4236
|
|
|
|
|
|
|
|
|
4237
|
|
|
|
|
|
|
Name Description |
|
4238
|
|
|
|
|
|
|
full Full catalog |
|
4239
|
|
|
|
|
|
|
payloads All payloads |
|
4240
|
|
|
|
|
|
|
navigation Navigation satellites |
|
4241
|
|
|
|
|
|
|
weather Weather satellites |
|
4242
|
|
|
|
|
|
|
geosynchronous Geosynchronous bodies |
|
4243
|
|
|
|
|
|
|
iridium Iridium satellites |
|
4244
|
|
|
|
|
|
|
orbcomm OrbComm satellites |
|
4245
|
|
|
|
|
|
|
globalstar Globalstar satellites |
|
4246
|
|
|
|
|
|
|
intelsat Intelsat satellites |
|
4247
|
|
|
|
|
|
|
inmarsat Inmarsat satellites |
|
4248
|
|
|
|
|
|
|
amateur Amateur Radio satellites |
|
4249
|
|
|
|
|
|
|
visible Visible satellites |
|
4250
|
|
|
|
|
|
|
special Special satellites |
|
4251
|
|
|
|
|
|
|
bright_geosynchronous |
|
4252
|
|
|
|
|
|
|
Bright Geosynchronous satellites |
|
4253
|
|
|
|
|
|
|
human_spaceflight |
|
4254
|
|
|
|
|
|
|
Human Spaceflight |
|
4255
|
|
|
|
|
|
|
well_tracked_objects |
|
4256
|
|
|
|
|
|
|
Well-Tracked Objects having |
|
4257
|
|
|
|
|
|
|
unknown country and launch point |
|
4258
|
|
|
|
|
|
|
|
|
4259
|
|
|
|
|
|
|
The following option is supported: |
|
4260
|
|
|
|
|
|
|
|
|
4261
|
|
|
|
|
|
|
-json |
|
4262
|
|
|
|
|
|
|
specifies the TLE be returned in JSON format |
|
4263
|
|
|
|
|
|
|
|
|
4264
|
|
|
|
|
|
|
Options may be specified either in command-line style |
|
4265
|
|
|
|
|
|
|
(that is, as C<< spacetrack( '-json', ... ) >>) or as a hash reference |
|
4266
|
|
|
|
|
|
|
(that is, as C<< spacetrack( { json => 1 }, ... ) >>). |
|
4267
|
|
|
|
|
|
|
|
|
4268
|
|
|
|
|
|
|
This method returns an L object. If the |
|
4269
|
|
|
|
|
|
|
operation succeeded, the content of the response will be the requested |
|
4270
|
|
|
|
|
|
|
data, unzipped if you used the version 1 interface. |
|
4271
|
|
|
|
|
|
|
|
|
4272
|
|
|
|
|
|
|
If you requested a non-existent catalog, the response code will be |
|
4273
|
|
|
|
|
|
|
C (a.k.a. 404); otherwise the response code will be |
|
4274
|
|
|
|
|
|
|
whatever the underlying HTTPS request returned. |
|
4275
|
|
|
|
|
|
|
|
|
4276
|
|
|
|
|
|
|
A Space Track username and password are required to use this method. |
|
4277
|
|
|
|
|
|
|
|
|
4278
|
|
|
|
|
|
|
If this method succeeds, the response will contain headers |
|
4279
|
|
|
|
|
|
|
|
|
4280
|
|
|
|
|
|
|
Pragma: spacetrack-type = orbit |
|
4281
|
|
|
|
|
|
|
Pragma: spacetrack-source = spacetrack |
|
4282
|
|
|
|
|
|
|
|
|
4283
|
|
|
|
|
|
|
These can be accessed by C<< $st->content_type( $resp ) >> and |
|
4284
|
|
|
|
|
|
|
C<< $st->content_source( $resp ) >> respectively. |
|
4285
|
|
|
|
|
|
|
|
|
4286
|
|
|
|
|
|
|
A list of valid names and brief descriptions can be obtained by calling |
|
4287
|
|
|
|
|
|
|
C<< $st->names ('spacetrack') >>. |
|
4288
|
|
|
|
|
|
|
|
|
4289
|
|
|
|
|
|
|
If you have set the C attribute true (e.g. C<< $st->set |
|
4290
|
|
|
|
|
|
|
(verbose => 1) >>), the content of the error response will include the |
|
4291
|
|
|
|
|
|
|
list of valid names. Note, however, that under version 1 of the |
|
4292
|
|
|
|
|
|
|
interface this list does not determine what can be retrieved. |
|
4293
|
|
|
|
|
|
|
|
|
4294
|
|
|
|
|
|
|
This method implicitly calls the C method if the session cookie |
|
4295
|
|
|
|
|
|
|
is missing or expired. If C fails, you will get the |
|
4296
|
|
|
|
|
|
|
HTTP::Response from C. |
|
4297
|
|
|
|
|
|
|
|
|
4298
|
|
|
|
|
|
|
=cut |
|
4299
|
|
|
|
|
|
|
|
|
4300
|
|
|
|
|
|
|
{ |
|
4301
|
|
|
|
|
|
|
|
|
4302
|
|
|
|
|
|
|
my %unpack_query = ( |
|
4303
|
|
|
|
|
|
|
ARRAY_REF() => sub { return @{ $_[0] } }, |
|
4304
|
|
|
|
|
|
|
HASH_REF() => sub { return $_[0] }, |
|
4305
|
|
|
|
|
|
|
); |
|
4306
|
|
|
|
|
|
|
|
|
4307
|
|
|
|
|
|
|
# Unpack a Space Track REST query. References are unpacked per the |
|
4308
|
|
|
|
|
|
|
# above table, if found there. Undefined values return an empty hash |
|
4309
|
|
|
|
|
|
|
# reference. Anything else croaks with a stack trace. |
|
4310
|
|
|
|
|
|
|
|
|
4311
|
0
|
|
|
0
|
|
0
|
sub _unpack_query { |
|
4312
|
0
|
0
|
|
|
|
0
|
my ( $arg ) = @_; |
|
4313
|
|
|
|
|
|
|
my $code = $unpack_query{ref $arg} |
|
4314
|
0
|
|
|
|
|
0
|
or Carp::confess "Bug - unexpected query $arg"; |
|
4315
|
|
|
|
|
|
|
return $code->( $arg ); |
|
4316
|
|
|
|
|
|
|
} |
|
4317
|
|
|
|
|
|
|
|
|
4318
|
|
|
|
|
|
|
} |
|
4319
|
|
|
|
|
|
|
|
|
4320
|
|
|
|
|
|
|
# Called dynamically |
|
4321
|
|
|
|
|
|
|
sub _spacetrack_opts { ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) |
|
4322
|
5
|
|
|
5
|
|
18
|
return [ |
|
4323
|
|
|
|
|
|
|
'json!' => 'Return data in JSON format', |
|
4324
|
|
|
|
|
|
|
'format=s' => 'Specify retrieval format', |
|
4325
|
|
|
|
|
|
|
]; |
|
4326
|
|
|
|
|
|
|
} |
|
4327
|
|
|
|
|
|
|
|
|
4328
|
|
|
|
|
|
|
# Called dynamically |
|
4329
|
0
|
|
|
0
|
|
0
|
sub _spacetrack_catalog_version { ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) |
|
4330
|
|
|
|
|
|
|
return $_[0]->getv( 'space_track_version' ); |
|
4331
|
|
|
|
|
|
|
} |
|
4332
|
|
|
|
|
|
|
|
|
4333
|
5
|
|
|
5
|
1
|
2098
|
sub spacetrack { |
|
4334
|
|
|
|
|
|
|
my ( $self, @args ) = @_; |
|
4335
|
5
|
|
|
|
|
17
|
|
|
4336
|
|
|
|
|
|
|
my ( $opt, $catalog ) = _parse_args( @args ); |
|
4337
|
5
|
|
|
|
|
24
|
|
|
4338
|
|
|
|
|
|
|
_retrieval_format( tle => $opt ); |
|
4339
|
|
|
|
|
|
|
|
|
4340
|
5
|
100
|
66
|
|
|
48
|
defined $catalog |
|
4341
|
|
|
|
|
|
|
and my $info = $catalogs{spacetrack}[2]{$catalog} |
|
4342
|
|
|
|
|
|
|
or return $self->_no_such_catalog( spacetrack => 2, $catalog ); |
|
4343
|
|
|
|
|
|
|
|
|
4344
|
4
|
50
|
|
|
|
15
|
defined $info->{deprecate} |
|
4345
|
|
|
|
|
|
|
and Carp::croak "Catalog '$catalog' is deprecated in favor of '$info->{deprecate}'"; |
|
4346
|
|
|
|
|
|
|
|
|
4347
|
4
|
100
|
|
|
|
41
|
defined $info->{favorite} |
|
4348
|
|
|
|
|
|
|
and return $self->favorite( $opt, $info->{favorite} ); |
|
4349
|
|
|
|
|
|
|
|
|
4350
|
3
|
|
|
|
|
7
|
my %retrieve_opt = %{ |
|
|
3
|
|
|
|
|
13
|
|
|
4351
|
|
|
|
|
|
|
$self->_convert_retrieve_options_to_rest( $opt ) |
|
4352
|
|
|
|
|
|
|
}; |
|
4353
|
|
|
|
|
|
|
|
|
4354
|
3
|
|
|
|
|
13
|
$info->{tle} |
|
4355
|
3
|
50
|
|
|
|
19
|
and @retrieve_opt{ keys %{ $info->{tle} } } = |
|
|
3
|
|
|
|
|
12
|
|
|
4356
|
|
|
|
|
|
|
values %{ $info->{tle} }; |
|
4357
|
3
|
|
|
|
|
7
|
|
|
4358
|
|
|
|
|
|
|
my $rslt; |
|
4359
|
3
|
50
|
|
|
|
10
|
|
|
4360
|
|
|
|
|
|
|
if ( $info->{satcat} ) { |
|
4361
|
0
|
|
|
|
|
0
|
|
|
4362
|
|
|
|
|
|
|
my %oid; |
|
4363
|
0
|
|
|
|
|
0
|
|
|
4364
|
|
|
|
|
|
|
foreach my $query ( _unpack_query( $info->{satcat} ) ) { |
|
4365
|
0
|
|
|
|
|
0
|
|
|
4366
|
|
|
|
|
|
|
$rslt = $self->spacetrack_query_v2( |
|
4367
|
|
|
|
|
|
|
basicspacedata => 'query', |
|
4368
|
|
|
|
|
|
|
class => 'satcat', |
|
4369
|
|
|
|
|
|
|
format => 'json', |
|
4370
|
|
|
|
|
|
|
predicates => 'OBJECT_NUMBER', |
|
4371
|
|
|
|
|
|
|
CURRENT => 'Y', |
|
4372
|
|
|
|
|
|
|
DECAY => 'null-val', |
|
4373
|
|
|
|
|
|
|
_sort_rest_arguments( $query ), |
|
4374
|
|
|
|
|
|
|
); |
|
4375
|
0
|
0
|
|
|
|
0
|
|
|
4376
|
|
|
|
|
|
|
$rslt->is_success() |
|
4377
|
|
|
|
|
|
|
or return $rslt; |
|
4378
|
0
|
|
|
|
|
0
|
|
|
4379
|
0
|
|
|
|
|
0
|
foreach my $body ( @{ |
|
4380
|
|
|
|
|
|
|
$self->_get_json_object()->decode( $rslt->content() ) |
|
4381
|
0
|
|
|
|
|
0
|
} ) { |
|
4382
|
|
|
|
|
|
|
$oid{ $body->{OBJECT_NUMBER} + 0 } = 1; |
|
4383
|
|
|
|
|
|
|
} |
|
4384
|
|
|
|
|
|
|
|
|
4385
|
|
|
|
|
|
|
} |
|
4386
|
|
|
|
|
|
|
|
|
4387
|
0
|
|
|
|
|
0
|
$rslt = $self->retrieve( $opt, |
|
|
0
|
|
|
|
|
0
|
|
|
4388
|
|
|
|
|
|
|
sort { $a <=> $b } keys %oid ); |
|
4389
|
0
|
0
|
|
|
|
0
|
|
|
4390
|
|
|
|
|
|
|
$rslt->is_success() |
|
4391
|
|
|
|
|
|
|
or return $rslt; |
|
4392
|
|
|
|
|
|
|
|
|
4393
|
|
|
|
|
|
|
} else { |
|
4394
|
3
|
|
|
|
|
16
|
|
|
4395
|
|
|
|
|
|
|
$rslt = $self->spacetrack_query_v2( |
|
4396
|
|
|
|
|
|
|
basicspacedata => 'query', |
|
4397
|
|
|
|
|
|
|
_sort_rest_arguments( \%retrieve_opt ), |
|
4398
|
|
|
|
|
|
|
); |
|
4399
|
3
|
100
|
|
|
|
16
|
|
|
4400
|
|
|
|
|
|
|
$rslt->is_success() |
|
4401
|
|
|
|
|
|
|
or return $rslt; |
|
4402
|
1
|
|
|
|
|
18
|
|
|
4403
|
|
|
|
|
|
|
$self->_convert_content( $rslt ); |
|
4404
|
1
|
|
|
|
|
14
|
|
|
4405
|
|
|
|
|
|
|
$self->_add_pragmata( $rslt, |
|
4406
|
|
|
|
|
|
|
'spacetrack-type' => 'orbit', |
|
4407
|
|
|
|
|
|
|
'spacetrack-source' => 'spacetrack', |
|
4408
|
|
|
|
|
|
|
'spacetrack-interface' => 2, |
|
4409
|
|
|
|
|
|
|
); |
|
4410
|
|
|
|
|
|
|
|
|
4411
|
|
|
|
|
|
|
} |
|
4412
|
1
|
|
|
|
|
10
|
|
|
4413
|
|
|
|
|
|
|
return $rslt; |
|
4414
|
|
|
|
|
|
|
|
|
4415
|
|
|
|
|
|
|
} |
|
4416
|
|
|
|
|
|
|
|
|
4417
|
|
|
|
|
|
|
=for html |
|
4418
|
|
|
|
|
|
|
|
|
4419
|
|
|
|
|
|
|
=item $resp = $st->spacetrack_query_v2( @path ); |
|
4420
|
|
|
|
|
|
|
|
|
4421
|
|
|
|
|
|
|
This method exposes the Space Track version 2 interface (a.k.a the REST |
|
4422
|
|
|
|
|
|
|
interface). It has nothing to do with the (probably badly-named) |
|
4423
|
|
|
|
|
|
|
C method. |
|
4424
|
|
|
|
|
|
|
|
|
4425
|
|
|
|
|
|
|
The arguments are the arguments to the REST interface. These will be |
|
4426
|
|
|
|
|
|
|
URI-escaped, and a login will be performed if necessary. This method |
|
4427
|
|
|
|
|
|
|
returns an C object containing the results of the |
|
4428
|
|
|
|
|
|
|
operation. |
|
4429
|
|
|
|
|
|
|
|
|
4430
|
|
|
|
|
|
|
Except for the URI escaping of the arguments and the implicit login, |
|
4431
|
|
|
|
|
|
|
this method interfaces directly to Space Track. It is provided for those |
|
4432
|
|
|
|
|
|
|
who want a way to experiment with the REST interface, or who wish to do |
|
4433
|
|
|
|
|
|
|
something not covered by the higher-level methods. |
|
4434
|
|
|
|
|
|
|
|
|
4435
|
|
|
|
|
|
|
For example, if you want the JSON version of the satellite box score |
|
4436
|
|
|
|
|
|
|
(rather than the tab-delimited version provided by the C |
|
4437
|
|
|
|
|
|
|
method) you will find the JSON in the response object of the following |
|
4438
|
|
|
|
|
|
|
call: |
|
4439
|
|
|
|
|
|
|
|
|
4440
|
|
|
|
|
|
|
my $resp = $st->spacetrack_query_v2( qw{ |
|
4441
|
|
|
|
|
|
|
basicspacedata query class boxscore |
|
4442
|
|
|
|
|
|
|
format json predicates all |
|
4443
|
|
|
|
|
|
|
} ); |
|
4444
|
|
|
|
|
|
|
); |
|
4445
|
|
|
|
|
|
|
|
|
4446
|
|
|
|
|
|
|
If this method is called directly from outside the C |
|
4447
|
|
|
|
|
|
|
name space, pragmata will be added to the results based on the |
|
4448
|
|
|
|
|
|
|
arguments, as follows: |
|
4449
|
|
|
|
|
|
|
|
|
4450
|
|
|
|
|
|
|
For C<< basicspacedata => 'modeldef' >> |
|
4451
|
|
|
|
|
|
|
|
|
4452
|
|
|
|
|
|
|
Pragma: spacetrack-type = modeldef |
|
4453
|
|
|
|
|
|
|
Pragma: spacetrack-source = spacetrack |
|
4454
|
|
|
|
|
|
|
Pragma: spacetrack-interface = 2 |
|
4455
|
|
|
|
|
|
|
|
|
4456
|
|
|
|
|
|
|
For C<< basicspacedata => 'query' >> and C<< class => 'tle' >> or |
|
4457
|
|
|
|
|
|
|
C<'tle_latest'>, |
|
4458
|
|
|
|
|
|
|
|
|
4459
|
|
|
|
|
|
|
Pragma: spacetrack-type = orbit |
|
4460
|
|
|
|
|
|
|
Pragma: spacetrack-source = spacetrack |
|
4461
|
|
|
|
|
|
|
Pragma: spacetrack-interface = 2 |
|
4462
|
|
|
|
|
|
|
|
|
4463
|
|
|
|
|
|
|
=cut |
|
4464
|
|
|
|
|
|
|
|
|
4465
|
|
|
|
|
|
|
{ |
|
4466
|
|
|
|
|
|
|
our $SPACETRACK_DELAY_SECONDS = $ENV{SPACETRACK_DELAY_SECONDS} || 3; |
|
4467
|
|
|
|
|
|
|
|
|
4468
|
|
|
|
|
|
|
my $spacetrack_delay_until; |
|
4469
|
|
|
|
|
|
|
|
|
4470
|
95
|
|
|
95
|
|
150
|
sub _spacetrack_delay { |
|
4471
|
95
|
50
|
|
|
|
234
|
my ( $self ) = @_; |
|
4472
|
|
|
|
|
|
|
$SPACETRACK_DELAY_SECONDS |
|
4473
|
0
|
0
|
|
|
|
0
|
or return; |
|
4474
|
|
|
|
|
|
|
$self->{dump_headers} & DUMP_DRY_RUN |
|
4475
|
0
|
0
|
|
|
|
0
|
and return; |
|
4476
|
0
|
|
|
|
|
0
|
if ( defined $spacetrack_delay_until ) { |
|
4477
|
0
|
0
|
|
|
|
0
|
my $now = _time(); |
|
4478
|
|
|
|
|
|
|
$now < $spacetrack_delay_until |
|
4479
|
|
|
|
|
|
|
and _sleep( $spacetrack_delay_until - $now ); |
|
4480
|
0
|
|
|
|
|
0
|
} |
|
4481
|
|
|
|
|
|
|
$spacetrack_delay_until = _time() + $SPACETRACK_DELAY_SECONDS; |
|
4482
|
0
|
|
|
|
|
0
|
|
|
4483
|
|
|
|
|
|
|
return; |
|
4484
|
|
|
|
|
|
|
} |
|
4485
|
|
|
|
|
|
|
} |
|
4486
|
|
|
|
|
|
|
|
|
4487
|
|
|
|
|
|
|
{ |
|
4488
|
|
|
|
|
|
|
my %tle_class = map { $_ => 1 } qw{ tle tle_latest }; |
|
4489
|
|
|
|
|
|
|
|
|
4490
|
95
|
|
|
95
|
1
|
362
|
sub spacetrack_query_v2 { |
|
4491
|
|
|
|
|
|
|
my ( $self, @args ) = @_; |
|
4492
|
|
|
|
|
|
|
|
|
4493
|
|
|
|
|
|
|
# Space Track has announced that beginning September 22 2014 |
|
4494
|
|
|
|
|
|
|
# they will begin limiting queries to 20 per minute. But they |
|
4495
|
|
|
|
|
|
|
# seem to have jumped the gun, since I get failures August 19 |
|
4496
|
|
|
|
|
|
|
# 2014 if I don't throttle. None of this applies, though, if |
|
4497
|
95
|
|
|
|
|
238
|
# we're not actually executing the query. |
|
4498
|
|
|
|
|
|
|
$self->_spacetrack_delay(); |
|
4499
|
95
|
|
|
|
|
173
|
|
|
4500
|
|
|
|
|
|
|
delete $self->{_pragmata}; |
|
4501
|
|
|
|
|
|
|
|
|
4502
|
|
|
|
|
|
|
# # Note that we need to add the comma to URI::Escape's RFC3986 list, |
|
4503
|
|
|
|
|
|
|
# # since Space Track does not decode it. |
|
4504
|
|
|
|
|
|
|
# my $url = join '/', |
|
4505
|
|
|
|
|
|
|
# $self->_make_space_track_base_url( 2 ), |
|
4506
|
|
|
|
|
|
|
# map { |
|
4507
|
|
|
|
|
|
|
# URI::Escape::uri_escape( $_, '^A-Za-z0-9.,_~:-' ) |
|
4508
|
|
|
|
|
|
|
# } @args; |
|
4509
|
95
|
|
|
|
|
216
|
|
|
4510
|
95
|
|
|
|
|
15161
|
my $uri = URI->new( $self->_make_space_track_base_url( 2 ) ); |
|
4511
|
|
|
|
|
|
|
$uri->path_segments( @args ); |
|
4512
|
|
|
|
|
|
|
# $url eq $uri->as_string() |
|
4513
|
|
|
|
|
|
|
# or warn "'$url' ne '@{[ $uri->as_string() ]}'"; |
|
4514
|
|
|
|
|
|
|
# $url = $uri->as_string(); |
|
4515
|
95
|
100
|
|
|
|
13076
|
|
|
4516
|
|
|
|
|
|
|
if ( my $resp = $self->_dump_request( |
|
4517
|
|
|
|
|
|
|
args => \@args, |
|
4518
|
|
|
|
|
|
|
method => 'GET', |
|
4519
|
|
|
|
|
|
|
url => $uri, |
|
4520
|
|
|
|
|
|
|
version => 2, |
|
4521
|
48
|
|
|
|
|
2995
|
) ) { |
|
4522
|
|
|
|
|
|
|
return $resp; |
|
4523
|
|
|
|
|
|
|
} |
|
4524
|
|
|
|
|
|
|
|
|
4525
|
47
|
100
|
|
|
|
129
|
$self->_check_cookie_generic( 2 ) |
|
4526
|
1
|
|
|
|
|
5
|
or do { |
|
4527
|
1
|
50
|
|
|
|
64
|
my $resp = $self->login(); |
|
4528
|
|
|
|
|
|
|
$resp->is_success() |
|
4529
|
|
|
|
|
|
|
or return $resp; |
|
4530
|
|
|
|
|
|
|
}; |
|
4531
|
|
|
|
|
|
|
## warn "Debug - $url/$cgi"; |
|
4532
|
47
|
|
|
|
|
141
|
# my $resp = $self->_get_agent()->get( $url ); |
|
4533
|
|
|
|
|
|
|
my $resp = $self->_get_agent()->get( $uri ); |
|
4534
|
47
|
50
|
|
|
|
175
|
|
|
4535
|
|
|
|
|
|
|
if ( $resp->is_success() ) { |
|
4536
|
47
|
50
|
33
|
|
|
493
|
|
|
4537
|
|
|
|
|
|
|
if ( $self->{pretty} && |
|
4538
|
|
|
|
|
|
|
_find_rest_arg_value( \@args, format => 'json' ) eq 'json' |
|
4539
|
0
|
|
|
|
|
0
|
) { |
|
4540
|
0
|
|
|
|
|
0
|
my $json = $self->_get_json_object(); |
|
4541
|
|
|
|
|
|
|
$resp->content( $json->encode( $json->decode( |
|
4542
|
|
|
|
|
|
|
$resp->content() ) ) ); |
|
4543
|
|
|
|
|
|
|
} |
|
4544
|
47
|
100
|
|
|
|
154
|
|
|
4545
|
|
|
|
|
|
|
if ( __PACKAGE__ ne caller ) { |
|
4546
|
2
|
|
|
|
|
8
|
|
|
4547
|
|
|
|
|
|
|
my $kind = _find_rest_arg_value( \@args, |
|
4548
|
2
|
|
|
|
|
7
|
basicspacedata => '' ); |
|
4549
|
|
|
|
|
|
|
my $class = _find_rest_arg_value( \@args, |
|
4550
|
|
|
|
|
|
|
class => '' ); |
|
4551
|
2
|
100
|
33
|
|
|
13
|
|
|
|
|
50
|
|
|
|
|
|
|
4552
|
|
|
|
|
|
|
if ( 'modeldef' eq $kind ) { |
|
4553
|
1
|
|
|
|
|
5
|
|
|
4554
|
|
|
|
|
|
|
$self->_add_pragmata( $resp, |
|
4555
|
|
|
|
|
|
|
'spacetrack-type' => 'modeldef', |
|
4556
|
|
|
|
|
|
|
'spacetrack-source' => 'spacetrack', |
|
4557
|
|
|
|
|
|
|
'spacetrack-interface' => 2, |
|
4558
|
|
|
|
|
|
|
); |
|
4559
|
|
|
|
|
|
|
|
|
4560
|
|
|
|
|
|
|
} elsif ( 'query' eq $kind && $tle_class{$class} ) { |
|
4561
|
1
|
|
|
|
|
4
|
|
|
4562
|
|
|
|
|
|
|
$self->_add_pragmata( $resp, |
|
4563
|
|
|
|
|
|
|
'spacetrack-type' => 'orbit', |
|
4564
|
|
|
|
|
|
|
'spacetrack-source' => 'spacetrack', |
|
4565
|
|
|
|
|
|
|
'spacetrack-interface' => 2, |
|
4566
|
|
|
|
|
|
|
); |
|
4567
|
|
|
|
|
|
|
|
|
4568
|
|
|
|
|
|
|
} |
|
4569
|
|
|
|
|
|
|
} |
|
4570
|
|
|
|
|
|
|
} |
|
4571
|
47
|
|
|
|
|
160
|
|
|
4572
|
47
|
|
|
|
|
175
|
$self->__dump_response( $resp ); |
|
4573
|
|
|
|
|
|
|
return $resp; |
|
4574
|
|
|
|
|
|
|
} |
|
4575
|
|
|
|
|
|
|
} |
|
4576
|
|
|
|
|
|
|
|
|
4577
|
4
|
|
|
4
|
|
11
|
sub _find_rest_arg_value { |
|
4578
|
4
|
|
|
|
|
15
|
my ( $args, $name, $default ) = @_; |
|
4579
|
8
|
100
|
|
|
|
26
|
for ( my $inx = $#$args - 1; $inx >= 0; $inx -= 2 ) { |
|
4580
|
|
|
|
|
|
|
$args->[$inx] eq $name |
|
4581
|
|
|
|
|
|
|
and return $args->[$inx + 1]; |
|
4582
|
0
|
|
|
|
|
0
|
} |
|
4583
|
|
|
|
|
|
|
return $default; |
|
4584
|
|
|
|
|
|
|
} |
|
4585
|
|
|
|
|
|
|
|
|
4586
|
|
|
|
|
|
|
=for html |
|
4587
|
|
|
|
|
|
|
|
|
4588
|
|
|
|
|
|
|
=item $resp = $st->update( $file_name ); |
|
4589
|
|
|
|
|
|
|
|
|
4590
|
|
|
|
|
|
|
This method updates the named TLE file, which must be in JSON format. On |
|
4591
|
|
|
|
|
|
|
a successful update, the content of the returned HTTP::Response object |
|
4592
|
|
|
|
|
|
|
is the updated TLE data, in whatever format is desired. If any updates |
|
4593
|
|
|
|
|
|
|
were in fact found, the file is rewritten. The rewritten JSON will be |
|
4594
|
|
|
|
|
|
|
pretty if the C attribute is true. |
|
4595
|
|
|
|
|
|
|
|
|
4596
|
|
|
|
|
|
|
The file to be updated can be generated by using the C<-json> option on |
|
4597
|
|
|
|
|
|
|
any of the methods that accesses Space Track data. For example, |
|
4598
|
|
|
|
|
|
|
|
|
4599
|
|
|
|
|
|
|
# Assuming $ENV{SPACETRACK_USER} contains |
|
4600
|
|
|
|
|
|
|
# username/password |
|
4601
|
|
|
|
|
|
|
my $st = Astro::SpaceTrack->new( |
|
4602
|
|
|
|
|
|
|
pretty => 1, |
|
4603
|
|
|
|
|
|
|
); |
|
4604
|
|
|
|
|
|
|
my $rslt = $st->spacetrack( { json => 1 }, 'iridium' ); |
|
4605
|
|
|
|
|
|
|
$rslt->is_success() |
|
4606
|
|
|
|
|
|
|
or die $rslt->status_line(); |
|
4607
|
|
|
|
|
|
|
open my $fh, '>', 'iridium.json' |
|
4608
|
|
|
|
|
|
|
or die "Failed to open file: $!"; |
|
4609
|
|
|
|
|
|
|
print { $fh } $rslt->content(); |
|
4610
|
|
|
|
|
|
|
close $fh; |
|
4611
|
|
|
|
|
|
|
|
|
4612
|
|
|
|
|
|
|
The following is the equivalent example using the F script: |
|
4613
|
|
|
|
|
|
|
|
|
4614
|
|
|
|
|
|
|
SpaceTrack> set pretty 1 |
|
4615
|
|
|
|
|
|
|
SpaceTrack> spacetrack -json iridium >iridium.json |
|
4616
|
|
|
|
|
|
|
|
|
4617
|
|
|
|
|
|
|
This method reads the file to be updated, determines the highest C |
|
4618
|
|
|
|
|
|
|
value, and then requests the given OIDs, restricting the return to |
|
4619
|
|
|
|
|
|
|
C values greater than the highest found. If anything is returned, |
|
4620
|
|
|
|
|
|
|
the file is rewritten. |
|
4621
|
|
|
|
|
|
|
|
|
4622
|
|
|
|
|
|
|
The following options may be specified: |
|
4623
|
|
|
|
|
|
|
|
|
4624
|
|
|
|
|
|
|
-json |
|
4625
|
|
|
|
|
|
|
specifies the TLE be returned in JSON format |
|
4626
|
|
|
|
|
|
|
|
|
4627
|
|
|
|
|
|
|
Options may be specified either in command-line style (that is, as |
|
4628
|
|
|
|
|
|
|
C<< spacetrack( '-json', ... ) >>) or as a hash reference (that is, as |
|
4629
|
|
|
|
|
|
|
C<< spacetrack( { json => 1 }, ... ) >>). |
|
4630
|
|
|
|
|
|
|
|
|
4631
|
|
|
|
|
|
|
B that there is no way to specify the C<-rcs> or C<-effective> |
|
4632
|
|
|
|
|
|
|
options. If the file being updated contains these values, they will be |
|
4633
|
|
|
|
|
|
|
lost as the individual OIDs are updated. |
|
4634
|
|
|
|
|
|
|
|
|
4635
|
|
|
|
|
|
|
=cut |
|
4636
|
|
|
|
|
|
|
|
|
4637
|
|
|
|
|
|
|
{ |
|
4638
|
|
|
|
|
|
|
|
|
4639
|
|
|
|
|
|
|
my %encode = ( |
|
4640
|
|
|
|
|
|
|
'3le' => sub { |
|
4641
|
|
|
|
|
|
|
my ( undef, $data ) = @_; # JSON object unused |
|
4642
|
|
|
|
|
|
|
return join '', map { |
|
4643
|
|
|
|
|
|
|
"$_->{OBJECT_NAME}\n$_->{TLE_LINE1}\n$_->{TLE_LINE2}\n" |
|
4644
|
|
|
|
|
|
|
} @{ $data }; |
|
4645
|
|
|
|
|
|
|
}, |
|
4646
|
|
|
|
|
|
|
json => sub { |
|
4647
|
|
|
|
|
|
|
my ( $json, $data ) = @_; |
|
4648
|
|
|
|
|
|
|
return $json->encode( $data ); |
|
4649
|
|
|
|
|
|
|
}, |
|
4650
|
|
|
|
|
|
|
tle => sub { |
|
4651
|
|
|
|
|
|
|
my ( undef, $data ) = @_; # JSON object unused |
|
4652
|
|
|
|
|
|
|
return join '', map { |
|
4653
|
|
|
|
|
|
|
"$_->{TLE_LINE1}\n$_->{TLE_LINE2}\n" |
|
4654
|
|
|
|
|
|
|
} @{ $data }; |
|
4655
|
|
|
|
|
|
|
}, |
|
4656
|
|
|
|
|
|
|
); |
|
4657
|
|
|
|
|
|
|
|
|
4658
|
|
|
|
|
|
|
# Called dynamically |
|
4659
|
|
|
|
|
|
|
sub _update_opts { ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) |
|
4660
|
0
|
|
|
0
|
|
0
|
return [ |
|
4661
|
|
|
|
|
|
|
_get_retrieve_options(), |
|
4662
|
|
|
|
|
|
|
]; |
|
4663
|
|
|
|
|
|
|
} |
|
4664
|
|
|
|
|
|
|
|
|
4665
|
0
|
|
|
0
|
1
|
0
|
sub update { |
|
4666
|
|
|
|
|
|
|
my ( $self, @args ) = @_; |
|
4667
|
0
|
|
|
|
|
0
|
|
|
4668
|
|
|
|
|
|
|
my ( $opt, $fn ) = $self->_parse_retrieve_args( @args ); |
|
4669
|
0
|
|
|
|
|
0
|
|
|
|
0
|
|
|
|
|
0
|
|
|
4670
|
|
|
|
|
|
|
$opt = { %{ $opt } }; # Since we modify it. |
|
4671
|
|
|
|
|
|
|
|
|
4672
|
0
|
0
|
|
|
|
0
|
delete $opt->{start_epoch} |
|
4673
|
|
|
|
|
|
|
and Carp::croak '-start_epoch not allowed'; |
|
4674
|
0
|
0
|
|
|
|
0
|
delete $opt->{end_epoch} |
|
4675
|
|
|
|
|
|
|
and Carp::croak '-end_epoch not allowed'; |
|
4676
|
0
|
|
|
|
|
0
|
|
|
4677
|
0
|
|
|
|
|
0
|
my $json = $self->_get_json_object(); |
|
4678
|
|
|
|
|
|
|
my $data; |
|
4679
|
0
|
|
|
|
|
0
|
{ |
|
|
0
|
|
|
|
|
0
|
|
|
4680
|
0
|
0
|
|
|
|
0
|
local $/ = undef; |
|
4681
|
|
|
|
|
|
|
open my $fh, '<', $fn |
|
4682
|
0
|
|
|
|
|
0
|
or Carp::croak "Unable to open $fn: $!"; |
|
4683
|
0
|
|
|
|
|
0
|
$data = $json->decode( <$fh> ); |
|
4684
|
|
|
|
|
|
|
close $fh; |
|
4685
|
|
|
|
|
|
|
} |
|
4686
|
0
|
|
|
|
|
0
|
|
|
4687
|
0
|
|
|
|
|
0
|
my $file = -1; |
|
4688
|
0
|
|
|
|
|
0
|
my @oids; |
|
|
0
|
|
|
|
|
0
|
|
|
4689
|
0
|
|
|
|
|
0
|
foreach my $datum ( @{ $data } ) { |
|
4690
|
|
|
|
|
|
|
push @oids, $datum->{OBJECT_NUMBER}; |
|
4691
|
|
|
|
|
|
|
my $ff = defined $datum->{_file_of_record} ? |
|
4692
|
0
|
0
|
|
|
|
0
|
delete $datum->{_file_of_record} : |
|
4693
|
0
|
0
|
|
|
|
0
|
$datum->{FILE}; |
|
4694
|
|
|
|
|
|
|
$ff > $file |
|
4695
|
|
|
|
|
|
|
and $file = $ff; |
|
4696
|
|
|
|
|
|
|
} |
|
4697
|
|
|
|
|
|
|
|
|
4698
|
0
|
0
|
|
|
|
0
|
defined $opt->{since_file} |
|
4699
|
|
|
|
|
|
|
or $opt->{since_file} = $file; |
|
4700
|
0
|
0
|
|
|
|
0
|
|
|
|
|
0
|
|
|
|
|
|
|
4701
|
|
|
|
|
|
|
my $format = delete $opt->{json} ? 'json' : |
|
4702
|
0
|
|
|
|
|
0
|
$self->getv( 'with_name' ) ? '3le' : 'tle'; |
|
4703
|
|
|
|
|
|
|
$opt->{format} = 'json'; |
|
4704
|
0
|
|
|
|
|
0
|
|
|
|
0
|
|
|
|
|
0
|
|
|
4705
|
|
|
|
|
|
|
my $resp = $self->retrieve( $opt, sort { $a <=> $b } @oids ); |
|
4706
|
0
|
0
|
|
|
|
0
|
|
|
4707
|
|
|
|
|
|
|
if ( $resp->code() == HTTP_NOT_FOUND ) { |
|
4708
|
0
|
|
|
|
|
0
|
|
|
4709
|
0
|
|
|
|
|
0
|
$resp->code( HTTP_OK ); |
|
4710
|
|
|
|
|
|
|
$self->_add_pragmata( $resp, |
|
4711
|
|
|
|
|
|
|
'spacetrack-type' => 'orbit', |
|
4712
|
|
|
|
|
|
|
'spacetrack-source' => 'spacetrack', |
|
4713
|
|
|
|
|
|
|
'spacetrack-interface' => 2, |
|
4714
|
|
|
|
|
|
|
); |
|
4715
|
|
|
|
|
|
|
|
|
4716
|
|
|
|
|
|
|
} else { |
|
4717
|
0
|
0
|
|
|
|
0
|
|
|
4718
|
|
|
|
|
|
|
$resp->is_success() |
|
4719
|
|
|
|
|
|
|
or return $resp; |
|
4720
|
0
|
|
|
|
|
0
|
|
|
|
0
|
|
|
|
|
0
|
|
|
|
0
|
|
|
|
|
0
|
|
|
4721
|
|
|
|
|
|
|
my %merge = map { $_->{OBJECT_NUMBER} => $_ } @{ $data }; |
|
4722
|
0
|
|
|
|
|
0
|
|
|
|
0
|
|
|
|
|
0
|
|
|
4723
|
0
|
|
|
|
|
0
|
foreach my $datum ( @{ $json->decode( $resp->content() ) } ) { |
|
|
0
|
|
|
|
|
0
|
|
|
|
0
|
|
|
|
|
0
|
|
|
4724
|
|
|
|
|
|
|
%{ $merge{$datum->{OBJECT_NUMBER}} } = %{ $datum }; |
|
4725
|
|
|
|
|
|
|
} |
|
4726
|
|
|
|
|
|
|
|
|
4727
|
0
|
0
|
|
|
|
0
|
{ |
|
|
0
|
|
|
|
|
0
|
|
|
4728
|
|
|
|
|
|
|
open my $fh, '>', $fn |
|
4729
|
0
|
|
|
|
|
0
|
or Carp::croak "Failed to open $fn: $!"; |
|
|
0
|
|
|
|
|
0
|
|
|
4730
|
0
|
|
|
|
|
0
|
print { $fh } $json->encode( $data ); |
|
4731
|
|
|
|
|
|
|
close $fh; |
|
4732
|
|
|
|
|
|
|
} |
|
4733
|
|
|
|
|
|
|
|
|
4734
|
|
|
|
|
|
|
} |
|
4735
|
0
|
|
|
|
|
0
|
|
|
4736
|
|
|
|
|
|
|
$resp->content( $encode{$format}->( $json, $data ) ); |
|
4737
|
0
|
|
|
|
|
0
|
|
|
4738
|
|
|
|
|
|
|
return $resp; |
|
4739
|
|
|
|
|
|
|
} |
|
4740
|
|
|
|
|
|
|
|
|
4741
|
|
|
|
|
|
|
} |
|
4742
|
|
|
|
|
|
|
|
|
4743
|
|
|
|
|
|
|
|
|
4744
|
|
|
|
|
|
|
#### |
|
4745
|
|
|
|
|
|
|
# |
|
4746
|
|
|
|
|
|
|
# Private methods. |
|
4747
|
|
|
|
|
|
|
# |
|
4748
|
|
|
|
|
|
|
|
|
4749
|
|
|
|
|
|
|
# $self->_add_pragmata ($resp, $name => $value, ...); |
|
4750
|
|
|
|
|
|
|
# |
|
4751
|
|
|
|
|
|
|
# This method adds pragma headers to the given HTTP::Response |
|
4752
|
|
|
|
|
|
|
# object, of the form pragma => "$name = $value". The pragmata are |
|
4753
|
|
|
|
|
|
|
# also cached in $self. |
|
4754
|
|
|
|
|
|
|
# |
|
4755
|
|
|
|
|
|
|
# Pragmata names are normalized by converting them to lower case |
|
4756
|
|
|
|
|
|
|
# and converting underscores to dashes. |
|
4757
|
|
|
|
|
|
|
|
|
4758
|
153
|
|
|
153
|
|
472
|
sub _add_pragmata { |
|
4759
|
153
|
|
|
|
|
403
|
my ($self, $resp, @args) = @_; |
|
4760
|
331
|
|
|
|
|
6567
|
while (@args) { |
|
4761
|
331
|
|
|
|
|
695
|
my ( $name, $value ) = splice @args, 0, 2; |
|
4762
|
331
|
|
|
|
|
737
|
$name = lc $name; |
|
4763
|
331
|
|
|
|
|
850
|
$name =~ s/ _ /-/smxg; |
|
4764
|
331
|
|
|
|
|
1310
|
$self->{_pragmata}{$name} = $value; |
|
4765
|
|
|
|
|
|
|
$resp->push_header(pragma => "$name = $value"); |
|
4766
|
153
|
|
|
|
|
5763
|
} |
|
4767
|
|
|
|
|
|
|
return; |
|
4768
|
|
|
|
|
|
|
} |
|
4769
|
|
|
|
|
|
|
|
|
4770
|
|
|
|
|
|
|
{ |
|
4771
|
|
|
|
|
|
|
my %format_map = qw{ |
|
4772
|
|
|
|
|
|
|
3le tle |
|
4773
|
|
|
|
|
|
|
}; |
|
4774
|
|
|
|
|
|
|
|
|
4775
|
|
|
|
|
|
|
# $accumulator = _accumulator_for( $format, \%opt ) |
|
4776
|
|
|
|
|
|
|
# |
|
4777
|
|
|
|
|
|
|
# This subroutine manufactires and returns an accumulator for the |
|
4778
|
|
|
|
|
|
|
# named format. The reference to the options hash is itself |
|
4779
|
|
|
|
|
|
|
# optional. The supported options are: |
|
4780
|
|
|
|
|
|
|
# file => true if the data contains a FILE key and the caller |
|
4781
|
|
|
|
|
|
|
# requests that a _file_of_record key be generated if |
|
4782
|
|
|
|
|
|
|
# possible and appropriate. Individual accumulators are at |
|
4783
|
|
|
|
|
|
|
# liberty to ignore this. |
|
4784
|
|
|
|
|
|
|
# pretty => true if the caller requests that the returned data be |
|
4785
|
|
|
|
|
|
|
# nicely formatted. This normally comes from the 'pretty' |
|
4786
|
|
|
|
|
|
|
# attribute. Individual accumulators are at liberty to |
|
4787
|
|
|
|
|
|
|
# ignore this. |
|
4788
|
|
|
|
|
|
|
# |
|
4789
|
|
|
|
|
|
|
# The return is a code reference. This reference is intended to be |
|
4790
|
|
|
|
|
|
|
# called as |
|
4791
|
|
|
|
|
|
|
# $accumulator->( $self, $resp ) |
|
4792
|
|
|
|
|
|
|
# for each successful HTTP response. After all responses have been |
|
4793
|
|
|
|
|
|
|
# processed, the accumulated data are retrieved using |
|
4794
|
|
|
|
|
|
|
# ( $content, $data ) = $accumulator( $self ) |
|
4795
|
|
|
|
|
|
|
# The first return is the text representation of the accumulated |
|
4796
|
|
|
|
|
|
|
# data. The second is the decoded data, and is returned at the |
|
4797
|
|
|
|
|
|
|
# accumulator's option. In scalar context only $content is returned. |
|
4798
|
|
|
|
|
|
|
|
|
4799
|
83
|
|
|
83
|
|
158
|
sub _accumulator_for { |
|
4800
|
83
|
|
66
|
|
|
275
|
my ( $format, $opt ) = @_; |
|
4801
|
83
|
|
50
|
|
|
586
|
my $name = $format_map{$format} || $format; |
|
4802
|
|
|
|
|
|
|
my $accumulator = __PACKAGE__->can( "_accumulate_${name}_data" ) |
|
4803
|
|
|
|
|
|
|
|| \&_accumulate_unknown_data; |
|
4804
|
|
|
|
|
|
|
my $returner = __PACKAGE__->can( "_accumulate_${name}_return" ) |
|
4805
|
20
|
|
|
20
|
|
49
|
|| sub { |
|
4806
|
20
|
|
|
|
|
57
|
my ( undef, $context ) = @_; |
|
4807
|
83
|
|
100
|
|
|
497
|
return $context->{data}; |
|
4808
|
83
|
|
100
|
|
|
361
|
}; |
|
4809
|
|
|
|
|
|
|
my $context = { |
|
4810
|
|
|
|
|
|
|
format => $format, |
|
4811
|
|
|
|
|
|
|
opt => $opt || {}, |
|
4812
|
|
|
|
|
|
|
}; |
|
4813
|
106
|
|
|
106
|
|
197
|
return sub { |
|
4814
|
106
|
100
|
|
|
|
242
|
my ( $self, $resp ) = @_; |
|
4815
|
|
|
|
|
|
|
defined $resp |
|
4816
|
54
|
|
|
|
|
136
|
or return $returner->( $self, $context ); |
|
4817
|
54
|
50
|
33
|
|
|
771
|
my $content = $resp->content(); |
|
4818
|
|
|
|
|
|
|
defined $content |
|
4819
|
|
|
|
|
|
|
and $content ne '' |
|
4820
|
54
|
|
|
|
|
123
|
or return; |
|
4821
|
|
|
|
|
|
|
my $data = $accumulator->( $self, $content, $context ); |
|
4822
|
54
|
100
|
100
|
|
|
170
|
$context->{opt}{file} |
|
4823
|
|
|
|
|
|
|
and $data |
|
4824
|
54
|
|
|
|
|
386
|
and _accumulate_file_of_record( $self, $context, $data ); |
|
4825
|
|
|
|
|
|
|
return; |
|
4826
|
83
|
|
|
|
|
421
|
} |
|
4827
|
|
|
|
|
|
|
} |
|
4828
|
|
|
|
|
|
|
|
|
4829
|
|
|
|
|
|
|
} |
|
4830
|
|
|
|
|
|
|
|
|
4831
|
1
|
|
|
1
|
|
5
|
sub _accumulate_file_of_record { |
|
4832
|
1
|
50
|
|
|
|
6
|
my ( undef, $context, $data ) = @_; # Invocant unused |
|
4833
|
0
|
|
|
|
|
0
|
if ( defined $context->{file} ) { |
|
|
0
|
|
|
|
|
0
|
|
|
4834
|
|
|
|
|
|
|
foreach my $datum ( @{ $data } ) { |
|
4835
|
|
|
|
|
|
|
defined $datum->{FILE} |
|
4836
|
0
|
0
|
0
|
|
|
0
|
and $datum->{FILE} > $context->{file} |
|
4837
|
|
|
|
|
|
|
and $datum->{_file_of_record} = $context->{file}; |
|
4838
|
|
|
|
|
|
|
} |
|
4839
|
|
|
|
|
|
|
} else { |
|
4840
|
1
|
|
|
|
|
9
|
$context->{file} = List::Util::max( -1, |
|
4841
|
1
|
|
|
|
|
6
|
map { $_->{FILE} } |
|
4842
|
1
|
|
|
|
|
3
|
grep { defined $_->{FILE} } |
|
|
1
|
|
|
|
|
2
|
|
|
4843
|
|
|
|
|
|
|
@{ $data } |
|
4844
|
|
|
|
|
|
|
); |
|
4845
|
1
|
|
|
|
|
3
|
} |
|
4846
|
|
|
|
|
|
|
return; |
|
4847
|
|
|
|
|
|
|
} |
|
4848
|
|
|
|
|
|
|
|
|
4849
|
|
|
|
|
|
|
# The data accumulators. The conventions which must be followed are |
|
4850
|
|
|
|
|
|
|
# that, given a format named 'fmt': |
|
4851
|
|
|
|
|
|
|
# |
|
4852
|
|
|
|
|
|
|
# 1) There MUST be an accumulator named _accumulate_fmt_data(). Its |
|
4853
|
|
|
|
|
|
|
# arguments are the invocant, the content of the return, and the |
|
4854
|
|
|
|
|
|
|
# context hash. It must accumulate data in $context->{data}, in any |
|
4855
|
|
|
|
|
|
|
# format it likes. |
|
4856
|
|
|
|
|
|
|
# 2) If _accumulate_fmt_data() decodes the data, it SHOULD return a |
|
4857
|
|
|
|
|
|
|
# reference to the decoded array. Otherwise it MUST return nothing. |
|
4858
|
|
|
|
|
|
|
# 3) There MAY be a returner named _accumulate_fmt_return(). If it |
|
4859
|
|
|
|
|
|
|
# exists its arguments are the invocant and the context hash. It MUST |
|
4860
|
|
|
|
|
|
|
# return a valid representation of the accumulated data in the |
|
4861
|
|
|
|
|
|
|
# desired format. |
|
4862
|
|
|
|
|
|
|
# 4) If _accumulate_fmt_return() does not exist, the return will be the |
|
4863
|
|
|
|
|
|
|
# contents of $context->{data}, which MUST have been maintained by |
|
4864
|
|
|
|
|
|
|
# _accumulate_fmt_data() as a valid representation of the data in the |
|
4865
|
|
|
|
|
|
|
# desired format. |
|
4866
|
|
|
|
|
|
|
# 5) Note that if _accumulate_fmt_return() exists, |
|
4867
|
|
|
|
|
|
|
# _accumulate_fmt_data need not maintain $context->{data} as a valid |
|
4868
|
|
|
|
|
|
|
# representation of the accumulated data. |
|
4869
|
|
|
|
|
|
|
|
|
4870
|
|
|
|
|
|
|
# Accessed via __PACKAGE__->can( "accumulate_${name}_data" ) in |
|
4871
|
|
|
|
|
|
|
# _accumulator_for(), above |
|
4872
|
0
|
|
|
0
|
|
0
|
sub _accumulate_csv_data { ## no critic (ProhibitUnusedPrivateSubroutines) |
|
4873
|
0
|
0
|
|
|
|
0
|
my ( undef, $content, $context ) = @_; # Invocant unused |
|
4874
|
0
|
|
|
|
|
0
|
if ( defined $context->{data} ) { |
|
4875
|
0
|
|
|
|
|
0
|
$context->{data} =~ s{ (?
|
|
4876
|
0
|
|
|
|
|
0
|
$content =~ s{ .* \n }{}smx; |
|
4877
|
|
|
|
|
|
|
$context->{data} .= $content; |
|
4878
|
0
|
|
|
|
|
0
|
} else { |
|
4879
|
|
|
|
|
|
|
$context->{data} = $content; |
|
4880
|
0
|
|
|
|
|
0
|
} |
|
4881
|
|
|
|
|
|
|
return; |
|
4882
|
|
|
|
|
|
|
} |
|
4883
|
|
|
|
|
|
|
|
|
4884
|
|
|
|
|
|
|
# Accessed via __PACKAGE__->can( "accumulate_${name}_data" ) in |
|
4885
|
|
|
|
|
|
|
# _accumulator_for(), above |
|
4886
|
0
|
|
|
0
|
|
0
|
sub _accumulate_html_data { ## no critic (ProhibitUnusedPrivateSubroutines) |
|
4887
|
0
|
0
|
|
|
|
0
|
my ( undef, $content, $context ) = @_; # Invocant unused |
|
4888
|
0
|
|
|
|
|
0
|
if ( defined $context->{data} ) { |
|
4889
|
0
|
|
|
|
|
0
|
$context->{data} =~ s{ \s* \s* |
\s* \z }{}smx;
\s* }{}smx;
|
4891
|
|
|
|
|
|
|
$context->{data} .= $content; |
|
4892
|
0
|
|
|
|
|
0
|
} else { |
|
4893
|
|
|
|
|
|
|
$context->{data} = $content; |
|
4894
|
0
|
|
|
|
|
0
|
} |
|
4895
|
|
|
|
|
|
|
return; |
|
4896
|
|
|
|
|
|
|
} |
|
4897
|
|
|
|
|
|
|
|
|
4898
|
|
|
|
|
|
|
# Accessed via __PACKAGE__->can( "accumulate_${name}_data" ) in |
|
4899
|
|
|
|
|
|
|
# _accumulator_for(), above |
|
4900
|
33
|
|
|
33
|
|
149
|
sub _accumulate_json_data { ## no critic (ProhibitUnusedPrivateSubroutines) |
|
4901
|
|
|
|
|
|
|
my ( $self, $content, $context ) = @_; |
|
4902
|
|
|
|
|
|
|
|
|
4903
|
|
|
|
|
|
|
my $json = $context->{json} ||= $self->_get_json_object( |
|
4904
|
33
|
|
66
|
|
|
151
|
pretty => $context->{opt}{pretty}, |
|
4905
|
|
|
|
|
|
|
); |
|
4906
|
33
|
|
|
|
|
789
|
|
|
4907
|
|
|
|
|
|
|
my $data = $json->decode( $content ); |
|
4908
|
33
|
50
|
|
|
|
168
|
|
|
4909
|
|
|
|
|
|
|
ARRAY_REF eq ref $data |
|
4910
|
|
|
|
|
|
|
or $data = [ $data ]; |
|
4911
|
33
|
100
|
|
|
|
58
|
|
|
|
33
|
|
|
|
|
73
|
|
|
4912
|
|
|
|
|
|
|
@{ $data } |
|
4913
|
|
|
|
|
|
|
or return; |
|
4914
|
32
|
100
|
|
|
|
78
|
|
|
4915
|
1
|
|
|
|
|
4
|
if ( $context->{data} ) { |
|
|
1
|
|
|
|
|
5
|
|
|
|
1
|
|
|
|
|
3
|
|
|
4916
|
|
|
|
|
|
|
push @{ $context->{data} }, @{ $data }; |
|
4917
|
31
|
|
|
|
|
56
|
} else { |
|
4918
|
|
|
|
|
|
|
$context->{data} = $data; |
|
4919
|
|
|
|
|
|
|
} |
|
4920
|
32
|
|
|
|
|
62
|
|
|
4921
|
|
|
|
|
|
|
return $data; |
|
4922
|
|
|
|
|
|
|
} |
|
4923
|
|
|
|
|
|
|
|
|
4924
|
|
|
|
|
|
|
# Accessed via __PACKAGE__->can( "accumulate_${name}_return" ) in |
|
4925
|
|
|
|
|
|
|
# _accumulator_for(), above |
|
4926
|
32
|
|
|
32
|
|
53
|
sub _accumulate_json_return { ## no critic (ProhibitUnusedPrivateSubroutines) |
|
4927
|
|
|
|
|
|
|
my ( $self, $context ) = @_; |
|
4928
|
|
|
|
|
|
|
|
|
4929
|
|
|
|
|
|
|
my $json = $context->{json} ||= $self->_get_json_object( |
|
4930
|
32
|
|
33
|
|
|
83
|
pretty => $context->{opt}{pretty}, |
|
4931
|
|
|
|
|
|
|
); |
|
4932
|
32
|
|
100
|
|
|
89
|
|
|
4933
|
|
|
|
|
|
|
$context->{data} ||= []; # In case we did not find anything. |
|
4934
|
|
|
|
|
|
|
return wantarray |
|
4935
|
32
|
100
|
|
|
|
477
|
? ( $json->encode( $context->{data} ), $context->{data} ) |
|
4936
|
|
|
|
|
|
|
: $json->encode( $context->{data} ); |
|
4937
|
|
|
|
|
|
|
} |
|
4938
|
|
|
|
|
|
|
|
|
4939
|
0
|
|
|
0
|
|
0
|
sub _accumulate_unknown_data { |
|
4940
|
|
|
|
|
|
|
my ( undef, $content, $context ) = @_; # Invocant unused |
|
4941
|
0
|
0
|
|
|
|
0
|
defined $context->{data} |
|
4942
|
0
|
|
|
|
|
0
|
and Carp::croak "Unable to accumulate $context->{format} data"; |
|
4943
|
0
|
|
|
|
|
0
|
$context->{data} = $content; |
|
4944
|
|
|
|
|
|
|
return; |
|
4945
|
|
|
|
|
|
|
} |
|
4946
|
|
|
|
|
|
|
|
|
4947
|
|
|
|
|
|
|
# Accessed via __PACKAGE__->can( "accumulate_${name}_data" ) in |
|
4948
|
|
|
|
|
|
|
# _accumulator_for(), above |
|
4949
|
21
|
|
|
21
|
|
53
|
sub _accumulate_tle_data { ## no critic (ProhibitUnusedPrivateSubroutines) |
|
4950
|
21
|
|
|
|
|
77
|
my ( undef, $content, $context ) = @_; # Invocant unused |
|
4951
|
21
|
|
|
|
|
40
|
$context->{data} .= $content; |
|
4952
|
|
|
|
|
|
|
return; |
|
4953
|
|
|
|
|
|
|
} |
|
4954
|
|
|
|
|
|
|
|
|
4955
|
|
|
|
|
|
|
# Accessed via __PACKAGE__->can( "accumulate_${name}_data" ) in |
|
4956
|
|
|
|
|
|
|
# _accumulator_for(), above |
|
4957
|
0
|
|
|
0
|
|
0
|
sub _accumulate_xml_data { ## no critic (ProhibitUnusedPrivateSubroutines) |
|
4958
|
0
|
0
|
|
|
|
0
|
my ( undef, $content, $context ) = @_; |
|
4959
|
0
|
|
|
|
|
0
|
if ( defined $context->{data} ) { |
|
4960
|
0
|
|
|
|
|
0
|
$context->{data} =~ s{ \s* \s* \z }{}smx; |
|
4961
|
0
|
|
|
|
|
0
|
$content =~ s{ .* \s* }{}smx; |
|
4962
|
|
|
|
|
|
|
$context->{data} .= $content; |
|
4963
|
0
|
|
|
|
|
0
|
} else { |
|
4964
|
|
|
|
|
|
|
$context->{data} = $content; |
|
4965
|
0
|
|
|
|
|
0
|
} |
|
4966
|
|
|
|
|
|
|
return; |
|
4967
|
|
|
|
|
|
|
} |
|
4968
|
|
|
|
|
|
|
|
|
4969
|
|
|
|
|
|
|
# _check_cookie_generic looks for our session cookie. If it is found, it |
|
4970
|
|
|
|
|
|
|
# returns true if it thinks the cookie is valid, and false otherwise. If |
|
4971
|
|
|
|
|
|
|
# it is not found, it returns false. |
|
4972
|
|
|
|
|
|
|
|
|
4973
|
2
|
|
|
2
|
|
8
|
sub _record_cookie_generic { |
|
4974
|
|
|
|
|
|
|
my ( $self, $version ) = @_; |
|
4975
|
2
|
50
|
|
|
|
8
|
defined $version |
|
4976
|
2
|
|
|
|
|
7
|
or $version = $self->{space_track_version}; |
|
4977
|
2
|
|
|
|
|
5
|
my $interface_info = $self->{_space_track_interface}[$version]; |
|
4978
|
2
|
|
|
|
|
5
|
my $cookie_name = $interface_info->{cookie_name}; |
|
4979
|
|
|
|
|
|
|
my $domain = $interface_info->{domain_space_track}; |
|
4980
|
2
|
|
|
|
|
5
|
|
|
4981
|
|
|
|
|
|
|
my ( $cookie, $expires ); |
|
4982
|
2
|
50
|
|
2
|
|
64
|
$self->_get_agent()->cookie_jar->scan( sub { |
|
4983
|
|
|
|
|
|
|
$self->{dump_headers} & DUMP_COOKIE |
|
4984
|
2
|
50
|
|
|
|
9
|
and $self->_dump_cookie( "_record_cookie_generic:\n", @_ ); |
|
4985
|
|
|
|
|
|
|
$_[4] eq $domain |
|
4986
|
2
|
50
|
|
|
|
11
|
or return; |
|
4987
|
|
|
|
|
|
|
$_[3] eq SESSION_PATH |
|
4988
|
2
|
50
|
|
|
|
11
|
or return; |
|
4989
|
|
|
|
|
|
|
$_[1] eq $cookie_name |
|
4990
|
2
|
|
|
|
|
10
|
or return; |
|
4991
|
2
|
|
|
|
|
5
|
( $cookie, $expires ) = @_[2, 8]; |
|
4992
|
2
|
|
|
|
|
7
|
return; |
|
4993
|
|
|
|
|
|
|
} ); |
|
4994
|
|
|
|
|
|
|
|
|
4995
|
|
|
|
|
|
|
# I don't get an expiration time back from the version 2 interface. |
|
4996
|
|
|
|
|
|
|
# But the docs say the cookie is only good for about two hours, so |
|
4997
|
2
|
50
|
33
|
|
|
42
|
# to be on the safe side I fudge in an hour. |
|
4998
|
|
|
|
|
|
|
$version == 2 |
|
4999
|
|
|
|
|
|
|
and not defined $expires |
|
5000
|
|
|
|
|
|
|
and $expires = time + 3600; |
|
5001
|
2
|
50
|
|
|
|
10
|
|
|
5002
|
2
|
|
|
|
|
8
|
if ( defined $cookie ) { |
|
5003
|
2
|
50
|
|
|
|
9
|
$interface_info->{session_cookie} = $cookie; |
|
5004
|
|
|
|
|
|
|
$self->{dump_headers} & DUMP_TRACE |
|
5005
|
2
|
50
|
|
|
|
7
|
and warn "Session cookie: $cookie\n"; ## no critic (RequireCarping) |
|
5006
|
2
|
|
|
|
|
6
|
if ( exists $interface_info->{cookie_expires} ) { |
|
5007
|
2
|
50
|
|
|
|
7
|
$interface_info->{cookie_expires} = $expires; |
|
5008
|
|
|
|
|
|
|
$self->{dump_headers} & DUMP_TRACE |
|
5009
|
|
|
|
|
|
|
and warn 'Cookie expiration: ', |
|
5010
|
|
|
|
|
|
|
POSIX::strftime( '%d-%b-%Y %H:%M:%S', localtime $expires ), |
|
5011
|
2
|
|
|
|
|
9
|
" ($expires)\n"; ## no critic (RequireCarping) |
|
5012
|
|
|
|
|
|
|
return $expires > time; |
|
5013
|
0
|
0
|
|
|
|
0
|
} |
|
5014
|
|
|
|
|
|
|
return $interface_info->{session_cookie} ? 1 : 0; |
|
5015
|
0
|
0
|
|
|
|
0
|
} else { |
|
5016
|
|
|
|
|
|
|
$self->{dump_headers} & DUMP_TRACE |
|
5017
|
0
|
|
|
|
|
0
|
and warn "Session cookie not found\n"; ## no critic (RequireCarping) |
|
5018
|
|
|
|
|
|
|
return; |
|
5019
|
|
|
|
|
|
|
} |
|
5020
|
|
|
|
|
|
|
} |
|
5021
|
|
|
|
|
|
|
|
|
5022
|
47
|
|
|
47
|
|
97
|
sub _check_cookie_generic { |
|
5023
|
|
|
|
|
|
|
my ( $self, $version ) = @_; |
|
5024
|
47
|
50
|
|
|
|
96
|
defined $version |
|
5025
|
47
|
|
|
|
|
84
|
or $version = $self->{space_track_version}; |
|
5026
|
|
|
|
|
|
|
my $interface_info = $self->{_space_track_interface}[$version]; |
|
5027
|
47
|
50
|
|
|
|
110
|
|
|
5028
|
|
|
|
|
|
|
if ( exists $interface_info->{cookie_expires} ) { |
|
5029
|
47
|
|
66
|
|
|
305
|
return defined $interface_info->{cookie_expires} |
|
5030
|
|
|
|
|
|
|
&& $interface_info->{cookie_expires} > time; |
|
5031
|
0
|
|
|
|
|
0
|
} else { |
|
5032
|
|
|
|
|
|
|
return defined $interface_info->{session_cookie}; |
|
5033
|
|
|
|
|
|
|
} |
|
5034
|
|
|
|
|
|
|
} |
|
5035
|
|
|
|
|
|
|
|
|
5036
|
|
|
|
|
|
|
# _convert_content converts the content of an HTTP::Response |
|
5037
|
|
|
|
|
|
|
# from crlf-delimited to lf-delimited. |
|
5038
|
|
|
|
|
|
|
|
|
5039
|
|
|
|
|
|
|
{ # Begin local symbol block |
|
5040
|
|
|
|
|
|
|
|
|
5041
|
|
|
|
|
|
|
my $lookfor = $^O eq 'MacOS' ? qr{ \012|\015+ }smx : qr{ \r \n }smx; |
|
5042
|
|
|
|
|
|
|
|
|
5043
|
33
|
|
|
33
|
|
103
|
sub _convert_content { |
|
5044
|
33
|
|
|
|
|
153
|
my ( undef, @args ) = @_; # Invocant unused |
|
5045
|
33
|
|
|
|
|
84
|
local $/ = undef; # Slurp mode. |
|
5046
|
33
|
|
|
|
|
105
|
foreach my $resp (@args) { |
|
5047
|
|
|
|
|
|
|
my $buffer = $resp->content; |
|
5048
|
|
|
|
|
|
|
# If we request a non-existent Space Track catalog number, |
|
5049
|
|
|
|
|
|
|
# we get 200 OK but the unzipped content is undefined. We |
|
5050
|
|
|
|
|
|
|
# catch this before we get this far, but the buffer check is |
|
5051
|
33
|
50
|
|
|
|
452
|
# left in in case something else leaks through. |
|
5052
|
33
|
|
|
|
|
5374
|
defined $buffer or $buffer = ''; |
|
5053
|
33
|
|
|
|
|
176
|
$buffer =~ s/$lookfor/\n/smxgo; |
|
5054
|
33
|
|
|
|
|
16668
|
1 while ($buffer =~ s/ \A \n+ //smx); |
|
5055
|
33
|
100
|
|
|
|
519
|
$buffer =~ s/ \s+ \n /\n/smxg; |
|
5056
|
33
|
|
|
|
|
136
|
$buffer =~ m/ \n \z /smx or $buffer .= "\n"; |
|
5057
|
33
|
|
|
|
|
751
|
$resp->content ($buffer); |
|
5058
|
|
|
|
|
|
|
$resp->header ( |
|
5059
|
|
|
|
|
|
|
'content-length' => length ($buffer), |
|
5060
|
|
|
|
|
|
|
); |
|
5061
|
33
|
|
|
|
|
1980
|
} |
|
5062
|
|
|
|
|
|
|
return; |
|
5063
|
|
|
|
|
|
|
} |
|
5064
|
|
|
|
|
|
|
} # End local symbol block. |
|
5065
|
|
|
|
|
|
|
|
|
5066
|
|
|
|
|
|
|
# $self->_deprecation_notice( $method, $argument ); |
|
5067
|
|
|
|
|
|
|
# |
|
5068
|
|
|
|
|
|
|
# This method centralizes deprecation. Deprecation is driven of |
|
5069
|
|
|
|
|
|
|
# the %deprecate hash. Values are: |
|
5070
|
|
|
|
|
|
|
# false - no warning |
|
5071
|
|
|
|
|
|
|
# 1 - warn on first use |
|
5072
|
|
|
|
|
|
|
# 2 - warn on each use |
|
5073
|
|
|
|
|
|
|
# 3 - die on each use. |
|
5074
|
|
|
|
|
|
|
|
|
5075
|
|
|
|
|
|
|
{ |
|
5076
|
|
|
|
|
|
|
|
|
5077
|
|
|
|
|
|
|
my %deprecate = ( |
|
5078
|
|
|
|
|
|
|
celestrak => { |
|
5079
|
|
|
|
|
|
|
# sts => 3, |
|
5080
|
|
|
|
|
|
|
'--descending' => 2, |
|
5081
|
|
|
|
|
|
|
'--end_epoch' => 2, |
|
5082
|
|
|
|
|
|
|
'--last5' => 2, |
|
5083
|
|
|
|
|
|
|
'--sort' => 2, |
|
5084
|
|
|
|
|
|
|
'--start_epoch' => 2, |
|
5085
|
|
|
|
|
|
|
}, |
|
5086
|
|
|
|
|
|
|
attribute => { |
|
5087
|
|
|
|
|
|
|
url_iridium_status_mccants => 3, |
|
5088
|
|
|
|
|
|
|
}, |
|
5089
|
|
|
|
|
|
|
iridium_status => { |
|
5090
|
|
|
|
|
|
|
mccants => 3, |
|
5091
|
|
|
|
|
|
|
}, |
|
5092
|
|
|
|
|
|
|
iridium_status_format => { |
|
5093
|
|
|
|
|
|
|
mccants => 3, |
|
5094
|
|
|
|
|
|
|
}, |
|
5095
|
|
|
|
|
|
|
); |
|
5096
|
|
|
|
|
|
|
|
|
5097
|
96
|
|
|
96
|
|
224
|
sub _deprecation_notice { |
|
5098
|
96
|
100
|
|
|
|
277
|
my ( undef, $method, $argument ) = @_; # Invocant unused |
|
5099
|
|
|
|
|
|
|
my $level = $deprecate{$method} |
|
5100
|
90
|
|
|
|
|
146
|
or return; |
|
5101
|
90
|
50
|
|
|
|
223
|
my $desc = $method; |
|
5102
|
90
|
50
|
|
|
|
199
|
if ( ref $level ) { |
|
5103
|
90
|
50
|
|
|
|
283
|
defined $argument or Carp::confess( 'Bug - $argument undefined' ); |
|
5104
|
|
|
|
|
|
|
$level = $level->{$argument} |
|
5105
|
0
|
|
|
|
|
0
|
or return; |
|
5106
|
|
|
|
|
|
|
$desc = "$method $argument"; |
|
5107
|
0
|
0
|
|
|
|
0
|
} |
|
5108
|
|
|
|
|
|
|
$level >= 3 |
|
5109
|
0
|
0
|
|
|
|
0
|
and Carp::croak "$desc is retracted"; |
|
5110
|
|
|
|
|
|
|
warnings::enabled( 'deprecated' ) |
|
5111
|
0
|
0
|
|
|
|
0
|
and Carp::carp "$desc is deprecated"; |
|
5112
|
|
|
|
|
|
|
1 == $level |
|
5113
|
0
|
0
|
|
|
|
0
|
or return; |
|
5114
|
0
|
|
|
|
|
0
|
if ( ref $deprecate{$method} ) { |
|
5115
|
|
|
|
|
|
|
$deprecate{$method}{$argument} = 0; |
|
5116
|
0
|
|
|
|
|
0
|
} else { |
|
5117
|
|
|
|
|
|
|
$deprecate{$method} = 0; |
|
5118
|
0
|
|
|
|
|
0
|
} |
|
5119
|
|
|
|
|
|
|
return; |
|
5120
|
|
|
|
|
|
|
} |
|
5121
|
|
|
|
|
|
|
|
|
5122
|
|
|
|
|
|
|
} |
|
5123
|
|
|
|
|
|
|
|
|
5124
|
|
|
|
|
|
|
# _dump_cookie is intended to be called from inside the |
|
5125
|
|
|
|
|
|
|
# HTTP::Cookie->scan method. The first argument is prefix text |
|
5126
|
|
|
|
|
|
|
# for the dump, and the subsequent arguments are the arguments |
|
5127
|
|
|
|
|
|
|
# passed to the scan method. |
|
5128
|
|
|
|
|
|
|
# It dumps the contents of the cookie to STDERR via a warn (). |
|
5129
|
|
|
|
|
|
|
# A typical session cookie looks like this: |
|
5130
|
|
|
|
|
|
|
# version => 0 |
|
5131
|
|
|
|
|
|
|
# key => 'spacetrack_session' |
|
5132
|
|
|
|
|
|
|
# val => whatever |
|
5133
|
|
|
|
|
|
|
# path => '/' |
|
5134
|
|
|
|
|
|
|
# domain => 'www.space-track.org' |
|
5135
|
|
|
|
|
|
|
# port => undef |
|
5136
|
|
|
|
|
|
|
# path_spec => 1 |
|
5137
|
|
|
|
|
|
|
# secure => undef |
|
5138
|
|
|
|
|
|
|
# expires => undef |
|
5139
|
|
|
|
|
|
|
# discard => 1 |
|
5140
|
|
|
|
|
|
|
# hash => {} |
|
5141
|
|
|
|
|
|
|
# The response to the login, though, has an actual expiration |
|
5142
|
|
|
|
|
|
|
# time, which we take cognisance of. |
|
5143
|
|
|
|
|
|
|
|
|
5144
|
|
|
|
|
|
|
{ # begin local symbol block |
|
5145
|
|
|
|
|
|
|
|
|
5146
|
|
|
|
|
|
|
my @names = qw{version key val path domain port path_spec secure |
|
5147
|
|
|
|
|
|
|
expires discard hash}; |
|
5148
|
|
|
|
|
|
|
|
|
5149
|
0
|
|
|
0
|
|
0
|
sub _dump_cookie { |
|
5150
|
0
|
|
|
|
|
0
|
my ( $self, $prefix, @args ) = @_; |
|
5151
|
0
|
0
|
|
|
|
0
|
my $json = $self->_get_json_object( pretty => 1 ); |
|
5152
|
0
|
|
|
|
|
0
|
$prefix and warn $prefix; ## no critic (RequireCarping) |
|
5153
|
0
|
|
|
|
|
0
|
for (my $inx = 0; $inx < @names; $inx++) { |
|
5154
|
|
|
|
|
|
|
warn " $names[$inx] => ", $json->encode( $args[$inx] ); ## no critic (RequireCarping) |
|
5155
|
0
|
|
|
|
|
0
|
} |
|
5156
|
|
|
|
|
|
|
return; |
|
5157
|
|
|
|
|
|
|
} |
|
5158
|
|
|
|
|
|
|
} # end local symbol block |
|
5159
|
|
|
|
|
|
|
|
|
5160
|
|
|
|
|
|
|
|
|
5161
|
|
|
|
|
|
|
# __dump_response dumps the headers of the passed-in response |
|
5162
|
|
|
|
|
|
|
# object. The hook is used for capturing responses to use when |
|
5163
|
|
|
|
|
|
|
# mocking LWP::UserAgent, and is UNSUPPORTED, and subject to |
|
5164
|
|
|
|
|
|
|
# change or retraction without notice. |
|
5165
|
|
|
|
|
|
|
|
|
5166
|
133
|
|
|
133
|
|
341
|
sub __dump_response { |
|
5167
|
|
|
|
|
|
|
my ( $self, $resp, $message ) = @_; |
|
5168
|
133
|
50
|
|
|
|
457
|
|
|
5169
|
0
|
|
|
|
|
0
|
if ( $self->{dump_headers} & DUMP_RESPONSE ) { |
|
5170
|
0
|
0
|
0
|
|
|
0
|
my $content = $resp->content(); |
|
5171
|
|
|
|
|
|
|
if ( $self->{dump_headers} & DUMP_TRUNCATED |
|
5172
|
0
|
|
|
|
|
0
|
&& 61 < length $content ) { |
|
5173
|
|
|
|
|
|
|
$content = substr( $content, 0, 61 ) . '...'; |
|
5174
|
0
|
|
|
|
|
0
|
} |
|
5175
|
0
|
|
|
|
|
0
|
my @data = ( $resp->code(), $resp->message(), [], $content ); |
|
5176
|
0
|
|
|
|
|
0
|
foreach my $name ( $resp->headers()->header_field_names() ) { |
|
5177
|
0
|
0
|
|
|
|
0
|
my @val = $resp->header( $name ); |
|
|
0
|
|
|
|
|
0
|
|
|
5178
|
|
|
|
|
|
|
push @{ $data[2] }, $name, @val > 1 ? \@val : $val[0]; |
|
5179
|
0
|
0
|
|
|
|
0
|
} |
|
5180
|
0
|
|
|
|
|
0
|
if ( my $rqst = $resp->request() ) { |
|
5181
|
|
|
|
|
|
|
push @data, { |
|
5182
|
|
|
|
|
|
|
method => $rqst->method(), |
|
5183
|
|
|
|
|
|
|
uri => '' . $rqst->uri(), # Force stringification |
|
5184
|
|
|
|
|
|
|
}; |
|
5185
|
0
|
|
|
|
|
0
|
} |
|
5186
|
|
|
|
|
|
|
my $encoded = $self->_get_json_object( pretty => 1 )->encode( |
|
5187
|
0
|
0
|
|
|
|
0
|
\@data ); |
|
5188
|
|
|
|
|
|
|
defined $message |
|
5189
|
0
|
|
|
|
|
0
|
or $message = 'Response object'; |
|
5190
|
0
|
|
|
|
|
0
|
$message =~ s/ \s+ \z //smx; |
|
5191
|
|
|
|
|
|
|
warn "$message:\n$encoded"; |
|
5192
|
133
|
|
|
|
|
270
|
} |
|
5193
|
|
|
|
|
|
|
return; |
|
5194
|
|
|
|
|
|
|
} |
|
5195
|
|
|
|
|
|
|
|
|
5196
|
|
|
|
|
|
|
# _dump_request dumps the request if desired. |
|
5197
|
|
|
|
|
|
|
# |
|
5198
|
|
|
|
|
|
|
# If the dump_request attribute has the DUMP_REQUEST bit set, this |
|
5199
|
|
|
|
|
|
|
# routine dumps the request. If the DUMP_DRY_RUN bit is set, |
|
5200
|
|
|
|
|
|
|
# the dump is returned in the content of an HTTP::Response object, |
|
5201
|
|
|
|
|
|
|
# with the response code set to HTTP_I_AM_A_TEAPOT. Otherwise the |
|
5202
|
|
|
|
|
|
|
# request is dumped to STDERR. |
|
5203
|
|
|
|
|
|
|
# |
|
5204
|
|
|
|
|
|
|
# If any of the conditions fails, this module simply returns. |
|
5205
|
|
|
|
|
|
|
|
|
5206
|
121
|
|
|
121
|
|
555
|
sub _dump_request { |
|
5207
|
121
|
100
|
|
|
|
572
|
my ( $self, %args ) = @_; |
|
5208
|
|
|
|
|
|
|
$self->{dump_headers} & DUMP_REQUEST |
|
5209
|
|
|
|
|
|
|
or return; |
|
5210
|
48
|
|
|
|
|
79
|
|
|
5211
|
48
|
50
|
|
|
|
119
|
my $message = delete $args{message}; |
|
5212
|
|
|
|
|
|
|
defined $message |
|
5213
|
48
|
|
|
|
|
285
|
or $message = 'Request object'; |
|
5214
|
|
|
|
|
|
|
$message =~ s/ \s* \z /:\n/smx; |
|
5215
|
48
|
50
|
|
|
|
132
|
|
|
5216
|
|
|
|
|
|
|
my $json = $self->_get_json_object( pretty => 1 ) |
|
5217
|
|
|
|
|
|
|
or return; |
|
5218
|
48
|
|
|
|
|
170
|
|
|
5219
|
192
|
50
|
|
|
|
440
|
foreach my $key ( keys %args ) { |
|
5220
|
|
|
|
|
|
|
CODE_REF eq ref $args{$key} |
|
5221
|
0
|
|
|
|
|
0
|
or next; |
|
5222
|
|
|
|
|
|
|
$args{$key} = $args{$key}->( \%args ); |
|
5223
|
|
|
|
|
|
|
} |
|
5224
|
48
|
50
|
|
|
|
640
|
|
|
5225
|
|
|
|
|
|
|
$self->{dump_headers} & DUMP_DRY_RUN |
|
5226
|
|
|
|
|
|
|
and return HTTP::Response->new( |
|
5227
|
|
|
|
|
|
|
HTTP_I_AM_A_TEAPOT, undef, undef, $json->encode( [ \%args ] ) |
|
5228
|
|
|
|
|
|
|
); |
|
5229
|
0
|
|
|
|
|
0
|
|
|
5230
|
|
|
|
|
|
|
warn $message, $json->encode( \%args ); |
|
5231
|
0
|
|
|
|
|
0
|
|
|
5232
|
|
|
|
|
|
|
return; |
|
5233
|
|
|
|
|
|
|
} |
|
5234
|
|
|
|
|
|
|
|
|
5235
|
83
|
|
|
83
|
|
211
|
sub _get_json_object { |
|
5236
|
|
|
|
|
|
|
my ( $self, %arg ) = @_; |
|
5237
|
83
|
100
|
|
|
|
245
|
defined $arg{pretty} |
|
5238
|
83
|
|
|
|
|
526
|
or $arg{pretty} = $self->{pretty}; |
|
5239
|
|
|
|
|
|
|
my $json = JSON->new()->utf8()->convert_blessed(); |
|
5240
|
83
|
100
|
|
|
|
312
|
$arg{pretty} |
|
5241
|
83
|
|
|
|
|
272
|
and $json->pretty()->canonical(); |
|
5242
|
|
|
|
|
|
|
return $json; |
|
5243
|
|
|
|
|
|
|
} |
|
5244
|
|
|
|
|
|
|
|
|
5245
|
|
|
|
|
|
|
# my @oids = $self->_expand_oid_list( @args ); |
|
5246
|
|
|
|
|
|
|
# |
|
5247
|
|
|
|
|
|
|
# This subroutine expands the input into a list of OIDs. Commas are |
|
5248
|
|
|
|
|
|
|
# recognized as separating an argument into multiple specifications. |
|
5249
|
|
|
|
|
|
|
# Dashes are recognized as range operators, which are expanded. The |
|
5250
|
|
|
|
|
|
|
# result is returned. |
|
5251
|
|
|
|
|
|
|
|
|
5252
|
46
|
|
|
46
|
|
130
|
sub _expand_oid_list { |
|
5253
|
|
|
|
|
|
|
my ( $self, @args ) = @_; |
|
5254
|
46
|
|
|
|
|
68
|
|
|
5255
|
46
|
|
|
|
|
83
|
my @rslt; |
|
|
211
|
|
|
|
|
1070
|
|
|
5256
|
211
|
100
|
|
|
|
784
|
foreach my $arg ( map { split qr{ , | \s+ }smx, $_ } @args ) { |
|
|
|
50
|
|
|
|
|
|
|
5257
|
|
|
|
|
|
|
if ( my ( $lo, $hi ) = $arg =~ |
|
5258
|
|
|
|
|
|
|
m/ \A \s* ( \d+ ) \s* - \s* ( \d+ ) \s* \z /smx |
|
5259
|
1
|
50
|
|
|
|
9
|
) { |
|
5260
|
|
|
|
|
|
|
( $lo, $hi ) = $self->_check_range( $lo, $hi ) |
|
5261
|
|
|
|
|
|
|
and push @rslt, $lo .. $hi; |
|
5262
|
210
|
|
|
|
|
533
|
} elsif ( $arg =~ m/ \A \s* ( \d+ ) \s* \z /smx ) { |
|
5263
|
|
|
|
|
|
|
push @rslt, $1; |
|
5264
|
|
|
|
|
|
|
} else { |
|
5265
|
|
|
|
|
|
|
# TODO -- ignore? die? what? |
|
5266
|
|
|
|
|
|
|
} |
|
5267
|
46
|
|
|
|
|
243
|
} |
|
5268
|
|
|
|
|
|
|
return @rslt; |
|
5269
|
|
|
|
|
|
|
} |
|
5270
|
|
|
|
|
|
|
|
|
5271
|
|
|
|
|
|
|
# Take as input a reference to one of the legal options arrays, and |
|
5272
|
|
|
|
|
|
|
# extract the equivalent keys. The return is suitable for assigning to a |
|
5273
|
|
|
|
|
|
|
# hash used to test the keys; that is, it is ( key0 => 1, key1 => 1, ... |
|
5274
|
|
|
|
|
|
|
# ). |
|
5275
|
|
|
|
|
|
|
|
|
5276
|
|
|
|
|
|
|
{ |
|
5277
|
|
|
|
|
|
|
my $strip = qr{ [=:|!+] .* }smx; |
|
5278
|
|
|
|
|
|
|
|
|
5279
|
28
|
|
|
28
|
|
58
|
sub _extract_keys { |
|
5280
|
28
|
50
|
|
|
|
91
|
my ( $lgl_opts ) = @_; |
|
5281
|
28
|
|
|
|
|
58
|
if ( ARRAY_REF eq ref $lgl_opts ) { |
|
|
28
|
|
|
|
|
65
|
|
|
5282
|
28
|
|
|
|
|
111
|
my $len = @{ $lgl_opts }; |
|
5283
|
28
|
|
|
|
|
101
|
my @rslt; |
|
5284
|
210
|
|
|
|
|
909
|
for ( my $inx = 0; $inx < $len; $inx += 2 ) { |
|
5285
|
210
|
|
|
|
|
561
|
( my $key = $lgl_opts->[$inx] ) =~ s/ $strip //smxo; |
|
5286
|
|
|
|
|
|
|
push @rslt, $key, 1; |
|
5287
|
28
|
|
|
|
|
219
|
} |
|
5288
|
|
|
|
|
|
|
return @rslt; |
|
5289
|
0
|
|
|
|
|
0
|
} else { |
|
5290
|
0
|
|
|
|
|
0
|
$lgl_opts =~ s/ $strip //smxo; |
|
5291
|
|
|
|
|
|
|
return $lgl_opts; |
|
5292
|
|
|
|
|
|
|
} |
|
5293
|
|
|
|
|
|
|
} |
|
5294
|
|
|
|
|
|
|
} |
|
5295
|
|
|
|
|
|
|
|
|
5296
|
|
|
|
|
|
|
# The following are data transform routines for _search_rest(). |
|
5297
|
|
|
|
|
|
|
# The arguments are the datum and the class for which it is being |
|
5298
|
|
|
|
|
|
|
# formatted. |
|
5299
|
|
|
|
|
|
|
|
|
5300
|
|
|
|
|
|
|
# Parse an international launch id, and format it for a Space-Track REST |
|
5301
|
|
|
|
|
|
|
# query. The parsing is done by _parse_international_id(). The |
|
5302
|
|
|
|
|
|
|
# formatting prefixes the 'contains' wildcard '~~' unless year, sequence |
|
5303
|
|
|
|
|
|
|
# and part are all present. |
|
5304
|
|
|
|
|
|
|
|
|
5305
|
14
|
|
|
14
|
|
67
|
sub _format_international_id_rest { |
|
5306
|
14
|
|
|
|
|
38
|
my ( $intl_id ) = @_; |
|
5307
|
14
|
100
|
|
|
|
66
|
my @parts = _parse_international_id( $intl_id ); |
|
5308
|
|
|
|
|
|
|
@parts >= 3 |
|
5309
|
10
|
100
|
|
|
|
68
|
and return sprintf '%04d-%03d%s', @parts; |
|
5310
|
|
|
|
|
|
|
@parts >= 2 |
|
5311
|
1
|
|
|
|
|
7
|
and return sprintf '~~%04d-%03d', @parts; |
|
5312
|
|
|
|
|
|
|
return sprintf '~~%04d-', $parts[0]; |
|
5313
|
|
|
|
|
|
|
} |
|
5314
|
|
|
|
|
|
|
|
|
5315
|
|
|
|
|
|
|
# Parse a launch date, and format it for a Space-Track REST query. The |
|
5316
|
|
|
|
|
|
|
# parsing is done by _parse_launch_date(). The formatting prefixes the |
|
5317
|
|
|
|
|
|
|
# 'contains' wildcard '~~' unless year, month, and day are all present. |
|
5318
|
|
|
|
|
|
|
|
|
5319
|
14
|
|
|
14
|
|
30
|
sub _format_launch_date_rest { |
|
5320
|
14
|
50
|
|
|
|
36
|
my ( $date ) = @_; |
|
5321
|
|
|
|
|
|
|
my @parts = _parse_launch_date( $date ) |
|
5322
|
14
|
50
|
|
|
|
120
|
or return; |
|
5323
|
|
|
|
|
|
|
@parts >= 3 |
|
5324
|
0
|
0
|
|
|
|
0
|
and return sprintf '%04d-%02d-%02d', @parts; |
|
5325
|
|
|
|
|
|
|
@parts >= 2 |
|
5326
|
0
|
|
|
|
|
0
|
and return sprintf '~~%04d-%02d', @parts; |
|
5327
|
|
|
|
|
|
|
return sprintf '~~%04d', $parts[0]; |
|
5328
|
|
|
|
|
|
|
} |
|
5329
|
|
|
|
|
|
|
|
|
5330
|
|
|
|
|
|
|
# Note: If we have a bad cookie, we get a success status, with |
|
5331
|
|
|
|
|
|
|
# the text |
|
5332
|
|
|
|
|
|
|
# |
|
5333
|
|
|
|
|
|
|
#
|
|
5334
|
|
|
|
|
|
|
# PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" |
|
5335
|
|
|
|
|
|
|
# "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> |
|
5336
|
|
|
|
|
|
|
# Space-Track |
|
5337
|
|
|
|
|
|
|
# |
|
5338
|
|
|
|
|
|
|
# |
|
5339
|
|
|
|
|
|
|
# |
|
5340
|
|
|
|
|
|
|
# Error, Corrupted session cookie |
|
5341
|
|
|
|
|
|
|
# Please LOGIN again. |
|
5342
|
|
|
|
|
|
|
# |
|
5343
|
|
|
|
|
|
|
# |
|
5344
|
|
|
|
|
|
|
# If this happens, it would be good to retry the login. |
|
5345
|
|
|
|
|
|
|
|
|
5346
|
66
|
|
|
66
|
|
143
|
sub _get_agent { |
|
5347
|
|
|
|
|
|
|
my ( $self ) = @_; |
|
5348
|
66
|
100
|
|
|
|
317
|
$self->{agent} |
|
5349
|
7
|
|
|
|
|
40
|
and return $self->{agent}; |
|
5350
|
|
|
|
|
|
|
my $agent = $self->{agent} = LWP::UserAgent->new( |
|
5351
|
|
|
|
|
|
|
ssl_opts => { |
|
5352
|
|
|
|
|
|
|
verify_hostname => $self->getv( 'verify_hostname' ), |
|
5353
|
|
|
|
|
|
|
}, |
|
5354
|
|
|
|
|
|
|
); |
|
5355
|
7
|
|
|
|
|
1852
|
|
|
5356
|
|
|
|
|
|
|
$agent->env_proxy(); |
|
5357
|
7
|
50
|
|
|
|
99233
|
|
|
5358
|
|
|
|
|
|
|
$agent->cookie_jar() |
|
5359
|
|
|
|
|
|
|
or $agent->cookie_jar( {} ); |
|
5360
|
7
|
|
|
|
|
40446
|
|
|
5361
|
|
|
|
|
|
|
return $agent; |
|
5362
|
|
|
|
|
|
|
} |
|
5363
|
|
|
|
|
|
|
|
|
5364
|
|
|
|
|
|
|
# $resp = $self->_get_from_net( name => value ... ) |
|
5365
|
|
|
|
|
|
|
# |
|
5366
|
|
|
|
|
|
|
# This private method retrieves a URL and returns the response object. |
|
5367
|
|
|
|
|
|
|
# The optional name/value pairs are: |
|
5368
|
|
|
|
|
|
|
# |
|
5369
|
|
|
|
|
|
|
# catalog => catalog_name |
|
5370
|
|
|
|
|
|
|
# If this exists, it is the name of the catalog to retrieve. An |
|
5371
|
|
|
|
|
|
|
# error is returned if it is not defined, or if the catalog does |
|
5372
|
|
|
|
|
|
|
# not exist. |
|
5373
|
|
|
|
|
|
|
# file => cache_file_name |
|
5374
|
|
|
|
|
|
|
# If this is defined, the data are returned only if it has been |
|
5375
|
|
|
|
|
|
|
# modified since the modification date of the file. If the data |
|
5376
|
|
|
|
|
|
|
# have been modified, the cache file is refreshed; otherwise the |
|
5377
|
|
|
|
|
|
|
# response is loaded from the cache file. |
|
5378
|
|
|
|
|
|
|
# method => method_name |
|
5379
|
|
|
|
|
|
|
# If this is defined, it is the name of the method doing the |
|
5380
|
|
|
|
|
|
|
# catalog lookup. This is unused unless 'catalog' is defined, and |
|
5381
|
|
|
|
|
|
|
# defaults to the name of the calling method. |
|
5382
|
|
|
|
|
|
|
# post_process => code reference |
|
5383
|
|
|
|
|
|
|
# If the network operation succeeded and this is defined, it is |
|
5384
|
|
|
|
|
|
|
# called and passed the invocant, the HTTP::Response object, and |
|
5385
|
|
|
|
|
|
|
# a reference to the catalog information hash (or to an empty hash |
|
5386
|
|
|
|
|
|
|
# if 'url' was specified). The HTTP::Response object returned |
|
5387
|
|
|
|
|
|
|
# (which may or may not be the one passed in) is the basis for any |
|
5388
|
|
|
|
|
|
|
# further processing. |
|
5389
|
|
|
|
|
|
|
# spacetrack_source => spacetrack_source |
|
5390
|
|
|
|
|
|
|
# If this is defined, the corresponding-named pragma is set. The |
|
5391
|
|
|
|
|
|
|
# default comes from the same-named key in the catalog info if that |
|
5392
|
|
|
|
|
|
|
# is defined, or the 'method' argument (as defaulted). |
|
5393
|
|
|
|
|
|
|
# spacetrack_type => spacetrack_type |
|
5394
|
|
|
|
|
|
|
# If this is defined, the corresponding-named pragma is set. |
|
5395
|
|
|
|
|
|
|
# url => URL |
|
5396
|
|
|
|
|
|
|
# If this is defined, it is the URL of the data to retrieve. |
|
5397
|
|
|
|
|
|
|
# |
|
5398
|
|
|
|
|
|
|
# Either 'catalog' or 'url' MUST be specified. If 'url' is defined, |
|
5399
|
|
|
|
|
|
|
# 'catalog' is ignored. |
|
5400
|
|
|
|
|
|
|
|
|
5401
|
12
|
|
|
12
|
|
81
|
sub _get_from_net { |
|
5402
|
12
|
|
|
|
|
45
|
my ( $self, %arg ) = @_; |
|
5403
|
|
|
|
|
|
|
delete $self->{_pragmata}; |
|
5404
|
12
|
50
|
|
|
|
122
|
|
|
5405
|
12
|
|
|
|
|
129
|
my $method = defined $arg{method} ? $arg{method} : ( caller 1)[3]; |
|
5406
|
|
|
|
|
|
|
$method =~ s/ .* :: //smx; |
|
5407
|
12
|
|
|
|
|
35
|
|
|
5408
|
|
|
|
|
|
|
my $url; |
|
5409
|
12
|
100
|
|
|
|
50
|
my $info; |
|
|
|
50
|
|
|
|
|
|
|
5410
|
6
|
|
|
|
|
15
|
if ( defined $arg{url} ) { |
|
5411
|
6
|
|
|
|
|
16
|
$url = $arg{url}; |
|
5412
|
|
|
|
|
|
|
$info = {}; |
|
5413
|
|
|
|
|
|
|
} elsif ( exists $arg{catalog} ) { |
|
5414
|
|
|
|
|
|
|
defined $arg{catalog} |
|
5415
|
|
|
|
|
|
|
and $catalogs{$method} |
|
5416
|
6
|
50
|
33
|
|
|
78
|
and $info = $catalogs{$method}{$arg{catalog}} |
|
|
|
|
33
|
|
|
|
|
|
5417
|
6
|
|
|
|
|
37
|
or return $self->_no_such_catalog( $method, $arg{catalog} ); |
|
5418
|
|
|
|
|
|
|
$self->_deprecation_notice( $method => $arg{catalog} ); |
|
5419
|
6
|
50
|
|
|
|
40
|
$url = $info->{url} |
|
5420
|
|
|
|
|
|
|
or Carp::confess "Bug - No url defined for $method( '$arg{catalog}' )"; |
|
5421
|
0
|
|
|
|
|
0
|
} else { |
|
5422
|
|
|
|
|
|
|
Carp::confess q; |
|
5423
|
|
|
|
|
|
|
} |
|
5424
|
12
|
50
|
|
|
|
55
|
|
|
5425
|
37
|
100
|
|
|
|
201
|
if ( my $resp = $self->_dump_request( |
|
5426
|
|
|
|
|
|
|
args => { map { $_ => CODE_REF eq ref $arg{$_} ? 'sub { ... }' : $arg{$_} } keys %arg }, |
|
5427
|
|
|
|
|
|
|
method => 'GET', |
|
5428
|
|
|
|
|
|
|
url => $url, |
|
5429
|
|
|
|
|
|
|
version => 2, |
|
5430
|
0
|
|
|
|
|
0
|
) ) { |
|
5431
|
|
|
|
|
|
|
return $resp; |
|
5432
|
|
|
|
|
|
|
} |
|
5433
|
12
|
|
|
|
|
73
|
|
|
5434
|
12
|
|
|
|
|
98
|
my $agent = $self->_get_agent(); |
|
5435
|
12
|
|
|
|
|
1854
|
my $rqst = HTTP::Request->new( GET => $url ); |
|
5436
|
12
|
100
|
|
|
|
55
|
my $file_time; |
|
5437
|
1
|
50
|
|
|
|
23
|
if ( defined $arg{file} ) { |
|
5438
|
1
|
|
|
|
|
6
|
if ( my @stat = stat $arg{file} ) { |
|
5439
|
1
|
|
|
|
|
22
|
$file_time = HTTP::Date::time2str( $stat[9] ); |
|
5440
|
|
|
|
|
|
|
$rqst->header( if_modified_since => $file_time ); |
|
5441
|
|
|
|
|
|
|
} |
|
5442
|
|
|
|
|
|
|
} |
|
5443
|
12
|
|
|
|
|
87
|
|
|
5444
|
|
|
|
|
|
|
my $resp; |
|
5445
|
|
|
|
|
|
|
$resp = $self->_dump_request( |
|
5446
|
0
|
|
|
0
|
|
0
|
arg => sub { |
|
5447
|
0
|
|
|
|
|
0
|
my %sanitary = %arg; |
|
5448
|
|
|
|
|
|
|
foreach my $key ( qw{ post_process } ) { |
|
5449
|
0
|
0
|
|
|
|
0
|
delete $sanitary{$key} |
|
5450
|
|
|
|
|
|
|
and $sanitary{$key} = CODE_REF; |
|
5451
|
0
|
|
|
|
|
0
|
} |
|
5452
|
|
|
|
|
|
|
return \%sanitary; |
|
5453
|
|
|
|
|
|
|
}, |
|
5454
|
|
|
|
|
|
|
message => '_get_from_net() request object', |
|
5455
|
|
|
|
|
|
|
method => 'GET', |
|
5456
|
|
|
|
|
|
|
url => $url, |
|
5457
|
0
|
|
|
0
|
|
0
|
hdrs => sub { |
|
5458
|
0
|
|
|
|
|
0
|
my %rslt; |
|
5459
|
0
|
|
|
|
|
0
|
foreach my $name ( $rqst->header_field_names() ) { |
|
5460
|
0
|
0
|
|
|
|
0
|
my @v = $rqst->header( $name ); |
|
5461
|
|
|
|
|
|
|
$rslt{$name} = @v == 1 ? $v[0] : \@v; |
|
5462
|
0
|
|
|
|
|
0
|
} |
|
5463
|
|
|
|
|
|
|
return \%rslt; |
|
5464
|
|
|
|
|
|
|
}, |
|
5465
|
12
|
50
|
|
|
|
122
|
) |
|
5466
|
12
|
|
|
|
|
169
|
and return $resp; |
|
5467
|
12
|
|
|
|
|
7851824
|
$resp = $agent->request( $rqst ); |
|
5468
|
|
|
|
|
|
|
$self->__dump_response( |
|
5469
|
|
|
|
|
|
|
$resp, '_get_from_net() initial response object' ); |
|
5470
|
12
|
50
|
|
|
|
48
|
|
|
5471
|
|
|
|
|
|
|
if ( $resp->code() == HTTP_NOT_MODIFIED ) { |
|
5472
|
0
|
0
|
|
|
|
0
|
defined $arg{file} |
|
5473
|
0
|
|
|
|
|
0
|
or Carp::confess q{Programming Error - argument 'file' not defined}; |
|
5474
|
|
|
|
|
|
|
local $/ = undef; |
|
5475
|
0
|
0
|
|
|
|
0
|
open my $fh, '<', $arg{file} |
|
5476
|
|
|
|
|
|
|
or return HTTP::Response->new( |
|
5477
|
|
|
|
|
|
|
HTTP_INTERNAL_SERVER_ERROR, |
|
5478
|
0
|
|
|
|
|
0
|
"Unable to read $arg{file}: $!" ); |
|
5479
|
0
|
|
|
|
|
0
|
$resp->content( scalar <$fh> ); |
|
5480
|
0
|
|
|
|
|
0
|
close $fh; |
|
5481
|
0
|
0
|
|
|
|
0
|
$resp->code( HTTP_OK ); |
|
5482
|
|
|
|
|
|
|
defined $file_time |
|
5483
|
0
|
|
|
|
|
0
|
and $resp->header( last_modified => $file_time ); |
|
5484
|
|
|
|
|
|
|
$arg{spacetrack_cache_hit} = 1; |
|
5485
|
|
|
|
|
|
|
} else { |
|
5486
|
|
|
|
|
|
|
$resp->is_success() |
|
5487
|
12
|
50
|
33
|
|
|
246
|
and defined $arg{post_process} |
|
5488
|
12
|
100
|
|
|
|
122
|
and $resp = $arg{post_process}->( $self, $resp, $info ); |
|
5489
|
|
|
|
|
|
|
$resp->is_success() # $resp may be a different object now. |
|
5490
|
11
|
|
|
|
|
177
|
or return $resp; |
|
5491
|
11
|
100
|
|
|
|
79
|
$self->_convert_content( $resp ); |
|
5492
|
|
|
|
|
|
|
if ( defined $arg{file} ) { |
|
5493
|
1
|
50
|
|
|
|
138
|
open my $fh, '>', $arg{file} |
|
5494
|
|
|
|
|
|
|
or return HTTP::Response->new( |
|
5495
|
|
|
|
|
|
|
HTTP_INTERNAL_SERVER_ERROR, |
|
5496
|
1
|
|
|
|
|
5
|
"Unable to write $arg{file}: $!" ); |
|
|
1
|
|
|
|
|
6
|
|
|
5497
|
1
|
|
|
|
|
480
|
print { $fh } $resp->content(); |
|
5498
|
1
|
|
|
|
|
10
|
close $fh; |
|
5499
|
|
|
|
|
|
|
$arg{spacetrack_cache_hit} = 0; |
|
5500
|
|
|
|
|
|
|
} |
|
5501
|
|
|
|
|
|
|
} |
|
5502
|
|
|
|
|
|
|
|
|
5503
|
|
|
|
|
|
|
defined $arg{spacetrack_source} |
|
5504
|
|
|
|
|
|
|
or $arg{spacetrack_source} = |
|
5505
|
|
|
|
|
|
|
defined $info->{spacetrack_source} ? |
|
5506
|
11
|
50
|
|
|
|
70
|
$info->{spacetrack_source} : |
|
|
|
100
|
|
|
|
|
|
|
5507
|
|
|
|
|
|
|
$method; |
|
5508
|
|
|
|
|
|
|
|
|
5509
|
|
|
|
|
|
|
$self->_add_pragmata( $resp, |
|
5510
|
11
|
|
|
|
|
44
|
map { |
|
5511
|
33
|
100
|
|
|
|
224
|
defined $arg{$_} ? ( $_ => $arg{$_} ) : |
|
|
|
100
|
|
|
|
|
|
|
5512
|
|
|
|
|
|
|
defined $info->{$_} ? ( $_ => $info->{$_} ) : |
|
5513
|
|
|
|
|
|
|
() |
|
5514
|
|
|
|
|
|
|
} |
|
5515
|
11
|
|
|
|
|
82
|
qw{ spacetrack_type spacetrack_source spacetrack_cache_hit } ); |
|
5516
|
|
|
|
|
|
|
$self->__dump_response( $resp, |
|
5517
|
11
|
|
|
|
|
647
|
'_get_from_net() final response object' ); |
|
5518
|
|
|
|
|
|
|
return $resp; |
|
5519
|
|
|
|
|
|
|
} |
|
5520
|
|
|
|
|
|
|
|
|
5521
|
|
|
|
|
|
|
# _get_space_track_domain() returns the domain name portion of the Space |
|
5522
|
|
|
|
|
|
|
# Track URL from the appropriate attribute. The argument is the |
|
5523
|
|
|
|
|
|
|
# interface version number, which defaults to the value of the |
|
5524
|
|
|
|
|
|
|
# space_track_version attribute. |
|
5525
|
|
|
|
|
|
|
|
|
5526
|
99
|
|
|
99
|
|
174
|
sub _get_space_track_domain { |
|
5527
|
|
|
|
|
|
|
my ( $self, $version ) = @_; |
|
5528
|
99
|
100
|
|
|
|
218
|
defined $version |
|
5529
|
99
|
|
|
|
|
579
|
or $version = $self->{space_track_version}; |
|
5530
|
|
|
|
|
|
|
return $self->{_space_track_interface}[$version]{domain_space_track}; |
|
5531
|
|
|
|
|
|
|
} |
|
5532
|
|
|
|
|
|
|
|
|
5533
|
|
|
|
|
|
|
# __get_loader() retrieves a loader. A code reference to it is returned. |
|
5534
|
|
|
|
|
|
|
# |
|
5535
|
|
|
|
|
|
|
# NOTE WELL: This subroutine is for the benefit of |
|
5536
|
|
|
|
|
|
|
# t/spacetrack_request.t, and is called by that code. The leading double |
|
5537
|
|
|
|
|
|
|
# underscore is to flag it to Perl::Critic as package private rather |
|
5538
|
|
|
|
|
|
|
# than module private. |
|
5539
|
|
|
|
|
|
|
|
|
5540
|
|
|
|
|
|
|
sub __get_loader { |
|
5541
|
1
|
|
|
1
|
|
113
|
## my ( $invocant, %arg ) = @_; # Arguments unused |
|
5542
|
|
|
|
|
|
|
my $json = JSON->new()->utf8( 1 ); |
|
5543
|
48
|
|
|
48
|
|
3339
|
return sub { |
|
5544
|
|
|
|
|
|
|
return $json->decode( $_[0] ); |
|
5545
|
1
|
|
|
|
|
7
|
} |
|
5546
|
|
|
|
|
|
|
} |
|
5547
|
|
|
|
|
|
|
|
|
5548
|
|
|
|
|
|
|
# _handle_observing_list takes as input any number of arguments. |
|
5549
|
|
|
|
|
|
|
# each is split on newlines, and lines beginning with a five-digit |
|
5550
|
|
|
|
|
|
|
# number (with leading spaces allowed) are taken to specify the |
|
5551
|
|
|
|
|
|
|
# catalog number (first five characters) and common name (the rest) |
|
5552
|
|
|
|
|
|
|
# of an object. The resultant catalog numbers are run through the |
|
5553
|
|
|
|
|
|
|
# retrieve () method. If called in scalar context, the return is |
|
5554
|
|
|
|
|
|
|
# the resultant HTTP::Response object. In list context, the first |
|
5555
|
|
|
|
|
|
|
# return is the HTTP::Response object, and the second is a reference |
|
5556
|
|
|
|
|
|
|
# to a list of list references, each lower-level reference containing |
|
5557
|
|
|
|
|
|
|
# catalog number and name. |
|
5558
|
|
|
|
|
|
|
|
|
5559
|
1
|
|
|
1
|
|
13
|
sub _handle_observing_list { |
|
5560
|
1
|
|
|
|
|
3
|
my ( $self, $opt, @args ) = @_; |
|
5561
|
|
|
|
|
|
|
my (@catnum, @data); |
|
5562
|
|
|
|
|
|
|
|
|
5563
|
|
|
|
|
|
|
# Do not _parse_retrieve_args() here; we expect our caller to handle |
|
5564
|
|
|
|
|
|
|
# this. |
|
5565
|
1
|
|
|
|
|
3
|
|
|
|
1
|
|
|
|
|
12
|
|
|
5566
|
1
|
|
|
|
|
8
|
foreach (map {split qr{ \n }smx, $_} @args) { |
|
5567
|
1
|
50
|
|
|
|
9
|
s/ \s+ \z //smx; |
|
5568
|
1
|
50
|
|
|
|
6
|
my ( $id ) = m/ \A ( [\s\d]{5} ) /smx or next; |
|
5569
|
1
|
|
|
|
|
5
|
$id =~ m/ \A \s* \d+ \z /smx or next; |
|
5570
|
1
|
|
|
|
|
6
|
my $name = substr $_, 5; |
|
5571
|
1
|
|
|
|
|
3
|
$name =~ s/ \A \s+ //smx; |
|
5572
|
1
|
|
|
|
|
6
|
push @catnum, $id; |
|
5573
|
|
|
|
|
|
|
push @data, [ $id, $name ]; |
|
5574
|
1
|
|
|
|
|
2
|
} |
|
5575
|
1
|
50
|
|
|
|
4
|
my $resp; |
|
5576
|
|
|
|
|
|
|
if ( $opt->{observing_list} ) { |
|
5577
|
0
|
0
|
|
|
|
0
|
$resp = HTTP::Response->new( HTTP_OK, undef, undef, |
|
|
0
|
|
|
|
|
0
|
|
|
5578
|
0
|
|
|
|
|
0
|
join '', map { m/ \n \z /smx ? $_ : "$_\n" } @args ); |
|
5579
|
0
|
|
|
|
|
0
|
my $source = ( caller 1 )[3]; |
|
5580
|
0
|
|
|
|
|
0
|
$source =~ s/ .* :: //smx; |
|
5581
|
|
|
|
|
|
|
$self->_add_pragmata( $resp, |
|
5582
|
|
|
|
|
|
|
'spacetrack-type' => 'observing-list', |
|
5583
|
|
|
|
|
|
|
'spacetrack-source' => $source, |
|
5584
|
0
|
|
|
|
|
0
|
); |
|
5585
|
|
|
|
|
|
|
$self->__dump_response( $resp ); |
|
5586
|
1
|
|
|
|
|
6
|
} else { |
|
|
0
|
|
|
|
|
0
|
|
|
5587
|
1
|
50
|
|
|
|
5
|
$resp = $self->retrieve( $opt, sort {$a <=> $b} @catnum ); |
|
5588
|
|
|
|
|
|
|
if ( $resp->is_success ) { |
|
5589
|
1
|
50
|
|
|
|
11
|
|
|
5590
|
0
|
|
|
|
|
0
|
unless ( $self->{_pragmata} ) { |
|
5591
|
|
|
|
|
|
|
$self->_add_pragmata( $resp, |
|
5592
|
|
|
|
|
|
|
'spacetrack-type' => 'orbit', |
|
5593
|
|
|
|
|
|
|
'spacetrack-source' => 'spacetrack', |
|
5594
|
|
|
|
|
|
|
); |
|
5595
|
1
|
|
|
|
|
3
|
} |
|
5596
|
|
|
|
|
|
|
$self->__dump_response( $resp ); |
|
5597
|
|
|
|
|
|
|
} |
|
5598
|
1
|
50
|
|
|
|
26
|
} |
|
5599
|
|
|
|
|
|
|
return wantarray ? ($resp, \@data) : $resp; |
|
5600
|
|
|
|
|
|
|
} |
|
5601
|
|
|
|
|
|
|
|
|
5602
|
|
|
|
|
|
|
# _instance takes a variable and a class, and returns true if the |
|
5603
|
|
|
|
|
|
|
# variable is blessed into the class. It returns false for |
|
5604
|
|
|
|
|
|
|
# variables that are not references. |
|
5605
|
1
|
|
|
1
|
|
3
|
sub _instance { |
|
5606
|
1
|
50
|
|
|
|
4
|
my ( $object, $class ) = @_; |
|
5607
|
1
|
50
|
|
|
|
6
|
ref $object or return; |
|
5608
|
1
|
|
|
|
|
10
|
Scalar::Util::blessed( $object ) or return; |
|
5609
|
|
|
|
|
|
|
return $object->isa( $class ); |
|
5610
|
|
|
|
|
|
|
} |
|
5611
|
|
|
|
|
|
|
|
|
5612
|
|
|
|
|
|
|
|
|
5613
|
|
|
|
|
|
|
# _make_space_track_base_url() makes the a base Space Track URL. You can |
|
5614
|
|
|
|
|
|
|
# pass the interface version number (1 or 2) as an argument -- it |
|
5615
|
|
|
|
|
|
|
# defaults to the value of the space_track_version attribute. |
|
5616
|
|
|
|
|
|
|
|
|
5617
|
99
|
|
|
99
|
|
189
|
sub _make_space_track_base_url { |
|
5618
|
99
|
|
|
|
|
303
|
my ( $self, $version ) = @_; |
|
5619
|
|
|
|
|
|
|
return $self->{scheme_space_track} . '://' . |
|
5620
|
|
|
|
|
|
|
$self->_get_space_track_domain( $version ); |
|
5621
|
|
|
|
|
|
|
} |
|
5622
|
|
|
|
|
|
|
|
|
5623
|
|
|
|
|
|
|
# _mung_login_status() takes as its argument an HTTP::Response object. |
|
5624
|
|
|
|
|
|
|
# If the code is 500 and the message suggests a certificate problem, add |
|
5625
|
|
|
|
|
|
|
# the suggestion that the user set verify_hostname false. |
|
5626
|
|
|
|
|
|
|
|
|
5627
|
0
|
|
|
0
|
|
0
|
sub _mung_login_status { |
|
5628
|
|
|
|
|
|
|
my ( $resp ) = @_; |
|
5629
|
0
|
0
|
|
|
|
0
|
# 500 Can't connect to www.space-track.org:443 (certificate verify failed) |
|
5630
|
|
|
|
|
|
|
$resp->code() == HTTP_INTERNAL_SERVER_ERROR |
|
5631
|
0
|
0
|
|
|
|
0
|
or return $resp; |
|
5632
|
|
|
|
|
|
|
( my $msg = $resp->message() ) =~ |
|
5633
|
|
|
|
|
|
|
s{ ( [(] \Qcertificate verify failed\E ) [)]} |
|
5634
|
0
|
|
|
|
|
0
|
{$1; try setting the verify_hostname attribute false)}smx |
|
5635
|
0
|
|
|
|
|
0
|
or return $resp; |
|
5636
|
|
|
|
|
|
|
$resp->message( $msg ); |
|
5637
|
|
|
|
|
|
|
return $resp; |
|
5638
|
|
|
|
|
|
|
} |
|
5639
|
|
|
|
|
|
|
|
|
5640
|
|
|
|
|
|
|
# _mutate_attrib takes the name of an attribute and the new value |
|
5641
|
|
|
|
|
|
|
# for the attribute, and does what its name says. |
|
5642
|
|
|
|
|
|
|
|
|
5643
|
|
|
|
|
|
|
# We supress Perl::Critic because we're a one-liner. CAVEAT: we MUST |
|
5644
|
17
|
|
|
17
|
|
86
|
# not modify the contents of @_. Modifying @_ itself is fine. |
|
5645
|
17
|
|
|
|
|
42
|
sub _mutate_attrib { |
|
5646
|
|
|
|
|
|
|
$_[0]->_deprecation_notice( attribute => $_[1] ); |
|
5647
|
|
|
|
|
|
|
return ($_[0]{$_[1]} = $_[2]); |
|
5648
|
|
|
|
|
|
|
} |
|
5649
|
23
|
|
|
23
|
|
56
|
|
|
5650
|
23
|
50
|
|
|
|
78
|
sub _mutate_dump_headers { |
|
5651
|
0
|
|
|
|
|
0
|
my ( $self, $name, $value, $args ) = @_; |
|
5652
|
0
|
|
|
|
|
0
|
if ( $value =~ m/ \A --? /smx ) { |
|
5653
|
0
|
|
|
|
|
0
|
$value = 0; |
|
5654
|
|
|
|
|
|
|
my $go = Getopt::Long::Parser->new(); |
|
5655
|
|
|
|
|
|
|
$go->configure( qw{ require_order } ); |
|
5656
|
0
|
|
|
|
|
0
|
$go->getoptionsfromarray( |
|
5657
|
0
|
0
|
|
0
|
|
0
|
$args, |
|
5658
|
0
|
|
|
|
|
0
|
map {; "$_!" => sub { |
|
5659
|
0
|
|
|
|
|
0
|
$_[1] and do { |
|
5660
|
|
|
|
|
|
|
my $method = "DUMP_\U$_[0]"; |
|
5661
|
0
|
|
|
|
|
0
|
$value |= $self->$method(); |
|
5662
|
|
|
|
|
|
|
}; |
|
5663
|
0
|
|
|
|
|
0
|
return; |
|
5664
|
|
|
|
|
|
|
} |
|
5665
|
0
|
|
|
|
|
0
|
} @dump_options |
|
|
0
|
|
|
|
|
0
|
|
|
5666
|
|
|
|
|
|
|
); |
|
5667
|
23
|
50
|
|
|
|
48
|
push @{ $args }, $value; # Since caller pops it. |
|
5668
|
|
|
|
|
|
|
} else { |
|
5669
|
|
|
|
|
|
|
$value =~ m/ \A 0 (?: [0-7]+ | x [[:xdigit:]]+ ) \z /smx |
|
5670
|
23
|
|
|
|
|
53
|
and $value = oct $value; |
|
5671
|
|
|
|
|
|
|
} |
|
5672
|
|
|
|
|
|
|
return ( $self->{$name} = $value ); |
|
5673
|
|
|
|
|
|
|
} |
|
5674
|
|
|
|
|
|
|
|
|
5675
|
|
|
|
|
|
|
{ |
|
5676
|
|
|
|
|
|
|
my %id_file_name = ( |
|
5677
|
|
|
|
|
|
|
MSWin32 => sub { |
|
5678
|
|
|
|
|
|
|
my $home = $ENV{HOME} || $ENV{USERPROFILE} || join '', |
|
5679
|
|
|
|
|
|
|
$ENV{HOMEDRIVE}, $ENV{HOMEPATH}; |
|
5680
|
|
|
|
|
|
|
return "$home\\spacetrack.id"; |
|
5681
|
|
|
|
|
|
|
}, |
|
5682
|
|
|
|
|
|
|
VMS => sub { |
|
5683
|
|
|
|
|
|
|
my $home = $ENV{HOME} || 'sys$login'; |
|
5684
|
|
|
|
|
|
|
return "$home:spacetrack.id"; |
|
5685
|
|
|
|
|
|
|
}, |
|
5686
|
|
|
|
|
|
|
); |
|
5687
|
|
|
|
|
|
|
|
|
5688
|
0
|
|
|
0
|
|
0
|
sub __identity_file_name { |
|
5689
|
0
|
|
0
|
0
|
|
0
|
my $id_file = ( $id_file_name{$^O} || sub { |
|
5690
|
0
|
|
|
|
|
0
|
return join '/', $ENV{HOME}, '.spacetrack-identity' } |
|
5691
|
0
|
0
|
|
|
|
0
|
)->(); |
|
5692
|
|
|
|
|
|
|
my $gpg_file = "$id_file.gpg"; |
|
5693
|
0
|
|
|
|
|
0
|
-e $gpg_file |
|
5694
|
|
|
|
|
|
|
and return $gpg_file; |
|
5695
|
|
|
|
|
|
|
return $id_file; |
|
5696
|
|
|
|
|
|
|
} |
|
5697
|
|
|
|
|
|
|
|
|
5698
|
|
|
|
|
|
|
} |
|
5699
|
|
|
|
|
|
|
|
|
5700
|
0
|
|
|
0
|
|
0
|
# This basically duplicates the logic in Config::Identity |
|
5701
|
0
|
0
|
|
|
|
0
|
sub __identity_file_is_encrypted { |
|
5702
|
|
|
|
|
|
|
my $fn = __identity_file_name(); |
|
5703
|
0
|
0
|
|
|
|
0
|
-B $fn |
|
5704
|
|
|
|
|
|
|
and return 1; |
|
5705
|
0
|
|
|
|
|
0
|
open my $fh, '<:encoding(utf-8)', $fn |
|
5706
|
0
|
|
|
|
|
0
|
or return; |
|
5707
|
0
|
|
|
|
|
0
|
local $/ = undef; |
|
5708
|
0
|
|
|
|
|
0
|
my $content = <$fh>; |
|
5709
|
|
|
|
|
|
|
close $fh; |
|
5710
|
|
|
|
|
|
|
return $content =~ m/ \Q----BEGIN PGP MESSAGE----\E /smx; |
|
5711
|
|
|
|
|
|
|
} |
|
5712
|
20
|
|
|
20
|
|
57
|
|
|
5713
|
|
|
|
|
|
|
sub _mutate_identity { |
|
5714
|
20
|
50
|
|
|
|
76
|
my ( $self, $name, $value ) = @_; |
|
5715
|
20
|
50
|
33
|
|
|
116
|
defined $value |
|
5716
|
0
|
|
|
|
|
0
|
or $value = $ENV{SPACETRACK_IDENTITY}; |
|
|
0
|
|
|
|
|
0
|
|
|
5717
|
|
|
|
|
|
|
if ( $value and my $identity = __spacetrack_identity() ) { |
|
5718
|
20
|
|
|
|
|
52
|
$self->set( %{ $identity } ); |
|
5719
|
|
|
|
|
|
|
} |
|
5720
|
|
|
|
|
|
|
return ( $self->{$name} = $value ); |
|
5721
|
|
|
|
|
|
|
} |
|
5722
|
|
|
|
|
|
|
|
|
5723
|
|
|
|
|
|
|
=for html |
|
5724
|
|
|
|
|
|
|
|
|
5725
|
|
|
|
|
|
|
=item Astro::SpaceTrack->flush_identity_cache(); |
|
5726
|
|
|
|
|
|
|
|
|
5727
|
|
|
|
|
|
|
The identity file is normally read only once, and the data cached. This |
|
5728
|
|
|
|
|
|
|
static method flushes the cache to force the identity data to be reread. |
|
5729
|
|
|
|
|
|
|
|
|
5730
|
|
|
|
|
|
|
=cut |
|
5731
|
|
|
|
|
|
|
|
|
5732
|
|
|
|
|
|
|
{ |
|
5733
|
|
|
|
|
|
|
my $identity; |
|
5734
|
|
|
|
|
|
|
my $loaded; |
|
5735
|
0
|
|
|
0
|
1
|
0
|
|
|
5736
|
0
|
|
|
|
|
0
|
sub flush_identity_cache { |
|
5737
|
|
|
|
|
|
|
$identity = $loaded = undef; |
|
5738
|
|
|
|
|
|
|
return; |
|
5739
|
|
|
|
|
|
|
} |
|
5740
|
0
|
0
|
|
0
|
|
0
|
|
|
5741
|
|
|
|
|
|
|
sub __spacetrack_identity { |
|
5742
|
0
|
|
|
|
|
0
|
$loaded |
|
5743
|
0
|
|
|
|
|
0
|
and return $identity; |
|
5744
|
0
|
0
|
|
|
|
0
|
$loaded = 1; |
|
5745
|
|
|
|
|
|
|
my $fn = __identity_file_name(); |
|
5746
|
|
|
|
|
|
|
-f $fn |
|
5747
|
0
|
|
|
|
|
0
|
or return $identity; |
|
|
0
|
|
|
|
|
0
|
|
|
5748
|
0
|
0
|
|
|
|
0
|
{ |
|
5749
|
0
|
|
|
|
|
0
|
local $@ = undef; |
|
5750
|
0
|
|
|
|
|
0
|
eval { |
|
5751
|
0
|
|
|
|
|
0
|
require Config::Identity; |
|
5752
|
|
|
|
|
|
|
$identity = { Config::Identity->load( $fn ) }; |
|
5753
|
|
|
|
|
|
|
1; |
|
5754
|
0
|
|
|
|
|
0
|
} or return; |
|
5755
|
0
|
0
|
|
|
|
0
|
} |
|
5756
|
|
|
|
|
|
|
foreach my $key ( qw{ username password } ) { |
|
5757
|
|
|
|
|
|
|
exists $identity->{$key} |
|
5758
|
0
|
0
|
|
|
|
0
|
or Carp::croak "Identity file omits $key"; |
|
|
0
|
|
|
|
|
0
|
|
|
5759
|
|
|
|
|
|
|
} |
|
5760
|
0
|
|
|
|
|
0
|
scalar keys %{ $identity } > 2 |
|
5761
|
|
|
|
|
|
|
and Carp::croak 'Identity file defines keys besides username and password'; |
|
5762
|
|
|
|
|
|
|
return $identity; |
|
5763
|
|
|
|
|
|
|
} |
|
5764
|
|
|
|
|
|
|
} |
|
5765
|
|
|
|
|
|
|
|
|
5766
|
|
|
|
|
|
|
{ |
|
5767
|
|
|
|
|
|
|
my %need_logout = map { $_ => 1 } qw{ domain_space_track }; |
|
5768
|
0
|
|
|
0
|
|
0
|
|
|
5769
|
0
|
|
|
|
|
0
|
sub _mutate_spacetrack_interface { |
|
5770
|
|
|
|
|
|
|
my ( $self, $name, $value ) = @_; |
|
5771
|
|
|
|
|
|
|
my $version = $self->{space_track_version}; |
|
5772
|
0
|
|
|
|
|
0
|
|
|
5773
|
|
|
|
|
|
|
my $spacetrack_interface_info = |
|
5774
|
0
|
0
|
|
|
|
0
|
$self->{_space_track_interface}[$version]; |
|
5775
|
|
|
|
|
|
|
|
|
5776
|
|
|
|
|
|
|
exists $spacetrack_interface_info->{$name} |
|
5777
|
0
|
0
|
|
|
|
0
|
or Carp::croak "Can not set $name for interface version $version"; |
|
5778
|
|
|
|
|
|
|
|
|
5779
|
|
|
|
|
|
|
$need_logout{$name} |
|
5780
|
0
|
|
|
|
|
0
|
and $self->logout(); |
|
5781
|
|
|
|
|
|
|
|
|
5782
|
|
|
|
|
|
|
return ( $spacetrack_interface_info->{$name} = $value ); |
|
5783
|
|
|
|
|
|
|
} |
|
5784
|
|
|
|
|
|
|
} |
|
5785
|
0
|
|
|
0
|
|
0
|
|
|
5786
|
0
|
|
|
|
|
0
|
sub _access_spacetrack_interface { |
|
5787
|
|
|
|
|
|
|
my ( $self, $name ) = @_; |
|
5788
|
0
|
|
|
|
|
0
|
my $version = $self->{space_track_version}; |
|
5789
|
0
|
0
|
|
|
|
0
|
my $spacetrack_interface_info = |
|
5790
|
|
|
|
|
|
|
$self->{_space_track_interface}[$version]; |
|
5791
|
0
|
|
|
|
|
0
|
exists $spacetrack_interface_info->{$name} |
|
5792
|
|
|
|
|
|
|
or Carp::croak "Can not get $name for interface version $version"; |
|
5793
|
|
|
|
|
|
|
return $spacetrack_interface_info->{$name}; |
|
5794
|
|
|
|
|
|
|
} |
|
5795
|
|
|
|
|
|
|
|
|
5796
|
|
|
|
|
|
|
# _mutate_authen clears the session cookie and then sets the |
|
5797
|
|
|
|
|
|
|
# desired attribute |
|
5798
|
|
|
|
|
|
|
|
|
5799
|
|
|
|
|
|
|
# This clears the session cookie and cookie expiration, then co-routines |
|
5800
|
4
|
|
|
4
|
|
17
|
# off to _mutate attrib. |
|
5801
|
4
|
|
|
|
|
189
|
sub _mutate_authen { |
|
5802
|
|
|
|
|
|
|
$_[0]->logout(); |
|
5803
|
|
|
|
|
|
|
goto &_mutate_attrib; |
|
5804
|
|
|
|
|
|
|
} |
|
5805
|
|
|
|
|
|
|
|
|
5806
|
|
|
|
|
|
|
# This subroutine just does some argument checking and then co-routines |
|
5807
|
|
|
|
|
|
|
# off to _mutate_attrib. |
|
5808
|
2
|
50
|
|
2
|
|
16
|
sub _mutate_iridium_status_format { |
|
5809
|
2
|
|
|
|
|
16
|
Carp::croak "Error - Illegal status format '$_[2]'" |
|
5810
|
2
|
|
|
|
|
14
|
unless $catalogs{iridium_status}{$_[2]}; |
|
5811
|
|
|
|
|
|
|
$_[0]->_deprecation_notice( iridium_status_format => $_[2] ); |
|
5812
|
|
|
|
|
|
|
goto &_mutate_attrib; |
|
5813
|
|
|
|
|
|
|
} |
|
5814
|
|
|
|
|
|
|
|
|
5815
|
|
|
|
|
|
|
# _mutate_number croaks if the value to be set is not numeric. |
|
5816
|
|
|
|
|
|
|
# Otherwise it sets the value. Only unsigned integers pass. |
|
5817
|
|
|
|
|
|
|
|
|
5818
|
|
|
|
|
|
|
# This subroutine just does some argument checking and then co-routines |
|
5819
|
0
|
0
|
|
0
|
|
0
|
# off to _mutate_attrib. |
|
5820
|
|
|
|
|
|
|
sub _mutate_number { |
|
5821
|
|
|
|
|
|
|
$_[2] =~ m/ \D /smx and Carp::croak <<"EOD"; |
|
5822
|
0
|
|
|
|
|
0
|
Attribute $_[1] must be set to a numeric value. |
|
5823
|
|
|
|
|
|
|
EOD |
|
5824
|
|
|
|
|
|
|
goto &_mutate_attrib; |
|
5825
|
|
|
|
|
|
|
} |
|
5826
|
|
|
|
|
|
|
|
|
5827
|
|
|
|
|
|
|
# _mutate_space_track_version() mutates the version of the interface |
|
5828
|
|
|
|
|
|
|
# used to retrieve data from Space Track. Valid values are 1 and 2, with |
|
5829
|
|
|
|
|
|
|
# any false value causing the default to be set. |
|
5830
|
2
|
|
|
2
|
|
16
|
|
|
5831
|
2
|
50
|
|
|
|
9
|
sub _mutate_space_track_version { |
|
5832
|
|
|
|
|
|
|
my ( $self, $name, $value ) = @_; |
|
5833
|
|
|
|
|
|
|
$value |
|
5834
|
2
|
50
|
33
|
|
|
23
|
or $value = DEFAULT_SPACE_TRACK_VERSION; |
|
5835
|
|
|
|
|
|
|
$value =~ m/ \A \d+ \z /smx |
|
5836
|
|
|
|
|
|
|
and $self->{_space_track_interface}[$value] |
|
5837
|
2
|
50
|
|
|
|
7
|
or Carp::croak "Invalid Space Track version $value"; |
|
5838
|
|
|
|
|
|
|
## $self->_deprecation_notice( $name => $value ); |
|
5839
|
2
|
|
|
|
|
6
|
$value == 1 |
|
5840
|
|
|
|
|
|
|
and Carp::croak 'The version 1 SpaceTrack interface stopped working July 16 2013 at 18:00 UT'; |
|
5841
|
|
|
|
|
|
|
return ( $self->{$name} = $value ); |
|
5842
|
|
|
|
|
|
|
} |
|
5843
|
|
|
|
|
|
|
|
|
5844
|
|
|
|
|
|
|
# _mutate_verify_hostname mutates the verify_hostname attribute. |
|
5845
|
|
|
|
|
|
|
# Since the value of this gets fed to LWP::UserAgent->new() to |
|
5846
|
|
|
|
|
|
|
# instantiate the {agent} attribute, we delete that attribute |
|
5847
|
|
|
|
|
|
|
# before changing the value, relying on $self->_get_agent() to |
|
5848
|
|
|
|
|
|
|
# instantiate it appropriately if needed -- and on any code that |
|
5849
|
|
|
|
|
|
|
# uses the agent to go through this private method to get it. |
|
5850
|
1
|
|
|
1
|
|
2
|
|
|
5851
|
1
|
|
|
|
|
3
|
sub _mutate_verify_hostname { |
|
5852
|
|
|
|
|
|
|
delete $_[0]->{agent}; |
|
5853
|
|
|
|
|
|
|
goto &_mutate_attrib; |
|
5854
|
|
|
|
|
|
|
} |
|
5855
|
|
|
|
|
|
|
|
|
5856
|
|
|
|
|
|
|
# _no_such_catalog takes as arguments a source and catalog name, |
|
5857
|
|
|
|
|
|
|
# and returns the appropriate HTTP::Response object based on the |
|
5858
|
|
|
|
|
|
|
# current verbosity setting. |
|
5859
|
|
|
|
|
|
|
|
|
5860
|
|
|
|
|
|
|
{ |
|
5861
|
|
|
|
|
|
|
|
|
5862
|
|
|
|
|
|
|
my %no_such_name = ( |
|
5863
|
|
|
|
|
|
|
celestrak => 'CelesTrak', |
|
5864
|
|
|
|
|
|
|
spacetrack => 'Space Track', |
|
5865
|
|
|
|
|
|
|
); |
|
5866
|
2
|
|
|
2
|
|
11
|
|
|
5867
|
|
|
|
|
|
|
sub _no_such_catalog { |
|
5868
|
2
|
50
|
|
|
|
11
|
my ( $self, $source, @args ) = @_; |
|
5869
|
|
|
|
|
|
|
|
|
5870
|
|
|
|
|
|
|
my $info = $catalogs{$source} |
|
5871
|
2
|
100
|
|
|
|
18
|
or Carp::confess "Bug - No such source as '$source'"; |
|
5872
|
1
|
|
|
|
|
3
|
|
|
5873
|
1
|
50
|
|
|
|
5
|
if ( ARRAY_REF eq ref $info ) { |
|
5874
|
|
|
|
|
|
|
my $inx = shift @args; |
|
5875
|
|
|
|
|
|
|
$info = $info->[$inx] |
|
5876
|
|
|
|
|
|
|
or Carp::confess "Bug - Illegal index $inx ", |
|
5877
|
|
|
|
|
|
|
"for '$source'"; |
|
5878
|
2
|
|
|
|
|
7
|
} |
|
5879
|
|
|
|
|
|
|
|
|
5880
|
2
|
|
33
|
|
|
11
|
my ( $catalog, $note ) = @args; |
|
5881
|
|
|
|
|
|
|
|
|
5882
|
|
|
|
|
|
|
my $name = $no_such_name{$source} || $source; |
|
5883
|
2
|
50
|
|
|
|
23
|
|
|
|
|
50
|
|
|
|
|
|
|
5884
|
|
|
|
|
|
|
my $lead = defined $catalog ? |
|
5885
|
|
|
|
|
|
|
$info->{$catalog} ? |
|
5886
|
|
|
|
|
|
|
"$name '$catalog' missing" : |
|
5887
|
2
|
100
|
|
|
|
10
|
"$name '$catalog' not found" : |
|
5888
|
|
|
|
|
|
|
"$name item not defined"; |
|
5889
|
|
|
|
|
|
|
$lead .= defined $note ? " ($note)." : '.'; |
|
5890
|
2
|
50
|
|
|
|
16
|
|
|
5891
|
|
|
|
|
|
|
return HTTP::Response->new (HTTP_NOT_FOUND, "$lead\n") |
|
5892
|
0
|
|
|
|
|
0
|
unless $self->{verbose}; |
|
5893
|
0
|
|
|
|
|
0
|
|
|
5894
|
|
|
|
|
|
|
my $resp = $self->names ($source); |
|
5895
|
|
|
|
|
|
|
return HTTP::Response->new (HTTP_NOT_FOUND, |
|
5896
|
|
|
|
|
|
|
join '', "$lead Try one of:\n", $resp->content, |
|
5897
|
|
|
|
|
|
|
); |
|
5898
|
|
|
|
|
|
|
} |
|
5899
|
|
|
|
|
|
|
|
|
5900
|
|
|
|
|
|
|
} |
|
5901
|
|
|
|
|
|
|
|
|
5902
|
|
|
|
|
|
|
# _parse_args parses options off an argument list. The first |
|
5903
|
|
|
|
|
|
|
# argument must be a list reference of options to be parsed. |
|
5904
|
|
|
|
|
|
|
# This list is pairs of values, the first being the Getopt::Long |
|
5905
|
|
|
|
|
|
|
# specification for the option, and the second being a description |
|
5906
|
|
|
|
|
|
|
# of the option suitable for help text. Subsequent arguments are |
|
5907
|
|
|
|
|
|
|
# the arguments list to be parsed. It returns a reference to a |
|
5908
|
|
|
|
|
|
|
# hash containing the options, followed by any remaining |
|
5909
|
|
|
|
|
|
|
# non-option arguments. If the first argument after the list |
|
5910
|
|
|
|
|
|
|
# reference is a hash reference, it simply returns. |
|
5911
|
|
|
|
|
|
|
|
|
5912
|
|
|
|
|
|
|
{ |
|
5913
|
|
|
|
|
|
|
my $go = Getopt::Long::Parser->new(); |
|
5914
|
109
|
|
|
109
|
|
303
|
|
|
5915
|
109
|
100
|
|
|
|
347
|
sub _parse_args { |
|
5916
|
20
|
|
|
|
|
65
|
my ( $lgl_opts, @args ) = @_; |
|
5917
|
20
|
|
|
|
|
366
|
unless ( ARRAY_REF eq ref $lgl_opts ) { |
|
5918
|
20
|
|
|
|
|
133
|
unshift @args, $lgl_opts; |
|
5919
|
20
|
50
|
|
|
|
280
|
( my $caller = ( caller 1 )[3] ) =~ s/ ( .* ) :: //smx; |
|
5920
|
|
|
|
|
|
|
my $pkg = $1; |
|
5921
|
20
|
|
|
|
|
85
|
my $code = $pkg->can( "_${caller}_opts" ) |
|
5922
|
|
|
|
|
|
|
or Carp::confess "Bug - _${caller}_opts not found"; |
|
5923
|
109
|
|
|
|
|
188
|
$lgl_opts = $code->(); |
|
5924
|
109
|
100
|
|
|
|
276
|
} |
|
5925
|
18
|
|
|
|
|
30
|
my $opt; |
|
|
18
|
|
|
|
|
81
|
|
|
5926
|
|
|
|
|
|
|
if ( HASH_REF eq ref $args[0] ) { |
|
5927
|
|
|
|
|
|
|
$opt = { %{ shift @args } }; # Poor man's clone. |
|
5928
|
18
|
50
|
|
|
|
58
|
# Validation is new, so I insert a hack to turn it off if need |
|
5929
|
18
|
|
|
|
|
47
|
# be. |
|
5930
|
18
|
|
|
|
|
44
|
unless ( $ENV{SPACETRACK_SKIP_OPTION_HASH_VALIDATION} ) { |
|
5931
|
18
|
|
|
|
|
29
|
my %lgl = _extract_keys( $lgl_opts ); |
|
|
18
|
|
|
|
|
54
|
|
|
5932
|
47
|
50
|
|
|
|
100
|
my @bad; |
|
5933
|
|
|
|
|
|
|
foreach my $key ( keys %{ $opt } ) { |
|
5934
|
|
|
|
|
|
|
$lgl{$key} |
|
5935
|
|
|
|
|
|
|
or push @bad, $key; |
|
5936
|
|
|
|
|
|
|
} |
|
5937
|
|
|
|
|
|
|
@bad |
|
5938
|
|
|
|
|
|
|
and _parse_args_failure( |
|
5939
|
18
|
50
|
|
|
|
63
|
carp => 1, |
|
|
0
|
|
|
|
|
0
|
|
|
5940
|
|
|
|
|
|
|
name => \@bad, |
|
5941
|
|
|
|
|
|
|
legal => { @{ $lgl_opts } }, |
|
5942
|
|
|
|
|
|
|
suffix => <<'EOD', |
|
5943
|
|
|
|
|
|
|
|
|
5944
|
|
|
|
|
|
|
You cam suppress this warning by setting environment variable |
|
5945
|
|
|
|
|
|
|
SPACETRACK_SKIP_OPTION_HASH_VALIDATION to a value Perl understands as |
|
5946
|
|
|
|
|
|
|
true (say, like 1), but this should be considered a stopgap while you |
|
5947
|
|
|
|
|
|
|
fix the calling code, or have it fixed, since my plan is to make this |
|
5948
|
|
|
|
|
|
|
fatal. |
|
5949
|
|
|
|
|
|
|
EOD |
|
5950
|
|
|
|
|
|
|
); |
|
5951
|
91
|
|
|
|
|
175
|
} |
|
5952
|
91
|
|
|
|
|
146
|
} else { |
|
|
91
|
|
|
|
|
563
|
|
|
5953
|
91
|
50
|
|
|
|
560
|
$opt = {}; |
|
5954
|
|
|
|
|
|
|
my %lgl = @{ $lgl_opts }; |
|
5955
|
|
|
|
|
|
|
$go->getoptionsfromarray( |
|
5956
|
|
|
|
|
|
|
\@args, |
|
5957
|
|
|
|
|
|
|
$opt, |
|
5958
|
|
|
|
|
|
|
keys %lgl, |
|
5959
|
|
|
|
|
|
|
) |
|
5960
|
109
|
|
|
|
|
72093
|
or _parse_args_failure( legal => \%lgl ); |
|
5961
|
|
|
|
|
|
|
} |
|
5962
|
|
|
|
|
|
|
return ( $opt, @args ); |
|
5963
|
|
|
|
|
|
|
} |
|
5964
|
|
|
|
|
|
|
} |
|
5965
|
0
|
|
|
0
|
|
0
|
|
|
5966
|
0
|
0
|
|
|
|
0
|
sub _parse_args_failure { |
|
5967
|
0
|
0
|
|
|
|
0
|
my %arg = @_; |
|
5968
|
|
|
|
|
|
|
my $msg = $arg{carp} ? 'Warning - ' : 'Error - '; |
|
5969
|
0
|
|
|
|
|
0
|
if ( defined $arg{name} ) { |
|
5970
|
0
|
0
|
|
|
|
0
|
my @names = ( ARRAY_REF eq ref $arg{name} ) ? |
|
5971
|
|
|
|
|
|
|
@{ $arg{name} } : |
|
5972
|
0
|
0
|
|
|
|
0
|
$arg{name}; |
|
5973
|
0
|
0
|
|
|
|
0
|
@names |
|
5974
|
0
|
|
|
|
|
0
|
or return; |
|
|
0
|
|
|
|
|
0
|
|
|
5975
|
0
|
|
|
|
|
0
|
my $opt = @names > 1 ? 'Options' : 'Option'; |
|
5976
|
|
|
|
|
|
|
my $txt = join ', ', map { "-$_" } sort @names; |
|
5977
|
0
|
0
|
|
|
|
0
|
$msg .= "$opt $txt illegal.\n"; |
|
5978
|
0
|
|
|
|
|
0
|
} |
|
5979
|
0
|
|
|
|
|
0
|
if ( defined $arg{legal} ) { |
|
|
0
|
|
|
|
|
0
|
|
|
5980
|
0
|
|
|
|
|
0
|
$msg .= "Legal options are\n"; |
|
5981
|
0
|
|
|
|
|
0
|
foreach my $opt ( sort keys %{ $arg{legal} } ) { |
|
5982
|
0
|
|
|
|
|
0
|
my $desc = $arg{legal}{$opt}; |
|
5983
|
|
|
|
|
|
|
$opt = _extract_keys( $opt ); |
|
5984
|
0
|
|
|
|
|
0
|
$msg .= " -$opt - $desc\n"; |
|
5985
|
|
|
|
|
|
|
} |
|
5986
|
|
|
|
|
|
|
$msg .= <<"EOD"; |
|
5987
|
|
|
|
|
|
|
with dates being either Perl times, or numeric year-month-day, with any |
|
5988
|
|
|
|
|
|
|
non-numeric character valid as punctuation. |
|
5989
|
|
|
|
|
|
|
EOD |
|
5990
|
0
|
0
|
|
|
|
0
|
} |
|
5991
|
|
|
|
|
|
|
defined $arg{suffix} |
|
5992
|
0
|
0
|
|
|
|
0
|
and $msg .= $arg{suffix}; |
|
5993
|
0
|
|
|
|
|
0
|
$arg{carp} |
|
5994
|
0
|
|
|
|
|
0
|
or Carp::croak $msg; |
|
5995
|
|
|
|
|
|
|
Carp::carp $msg; |
|
5996
|
|
|
|
|
|
|
return; |
|
5997
|
|
|
|
|
|
|
} |
|
5998
|
|
|
|
|
|
|
|
|
5999
|
|
|
|
|
|
|
# Parse an international launch ID in the form yyyy-sssp or yysssp. |
|
6000
|
|
|
|
|
|
|
# In the yyyy-sssp form, the year can be two digits (in which case 57-99 |
|
6001
|
|
|
|
|
|
|
# are 1957-1999 and 00-56 are 2000-2056) and the dash can be any |
|
6002
|
|
|
|
|
|
|
# non-alpha, non-digit, non-space character. In either case, trailing |
|
6003
|
|
|
|
|
|
|
# fields are optional. If provided, the part ('p') can be multiple |
|
6004
|
|
|
|
|
|
|
# alphabetic characters. Only fields actually specified will be |
|
6005
|
|
|
|
|
|
|
# returned. |
|
6006
|
14
|
|
|
14
|
|
32
|
|
|
6007
|
14
|
|
|
|
|
26
|
sub _parse_international_id { |
|
6008
|
|
|
|
|
|
|
my ( $intl_id ) = @_; |
|
6009
|
14
|
50
|
|
|
|
112
|
my ( $year, $launch, $part ); |
|
|
|
50
|
|
|
|
|
|
|
6010
|
|
|
|
|
|
|
|
|
6011
|
|
|
|
|
|
|
if ( $intl_id =~ |
|
6012
|
|
|
|
|
|
|
m< \A ( \d+ ) [^[:alpha:][:digit:]\s] |
|
6013
|
0
|
|
|
|
|
0
|
(?: ( \d{1,3} ) ( [[:alpha:]]* ) )? \z >smx |
|
6014
|
|
|
|
|
|
|
) { |
|
6015
|
|
|
|
|
|
|
( $year, $launch, $part ) = ( $1, $2, $3 ); |
|
6016
|
|
|
|
|
|
|
} elsif ( $intl_id =~ |
|
6017
|
14
|
|
|
|
|
51
|
m< \A ( \d\d ) (?: ( \d{3} ) ( [[:alpha:]]* ) )? >smx |
|
6018
|
|
|
|
|
|
|
) { |
|
6019
|
0
|
|
|
|
|
0
|
( $year, $launch, $part ) = ( $1, $2, $3 ); |
|
6020
|
|
|
|
|
|
|
} else { |
|
6021
|
|
|
|
|
|
|
return; |
|
6022
|
14
|
50
|
|
|
|
54
|
} |
|
|
|
50
|
|
|
|
|
|
|
6023
|
14
|
|
|
|
|
30
|
|
|
6024
|
14
|
100
|
|
|
|
33
|
$year += $year < 57 ? 2000 : $year < 100 ? 1900 : 0; |
|
6025
|
|
|
|
|
|
|
my @parts = ( $year ); |
|
6026
|
13
|
|
|
|
|
27
|
$launch |
|
6027
|
13
|
100
|
|
|
|
28
|
or return @parts; |
|
6028
|
|
|
|
|
|
|
push @parts, $launch; |
|
6029
|
13
|
|
|
|
|
42
|
$part |
|
6030
|
|
|
|
|
|
|
and push @parts, uc $part; |
|
6031
|
|
|
|
|
|
|
return @parts; |
|
6032
|
|
|
|
|
|
|
} |
|
6033
|
|
|
|
|
|
|
|
|
6034
|
|
|
|
|
|
|
# Parse a date in the form yyyy-mm-dd, with either two- or four-digit |
|
6035
|
|
|
|
|
|
|
# year, and month and day optional. The year is normalized to four |
|
6036
|
|
|
|
|
|
|
# digits using the NORAD pivot date of 57 -- that is, 57-99 represent |
|
6037
|
|
|
|
|
|
|
# 1957-1999, and 00-56 represent 2000-2056. The month and day are |
|
6038
|
|
|
|
|
|
|
# optional. Only fields actually specified will be returned. |
|
6039
|
14
|
|
|
14
|
|
29
|
|
|
6040
|
14
|
50
|
|
|
|
103
|
sub _parse_launch_date { |
|
6041
|
|
|
|
|
|
|
my ( $date ) = @_; |
|
6042
|
|
|
|
|
|
|
my ( $year, $month, $day ) = |
|
6043
|
14
|
50
|
|
|
|
57
|
$date =~ m/ \A (\d+) (?:\D+ (\d+) (?: \D+ (\d+) )? )? /smx |
|
|
|
50
|
|
|
|
|
|
|
6044
|
14
|
|
|
|
|
33
|
or return; |
|
6045
|
14
|
50
|
|
|
|
29
|
$year += $year < 57 ? 2000 : $year < 100 ? 1900 : 0; |
|
6046
|
|
|
|
|
|
|
my @parts = ( $year ); |
|
6047
|
14
|
|
|
|
|
29
|
defined $month |
|
6048
|
14
|
50
|
|
|
|
31
|
or return @parts; |
|
6049
|
14
|
|
|
|
|
92
|
push @parts, $month; |
|
6050
|
|
|
|
|
|
|
defined $day and push @parts, $day; |
|
6051
|
|
|
|
|
|
|
return @parts; |
|
6052
|
|
|
|
|
|
|
} |
|
6053
|
|
|
|
|
|
|
|
|
6054
|
|
|
|
|
|
|
# _parse_retrieve_args parses the retrieve() options off its |
|
6055
|
|
|
|
|
|
|
# arguments, prefixes a reference to the resultant options hash to |
|
6056
|
|
|
|
|
|
|
# the remaining arguments, and returns the resultant list. If the |
|
6057
|
|
|
|
|
|
|
# first argument is a list reference, it is taken as extra |
|
6058
|
|
|
|
|
|
|
# options, and removed from the argument list. If the next |
|
6059
|
|
|
|
|
|
|
# argument after the list reference (if any) is a hash reference, |
|
6060
|
|
|
|
|
|
|
# it simply returns its argument list, under the assumption that |
|
6061
|
|
|
|
|
|
|
# it has already been called. |
|
6062
|
|
|
|
|
|
|
|
|
6063
|
|
|
|
|
|
|
{ |
|
6064
|
|
|
|
|
|
|
|
|
6065
|
|
|
|
|
|
|
my @legal_retrieve_options = ( |
|
6066
|
|
|
|
|
|
|
@{ CLASSIC_RETRIEVE_OPTIONS() }, |
|
6067
|
|
|
|
|
|
|
# Space Track Version 2 interface options |
|
6068
|
|
|
|
|
|
|
'since_file=i' |
|
6069
|
|
|
|
|
|
|
=> '(Return only results added after the given file number)', |
|
6070
|
|
|
|
|
|
|
'json!' => '(Return TLEs in JSON format)', |
|
6071
|
|
|
|
|
|
|
'format=s' => 'Specify data format' |
|
6072
|
|
|
|
|
|
|
); |
|
6073
|
0
|
|
|
0
|
|
0
|
|
|
6074
|
|
|
|
|
|
|
sub _get_retrieve_options { |
|
6075
|
|
|
|
|
|
|
return @legal_retrieve_options; |
|
6076
|
|
|
|
|
|
|
} |
|
6077
|
85
|
|
|
85
|
|
238
|
|
|
6078
|
85
|
100
|
|
|
|
289
|
sub _parse_retrieve_args { |
|
6079
|
|
|
|
|
|
|
my ( undef, @args ) = @_; # Invocant unused |
|
6080
|
|
|
|
|
|
|
my $extra_options = ARRAY_REF eq ref $args[0] ? |
|
6081
|
|
|
|
|
|
|
shift @args : |
|
6082
|
|
|
|
|
|
|
undef; |
|
6083
|
|
|
|
|
|
|
|
|
6084
|
85
|
100
|
|
|
|
221
|
( my $opt, @args ) = _parse_args( |
|
|
50
|
|
|
|
|
223
|
|
|
6085
|
|
|
|
|
|
|
( $extra_options ? |
|
6086
|
|
|
|
|
|
|
[ @legal_retrieve_options, @{ $extra_options } ] : |
|
6087
|
|
|
|
|
|
|
\@legal_retrieve_options ), |
|
6088
|
85
|
|
66
|
|
|
456
|
@args ); |
|
6089
|
|
|
|
|
|
|
|
|
6090
|
85
|
|
|
|
|
227
|
$opt->{sort} ||= _validate_sort( $opt->{sort} ); |
|
6091
|
|
|
|
|
|
|
|
|
6092
|
85
|
|
|
|
|
274
|
_retrieval_format( undef, $opt ); |
|
6093
|
|
|
|
|
|
|
|
|
6094
|
|
|
|
|
|
|
return ( $opt, @args ); |
|
6095
|
|
|
|
|
|
|
} |
|
6096
|
|
|
|
|
|
|
} |
|
6097
|
|
|
|
|
|
|
|
|
6098
|
|
|
|
|
|
|
{ |
|
6099
|
|
|
|
|
|
|
my @usual_formats = map { $_ => 1 } qw{ xml json html csv }; |
|
6100
|
|
|
|
|
|
|
my $legacy_formats = { |
|
6101
|
|
|
|
|
|
|
default => 'legacy', |
|
6102
|
|
|
|
|
|
|
valid => { @usual_formats, map { $_ => 1 } qw{ legacy } }, |
|
6103
|
|
|
|
|
|
|
}; |
|
6104
|
|
|
|
|
|
|
my $tle_formats = { |
|
6105
|
|
|
|
|
|
|
default => 'legacy', |
|
6106
|
|
|
|
|
|
|
valid => { @usual_formats, map { $_ => 1 } qw{ tle 3le legacy } }, |
|
6107
|
|
|
|
|
|
|
}; |
|
6108
|
|
|
|
|
|
|
my %format = ( |
|
6109
|
|
|
|
|
|
|
box_score => $legacy_formats, |
|
6110
|
|
|
|
|
|
|
country_names => $legacy_formats, |
|
6111
|
|
|
|
|
|
|
launch_sites => $legacy_formats, |
|
6112
|
|
|
|
|
|
|
satcat => $legacy_formats, |
|
6113
|
|
|
|
|
|
|
tle => $tle_formats, |
|
6114
|
|
|
|
|
|
|
); |
|
6115
|
94
|
|
|
94
|
|
186
|
|
|
6116
|
|
|
|
|
|
|
sub _retrieval_format { |
|
6117
|
94
|
50
|
|
|
|
295
|
my ( $table, $opt ) = @_; |
|
|
|
100
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
6118
|
|
|
|
|
|
|
defined $table |
|
6119
|
|
|
|
|
|
|
or $table = defined $opt->{tle} ? $opt->{tle} ? 'tle' : |
|
6120
|
|
|
|
|
|
|
'satcat' : 'tle'; |
|
6121
|
94
|
50
|
100
|
|
|
275
|
$opt->{json} |
|
|
|
|
66
|
|
|
|
|
|
6122
|
|
|
|
|
|
|
and defined $opt->{format} |
|
6123
|
94
|
50
|
|
|
|
215
|
and $opt->{format} ne 'json' |
|
6124
|
|
|
|
|
|
|
and Carp::croak 'Inconsistent retrieval format specification'; |
|
6125
|
|
|
|
|
|
|
$format{$table} |
|
6126
|
|
|
|
|
|
|
or Carp::confess "Bug - $table not supported"; |
|
6127
|
94
|
100
|
|
|
|
308
|
defined $opt->{format} |
|
|
|
100
|
|
|
|
|
|
|
6128
|
|
|
|
|
|
|
or $opt->{format} = $opt->{json} ? 'json' : |
|
6129
|
94
|
100
|
|
|
|
266
|
$format{$table}{default}; |
|
6130
|
|
|
|
|
|
|
exists $opt->{json} |
|
6131
|
94
|
50
|
|
|
|
287
|
or $opt->{json} = 'json' eq $opt->{format}; |
|
6132
|
94
|
100
|
|
|
|
237
|
$format{$table}{valid}{ $opt->{format} } |
|
6133
|
|
|
|
|
|
|
or Carp::croak "Invalid $table retrieval format '$opt->{format}'"; |
|
6134
|
|
|
|
|
|
|
return $opt->{format} eq 'legacy' ? 'json' : $opt->{format}; |
|
6135
|
|
|
|
|
|
|
} |
|
6136
|
|
|
|
|
|
|
} |
|
6137
|
|
|
|
|
|
|
|
|
6138
|
|
|
|
|
|
|
# my $sort = _validate_sort( $sort ); |
|
6139
|
|
|
|
|
|
|
# |
|
6140
|
|
|
|
|
|
|
# Validate and canonicalize the value of the -sort option. |
|
6141
|
|
|
|
|
|
|
{ |
|
6142
|
68
|
|
|
68
|
|
134
|
my %valid = map { $_ => 1 } qw{ catnum epoch }; |
|
6143
|
68
|
50
|
|
|
|
318
|
sub _validate_sort { |
|
6144
|
|
|
|
|
|
|
my ( $sort ) = @_; |
|
6145
|
0
|
|
|
|
|
0
|
defined $sort |
|
6146
|
0
|
0
|
|
|
|
0
|
or return 'catnum'; |
|
6147
|
|
|
|
|
|
|
$sort = lc $sort; |
|
6148
|
0
|
|
|
|
|
0
|
$valid{$sort} |
|
6149
|
|
|
|
|
|
|
or Carp::croak "Illegal sort '$sort'"; |
|
6150
|
|
|
|
|
|
|
return $sort; |
|
6151
|
|
|
|
|
|
|
} |
|
6152
|
|
|
|
|
|
|
} |
|
6153
|
|
|
|
|
|
|
|
|
6154
|
|
|
|
|
|
|
# $opt = _parse_retrieve_dates ($opt); |
|
6155
|
|
|
|
|
|
|
|
|
6156
|
|
|
|
|
|
|
# This subroutine looks for keys start_epoch and end_epoch in the |
|
6157
|
|
|
|
|
|
|
# given option hash, parses them as YYYY-MM-DD (where the letters |
|
6158
|
|
|
|
|
|
|
# are digits and the dashes are any non-digit punctuation), and |
|
6159
|
|
|
|
|
|
|
# replaces those keys' values with a reference to a list |
|
6160
|
|
|
|
|
|
|
# containing the output of timegm() for the given time. If only |
|
6161
|
|
|
|
|
|
|
# one epoch is provided, the other is defaulted to provide a |
|
6162
|
|
|
|
|
|
|
# one-day date range. If the syntax is invalid, we croak. |
|
6163
|
|
|
|
|
|
|
# |
|
6164
|
|
|
|
|
|
|
# The return is the same hash reference that was passed in. |
|
6165
|
34
|
|
|
34
|
|
59
|
|
|
6166
|
|
|
|
|
|
|
sub _parse_retrieve_dates { |
|
6167
|
34
|
|
|
|
|
46
|
my ( $opt ) = @_; |
|
6168
|
34
|
|
|
|
|
64
|
|
|
6169
|
|
|
|
|
|
|
my $found; |
|
6170
|
68
|
100
|
|
|
|
169
|
foreach my $key ( qw{ end_epoch start_epoch } ) { |
|
6171
|
|
|
|
|
|
|
|
|
6172
|
6
|
50
|
|
|
|
44
|
next unless $opt->{$key}; |
|
6173
|
6
|
|
|
|
|
13
|
|
|
6174
|
6
|
50
|
|
|
|
40
|
if ( $opt->{$key} =~ m/ \D /smx ) { |
|
6175
|
|
|
|
|
|
|
my $str = $opt->{$key}; |
|
6176
|
|
|
|
|
|
|
$str =~ m< \A |
|
6177
|
|
|
|
|
|
|
( \d+ ) \D+ ( \d+ ) \D+ ( \d+ ) |
|
6178
|
|
|
|
|
|
|
(?: \D+ ( \d+ ) (?: \D+ ( \d+ ) (?: \D+ ( \d+ ) )? )? )? |
|
6179
|
6
|
|
|
|
|
32
|
\z >smx |
|
6180
|
6
|
|
|
|
|
15
|
or Carp::croak "Error - Illegal date '$str'"; |
|
6181
|
36
|
100
|
|
|
|
70
|
my @time = ( $6, $5, $4, $3, $2, $1 ); |
|
6182
|
|
|
|
|
|
|
foreach ( @time ) { |
|
6183
|
|
|
|
|
|
|
defined $_ |
|
6184
|
6
|
50
|
|
|
|
24
|
or $_ = 0; |
|
|
|
0
|
|
|
|
|
|
|
6185
|
6
|
|
|
|
|
14
|
} |
|
6186
|
|
|
|
|
|
|
if ( $time[5] > 1900 ) { |
|
6187
|
0
|
|
|
|
|
0
|
$time[5] -= 1900; |
|
6188
|
|
|
|
|
|
|
} elsif ( $time[5] < 57 ) { |
|
6189
|
6
|
|
|
|
|
13
|
$time[5] += 100; |
|
6190
|
6
|
50
|
|
|
|
12
|
} |
|
6191
|
6
|
|
|
|
|
24
|
$time[4] -= 1; |
|
6192
|
6
|
|
|
|
|
268
|
eval { |
|
6193
|
|
|
|
|
|
|
$opt->{$key} = Time::Local::timegm( @time ); |
|
6194
|
|
|
|
|
|
|
1; |
|
6195
|
|
|
|
|
|
|
} or Carp::croak "Error - Illegal date '$str'"; |
|
6196
|
6
|
|
|
|
|
15
|
} |
|
6197
|
|
|
|
|
|
|
|
|
6198
|
|
|
|
|
|
|
$found++; |
|
6199
|
34
|
100
|
|
|
|
76
|
} |
|
6200
|
|
|
|
|
|
|
|
|
6201
|
5
|
100
|
|
|
|
21
|
if ( $found ) { |
|
6202
|
4
|
|
66
|
|
|
22
|
|
|
6203
|
4
|
|
66
|
|
|
20
|
if ( $found == 1 ) { |
|
6204
|
|
|
|
|
|
|
$opt->{start_epoch} ||= $opt->{end_epoch} - 86400; |
|
6205
|
|
|
|
|
|
|
$opt->{end_epoch} ||= $opt->{start_epoch} + 86400; |
|
6206
|
5
|
50
|
|
|
|
15
|
} |
|
6207
|
|
|
|
|
|
|
|
|
6208
|
|
|
|
|
|
|
$opt->{start_epoch} <= $opt->{end_epoch} or Carp::croak <<'EOD'; |
|
6209
|
|
|
|
|
|
|
Error - End epoch must not be before start epoch. |
|
6210
|
5
|
|
|
|
|
12
|
EOD |
|
6211
|
|
|
|
|
|
|
|
|
6212
|
10
|
|
|
|
|
50
|
foreach my $key ( qw{ start_epoch end_epoch } ) { |
|
6213
|
10
|
|
|
|
|
20
|
|
|
6214
|
10
|
|
|
|
|
15
|
my @time = reverse( ( gmtime $opt->{$key} )[ 0 .. 5 ] ); |
|
6215
|
10
|
|
|
|
|
35
|
$time[0] += 1900; |
|
6216
|
|
|
|
|
|
|
$time[1] += 1; |
|
6217
|
|
|
|
|
|
|
$opt->{"_$key"} = \@time; |
|
6218
|
|
|
|
|
|
|
|
|
6219
|
|
|
|
|
|
|
} |
|
6220
|
34
|
|
|
|
|
59
|
} |
|
6221
|
|
|
|
|
|
|
|
|
6222
|
|
|
|
|
|
|
return $opt; |
|
6223
|
|
|
|
|
|
|
} |
|
6224
|
|
|
|
|
|
|
|
|
6225
|
|
|
|
|
|
|
# _parse_search_args parses the search_*() options off its |
|
6226
|
|
|
|
|
|
|
# arguments, prefixes a reference to the resultant options |
|
6227
|
|
|
|
|
|
|
# hash to the remaining arguments, and returns the resultant |
|
6228
|
|
|
|
|
|
|
# list. If the first argument is a hash reference, it validates |
|
6229
|
|
|
|
|
|
|
# that the hash contains only legal options. |
|
6230
|
|
|
|
|
|
|
|
|
6231
|
|
|
|
|
|
|
|
|
6232
|
|
|
|
|
|
|
{ |
|
6233
|
|
|
|
|
|
|
|
|
6234
|
|
|
|
|
|
|
my %status_query = ( |
|
6235
|
|
|
|
|
|
|
onorbit => 'null-val', |
|
6236
|
|
|
|
|
|
|
decayed => '<>null-val', |
|
6237
|
|
|
|
|
|
|
all => '', |
|
6238
|
|
|
|
|
|
|
); |
|
6239
|
|
|
|
|
|
|
|
|
6240
|
|
|
|
|
|
|
my %include_map = ( |
|
6241
|
|
|
|
|
|
|
payload => 'PAYLOAD', |
|
6242
|
|
|
|
|
|
|
rocket => 'ROCKET BODY', |
|
6243
|
|
|
|
|
|
|
debris => 'DEBRIS', |
|
6244
|
|
|
|
|
|
|
unknown => 'UNKNOWN', |
|
6245
|
|
|
|
|
|
|
tba => 'TBA', |
|
6246
|
|
|
|
|
|
|
other => 'OTHER', |
|
6247
|
|
|
|
|
|
|
); |
|
6248
|
50
|
|
|
50
|
|
96
|
|
|
6249
|
50
|
|
|
|
|
73
|
sub _convert_search_options_to_rest { |
|
6250
|
|
|
|
|
|
|
my ( undef, $opt ) = @_; # Invocant unused |
|
6251
|
50
|
50
|
|
|
|
112
|
my %rest; |
|
6252
|
|
|
|
|
|
|
|
|
6253
|
50
|
50
|
|
|
|
147
|
if ( defined $opt->{status} ) { |
|
6254
|
|
|
|
|
|
|
defined ( my $query = $status_query{$opt->{status}} ) |
|
6255
|
50
|
100
|
|
|
|
131
|
or Carp::croak "Unknown status '$opt->{status}'"; |
|
6256
|
|
|
|
|
|
|
$query |
|
6257
|
|
|
|
|
|
|
and $rest{DECAY} = $query; |
|
6258
|
|
|
|
|
|
|
} |
|
6259
|
50
|
|
|
|
|
72
|
|
|
|
50
|
|
|
|
|
65
|
|
|
6260
|
|
|
|
|
|
|
{ |
|
6261
|
50
|
100
|
66
|
|
|
107
|
my %incl; |
|
|
50
|
|
|
|
|
146
|
|
|
6262
|
12
|
|
|
|
|
31
|
|
|
|
72
|
|
|
|
|
130
|
|
|
6263
|
12
|
|
|
|
|
25
|
if ( $opt->{exclude} && @{ $opt->{exclude} } ) { |
|
|
12
|
|
|
|
|
26
|
|
|
6264
|
18
|
50
|
|
|
|
36
|
%incl = map { $_ => 1 } keys %include_map; |
|
6265
|
|
|
|
|
|
|
foreach ( @{ $opt->{exclude} } ) { |
|
6266
|
18
|
|
|
|
|
38
|
$include_map{$_} |
|
6267
|
|
|
|
|
|
|
or Carp::croak "Unknown exclusion '$_'"; |
|
6268
|
|
|
|
|
|
|
delete $incl{$_}; |
|
6269
|
|
|
|
|
|
|
} |
|
6270
|
50
|
100
|
66
|
|
|
116
|
} |
|
|
50
|
|
|
|
|
133
|
|
|
6271
|
1
|
|
|
|
|
6
|
|
|
|
1
|
|
|
|
|
9
|
|
|
6272
|
1
|
50
|
|
|
|
5
|
if ( $opt->{include} && @{ $opt->{include} } ) { |
|
6273
|
|
|
|
|
|
|
foreach ( @{ $opt->{include} } ) { |
|
6274
|
1
|
|
|
|
|
4
|
$include_map{$_} |
|
6275
|
|
|
|
|
|
|
or Carp::croak "Unknown inclusion '$_'"; |
|
6276
|
|
|
|
|
|
|
$incl{$_} = 1; |
|
6277
|
|
|
|
|
|
|
} |
|
6278
|
|
|
|
|
|
|
} |
|
6279
|
|
|
|
|
|
|
|
|
6280
|
50
|
100
|
|
|
|
164
|
keys %incl |
|
|
55
|
|
|
|
|
116
|
|
|
6281
|
|
|
|
|
|
|
and $rest{OBJECT_TYPE} = join ',', |
|
6282
|
|
|
|
|
|
|
map { $include_map{$_} } sort keys %incl; |
|
6283
|
|
|
|
|
|
|
|
|
6284
|
50
|
|
|
|
|
112
|
} |
|
6285
|
|
|
|
|
|
|
|
|
6286
|
|
|
|
|
|
|
return \%rest; |
|
6287
|
|
|
|
|
|
|
} |
|
6288
|
|
|
|
|
|
|
|
|
6289
|
|
|
|
|
|
|
my @legal_search_args = ( |
|
6290
|
|
|
|
|
|
|
'rcs!' => '(ignored and deprecated)', |
|
6291
|
|
|
|
|
|
|
'tle!' => '(return TLE data from search (defaults true))', |
|
6292
|
|
|
|
|
|
|
'status=s' => q{('onorbit', 'decayed', or 'all')}, |
|
6293
|
|
|
|
|
|
|
'exclude=s@' => q{('payload', 'debris', 'rocket', ... )}, |
|
6294
|
|
|
|
|
|
|
'include=s@' => q{('payload', 'debris', 'rocket', ... )}, |
|
6295
|
|
|
|
|
|
|
'comment!' => '(include comment in satcat data)', |
|
6296
|
|
|
|
|
|
|
); |
|
6297
|
|
|
|
|
|
|
my %legal_search_status = map {$_ => 1} qw{onorbit decayed all}; |
|
6298
|
0
|
|
|
0
|
|
0
|
|
|
6299
|
|
|
|
|
|
|
sub _get_search_options { |
|
6300
|
|
|
|
|
|
|
return \@legal_search_args; |
|
6301
|
|
|
|
|
|
|
} |
|
6302
|
50
|
|
|
50
|
|
114
|
|
|
6303
|
|
|
|
|
|
|
sub _parse_search_args { |
|
6304
|
50
|
50
|
|
|
|
139
|
my ( $self, @args ) = @_; |
|
6305
|
|
|
|
|
|
|
|
|
6306
|
50
|
|
|
|
|
86
|
my $extra = ARRAY_REF eq ref $args[0] ? shift @args : []; |
|
|
50
|
|
|
|
|
188
|
|
|
6307
|
|
|
|
|
|
|
@args = $self->_parse_retrieve_args( |
|
6308
|
50
|
|
|
|
|
117
|
[ @legal_search_args, @{ $extra } ], @args ); |
|
6309
|
|
|
|
|
|
|
|
|
6310
|
50
|
|
100
|
|
|
202
|
my $opt = $args[0]; |
|
6311
|
|
|
|
|
|
|
|
|
6312
|
50
|
50
|
|
|
|
124
|
$opt->{status} ||= 'onorbit'; |
|
6313
|
|
|
|
|
|
|
|
|
6314
|
0
|
|
|
|
|
0
|
$legal_search_status{$opt->{status}} or Carp::croak <<"EOD"; |
|
|
0
|
|
|
|
|
0
|
|
|
6315
|
|
|
|
|
|
|
Error - Illegal status '$opt->{status}'. You must specify one of |
|
6316
|
|
|
|
|
|
|
@{[join ', ', map {"'$_'"} sort keys %legal_search_status]} |
|
6317
|
50
|
|
|
|
|
97
|
EOD |
|
6318
|
100
|
|
100
|
|
|
377
|
|
|
6319
|
100
|
|
|
|
|
142
|
foreach my $key ( qw{ exclude include } ) { |
|
|
16
|
|
|
|
|
56
|
|
|
|
100
|
|
|
|
|
221
|
|
|
6320
|
100
|
|
|
|
|
182
|
$opt->{$key} ||= []; |
|
|
100
|
|
|
|
|
217
|
|
|
6321
|
19
|
50
|
|
|
|
49
|
$opt->{$key} = [ map { split ',', $_ } @{ $opt->{$key} } ]; |
|
6322
|
|
|
|
|
|
|
foreach ( @{ $opt->{$key} } ) { |
|
6323
|
0
|
|
|
|
|
0
|
$include_map{$_} or Carp::croak <<"EOD"; |
|
|
0
|
|
|
|
|
0
|
|
|
6324
|
|
|
|
|
|
|
Error - Illegal -$key value '$_'. You must specify one or more of |
|
6325
|
|
|
|
|
|
|
@{[join ', ', map {"'$_'"} sort keys %include_map]} |
|
6326
|
|
|
|
|
|
|
EOD |
|
6327
|
|
|
|
|
|
|
} |
|
6328
|
|
|
|
|
|
|
} |
|
6329
|
50
|
100
|
|
|
|
157
|
|
|
6330
|
|
|
|
|
|
|
defined $opt->{tle} |
|
6331
|
50
|
|
|
|
|
157
|
or $opt->{tle} = 1; |
|
6332
|
|
|
|
|
|
|
|
|
6333
|
|
|
|
|
|
|
return @args; |
|
6334
|
|
|
|
|
|
|
} |
|
6335
|
|
|
|
|
|
|
|
|
6336
|
|
|
|
|
|
|
my %search_opts = _extract_keys( \@legal_search_args ); |
|
6337
|
|
|
|
|
|
|
|
|
6338
|
|
|
|
|
|
|
# _remove_search_options |
|
6339
|
|
|
|
|
|
|
# |
|
6340
|
|
|
|
|
|
|
# Shallow clone the argument hash, remove any search arguments from |
|
6341
|
|
|
|
|
|
|
# it, and return a reference to the clone. Used for sanitizing the |
|
6342
|
|
|
|
|
|
|
# options for a search before passing them to retrieve() to actually |
|
6343
|
14
|
|
|
14
|
|
27
|
# get the TLEs. |
|
6344
|
14
|
|
|
|
|
23
|
sub _remove_search_options { |
|
|
14
|
|
|
|
|
77
|
|
|
6345
|
14
|
|
|
|
|
61
|
my ( $opt ) = @_; |
|
6346
|
14
|
|
|
|
|
33
|
my %rslt = %{ $opt }; |
|
6347
|
|
|
|
|
|
|
delete @rslt{ keys %search_opts }; |
|
6348
|
|
|
|
|
|
|
return \%rslt; |
|
6349
|
|
|
|
|
|
|
} |
|
6350
|
|
|
|
|
|
|
} |
|
6351
|
|
|
|
|
|
|
|
|
6352
|
|
|
|
|
|
|
# @keys = _sort_rest_arguments( \%rest_args ); |
|
6353
|
|
|
|
|
|
|
# |
|
6354
|
|
|
|
|
|
|
# This subroutine sorts the argument names in the desired order. |
|
6355
|
|
|
|
|
|
|
# A better way to do this may be to use Unicode::Collate, which |
|
6356
|
|
|
|
|
|
|
# has been core since 5.7.3. |
|
6357
|
|
|
|
|
|
|
|
|
6358
|
|
|
|
|
|
|
{ |
|
6359
|
|
|
|
|
|
|
|
|
6360
|
|
|
|
|
|
|
my %special = map { $_ => 1 } qw{ basicspacedata extendedspacedata }; |
|
6361
|
89
|
|
|
89
|
|
165
|
|
|
6362
|
|
|
|
|
|
|
sub _sort_rest_arguments { |
|
6363
|
89
|
50
|
|
|
|
210
|
my ( $rest_args ) = @_; |
|
6364
|
|
|
|
|
|
|
|
|
6365
|
|
|
|
|
|
|
HASH_REF eq ref $rest_args |
|
6366
|
89
|
|
|
|
|
140
|
or return; |
|
6367
|
|
|
|
|
|
|
|
|
6368
|
89
|
|
|
|
|
205
|
my @rslt; |
|
6369
|
|
|
|
|
|
|
|
|
6370
|
178
|
50
|
|
|
|
321
|
foreach my $key ( keys %special ) { |
|
6371
|
|
|
|
|
|
|
@rslt |
|
6372
|
178
|
50
|
|
|
|
416
|
and Carp::croak "You may not specify both '$rslt[0]' and '$key'"; |
|
6373
|
|
|
|
|
|
|
defined $rest_args->{$key} |
|
6374
|
|
|
|
|
|
|
and push @rslt, $key, $rest_args->{$key}; |
|
6375
|
|
|
|
|
|
|
} |
|
6376
|
567
|
|
|
|
|
1160
|
|
|
6377
|
978
|
|
|
|
|
1570
|
|
|
6378
|
|
|
|
|
|
|
push @rslt, map { ( $_->[0], $rest_args->{$_->[0]} ) } |
|
6379
|
567
|
|
|
|
|
950
|
sort { $a->[1] cmp $b->[1] } |
|
6380
|
567
|
|
|
|
|
1000
|
# Oh, for 5.14 and tr///r |
|
6381
|
89
|
|
|
|
|
163
|
map { [ $_, _swap_upper_and_lower( $_ ) ] } |
|
|
89
|
|
|
|
|
232
|
|
|
6382
|
|
|
|
|
|
|
grep { ! $special{$_} } |
|
6383
|
89
|
|
|
|
|
589
|
keys %{ $rest_args }; |
|
6384
|
|
|
|
|
|
|
|
|
6385
|
|
|
|
|
|
|
return @rslt; |
|
6386
|
|
|
|
|
|
|
} |
|
6387
|
|
|
|
|
|
|
} |
|
6388
|
0
|
|
|
0
|
|
0
|
|
|
6389
|
0
|
|
|
|
|
0
|
sub _spacetrack_v2_response_is_empty { |
|
6390
|
|
|
|
|
|
|
my ( $resp ) = @_; |
|
6391
|
|
|
|
|
|
|
return $resp->content() =~ m/ \A \s* (?: [[] \s* []] )? \s* \z /smx; |
|
6392
|
|
|
|
|
|
|
} |
|
6393
|
0
|
|
|
0
|
|
0
|
|
|
6394
|
|
|
|
|
|
|
sub __readline_completer { |
|
6395
|
0
|
0
|
|
|
|
0
|
my ( $app, $text, $line, $start ) = @_; |
|
6396
|
|
|
|
|
|
|
|
|
6397
|
|
|
|
|
|
|
$start |
|
6398
|
0
|
|
|
|
|
0
|
or return $app->_readline_complete_command( $text ); |
|
6399
|
0
|
|
|
|
|
0
|
|
|
6400
|
|
|
|
|
|
|
my ( $cmd, @cmd_line ) = split $readline_word_break_re, $line, -1; |
|
6401
|
0
|
|
|
|
|
0
|
$cmd = _verb_alias( $cmd ); |
|
6402
|
|
|
|
|
|
|
|
|
6403
|
0
|
0
|
|
|
|
0
|
local $COMPLETION_APP = $app; |
|
6404
|
0
|
|
|
|
|
0
|
|
|
6405
|
|
|
|
|
|
|
if ( my $code = $app->can( "_readline_complete_command_$cmd" ) ) { |
|
6406
|
|
|
|
|
|
|
return $code->( $app, $text, $line, $start, \@cmd_line ); |
|
6407
|
0
|
0
|
0
|
|
|
0
|
} |
|
6408
|
0
|
|
|
|
|
0
|
|
|
6409
|
|
|
|
|
|
|
if ( $text =~ m/ \A - /smx and my $code = $app->can( "_${cmd}_opts") ) { |
|
6410
|
|
|
|
|
|
|
return _readline_complete_options( $code, $text ); |
|
6411
|
|
|
|
|
|
|
} |
|
6412
|
0
|
0
|
|
|
|
0
|
|
|
6413
|
|
|
|
|
|
|
|
|
6414
|
|
|
|
|
|
|
$catalogs{$cmd} |
|
6415
|
0
|
|
|
|
|
0
|
and return $app->_readline_complete_catalog( $text, $cmd ); |
|
6416
|
0
|
0
|
|
|
|
0
|
|
|
|
|
0
|
|
|
|
|
|
|
6417
|
0
|
0
|
|
|
|
0
|
my @files = File::Glob::bsd_glob( "$text*" ); |
|
6418
|
|
|
|
|
|
|
if ( 1 == @files ) { |
|
6419
|
0
|
|
|
|
|
0
|
$files[0] .= -d $files[0] ? '/' : ' '; |
|
6420
|
0
|
0
|
0
|
|
|
0
|
} elsif ( $readline::var_CompleteAddsuffix ) { |
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
6421
|
0
|
|
|
|
|
0
|
foreach ( @files ) { |
|
6422
|
|
|
|
|
|
|
if ( -l $_ ) { |
|
6423
|
0
|
|
|
|
|
0
|
$_ .= '@'; |
|
6424
|
|
|
|
|
|
|
} elsif ( -d $_ ) { |
|
6425
|
0
|
|
|
|
|
0
|
$_ .= '/'; |
|
6426
|
|
|
|
|
|
|
} elsif ( -x _) { |
|
6427
|
0
|
|
|
|
|
0
|
$_ .= '*'; |
|
6428
|
|
|
|
|
|
|
} elsif ( -S _ || -p _ ) { |
|
6429
|
|
|
|
|
|
|
$_ .= '='; |
|
6430
|
|
|
|
|
|
|
} |
|
6431
|
0
|
|
|
|
|
0
|
} |
|
6432
|
0
|
|
|
|
|
0
|
} |
|
6433
|
|
|
|
|
|
|
$readline::rl_completer_terminator_character = ''; |
|
6434
|
|
|
|
|
|
|
return @files; |
|
6435
|
|
|
|
|
|
|
} |
|
6436
|
0
|
|
|
0
|
|
0
|
|
|
6437
|
0
|
|
|
|
|
0
|
sub _readline_complete_catalog { |
|
6438
|
0
|
0
|
|
|
|
0
|
my ( $app, $text, $cat ) = @_; |
|
6439
|
0
|
0
|
|
|
|
0
|
my $this_cat = $catalogs{$cat}; |
|
6440
|
|
|
|
|
|
|
if ( ARRAY_REF eq ref $this_cat ) { |
|
6441
|
0
|
|
|
|
|
0
|
my $code = $app->can( "_${cat}_catalog_version" ) |
|
6442
|
|
|
|
|
|
|
or Carp::confess "Bug - _${cat}_catalog_version() not found"; |
|
6443
|
|
|
|
|
|
|
$this_cat = $this_cat->[ $code->( $app ) ]; |
|
6444
|
|
|
|
|
|
|
} |
|
6445
|
0
|
0
|
0
|
|
|
0
|
defined $text |
|
|
0
|
|
|
|
|
0
|
|
|
6446
|
0
|
|
|
|
|
0
|
and $text ne '' |
|
6447
|
0
|
|
|
|
|
0
|
or return( sort keys %{ $this_cat } ); |
|
|
0
|
|
|
|
|
0
|
|
|
|
0
|
|
|
|
|
0
|
|
|
6448
|
|
|
|
|
|
|
my $re = qr/ \A \Q$text\E /smx; |
|
6449
|
|
|
|
|
|
|
return ( grep { $_ =~ $re } sort keys %{ $this_cat } ) |
|
6450
|
|
|
|
|
|
|
} |
|
6451
|
|
|
|
|
|
|
|
|
6452
|
|
|
|
|
|
|
{ |
|
6453
|
|
|
|
|
|
|
my @builtins; |
|
6454
|
|
|
|
|
|
|
my %disallow = map { $_ => 1 } qw{ |
|
6455
|
|
|
|
|
|
|
can getv import isa new |
|
6456
|
0
|
|
|
0
|
|
0
|
}; |
|
6457
|
0
|
0
|
|
|
|
0
|
sub _readline_complete_command { |
|
6458
|
0
|
|
|
|
|
0
|
my ( $app, $text ) = @_; |
|
6459
|
0
|
|
0
|
|
|
0
|
unless ( @builtins ) { |
|
6460
|
10
|
|
|
10
|
|
98
|
push @builtins, qw{ bye exit show }; |
|
|
10
|
|
|
|
|
33
|
|
|
|
10
|
|
|
|
|
14762
|
|
|
6461
|
0
|
|
|
|
|
0
|
my $stash = ( ref $app || $app ) . '::'; |
|
6462
|
0
|
0
|
|
|
|
0
|
no strict qw{ refs }; |
|
6463
|
|
|
|
|
|
|
foreach my $sym ( keys %$stash ) { |
|
6464
|
0
|
0
|
|
|
|
0
|
$sym =~ m/ \A _ /smx |
|
6465
|
|
|
|
|
|
|
and next; |
|
6466
|
0
|
0
|
|
|
|
0
|
$sym =~ m/ [[:upper:]] /smx |
|
6467
|
|
|
|
|
|
|
and next; |
|
6468
|
0
|
0
|
|
|
|
0
|
$disallow{$sym} |
|
6469
|
|
|
|
|
|
|
and next; |
|
6470
|
0
|
|
|
|
|
0
|
$app->can( $sym ) |
|
6471
|
|
|
|
|
|
|
or next; |
|
6472
|
0
|
|
|
|
|
0
|
push @builtins, $sym; |
|
6473
|
|
|
|
|
|
|
} |
|
6474
|
0
|
|
|
|
|
0
|
@builtins = sort @builtins; |
|
6475
|
0
|
|
|
|
|
0
|
} |
|
|
0
|
|
|
|
|
0
|
|
|
6476
|
0
|
0
|
0
|
|
|
0
|
my $match = qr< \A \Q$text\E >smx; |
|
6477
|
|
|
|
|
|
|
my @rslt = grep { $_ =~ $match } @builtins; |
|
6478
|
|
|
|
|
|
|
1 == @rslt |
|
6479
|
0
|
|
|
|
|
0
|
and $rslt[0] =~ m/ \W \z /smx |
|
6480
|
|
|
|
|
|
|
and $readline::rl_completer_terminator_character = ''; |
|
6481
|
|
|
|
|
|
|
return ( sort @rslt ); |
|
6482
|
|
|
|
|
|
|
} |
|
6483
|
|
|
|
|
|
|
} |
|
6484
|
0
|
|
|
0
|
|
0
|
|
|
6485
|
0
|
0
|
|
|
|
0
|
sub _readline_complete_options { |
|
6486
|
|
|
|
|
|
|
my ( $code, $text ) = @_; |
|
6487
|
|
|
|
|
|
|
$text =~ m/ \A ( --? ) ( .* ) /smx |
|
6488
|
0
|
|
|
|
|
0
|
or return; |
|
6489
|
0
|
|
|
|
|
0
|
# my ( $prefix, $match ) = ( $1, $2 ); |
|
|
0
|
|
|
|
|
0
|
|
|
6490
|
0
|
|
|
|
|
0
|
my $match = $2; |
|
6491
|
0
|
|
|
|
|
0
|
my %lgl = @{ $code->() }; |
|
6492
|
0
|
|
|
|
|
0
|
my $re = qr< \A \Q$match\E >smx; |
|
6493
|
0
|
|
|
|
|
0
|
my @rslt; |
|
6494
|
0
|
0
|
|
|
|
0
|
foreach ( keys %lgl ) { |
|
6495
|
|
|
|
|
|
|
my $type = ''; |
|
6496
|
0
|
|
|
|
|
0
|
( my $o = $_ ) =~ s/ ( [!=?] ) .* //smx |
|
6497
|
|
|
|
|
|
|
and $type = $1; |
|
6498
|
0
|
0
|
|
|
|
0
|
my @names = split qr< \| >smx, $o; |
|
|
0
|
|
|
|
|
0
|
|
|
6499
|
0
|
|
|
|
|
0
|
$type eq q |
|
|
0
|
|
|
|
|
0
|
|
|
|
0
|
|
|
|
|
0
|
|
|
6500
|
|
|
|
|
|
|
and push @names, map { "no-$_" } @names; |
|
6501
|
0
|
|
|
|
|
0
|
push @rslt, map { "--$_" } grep { $_ =~ $re } @names; |
|
6502
|
|
|
|
|
|
|
} |
|
6503
|
|
|
|
|
|
|
return ( sort @rslt ); |
|
6504
|
|
|
|
|
|
|
} |
|
6505
|
10
|
|
|
10
|
|
22
|
|
|
6506
|
10
|
|
|
|
|
14
|
sub _rest_date { |
|
|
10
|
|
|
|
|
56
|
|
|
6507
|
|
|
|
|
|
|
my ( $time ) = @_; |
|
6508
|
|
|
|
|
|
|
return sprintf '%04d-%02d-%02d %02d:%02d:%02d', @{ $time }; |
|
6509
|
|
|
|
|
|
|
} |
|
6510
|
|
|
|
|
|
|
|
|
6511
|
|
|
|
|
|
|
# $swapped = _swap_upper_and_lower( $original ); |
|
6512
|
|
|
|
|
|
|
# |
|
6513
|
|
|
|
|
|
|
# This subroutine swapps upper and lower case in its argument, |
|
6514
|
|
|
|
|
|
|
# using the transliteration operator. It should be used only by |
|
6515
|
|
|
|
|
|
|
# _sort_rest_arguments(). This can go away in favor of tr///r when |
|
6516
|
|
|
|
|
|
|
# (if!) the minimum version becomes 5.14. |
|
6517
|
567
|
|
|
567
|
|
891
|
|
|
6518
|
567
|
|
|
|
|
846
|
sub _swap_upper_and_lower { |
|
6519
|
567
|
|
|
|
|
1417
|
my ( $arg ) = @_; |
|
6520
|
|
|
|
|
|
|
$arg =~ tr/A-Za-z/a-zA-Z/; |
|
6521
|
|
|
|
|
|
|
return $arg; |
|
6522
|
|
|
|
|
|
|
} |
|
6523
|
|
|
|
|
|
|
|
|
6524
|
|
|
|
|
|
|
# _source takes a filename, and returns the contents of the file |
|
6525
|
|
|
|
|
|
|
# as a list. It dies if anything goes wrong. |
|
6526
|
0
|
|
|
0
|
|
0
|
|
|
6527
|
0
|
0
|
|
|
|
0
|
sub _source { |
|
6528
|
|
|
|
|
|
|
my ( undef, $fn ) = @_; # Invocant unused |
|
6529
|
|
|
|
|
|
|
wantarray or die <<'EOD'; |
|
6530
|
0
|
0
|
|
|
|
0
|
Error - _source () called in scalar or no context. This is a bug. |
|
6531
|
|
|
|
|
|
|
EOD |
|
6532
|
|
|
|
|
|
|
defined $fn or die <<'EOD'; |
|
6533
|
0
|
0
|
|
|
|
0
|
Error - No source file name specified. |
|
6534
|
|
|
|
|
|
|
EOD |
|
6535
|
|
|
|
|
|
|
my $fh = IO::File->new ($fn, '<') or die <<"EOD"; |
|
6536
|
|
|
|
|
|
|
Error - Failed to open source file '$fn'. |
|
6537
|
0
|
|
|
|
|
0
|
$! |
|
6538
|
|
|
|
|
|
|
EOD |
|
6539
|
|
|
|
|
|
|
return <$fh>; |
|
6540
|
|
|
|
|
|
|
} |
|
6541
|
|
|
|
|
|
|
|
|
6542
|
|
|
|
|
|
|
# my $string = _stringify_oid_list( $opt, @oids ); |
|
6543
|
|
|
|
|
|
|
# |
|
6544
|
|
|
|
|
|
|
# This subroutine sorts the @oids array, and stringifies it by |
|
6545
|
|
|
|
|
|
|
# eliminating duplicates, combining any consecutive runs of OIDs into |
|
6546
|
|
|
|
|
|
|
# ranges, and joining the result with commas. The string is returned. |
|
6547
|
|
|
|
|
|
|
# |
|
6548
|
|
|
|
|
|
|
# The $opt is a reference to a hash that specifies punctuation in the |
|
6549
|
|
|
|
|
|
|
# stringified result. The keys used are |
|
6550
|
|
|
|
|
|
|
# separator -- The string used to separate OID specifications. The |
|
6551
|
|
|
|
|
|
|
# default is ','. |
|
6552
|
|
|
|
|
|
|
# range_operator -- The string used to specify a range. If omitted, |
|
6553
|
|
|
|
|
|
|
# ranges will not be constructed. |
|
6554
|
|
|
|
|
|
|
# |
|
6555
|
|
|
|
|
|
|
# Note that ranges containing only two OIDs (e.g. 5-6) will be expanded |
|
6556
|
|
|
|
|
|
|
# as "5,6", not "5-6" (presuming $range_operator is '-'). |
|
6557
|
47
|
|
|
47
|
|
124
|
|
|
6558
|
|
|
|
|
|
|
sub _stringify_oid_list { |
|
6559
|
47
|
|
|
|
|
88
|
my ( $opt, @args ) = @_; |
|
6560
|
|
|
|
|
|
|
|
|
6561
|
|
|
|
|
|
|
my @rslt = ( -99 ); # Prime the pump |
|
6562
|
47
|
50
|
|
|
|
97
|
|
|
6563
|
|
|
|
|
|
|
@args |
|
6564
|
47
|
50
|
|
|
|
122
|
or return @args; |
|
6565
|
47
|
|
|
|
|
74
|
|
|
6566
|
|
|
|
|
|
|
my $separator = defined $opt->{separator} ? $opt->{separator} : ','; |
|
6567
|
47
|
50
|
|
|
|
90
|
my $range_operator = $opt->{range_operator}; |
|
6568
|
47
|
|
|
|
|
125
|
|
|
|
201
|
|
|
|
|
275
|
|
|
6569
|
213
|
100
|
|
|
|
356
|
if ( defined $range_operator ) { |
|
6570
|
151
|
100
|
|
|
|
238
|
foreach my $arg ( sort { $a <=> $b } @args ) { |
|
6571
|
147
|
|
|
|
|
218
|
if ( ARRAY_REF eq ref $rslt[-1] ) { |
|
6572
|
|
|
|
|
|
|
if ( $arg == $rslt[-1][1] + 1 ) { |
|
6573
|
4
|
50
|
|
|
|
11
|
$rslt[-1][1] = $arg; |
|
6574
|
|
|
|
|
|
|
} else { |
|
6575
|
|
|
|
|
|
|
$arg > $rslt[-1][1] |
|
6576
|
|
|
|
|
|
|
and push @rslt, $arg; |
|
6577
|
62
|
100
|
|
|
|
146
|
} |
|
6578
|
11
|
|
|
|
|
36
|
} else { |
|
6579
|
|
|
|
|
|
|
if ( $arg == $rslt[-1] + 1 ) { |
|
6580
|
51
|
50
|
|
|
|
154
|
$rslt[-1] = [ $rslt[-1], $arg ]; |
|
6581
|
|
|
|
|
|
|
} else { |
|
6582
|
|
|
|
|
|
|
$arg > $rslt[-1] |
|
6583
|
|
|
|
|
|
|
and push @rslt, $arg; |
|
6584
|
|
|
|
|
|
|
} |
|
6585
|
47
|
|
|
|
|
74
|
} |
|
6586
|
|
|
|
|
|
|
} |
|
6587
|
|
|
|
|
|
|
shift @rslt; # Drop the pump priming. |
|
6588
|
47
|
|
|
|
|
93
|
|
|
6589
|
|
|
|
|
|
|
return join( $separator, |
|
6590
|
|
|
|
|
|
|
map { ref $_ ? |
|
6591
|
55
|
100
|
|
|
|
297
|
$_->[1] > $_->[0] + 1 ? |
|
|
1
|
100
|
|
|
|
6
|
|
|
6592
|
|
|
|
|
|
|
"$_->[0]$range_operator$_->[1]" : |
|
6593
|
|
|
|
|
|
|
@{ $_ } : |
|
6594
|
|
|
|
|
|
|
$_ |
|
6595
|
|
|
|
|
|
|
} @rslt |
|
6596
|
|
|
|
|
|
|
); |
|
6597
|
0
|
|
|
|
|
0
|
|
|
|
0
|
|
|
|
|
0
|
|
|
6598
|
|
|
|
|
|
|
} else { |
|
6599
|
|
|
|
|
|
|
return join $separator, sort { $a <=> $b } @args; |
|
6600
|
|
|
|
|
|
|
} |
|
6601
|
|
|
|
|
|
|
|
|
6602
|
|
|
|
|
|
|
} |
|
6603
|
|
|
|
|
|
|
|
|
6604
|
|
|
|
|
|
|
eval { |
|
6605
|
|
|
|
|
|
|
require Time::HiRes; |
|
6606
|
|
|
|
|
|
|
*_sleep = \&Time::HiRes::sleep; |
|
6607
|
|
|
|
|
|
|
*_time = \&Time::HiRes::time; |
|
6608
|
|
|
|
|
|
|
1; |
|
6609
|
|
|
|
|
|
|
} or do { |
|
6610
|
|
|
|
|
|
|
*_sleep = sub { |
|
6611
|
|
|
|
|
|
|
return sleep $_[0]; |
|
6612
|
|
|
|
|
|
|
}; |
|
6613
|
|
|
|
|
|
|
*_time = sub { |
|
6614
|
|
|
|
|
|
|
return time; |
|
6615
|
|
|
|
|
|
|
}; |
|
6616
|
|
|
|
|
|
|
}; |
|
6617
|
|
|
|
|
|
|
|
|
6618
|
|
|
|
|
|
|
# _trim replaces undefined arguments with '', trims all arguments |
|
6619
|
|
|
|
|
|
|
# front and back, and returns the modified arguments. |
|
6620
|
5
|
|
|
5
|
|
19
|
|
|
6621
|
5
|
|
|
|
|
18
|
sub _trim { |
|
6622
|
5
|
50
|
|
|
|
20
|
my @args = @_; |
|
6623
|
5
|
|
|
|
|
22
|
foreach ( @args ) { |
|
6624
|
5
|
|
|
|
|
22
|
defined $_ or $_ = ''; |
|
6625
|
|
|
|
|
|
|
s/ \A \s+ //smx; |
|
6626
|
5
|
|
|
|
|
22
|
s/ \s+ \z //smx; |
|
6627
|
|
|
|
|
|
|
} |
|
6628
|
|
|
|
|
|
|
return @args; |
|
6629
|
|
|
|
|
|
|
} |
|
6630
|
|
|
|
|
|
|
|
|
6631
|
|
|
|
|
|
|
1; |
|
6632
|
|
|
|
|
|
|
|
|
6633
|
|
|
|
|
|
|
__END__ |