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
|
|
81308
|
use 5.006002; |
|
10
|
|
|
|
|
92
|
|
123
|
|
|
|
|
|
|
|
124
|
10
|
|
|
10
|
|
66
|
use strict; |
|
10
|
|
|
|
|
19
|
|
|
10
|
|
|
|
|
228
|
|
125
|
10
|
|
|
10
|
|
58
|
use warnings; |
|
10
|
|
|
|
|
29
|
|
|
10
|
|
|
|
|
298
|
|
126
|
|
|
|
|
|
|
|
127
|
10
|
|
|
10
|
|
55
|
use Exporter; |
|
10
|
|
|
|
|
18
|
|
|
10
|
|
|
|
|
1761
|
|
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
our @ISA = qw{ Exporter }; |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
our $VERSION = '0.161_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
|
|
90
|
use Carp (); |
|
10
|
|
|
|
|
24
|
|
|
10
|
|
|
|
|
324
|
|
151
|
10
|
|
|
10
|
|
7881
|
use Getopt::Long 2.39; |
|
10
|
|
|
|
|
126766
|
|
|
10
|
|
|
|
|
272
|
|
152
|
10
|
|
|
10
|
|
6133
|
use HTTP::Date (); |
|
10
|
|
|
|
|
54570
|
|
|
10
|
|
|
|
|
2013
|
|
153
|
10
|
|
|
10
|
|
4360
|
use HTTP::Request; |
|
10
|
|
|
|
|
208654
|
|
|
10
|
|
|
|
|
357
|
|
154
|
10
|
|
|
10
|
|
4909
|
use HTTP::Response; |
|
10
|
|
|
|
|
73735
|
|
|
10
|
|
|
|
|
472
|
|
155
|
10
|
|
|
|
|
1625
|
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
|
|
69
|
}; |
|
10
|
|
|
|
|
21
|
|
167
|
10
|
|
|
10
|
|
5308
|
use IO::File; |
|
10
|
|
|
|
|
87371
|
|
|
10
|
|
|
|
|
1067
|
|
168
|
10
|
|
|
10
|
|
7075
|
use IO::Uncompress::Unzip (); |
|
10
|
|
|
|
|
573724
|
|
|
10
|
|
|
|
|
289
|
|
169
|
10
|
|
|
10
|
|
6953
|
use JSON qw{}; |
|
10
|
|
|
|
|
101517
|
|
|
10
|
|
|
|
|
260
|
|
170
|
10
|
|
|
10
|
|
71
|
use List::Util (); |
|
10
|
|
|
|
|
25
|
|
|
10
|
|
|
|
|
175
|
|
171
|
10
|
|
|
10
|
|
7197
|
use LWP::UserAgent; # Not in the base. |
|
10
|
|
|
|
|
165717
|
|
|
10
|
|
|
|
|
342
|
|
172
|
10
|
|
|
10
|
|
74
|
use POSIX (); |
|
10
|
|
|
|
|
33
|
|
|
10
|
|
|
|
|
213
|
|
173
|
10
|
|
|
10
|
|
51
|
use Scalar::Util 1.07 (); |
|
10
|
|
|
|
|
282
|
|
|
10
|
|
|
|
|
236
|
|
174
|
10
|
|
|
10
|
|
5052
|
use Text::ParseWords (); |
|
10
|
|
|
|
|
13159
|
|
|
10
|
|
|
|
|
255
|
|
175
|
10
|
|
|
10
|
|
74
|
use Time::Local (); |
|
10
|
|
|
|
|
25
|
|
|
10
|
|
|
|
|
173
|
|
176
|
10
|
|
|
10
|
|
51
|
use URI qw{}; |
|
10
|
|
|
|
|
21
|
|
|
10
|
|
|
|
|
488
|
|
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
|
|
64
|
use constant COPACETIC => 'OK'; |
|
10
|
|
|
|
|
20
|
|
|
10
|
|
|
|
|
781
|
|
186
|
10
|
|
|
|
|
648
|
use constant BAD_SPACETRACK_RESPONSE => |
187
|
10
|
|
|
10
|
|
70
|
'Unable to parse SpaceTrack response'; |
|
10
|
|
|
|
|
23
|
|
188
|
10
|
|
|
|
|
486
|
use constant INVALID_CATALOG => |
189
|
10
|
|
|
10
|
|
65
|
'Catalog name %s invalid. Legal names are %s.'; |
|
10
|
|
|
|
|
18
|
|
190
|
10
|
|
|
10
|
|
60
|
use constant LAPSED_FUNDING => 'Funding lapsed.'; |
|
10
|
|
|
|
|
37
|
|
|
10
|
|
|
|
|
531
|
|
191
|
10
|
|
|
10
|
|
93
|
use constant LOGIN_FAILED => 'Login failed'; |
|
10
|
|
|
|
|
43
|
|
|
10
|
|
|
|
|
607
|
|
192
|
10
|
|
|
10
|
|
65
|
use constant NO_CREDENTIALS => 'Username or password not specified.'; |
|
10
|
|
|
|
|
20
|
|
|
10
|
|
|
|
|
519
|
|
193
|
10
|
|
|
10
|
|
62
|
use constant NO_CAT_ID => 'No catalog IDs specified.'; |
|
10
|
|
|
|
|
18
|
|
|
10
|
|
|
|
|
450
|
|
194
|
10
|
|
|
10
|
|
65
|
use constant NO_OBJ_NAME => 'No object name specified.'; |
|
10
|
|
|
|
|
20
|
|
|
10
|
|
|
|
|
555
|
|
195
|
10
|
|
|
10
|
|
65
|
use constant NO_RECORDS => 'No records found.'; |
|
10
|
|
|
|
|
22
|
|
|
10
|
|
|
|
|
475
|
|
196
|
|
|
|
|
|
|
|
197
|
10
|
|
|
10
|
|
58
|
use constant SESSION_PATH => '/'; |
|
10
|
|
|
|
|
47
|
|
|
10
|
|
|
|
|
642
|
|
198
|
|
|
|
|
|
|
|
199
|
10
|
|
|
10
|
|
74
|
use constant DEFAULT_SPACE_TRACK_REST_SEARCH_CLASS => 'satcat'; |
|
10
|
|
|
|
|
20
|
|
|
10
|
|
|
|
|
654
|
|
200
|
10
|
|
|
10
|
|
74
|
use constant DEFAULT_SPACE_TRACK_VERSION => 2; |
|
10
|
|
|
|
|
20
|
|
|
10
|
|
|
|
|
515
|
|
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
# dump_headers constants. |
203
|
10
|
|
|
10
|
|
80
|
use constant DUMP_NONE => 0; # No dump |
|
10
|
|
|
|
|
31
|
|
|
10
|
|
|
|
|
519
|
|
204
|
10
|
|
|
10
|
|
57
|
use constant DUMP_TRACE => 0x01; # Logic trace |
|
10
|
|
|
|
|
19
|
|
|
10
|
|
|
|
|
489
|
|
205
|
10
|
|
|
10
|
|
70
|
use constant DUMP_REQUEST => 0x02; # Request content |
|
10
|
|
|
|
|
18
|
|
|
10
|
|
|
|
|
446
|
|
206
|
10
|
|
|
10
|
|
52
|
use constant DUMP_DRY_RUN => 0x04; # Do not execute request |
|
10
|
|
|
|
|
26
|
|
|
10
|
|
|
|
|
487
|
|
207
|
10
|
|
|
10
|
|
60
|
use constant DUMP_COOKIE => 0x08; # Dump cookies. |
|
10
|
|
|
|
|
30
|
|
|
10
|
|
|
|
|
470
|
|
208
|
10
|
|
|
10
|
|
63
|
use constant DUMP_RESPONSE => 0x10; # Dump response. |
|
10
|
|
|
|
|
18
|
|
|
10
|
|
|
|
|
446
|
|
209
|
10
|
|
|
10
|
|
76
|
use constant DUMP_TRUNCATED => 0x20; # Dump with truncated content |
|
10
|
|
|
|
|
19
|
|
|
10
|
|
|
|
|
1161
|
|
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
|
|
79
|
use constant ARRAY_REF => ref []; |
|
10
|
|
|
|
|
17
|
|
|
10
|
|
|
|
|
749
|
|
220
|
10
|
|
|
10
|
|
65
|
use constant CODE_REF => ref sub {}; |
|
10
|
|
|
|
|
24
|
|
|
10
|
|
|
|
|
538
|
|
221
|
10
|
|
|
10
|
|
60
|
use constant HASH_REF => ref {}; |
|
10
|
|
|
|
|
27
|
|
|
10
|
|
|
|
|
779
|
|
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
|
|
|
|
|
599
|
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
|
|
68
|
]; |
|
10
|
|
|
|
|
19
|
|
237
|
|
|
|
|
|
|
|
238
|
10
|
|
|
|
|
710
|
use constant CELESTRAK_API_OPTIONS => [ |
239
|
|
|
|
|
|
|
'query=s', 'query type', |
240
|
|
|
|
|
|
|
'format=s', 'data format', |
241
|
10
|
|
|
10
|
|
71
|
]; |
|
10
|
|
|
|
|
42
|
|
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
use constant CELESTRAK_OPTIONS => [ |
244
|
10
|
|
|
|
|
22
|
@{ CLASSIC_RETRIEVE_OPTIONS() }, # TODO deprecate and remove |
245
|
10
|
|
|
|
|
25
|
@{ CELESTRAK_API_OPTIONS() }, |
|
10
|
|
|
|
|
767
|
|
246
|
10
|
|
|
10
|
|
88
|
]; |
|
10
|
|
|
|
|
22
|
|
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
use constant CELESTRAK_SUPPLEMENTAL_VALID_QUERY => { |
249
|
10
|
|
|
10
|
|
74
|
map { $_ => 1 } qw{ CATNR INTDES SOURCE NAME SPECIAL FILE } }; |
|
10
|
|
|
|
|
18
|
|
|
10
|
|
|
|
|
23
|
|
|
60
|
|
|
|
|
901
|
|
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
use constant CELESTRAK_VALID_QUERY => { |
252
|
10
|
|
|
10
|
|
65
|
map { $_ => 1 } qw{ CATNR INTDES GROUP NAME SPECIAL } }; |
|
10
|
|
|
|
|
20
|
|
|
10
|
|
|
|
|
23
|
|
|
50
|
|
|
|
|
58971
|
|
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
|
2199
|
my ( $class, %arg ) = @_; |
725
|
10
|
50
|
|
|
|
60
|
$class = ref $class if ref $class; |
726
|
|
|
|
|
|
|
|
727
|
10
|
|
|
|
|
228
|
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
|
|
|
|
|
44
|
bless $self, $class; |
765
|
|
|
|
|
|
|
|
766
|
10
|
|
|
|
|
78
|
$self->set( identity => delete $arg{identity} ); |
767
|
|
|
|
|
|
|
|
768
|
|
|
|
|
|
|
$ENV{SPACETRACK_OPT} and |
769
|
10
|
50
|
|
|
|
51
|
$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
|
|
|
|
66
|
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
|
|
|
|
|
40
|
$self->set( identity => undef ); |
785
|
|
|
|
|
|
|
} |
786
|
|
|
|
|
|
|
|
787
|
|
|
|
|
|
|
defined $ENV{SPACETRACK_VERIFY_HOSTNAME} |
788
|
|
|
|
|
|
|
and $self->set( verify_hostname => |
789
|
10
|
50
|
|
|
|
58
|
$ENV{SPACETRACK_VERIFY_HOSTNAME} ); |
790
|
|
|
|
|
|
|
|
791
|
10
|
100
|
|
|
|
55
|
keys %arg |
792
|
|
|
|
|
|
|
and $self->set( %arg ); |
793
|
|
|
|
|
|
|
|
794
|
10
|
|
|
|
|
284
|
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
|
|
4
|
'file=s' => 'Name of cache file', |
857
|
|
|
|
|
|
|
]; |
858
|
|
|
|
|
|
|
} |
859
|
|
|
|
|
|
|
|
860
|
|
|
|
|
|
|
sub amsat { |
861
|
1
|
|
|
1
|
1
|
5
|
my ( $self, @args ) = @_; |
862
|
|
|
|
|
|
|
|
863
|
1
|
|
|
|
|
4
|
( my $opt, @args ) = _parse_args( @args ); |
864
|
|
|
|
|
|
|
|
865
|
|
|
|
|
|
|
return $self->_get_from_net( |
866
|
1
|
|
|
|
|
11
|
%{ $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
|
|
27
|
my ( $self, $resp ) = @_; |
871
|
1
|
50
|
|
|
|
4
|
unless ( $self->{with_name} ) { |
872
|
1
|
|
|
|
|
33
|
my @content = split qr{ \015? \012 }smx, |
873
|
|
|
|
|
|
|
$resp->content(); |
874
|
1
|
50
|
|
|
|
694
|
@content % 3 |
875
|
|
|
|
|
|
|
and return HTTP::Response->new( |
876
|
|
|
|
|
|
|
HTTP_PRECONDITION_FAILED, |
877
|
|
|
|
|
|
|
'Response does not contain a multiple of 3 lines' ); |
878
|
1
|
|
|
|
|
4
|
my $ct = ''; |
879
|
1
|
|
|
|
|
3
|
while ( @content ) { |
880
|
192
|
|
|
|
|
310
|
shift @content; |
881
|
192
|
|
|
|
|
253
|
$ct .= join '', map { "$_\n" } splice @content, 0, 2; |
|
384
|
|
|
|
|
853
|
|
882
|
|
|
|
|
|
|
} |
883
|
1
|
|
|
|
|
67
|
$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
|
|
|
|
|
22
|
return $resp; |
889
|
|
|
|
|
|
|
}, |
890
|
1
|
|
|
|
|
2
|
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
|
3
|
my ( $self ) = @_; |
904
|
1
|
|
|
|
|
14
|
my @keys = grep { ! { |
905
|
|
|
|
|
|
|
url_iridium_status_mccants => 1, |
906
|
26
|
|
|
|
|
58
|
}->{$_} } sort keys %mutator; |
907
|
1
|
50
|
|
|
|
18
|
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
|
3
|
my $self = shift; |
934
|
1
|
|
33
|
|
|
6
|
$perl_version ||= do { |
935
|
1
|
50
|
|
|
|
16
|
$] >= 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
|
|
|
|
|
12
|
@{[__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
|
|
|
10
|
@{[$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
|
|
9
|
'json!' => 'Return data in JSON format', |
1026
|
|
|
|
|
|
|
'format=s' => 'Specify return format', |
1027
|
|
|
|
|
|
|
]; |
1028
|
|
|
|
|
|
|
} |
1029
|
|
|
|
|
|
|
|
1030
|
|
|
|
|
|
|
sub box_score { |
1031
|
2
|
|
|
2
|
1
|
1027
|
my ( $self, @args ) = @_; |
1032
|
|
|
|
|
|
|
|
1033
|
2
|
|
|
|
|
9
|
( my $opt, @args ) = _parse_args( @args ); |
1034
|
2
|
|
|
|
|
10
|
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
|
|
|
|
8
|
$resp->is_success() |
1042
|
|
|
|
|
|
|
or return $resp; |
1043
|
|
|
|
|
|
|
|
1044
|
1
|
|
|
|
|
12
|
$self->_add_pragmata($resp, |
1045
|
|
|
|
|
|
|
'spacetrack-type' => 'box_score', |
1046
|
|
|
|
|
|
|
'spacetrack-source' => 'spacetrack', |
1047
|
|
|
|
|
|
|
'spacetrack-interface' => 2, |
1048
|
|
|
|
|
|
|
); |
1049
|
|
|
|
|
|
|
|
1050
|
1
|
50
|
|
|
|
3
|
'json' eq $format |
1051
|
|
|
|
|
|
|
or return $resp; |
1052
|
|
|
|
|
|
|
|
1053
|
1
|
|
|
|
|
4
|
my $data; |
1054
|
|
|
|
|
|
|
|
1055
|
1
|
50
|
|
|
|
4
|
if ( ! $opt->{json} ) { |
1056
|
|
|
|
|
|
|
|
1057
|
1
|
|
|
|
|
4
|
$data = $self->_get_json_object()->decode( $resp->content() ); |
1058
|
|
|
|
|
|
|
|
1059
|
1
|
|
|
|
|
122
|
my $content; |
1060
|
1
|
|
|
|
|
10
|
foreach my $row ( @head ) { |
1061
|
2
|
|
|
|
|
5
|
$content .= join( "\t", @{ $row } ) . "\n"; |
|
2
|
|
|
|
|
15
|
|
1062
|
|
|
|
|
|
|
} |
1063
|
1
|
|
|
|
|
4
|
foreach my $datum ( @{ $data } ) { |
|
1
|
|
|
|
|
3
|
|
1064
|
|
|
|
|
|
|
defined $datum->{SPADOC_CD} |
1065
|
|
|
|
|
|
|
and $datum->{SPADOC_CD} eq 'ALL' |
1066
|
100
|
50
|
33
|
|
|
231
|
and $datum->{SPADOC_CD} = 'Total'; |
1067
|
|
|
|
|
|
|
$content .= join( "\t", map { |
1068
|
100
|
50
|
|
|
|
144
|
defined $datum->{$_} ? $datum->{$_} : '' |
|
1000
|
|
|
|
|
1853
|
|
1069
|
|
|
|
|
|
|
} @fields ) . "\n"; |
1070
|
|
|
|
|
|
|
} |
1071
|
|
|
|
|
|
|
|
1072
|
1
|
|
|
|
|
7
|
$resp = HTTP::Response->new (HTTP_OK, undef, undef, $content); |
1073
|
|
|
|
|
|
|
} |
1074
|
|
|
|
|
|
|
|
1075
|
|
|
|
|
|
|
wantarray |
1076
|
1
|
50
|
|
|
|
89
|
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
|
11
|
my ($self, @args) = @_; |
1197
|
3
|
|
|
|
|
12
|
delete $self->{_pragmata}; |
1198
|
|
|
|
|
|
|
|
1199
|
3
|
|
|
|
|
15
|
( my $opt, @args ) = _parse_args( CELESTRAK_OPTIONS, @args ); |
1200
|
|
|
|
|
|
|
|
1201
|
3
|
|
|
|
|
9
|
my $name = shift @args; |
1202
|
3
|
50
|
|
|
|
13
|
defined $name |
1203
|
|
|
|
|
|
|
or return HTTP::Response->new( |
1204
|
|
|
|
|
|
|
HTTP_PRECONDITION_FAILED, |
1205
|
|
|
|
|
|
|
'No catalog name specified' ); |
1206
|
|
|
|
|
|
|
|
1207
|
3
|
|
|
|
|
14
|
$self->_deprecation_notice( celestrak => $name ); |
1208
|
3
|
|
|
|
|
6
|
$self->_deprecation_notice( celestrak => "--$_" ) foreach sort keys %{ $opt }; |
|
3
|
|
|
|
|
13
|
|
1209
|
|
|
|
|
|
|
|
1210
|
3
|
|
|
|
|
8
|
my $query; |
1211
|
|
|
|
|
|
|
ref( $query = $self->_celestrak_validate_query( |
1212
|
3
|
50
|
|
|
|
16
|
delete $opt->{query}, $name, |
1213
|
|
|
|
|
|
|
CELESTRAK_VALID_QUERY, 'GROUP' ) ) |
1214
|
|
|
|
|
|
|
and return $query; |
1215
|
|
|
|
|
|
|
|
1216
|
3
|
|
|
|
|
6
|
my $format; |
1217
|
|
|
|
|
|
|
ref( $format = $self->_celestrak_validate_format( |
1218
|
3
|
50
|
|
|
|
14
|
delete $opt->{format} ) ) |
1219
|
|
|
|
|
|
|
and return $format; |
1220
|
|
|
|
|
|
|
|
1221
|
3
|
|
|
|
|
20
|
my $uri = URI->new( 'https://celestrak.org/NORAD/elements/gp.php' ); |
1222
|
3
|
|
|
|
|
345
|
$uri->query_form( |
1223
|
|
|
|
|
|
|
$query => $name, |
1224
|
|
|
|
|
|
|
FORMAT => $format, |
1225
|
|
|
|
|
|
|
); |
1226
|
|
|
|
|
|
|
|
1227
|
|
|
|
|
|
|
return $self->_get_from_net( |
1228
|
3
|
|
|
|
|
26
|
%{ $opt }, |
1229
|
|
|
|
|
|
|
url => $uri, |
1230
|
|
|
|
|
|
|
post_process => sub { |
1231
|
3
|
|
|
3
|
|
73
|
my ( $self, $resp ) = @_; |
1232
|
3
|
|
|
|
|
8
|
my $check; |
1233
|
3
|
100
|
|
|
|
20
|
$check = $self->_celestrak_response_check( $resp, |
1234
|
|
|
|
|
|
|
celestrak => $name ) |
1235
|
|
|
|
|
|
|
and return $check; |
1236
|
2
|
100
|
|
|
|
13
|
$name eq 'iridium' |
1237
|
|
|
|
|
|
|
and _celestrak_repack_iridium( $resp ); |
1238
|
2
|
|
|
|
|
6
|
return $resp; |
1239
|
|
|
|
|
|
|
}, |
1240
|
3
|
|
|
|
|
328
|
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
|
|
6
|
@{ CELESTRAK_API_OPTIONS() }, |
|
2
|
|
|
|
|
18
|
|
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
|
9
|
my ( $self, @args ) = @_; |
1399
|
2
|
|
|
|
|
14
|
( my $opt, @args ) = _parse_args( @args ); |
1400
|
|
|
|
|
|
|
|
1401
|
|
|
|
|
|
|
$opt->{rms} |
1402
|
|
|
|
|
|
|
and $opt->{match} |
1403
|
2
|
50
|
66
|
|
|
14
|
and return HTTP::Response->new( |
1404
|
|
|
|
|
|
|
HTTP_PRECONDITION_FAILED, |
1405
|
|
|
|
|
|
|
'You may not assert both --rms and --match', |
1406
|
|
|
|
|
|
|
); |
1407
|
|
|
|
|
|
|
|
1408
|
2
|
100
|
66
|
|
|
15
|
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
|
|
|
|
|
10
|
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
|
|
|
|
|
8
|
my $base_url = 'https://celestrak.org/NORAD/elements/supplemental'; |
1431
|
|
|
|
|
|
|
|
1432
|
2
|
|
|
|
|
4
|
my ( $spacetrack_type, $uri ); |
1433
|
|
|
|
|
|
|
|
1434
|
2
|
100
|
|
|
|
9
|
if ( $opt->{rms} ) { |
|
|
50
|
|
|
|
|
|
1435
|
1
|
|
|
|
|
3
|
$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
|
|
|
|
|
3
|
my $source = $info->{source}; |
1444
|
1
|
50
|
|
|
|
4
|
defined $source |
1445
|
|
|
|
|
|
|
or $source = $name; |
1446
|
|
|
|
|
|
|
|
1447
|
1
|
|
|
|
|
3
|
my $query; |
1448
|
|
|
|
|
|
|
ref( $query = $self->_celestrak_validate_query( |
1449
|
1
|
50
|
|
|
|
6
|
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
|
|
|
|
5
|
delete $opt->{format} ) ) |
1456
|
|
|
|
|
|
|
and return $format; |
1457
|
|
|
|
|
|
|
|
1458
|
1
|
|
|
|
|
11
|
$uri = URI->new( "$base_url/sup-gp.php" ); |
1459
|
1
|
|
|
|
|
116
|
$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
|
|
47
|
my ( $self, $resp ) = @_; |
1470
|
2
|
|
|
|
|
9
|
my $check; |
1471
|
2
|
50
|
|
|
|
15
|
$check = $self->_celestrak_response_check( $resp, |
1472
|
|
|
|
|
|
|
celestrak_supplemental => $name ) |
1473
|
|
|
|
|
|
|
and return $check; |
1474
|
2
|
|
|
|
|
8
|
return $resp; |
1475
|
|
|
|
|
|
|
}, |
1476
|
2
|
|
|
|
|
222
|
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
|
|
14
|
my ( $self, $format ) = @_; |
1486
|
4
|
50
|
|
|
|
15
|
$format = defined $format ? uc( $format ) : 'TLE'; |
1487
|
4
|
50
|
|
|
|
18
|
$valid_format{$format} |
1488
|
|
|
|
|
|
|
or return HTTP::Response->new( |
1489
|
|
|
|
|
|
|
HTTP_PRECONDITION_FAILED, |
1490
|
|
|
|
|
|
|
"Format '$format' is not valid" ); |
1491
|
4
|
50
|
33
|
|
|
14
|
$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
|
|
14
|
my ( undef, $query, $name, $valid, $dflt ) = @_; |
1500
|
4
|
50
|
|
|
|
38
|
$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
|
|
|
|
17
|
defined $query |
1505
|
|
|
|
|
|
|
or return $query; |
1506
|
4
|
50
|
|
|
|
19
|
$valid->{$query} |
1507
|
|
|
|
|
|
|
or return HTTP::Response->new( |
1508
|
|
|
|
|
|
|
HTTP_PRECONDITION_FAILED, |
1509
|
|
|
|
|
|
|
"Query '$query' is not valid" ); |
1510
|
4
|
|
|
|
|
20
|
return $query; |
1511
|
|
|
|
|
|
|
} |
1512
|
|
|
|
|
|
|
|
1513
|
|
|
|
|
|
|
sub _celestrak_repack_iridium { |
1514
|
1
|
|
|
1
|
|
4
|
my ( $resp ) = @_; |
1515
|
1
|
|
|
|
|
7
|
local $_ = $resp->content(); |
1516
|
1
|
|
|
|
|
124
|
s/ \s+ [[] . []] [ \t]* (?= \r? \n | \z ) //smxg; |
1517
|
1
|
|
|
|
|
7
|
$resp->content( $_ ); |
1518
|
1
|
|
|
|
|
28
|
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
|
|
24
|
my ($self, $resp, $source, $name, @args) = @_; |
1528
|
5
|
50
|
|
|
|
19
|
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
|
|
|
|
55
|
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
|
|
|
|
632
|
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
|
|
|
|
|
295
|
foreach my $type ( _trim( split ',', $type ) ) { |
1552
|
5
|
|
|
|
|
33
|
$type =~ s/ ; .* //smx; |
1553
|
5
|
50
|
|
|
|
26
|
$valid_type{$type} |
1554
|
|
|
|
|
|
|
or next; |
1555
|
5
|
|
|
|
|
34
|
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
|
|
|
|
3027
|
m/^No GP data found\b/sm |
1560
|
|
|
|
|
|
|
and last; |
1561
|
|
|
|
|
|
|
# As of July 25 2022 Celestrak does this. |
1562
|
5
|
100
|
|
|
|
44
|
m/^(?:GROUP|FILE) "[^"]+" does not exist/sm |
1563
|
|
|
|
|
|
|
and last; |
1564
|
4
|
|
|
|
|
23
|
return; |
1565
|
|
|
|
|
|
|
} |
1566
|
1
|
|
|
|
|
8
|
my $msg = "Content-Type: $type"; |
1567
|
1
|
50
|
|
|
|
9
|
@args and $msg = "@args; $msg"; |
1568
|
1
|
|
|
|
|
12
|
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
|
5
|
$_[2] = 'spacetrack-cache-hit'; |
1588
|
1
|
|
|
|
|
4
|
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
|
111
|
$_[2] = 'spacetrack-source'; |
1633
|
37
|
|
|
|
|
126
|
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
|
1044
|
$_[2] = 'spacetrack-type'; |
1669
|
38
|
|
|
|
|
157
|
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
|
54
|
$_[2] = 'spacetrack-interface'; |
1693
|
22
|
|
|
|
|
70
|
goto &_get_pragma_value; |
1694
|
|
|
|
|
|
|
} |
1695
|
|
|
|
|
|
|
|
1696
|
|
|
|
|
|
|
sub _get_pragma_value { |
1697
|
98
|
|
|
98
|
|
224
|
my ( $self, $resp, $pragma ) = @_; |
1698
|
|
|
|
|
|
|
defined $resp |
1699
|
98
|
100
|
|
|
|
746
|
or return $self->{_pragmata}{$pragma}; |
1700
|
5
|
|
|
|
|
17
|
( my $re = $pragma ) =~ s/ _ /-/smxg; |
1701
|
5
|
|
|
|
|
71
|
$re = qr{ \Q$re\E }smxi; |
1702
|
5
|
|
|
|
|
25
|
foreach ( $resp->header( 'Pragma' ) ) { |
1703
|
3
|
100
|
|
|
|
184
|
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
|
|
|
|
|
146
|
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
|
|
|
|
|
5
|
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
|
|
|
|
5
|
$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
|
|
|
|
7
|
'json' eq $format |
1773
|
|
|
|
|
|
|
or return $resp; |
1774
|
|
|
|
|
|
|
|
1775
|
1
|
|
|
|
|
4
|
my $json = $self->_get_json_object(); |
1776
|
|
|
|
|
|
|
|
1777
|
1
|
|
|
|
|
4
|
my $data = $json->decode( $resp->content() ); |
1778
|
|
|
|
|
|
|
|
1779
|
1
|
|
|
|
|
100
|
my %dict; |
1780
|
1
|
|
|
|
|
2
|
foreach my $datum ( @{ $data } ) { |
|
1
|
|
|
|
|
5
|
|
1781
|
|
|
|
|
|
|
defined $datum->{SPADOC_CD} |
1782
|
100
|
50
|
|
|
|
202
|
and $dict{$datum->{SPADOC_CD}} = $datum->{COUNTRY}; |
1783
|
|
|
|
|
|
|
} |
1784
|
|
|
|
|
|
|
|
1785
|
1
|
50
|
|
|
|
6
|
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
|
|
|
|
|
47
|
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
|
|
4
|
'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
|
|
|
|
|
2
|
delete $self->{_pragmata}; |
1843
|
|
|
|
|
|
|
|
1844
|
1
|
|
|
|
|
3
|
( my $opt, @args ) = _parse_args( @args ); |
1845
|
|
|
|
|
|
|
|
1846
|
|
|
|
|
|
|
@args |
1847
|
1
|
50
|
33
|
|
|
6
|
and defined $args[0] |
1848
|
|
|
|
|
|
|
or Carp::croak 'Must specify a favorite'; |
1849
|
1
|
50
|
|
|
|
4
|
@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
|
|
|
|
|
4
|
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
|
|
|
|
|
4
|
my $resp = $self->spacetrack_query_v2( |
1859
|
|
|
|
|
|
|
basicspacedata => 'query', |
1860
|
|
|
|
|
|
|
_sort_rest_arguments( $rest ) |
1861
|
|
|
|
|
|
|
); |
1862
|
|
|
|
|
|
|
|
1863
|
1
|
50
|
|
|
|
6
|
$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
|
|
|
|
|
5
|
my ( $opt, $file ) = $self->_parse_retrieve_args( @args ); |
1919
|
|
|
|
|
|
|
|
1920
|
1
|
|
|
|
|
6
|
delete $self->{_pragmata}; |
1921
|
|
|
|
|
|
|
|
1922
|
1
|
50
|
|
|
|
8
|
if ( ! Scalar::Util::openhandle( $file ) ) { |
1923
|
1
|
50
|
|
|
|
23
|
-e $file or return HTTP::Response->new ( |
1924
|
|
|
|
|
|
|
HTTP_NOT_FOUND, "Can't find file $file"); |
1925
|
1
|
50
|
|
|
|
10
|
my $fh = IO::File->new($file, '<') or |
1926
|
|
|
|
|
|
|
return HTTP::Response->new ( |
1927
|
|
|
|
|
|
|
HTTP_INTERNAL_SERVER_ERROR, "Can't open $file: $!"); |
1928
|
1
|
|
|
|
|
138
|
$file = $fh; |
1929
|
|
|
|
|
|
|
} |
1930
|
|
|
|
|
|
|
|
1931
|
1
|
|
|
|
|
5
|
local $/ = undef; |
1932
|
1
|
|
|
|
|
53
|
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
|
|
|
16
|
my $code = $self->can( "_get_attr_$name" ) || $self->can( 'getv' ); |
1969
|
1
|
|
|
|
|
4
|
my $value = $code->( $self, $name ); |
1970
|
1
|
|
|
|
|
22
|
my $resp = HTTP::Response->new( HTTP_OK, COPACETIC, undef, $value ); |
1971
|
1
|
|
|
|
|
55
|
$self->_add_pragmata( $resp, |
1972
|
|
|
|
|
|
|
'spacetrack-type' => 'get', |
1973
|
|
|
|
|
|
|
); |
1974
|
1
|
|
|
|
|
5
|
$self->__dump_response( $resp ); |
1975
|
1
|
50
|
|
|
|
8
|
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
|
732
|
my ( $self, $name ) = @_; |
2010
|
66
|
50
|
|
|
|
152
|
defined $name |
2011
|
|
|
|
|
|
|
or Carp::croak 'No attribute name specified'; |
2012
|
66
|
50
|
|
|
|
194
|
my $code = $accessor{$name} |
2013
|
|
|
|
|
|
|
or Carp::croak "No such attribute as '$name'"; |
2014
|
66
|
|
|
|
|
170
|
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
|
|
|
|
6
|
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
|
|
|
|
|
7
|
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
|
|
|
|
|
49
|
$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
|
|
107
|
use constant BODY_STATUS_IS_OPERATIONAL => 0; |
|
10
|
|
|
|
|
22
|
|
|
10
|
|
|
|
|
694
|
|
2262
|
10
|
|
|
10
|
|
67
|
use constant BODY_STATUS_IS_SPARE => 1; |
|
10
|
|
|
|
|
23
|
|
|
10
|
|
|
|
|
617
|
|
2263
|
10
|
|
|
10
|
|
64
|
use constant BODY_STATUS_IS_TUMBLING => 2; |
|
10
|
|
|
|
|
31
|
|
|
10
|
|
|
|
|
543
|
|
2264
|
10
|
|
|
10
|
|
84
|
use constant BODY_STATUS_IS_DECAYED => 3; |
|
10
|
|
|
|
|
22
|
|
|
10
|
|
|
|
|
83693
|
|
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
|
|
8
|
'raw!' => 'Do not supplement with kelso data' |
2399
|
|
|
|
|
|
|
]; |
2400
|
|
|
|
|
|
|
} |
2401
|
|
|
|
|
|
|
|
2402
|
|
|
|
|
|
|
sub iridium_status { |
2403
|
2
|
|
|
2
|
1
|
8
|
my ( $self, @args ) = @_; |
2404
|
2
|
|
|
|
|
10
|
my ( $opt, $fmt ) = _parse_args( @args ); |
2405
|
|
|
|
|
|
|
defined $fmt |
2406
|
2
|
50
|
|
|
|
22
|
or $fmt = $self->{iridium_status_format}; |
2407
|
2
|
|
|
|
|
9
|
$self->_deprecation_notice( iridium_status => $fmt ); |
2408
|
2
|
|
|
|
|
10
|
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
|
|
|
|
|
10
|
$resp = $self->_iridium_status_kelso( $fmt, \%rslt ); |
2414
|
2
|
50
|
|
|
|
18
|
$resp->is_success() |
2415
|
|
|
|
|
|
|
or return $resp; |
2416
|
|
|
|
|
|
|
} |
2417
|
|
|
|
|
|
|
|
2418
|
2
|
100
|
|
|
|
34
|
unless ( 'kelso' eq $fmt ) { |
2419
|
1
|
50
|
|
|
|
12
|
my $code = $self->can( "_iridium_status_$fmt" ) |
2420
|
|
|
|
|
|
|
or Carp::croak "Bad iridium_status format '$fmt'"; |
2421
|
1
|
50
|
|
|
|
6
|
( $resp = $code->( $self, $fmt, \%rslt ) )->is_success() |
2422
|
|
|
|
|
|
|
or return $resp; |
2423
|
|
|
|
|
|
|
} |
2424
|
|
|
|
|
|
|
|
2425
|
2
|
50
|
|
|
|
44
|
unless ( $opt->{raw} ) { |
2426
|
2
|
|
|
|
|
14
|
foreach my $body ( @all_iridium_classic ) { |
2427
|
190
|
100
|
66
|
|
|
701
|
$rslt{$body->[0]} |
2428
|
|
|
|
|
|
|
and $body->[4] != BODY_STATUS_IS_DECAYED |
2429
|
|
|
|
|
|
|
and next; |
2430
|
132
|
|
|
|
|
259
|
$rslt{$body->[0]} = [ @{ $body } ]; # shallow clone |
|
132
|
|
|
|
|
702
|
|
2431
|
|
|
|
|
|
|
} |
2432
|
|
|
|
|
|
|
} |
2433
|
|
|
|
|
|
|
|
2434
|
|
|
|
|
|
|
$resp->content (join '', map { |
2435
|
194
|
|
|
|
|
296
|
sprintf "%6d %-15s%-8s %s\n", @{$rslt{$_}}[0 .. 3]} |
|
194
|
|
|
|
|
661
|
|
2436
|
2
|
|
|
|
|
52
|
sort {$a <=> $b} keys %rslt); |
|
1052
|
|
|
|
|
1820
|
|
2437
|
2
|
|
|
|
|
92
|
$self->_add_pragmata($resp, |
2438
|
|
|
|
|
|
|
'spacetrack-type' => 'iridium-status', |
2439
|
|
|
|
|
|
|
'spacetrack-source' => $fmt, |
2440
|
|
|
|
|
|
|
); |
2441
|
2
|
|
|
|
|
16
|
$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
|
|
8
|
my ( $self, undef, $rslt ) = @_; # $fmt only relevant to mccants |
2452
|
2
|
|
|
|
|
10
|
my $resp = $self->_get_agent()->get( |
2453
|
|
|
|
|
|
|
$self->getv( 'url_iridium_status_kelso' ) |
2454
|
|
|
|
|
|
|
); |
2455
|
2
|
50
|
|
|
|
1140939
|
$resp->is_success or return $resp; |
2456
|
2
|
|
|
|
|
58
|
foreach my $buffer (split '\n', $resp->content) { |
2457
|
62
|
|
|
|
|
403
|
$buffer =~ s/ \s+ \z //smx; |
2458
|
62
|
|
|
|
|
208
|
my $id = substr ($buffer, 0, 5) + 0; |
2459
|
62
|
|
|
|
|
139
|
my $name = substr ($buffer, 5); |
2460
|
62
|
|
|
|
|
163
|
my $status = ''; |
2461
|
62
|
50
|
|
|
|
409
|
$name =~ s/ \s+ ( [[] .+? []] ) \s* \z //smx |
2462
|
|
|
|
|
|
|
and $status = $1; |
2463
|
62
|
|
|
|
|
169
|
my $portable_status = $status_portable{kelso}{$status}; |
2464
|
62
|
|
50
|
|
|
160
|
my $comment = $kelso_comment{$status} || ''; |
2465
|
62
|
|
|
|
|
142
|
$name = ucfirst lc $name; |
2466
|
62
|
|
|
|
|
395
|
$rslt->{$id} = [ $id, $name, $status, $comment, |
2467
|
|
|
|
|
|
|
$portable_status ]; |
2468
|
|
|
|
|
|
|
} |
2469
|
2
|
|
|
|
|
19
|
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
|
|
3
|
my ( undef, $rslt ) = @_; # Invocant unused |
2477
|
|
|
|
|
|
|
|
2478
|
1
|
|
|
|
|
2
|
foreach my $val ( values %{ $rslt } ) { |
|
1
|
|
|
|
|
5
|
|
2479
|
31
|
100
|
|
|
|
70
|
$val->[1] =~ m/ \A iridium \b /smxi |
2480
|
|
|
|
|
|
|
or next; |
2481
|
29
|
|
|
|
|
38
|
$val->[2] = ''; |
2482
|
29
|
|
|
|
|
41
|
$val->[4] = BODY_STATUS_IS_OPERATIONAL; |
2483
|
|
|
|
|
|
|
} |
2484
|
|
|
|
|
|
|
|
2485
|
1
|
|
|
|
|
3
|
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
|
|
6
|
my ( $self, undef, $rslt ) = @_; # $fmt arg not used |
2509
|
|
|
|
|
|
|
|
2510
|
1
|
|
|
|
|
5
|
$self->_iridium_status_assume_good( $rslt ); |
2511
|
1
|
|
|
|
|
9
|
my $resp = $self->_get_agent()->get( |
2512
|
|
|
|
|
|
|
$self->getv( 'url_iridium_status_sladen' ) |
2513
|
|
|
|
|
|
|
); |
2514
|
1
|
50
|
|
|
|
120740
|
$resp->is_success or return $resp; |
2515
|
1
|
|
|
|
|
32
|
my %oid; |
2516
|
|
|
|
|
|
|
my %dummy; |
2517
|
1
|
|
|
|
|
4
|
foreach my $id (keys %{ $rslt } ) { |
|
1
|
|
|
|
|
10
|
|
2518
|
31
|
100
|
|
|
|
95
|
$rslt->{$id}[1] =~ m/ dummy /smxi and do { |
2519
|
2
|
|
|
|
|
6
|
$dummy{$id} = $rslt->{$id}; |
2520
|
2
|
|
|
|
|
4
|
$dummy{$id}[3] = 'Dummy'; |
2521
|
2
|
|
|
|
|
4
|
next; |
2522
|
|
|
|
|
|
|
}; |
2523
|
29
|
50
|
|
|
|
77
|
$rslt->{$id}[1] =~ m/ (\d+) /smx or next; |
2524
|
29
|
|
|
|
|
80
|
$oid{+$1} = $id; |
2525
|
|
|
|
|
|
|
} |
2526
|
1
|
|
|
|
|
11
|
%{ $rslt } = %dummy; |
|
1
|
|
|
|
|
16
|
|
2527
|
|
|
|
|
|
|
|
2528
|
1
|
|
|
|
|
4
|
my $fail; |
2529
|
1
|
|
|
|
|
7
|
my $re = qr{ ( [\d/]+) }smx; |
2530
|
1
|
|
|
|
|
8
|
local $_ = $resp->content; |
2531
|
|
|
|
|
|
|
#### s{ .*? }{}smxgi; # Strip emphasis notes |
2532
|
1
|
|
|
|
|
753
|
s/ < .*? > //smxg; # Strip markup |
2533
|
|
|
|
|
|
|
# Parenthesized numbers are assumed to represent tumbling |
2534
|
|
|
|
|
|
|
# satellites in the in-service or spare grids. |
2535
|
1
|
|
|
|
|
10
|
my %exception; |
2536
|
|
|
|
|
|
|
{ |
2537
|
|
|
|
|
|
|
# 23-Nov-2017 update double-parenthesized 6. |
2538
|
1
|
|
|
|
|
3
|
s< [(]+ (\d+) [)]+ > |
|
1
|
|
|
|
|
287
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
2539
|
|
|
|
|
|
|
< $exception{$1} = BODY_STATUS_IS_TUMBLING; $1>smxge; |
2540
|
1
|
|
|
|
|
688
|
} |
2541
|
1
|
|
|
|
|
271
|
s/ [(] .*? [)\n] //smxg; # Strip parenthetical comments |
2542
|
81
|
100
|
|
|
|
282
|
foreach ( split qr{ \n }smx ) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
2543
|
1
|
|
|
|
|
4
|
if (m/ < -+ \s+ failed \s+ (?: or \s+ retired \s+ )? -+ > /smxi) { |
2544
|
1
|
|
|
|
|
4
|
$fail++; |
2545
|
|
|
|
|
|
|
$re = qr{ (\d+) (\w?) }smx; |
2546
|
12
|
|
|
|
|
26
|
} elsif ( s/ \A \s* ( plane \s+ \d+ ) \s* : \s* //smxi ) { |
2547
|
|
|
|
|
|
|
my $plane = $1; |
2548
|
12
|
|
|
|
|
59
|
## s/ \A \D+ //smx; # Strip leading non-digits |
2549
|
12
|
|
|
|
|
57
|
s/ \b [[:alpha:]] .* //smx; # Strip trailing comments |
2550
|
12
|
|
|
|
|
22
|
s/ \s+ \z //smx; # Strip trailing whitespace |
2551
|
12
|
|
|
|
|
122
|
my $inx = 0; # First 11 functional are in service |
2552
|
169
|
|
|
|
|
327
|
while (m/ $re /smxg) { |
2553
|
169
|
|
|
|
|
238
|
my $num_list = $1; |
2554
|
169
|
|
|
|
|
535
|
my $detail = $2; |
2555
|
170
|
|
|
|
|
303
|
foreach my $num ( split qr{ / }smx, $num_list ) { |
2556
|
170
|
100
|
|
|
|
346
|
$num = $num + 0; # Numify. |
2557
|
|
|
|
|
|
|
my $id = $oid{$num} or do { |
2558
|
|
|
|
|
|
|
# This is normal for decayed satellites or Iridium |
2559
|
|
|
|
|
|
|
# NEXT. |
2560
|
141
|
|
|
|
|
245
|
# warn "No oid for Iridium $num\n"; |
2561
|
|
|
|
|
|
|
next; |
2562
|
29
|
|
|
|
|
57
|
}; |
2563
|
29
|
50
|
|
|
|
48
|
my $name = "Iridium $num"; |
2564
|
|
|
|
|
|
|
if ($fail) { |
2565
|
29
|
|
33
|
|
|
60
|
my $interp = $sladen_interpret_detail{$detail} |
2566
|
29
|
|
|
|
|
46
|
|| $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
|
|
|
|
|
713
|
} continue { |
2580
|
|
|
|
|
|
|
$inx++; |
2581
|
|
|
|
|
|
|
} |
2582
|
1
|
|
|
|
|
3
|
} elsif ( m/ Notes: /smx ) { |
2583
|
|
|
|
|
|
|
last; |
2584
|
67
|
|
|
|
|
90
|
} else { # TODO this is just for debugging. |
2585
|
|
|
|
|
|
|
0; |
2586
|
|
|
|
|
|
|
} |
2587
|
|
|
|
|
|
|
} |
2588
|
1
|
|
|
|
|
99
|
|
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
|
|
6
|
return [ |
2682
|
|
|
|
|
|
|
'json!' => 'Return data in JSON format', |
2683
|
|
|
|
|
|
|
'format=s' => 'Specify return format', |
2684
|
|
|
|
|
|
|
]; |
2685
|
|
|
|
|
|
|
} |
2686
|
|
|
|
|
|
|
|
2687
|
1
|
|
|
1
|
1
|
6
|
sub launch_sites { |
2688
|
|
|
|
|
|
|
my ( $self, @args ) = @_; |
2689
|
1
|
|
|
|
|
6
|
|
2690
|
1
|
|
|
|
|
4
|
( my $opt, @args ) = _parse_args( @args ); |
2691
|
|
|
|
|
|
|
my $format = _retrieval_format( launch_sites => $opt ); |
2692
|
1
|
|
|
|
|
5
|
|
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
|
|
|
|
5
|
} ); |
2699
|
|
|
|
|
|
|
$resp->is_success() |
2700
|
|
|
|
|
|
|
or return $resp; |
2701
|
1
|
|
|
|
|
10
|
|
2702
|
|
|
|
|
|
|
$self->_add_pragmata($resp, |
2703
|
|
|
|
|
|
|
'spacetrack-type' => 'launch_sites', |
2704
|
|
|
|
|
|
|
'spacetrack-source' => 'spacetrack', |
2705
|
|
|
|
|
|
|
'spacetrack-interface' => 2, |
2706
|
|
|
|
|
|
|
); |
2707
|
1
|
50
|
|
|
|
4
|
|
2708
|
|
|
|
|
|
|
'json' ne $format |
2709
|
|
|
|
|
|
|
and return $resp; |
2710
|
1
|
|
|
|
|
4
|
|
2711
|
|
|
|
|
|
|
my $json = $self->_get_json_object(); |
2712
|
1
|
|
|
|
|
5
|
|
2713
|
|
|
|
|
|
|
my $data = $json->decode( $resp->content() ); |
2714
|
1
|
|
|
|
|
19
|
|
2715
|
1
|
|
|
|
|
3
|
my %dict; |
|
1
|
|
|
|
|
3
|
|
2716
|
|
|
|
|
|
|
foreach my $datum ( @{ $data } ) { |
2717
|
34
|
50
|
|
|
|
60
|
defined $datum->{SITE_CODE} |
2718
|
|
|
|
|
|
|
and $dict{$datum->{SITE_CODE}} = $datum->{LAUNCH_SITE}; |
2719
|
|
|
|
|
|
|
} |
2720
|
1
|
50
|
|
|
|
5
|
|
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
|
5
|
sub login { |
2766
|
2
|
|
|
|
|
7
|
my ( $self, @args ) = @_; |
2767
|
2
|
50
|
|
|
|
6
|
delete $self->{_pragmata}; |
2768
|
2
|
50
|
33
|
|
|
14
|
@args and $self->set( @args ); |
2769
|
|
|
|
|
|
|
( $self->{username} && $self->{password} ) or |
2770
|
|
|
|
|
|
|
return HTTP::Response->new ( |
2771
|
2
|
50
|
|
|
|
18
|
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
|
|
|
|
|
21
|
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
|
|
|
|
|
9
|
password => $self->{password}, |
2792
|
|
|
|
|
|
|
] ); |
2793
|
2
|
50
|
|
|
|
14
|
|
2794
|
|
|
|
|
|
|
$resp->is_success() |
2795
|
2
|
|
|
|
|
36
|
or return _mung_login_status( $resp ); |
2796
|
|
|
|
|
|
|
$self->__dump_response( $resp ); |
2797
|
2
|
50
|
|
|
|
12
|
|
2798
|
|
|
|
|
|
|
$resp->content() =~ m/ \b failed \b /smxi |
2799
|
|
|
|
|
|
|
and return HTTP::Response->new( HTTP_UNAUTHORIZED, LOGIN_FAILED ); |
2800
|
2
|
50
|
|
|
|
39
|
|
2801
|
|
|
|
|
|
|
$self->_record_cookie_generic( 2 ) |
2802
|
|
|
|
|
|
|
or return HTTP::Response->new( HTTP_UNAUTHORIZED, LOGIN_FAILED ); |
2803
|
2
|
50
|
|
|
|
8
|
|
2804
|
|
|
|
|
|
|
$self->{dump_headers} & DUMP_TRACE and warn <<'EOD'; |
2805
|
|
|
|
|
|
|
Login successful. |
2806
|
2
|
|
|
|
|
12
|
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
|
7
|
sub logout { |
2820
|
4
|
|
|
|
|
9
|
my ( $self ) = @_; |
2821
|
4
|
|
|
|
|
13
|
foreach my $spacetrack_interface_info ( |
2822
|
12
|
100
|
|
|
|
27
|
@{ $self->{_space_track_interface} } ) { |
2823
|
|
|
|
|
|
|
$spacetrack_interface_info |
2824
|
|
|
|
|
|
|
or next; |
2825
|
4
|
50
|
|
|
|
12
|
exists $spacetrack_interface_info->{session_cookie} |
2826
|
|
|
|
|
|
|
and $spacetrack_interface_info->{session_cookie} = undef; |
2827
|
4
|
50
|
|
|
|
17
|
exists $spacetrack_interface_info->{cookie_expires} |
2828
|
|
|
|
|
|
|
and $spacetrack_interface_info->{cookie_expires} = 0; |
2829
|
4
|
|
|
|
|
15
|
} |
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
|
|
29
|
return [ |
2904
|
|
|
|
|
|
|
'file=s' => 'Name of cache file', |
2905
|
|
|
|
|
|
|
]; |
2906
|
|
|
|
|
|
|
} |
2907
|
|
|
|
|
|
|
|
2908
|
6
|
|
|
6
|
1
|
23
|
sub mccants { |
2909
|
|
|
|
|
|
|
my ( $self, @args ) = @_; |
2910
|
6
|
|
|
|
|
33
|
|
2911
|
|
|
|
|
|
|
( my $opt, @args ) = _parse_args( @args ); |
2912
|
|
|
|
|
|
|
|
2913
|
6
|
|
|
|
|
75
|
return $self->_get_from_net( |
2914
|
|
|
|
|
|
|
%{ $opt }, |
2915
|
|
|
|
|
|
|
catalog => $args[0], |
2916
|
6
|
|
|
6
|
|
161
|
post_process => sub { |
2917
|
6
|
|
|
|
|
16
|
my ( undef, $resp, $info ) = @_; # Invocant unused |
2918
|
|
|
|
|
|
|
my ( $content, @zip_opt ); |
2919
|
6
|
50
|
|
|
|
37
|
defined $info->{member} |
2920
|
6
|
50
|
|
|
|
41
|
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
|
|
|
|
|
45121
|
$IO::Uncompress::Unzip::UnzipError ); |
2926
|
6
|
|
|
|
|
959
|
$resp->content( $content ); |
2927
|
|
|
|
|
|
|
return $resp; |
2928
|
6
|
|
|
|
|
20
|
}, |
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
|
7
|
sub names { |
2955
|
2
|
|
|
|
|
6
|
my ( $self, $name ) = @_; |
2956
|
2
|
|
|
|
|
6
|
$name = lc $name; |
2957
|
|
|
|
|
|
|
delete $self->{_pragmata}; |
2958
|
2
|
100
|
|
|
|
15
|
|
2959
|
|
|
|
|
|
|
$catalogs{$name} or return HTTP::Response->new( |
2960
|
1
|
|
|
|
|
5
|
HTTP_NOT_FOUND, "Data source '$name' not found."); |
2961
|
1
|
50
|
|
|
|
5
|
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
|
|
|
|
181
|
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
|
|
|
|
|
16
|
} |
2970
|
1
|
50
|
|
|
|
58
|
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
|
9474
|
sub retrieve { |
3091
|
34
|
|
|
|
|
90
|
my ( $self, @args ) = @_; |
3092
|
|
|
|
|
|
|
delete $self->{_pragmata}; |
3093
|
34
|
|
|
|
|
98
|
|
3094
|
34
|
|
|
|
|
89
|
@args = $self->_parse_retrieve_args( @args ); |
3095
|
|
|
|
|
|
|
my $opt = _parse_retrieve_dates( shift @args ); |
3096
|
34
|
|
|
|
|
90
|
|
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
|
|
|
|
|
89
|
|
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
|
|
|
|
123
|
( $rest->{format}, { |
3110
|
|
|
|
|
|
|
file => 1, |
3111
|
|
|
|
|
|
|
pretty => $self->getv( 'pretty' ) |
3112
|
|
|
|
|
|
|
}, |
3113
|
|
|
|
|
|
|
) |
3114
|
|
|
|
|
|
|
); |
3115
|
33
|
|
|
|
|
89
|
|
3116
|
|
|
|
|
|
|
while ( @args ) { |
3117
|
35
|
|
|
|
|
94
|
|
3118
|
35
|
|
|
|
|
126
|
my @batch = splice @args, 0, $RETRIEVAL_SIZE; |
3119
|
|
|
|
|
|
|
$rest->{OBJECT_NUMBER} = _stringify_oid_list( { |
3120
|
|
|
|
|
|
|
separator => ',', |
3121
|
|
|
|
|
|
|
range_operator => '--', |
3122
|
|
|
|
|
|
|
}, @batch ); |
3123
|
35
|
|
|
|
|
123
|
|
3124
|
|
|
|
|
|
|
my $resp = $self->spacetrack_query_v2( |
3125
|
|
|
|
|
|
|
basicspacedata => 'query', |
3126
|
|
|
|
|
|
|
_sort_rest_arguments( $rest ) |
3127
|
|
|
|
|
|
|
); |
3128
|
35
|
50
|
66
|
|
|
131
|
|
3129
|
|
|
|
|
|
|
$resp->is_success() |
3130
|
|
|
|
|
|
|
or $resp->code() == HTTP_I_AM_A_TEAPOT |
3131
|
|
|
|
|
|
|
or return $resp; |
3132
|
35
|
|
|
|
|
428
|
|
3133
|
|
|
|
|
|
|
$accumulator->( $self, $resp ); |
3134
|
|
|
|
|
|
|
|
3135
|
|
|
|
|
|
|
} |
3136
|
33
|
50
|
|
|
|
70
|
|
3137
|
|
|
|
|
|
|
( my $data = $accumulator->( $self ) ) |
3138
|
|
|
|
|
|
|
or return HTTP::Response->new ( HTTP_NOT_FOUND, NO_RECORDS ); |
3139
|
33
|
50
|
|
|
|
76
|
|
3140
|
|
|
|
|
|
|
ref $data |
3141
|
|
|
|
|
|
|
and $data = $self->_get_json_object()->encode( $data ); |
3142
|
33
|
100
|
|
|
|
96
|
|
3143
|
|
|
|
|
|
|
$no_execute |
3144
|
|
|
|
|
|
|
and return HTTP::Response->new( |
3145
|
|
|
|
|
|
|
HTTP_I_AM_A_TEAPOT, undef, undef, $data ); |
3146
|
21
|
|
|
|
|
67
|
|
3147
|
|
|
|
|
|
|
my $resp = HTTP::Response->new( HTTP_OK, COPACETIC, undef, |
3148
|
|
|
|
|
|
|
$data ); |
3149
|
21
|
|
|
|
|
1002
|
|
3150
|
21
|
|
|
|
|
70
|
$self->_convert_content( $resp ); |
3151
|
|
|
|
|
|
|
$self->_add_pragmata( $resp, |
3152
|
|
|
|
|
|
|
'spacetrack-type' => 'orbit', |
3153
|
|
|
|
|
|
|
'spacetrack-source' => 'spacetrack', |
3154
|
|
|
|
|
|
|
'spacetrack-interface' => 2, |
3155
|
21
|
|
|
|
|
255
|
); |
3156
|
|
|
|
|
|
|
return $resp; |
3157
|
|
|
|
|
|
|
} |
3158
|
|
|
|
|
|
|
|
3159
|
|
|
|
|
|
|
{ |
3160
|
|
|
|
|
|
|
|
3161
|
|
|
|
|
|
|
my %rest_sort_map = ( |
3162
|
|
|
|
|
|
|
catnum => 'OBJECT_NUMBER', |
3163
|
|
|
|
|
|
|
epoch => 'EPOCH', |
3164
|
|
|
|
|
|
|
); |
3165
|
|
|
|
|
|
|
|
3166
|
38
|
|
|
38
|
|
74
|
sub _convert_retrieve_options_to_rest { |
3167
|
|
|
|
|
|
|
my ( $self, $opt ) = @_; |
3168
|
38
|
|
|
|
|
95
|
|
3169
|
|
|
|
|
|
|
my %rest = ( |
3170
|
|
|
|
|
|
|
class => 'tle_latest', |
3171
|
|
|
|
|
|
|
); |
3172
|
38
|
100
|
66
|
|
|
149
|
|
3173
|
5
|
|
|
|
|
13
|
if ( $opt->{start_epoch} || $opt->{end_epoch} ) { |
|
10
|
|
|
|
|
23
|
|
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
|
|
|
198
|
'OBJECT_NUMBER' ) |
3181
|
|
|
|
|
|
|
. ( $opt->{descending} ? ' desc' : ' asc' ); |
3182
|
38
|
100
|
|
|
|
98
|
|
3183
|
1
|
|
|
|
|
4
|
if ( $opt->{since_file} ) { |
3184
|
1
|
|
|
|
|
3
|
$rest{FILE} = ">$opt->{since_file}"; |
3185
|
|
|
|
|
|
|
$rest{class} = 'tle'; |
3186
|
|
|
|
|
|
|
} |
3187
|
38
|
50
|
33
|
|
|
93
|
|
3188
|
0
|
|
|
|
|
0
|
if ( $opt->{status} && $opt->{status} ne 'onorbit' ) { |
3189
|
|
|
|
|
|
|
$rest{class} = 'tle'; |
3190
|
|
|
|
|
|
|
} |
3191
|
38
|
|
|
|
|
108
|
|
3192
|
|
|
|
|
|
|
foreach my $name ( |
3193
|
|
|
|
|
|
|
qw{ class format }, |
3194
|
|
|
|
|
|
|
qw{ ECCENTRICITY FILE MEAN_MOTION OBJECT_NAME }, |
3195
|
|
|
|
|
|
|
) { |
3196
|
228
|
100
|
|
|
|
480
|
defined $opt->{$name} |
3197
|
|
|
|
|
|
|
and $rest{$name} = $opt->{$name}; |
3198
|
|
|
|
|
|
|
} |
3199
|
38
|
100
|
|
|
|
107
|
|
3200
|
34
|
100
|
|
|
|
86
|
if ( 'legacy' eq $rest{format} ) { |
3201
|
9
|
|
|
|
|
16
|
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
|
|
|
|
|
46
|
} else { |
3206
|
|
|
|
|
|
|
$rest{format} = 'tle'; |
3207
|
|
|
|
|
|
|
} |
3208
|
|
|
|
|
|
|
} |
3209
|
|
|
|
|
|
|
|
3210
|
38
|
100
|
|
|
|
119
|
$rest{class} eq 'tle_latest' |
|
|
100
|
|
|
|
|
|
3211
|
|
|
|
|
|
|
and $rest{ORDINAL} = $opt->{last5} ? '1--5' : 1; |
3212
|
38
|
|
|
|
|
97
|
|
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
|
|
87
|
sub _search_heading_order { |
3235
|
50
|
|
|
|
|
82
|
my ( $opt ) = @_; |
|
550
|
|
|
|
|
816
|
|
3236
|
|
|
|
|
|
|
return ( map { $_->[1] } |
3237
|
|
|
|
|
|
|
_search_heading_relevant( $opt ) |
3238
|
|
|
|
|
|
|
); |
3239
|
|
|
|
|
|
|
} |
3240
|
|
|
|
|
|
|
|
3241
|
100
|
|
|
100
|
|
178
|
sub _search_heading_relevant { |
3242
|
|
|
|
|
|
|
my ( $opt ) = @_; |
3243
|
100
|
100
|
|
|
|
171
|
return ( |
|
1200
|
|
|
|
|
2557
|
|
3244
|
|
|
|
|
|
|
grep { ! defined $_->[0] || $opt->{$_->[0]} } |
3245
|
|
|
|
|
|
|
@heading_info |
3246
|
|
|
|
|
|
|
); |
3247
|
|
|
|
|
|
|
} |
3248
|
|
|
|
|
|
|
|
3249
|
50
|
|
|
50
|
|
95
|
sub _search_heading_hash_ref { |
3250
|
|
|
|
|
|
|
my ( $opt ) = @_; |
3251
|
50
|
|
|
|
|
89
|
return { |
|
550
|
|
|
|
|
1197
|
|
3252
|
|
|
|
|
|
|
map { $_->[1] => $_->[2] } |
3253
|
|
|
|
|
|
|
_search_heading_relevant( $opt ) |
3254
|
|
|
|
|
|
|
}; |
3255
|
|
|
|
|
|
|
} |
3256
|
|
|
|
|
|
|
|
3257
|
|
|
|
|
|
|
} |
3258
|
|
|
|
|
|
|
|
3259
|
50
|
|
|
50
|
|
139
|
sub _search_rest { |
3260
|
50
|
|
|
|
|
141
|
my ( $self, $pred, $xfrm, @args ) = @_; |
3261
|
|
|
|
|
|
|
delete $self->{_pragmata}; |
3262
|
50
|
|
|
|
|
139
|
|
3263
|
|
|
|
|
|
|
( my $opt, @args ) = $self->_parse_search_args( @args ); |
3264
|
50
|
|
|
|
|
109
|
|
3265
|
50
|
|
|
|
|
131
|
my $headings = _search_heading_hash_ref( $opt ); |
3266
|
|
|
|
|
|
|
my @heading_order = _search_heading_order( $opt ); |
3267
|
50
|
100
|
|
|
|
146
|
|
3268
|
|
|
|
|
|
|
if ( $pred eq 'OBJECT_NUMBER' ) { |
3269
|
12
|
50
|
|
|
|
44
|
|
3270
|
|
|
|
|
|
|
@args = $self->_expand_oid_list( @args ) |
3271
|
|
|
|
|
|
|
or return HTTP::Response->new( |
3272
|
|
|
|
|
|
|
HTTP_PRECONDITION_FAILED, NO_CAT_ID ); |
3273
|
12
|
|
|
|
|
50
|
|
3274
|
|
|
|
|
|
|
@args = ( |
3275
|
|
|
|
|
|
|
_stringify_oid_list( { |
3276
|
|
|
|
|
|
|
separator => ',', |
3277
|
|
|
|
|
|
|
range_operator => '--', |
3278
|
|
|
|
|
|
|
}, |
3279
|
|
|
|
|
|
|
@args |
3280
|
|
|
|
|
|
|
) |
3281
|
|
|
|
|
|
|
); |
3282
|
|
|
|
|
|
|
|
3283
|
|
|
|
|
|
|
} |
3284
|
50
|
|
|
|
|
132
|
|
3285
|
50
|
50
|
66
|
|
|
144
|
my $rest_args = $self->_convert_search_options_to_rest( $opt ); |
3286
|
50
|
|
|
|
|
91
|
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
|
|
|
|
112
|
$rest_args->{class} : |
3294
|
|
|
|
|
|
|
DEFAULT_SPACE_TRACK_REST_SEARCH_CLASS; |
3295
|
50
|
|
|
|
|
107
|
|
3296
|
|
|
|
|
|
|
my $accumulator = _accumulator_for( $rest_args->{format} ); |
3297
|
50
|
|
|
|
|
103
|
|
|
50
|
|
|
|
|
120
|
|
3298
|
|
|
|
|
|
|
foreach my $search_for ( map { $xfrm->( $_, $class ) } @args ) { |
3299
|
50
|
|
|
|
|
73
|
|
3300
|
|
|
|
|
|
|
my $rslt; |
3301
|
50
|
|
|
|
|
75
|
{ |
|
50
|
|
|
|
|
125
|
|
3302
|
50
|
|
|
|
|
73
|
local $self->{pretty} = 0; |
|
50
|
|
|
|
|
199
|
|
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
|
|
|
|
|
141
|
|
3310
|
|
|
|
|
|
|
$accumulator->( $self, $rslt ); |
3311
|
|
|
|
|
|
|
|
3312
|
|
|
|
|
|
|
} |
3313
|
19
|
|
|
|
|
56
|
|
3314
|
|
|
|
|
|
|
my ( $content, $data ) = $accumulator->( $self ); |
3315
|
19
|
100
|
|
|
|
52
|
|
3316
|
|
|
|
|
|
|
if ( $opt->{tle} ) { |
3317
|
14
|
50
|
|
|
|
38
|
defined $opt->{format} |
3318
|
14
|
50
|
|
|
|
36
|
or $opt->{format} = 'tle'; |
3319
|
|
|
|
|
|
|
ARRAY_REF eq ref $data |
3320
|
14
|
|
|
|
|
34
|
or Carp::croak "Format $rest_args->{format} does not support TLE retrieval"; |
3321
|
|
|
|
|
|
|
my $ropt = _remove_search_options( $opt ); |
3322
|
|
|
|
|
|
|
|
3323
|
14
|
|
|
|
|
25
|
my $rslt = $self->retrieve( $ropt, |
|
48
|
|
|
|
|
108
|
|
|
14
|
|
|
|
|
30
|
|
3324
|
|
|
|
|
|
|
map { $_->{OBJECT_NUMBER} } @{ $data } ); |
3325
|
14
|
|
|
|
|
358
|
|
3326
|
|
|
|
|
|
|
return $rslt; |
3327
|
|
|
|
|
|
|
|
3328
|
|
|
|
|
|
|
} else { |
3329
|
5
|
50
|
|
|
|
18
|
|
3330
|
5
|
|
|
|
|
8
|
if ( 'legacy' eq $opt->{format} ) { |
3331
|
5
|
|
|
|
|
10
|
$content = ''; |
3332
|
|
|
|
|
|
|
foreach my $datum ( |
3333
|
5
|
|
|
|
|
11
|
$headings, |
3334
|
|
|
|
|
|
|
@{ $data } |
3335
|
|
|
|
|
|
|
) { |
3336
|
12
|
100
|
|
|
|
22
|
$content .= join( "\t", |
|
132
|
|
|
|
|
292
|
|
3337
|
|
|
|
|
|
|
map { defined $datum->{$_} ? $datum->{$_} : '' } |
3338
|
|
|
|
|
|
|
@heading_order |
3339
|
|
|
|
|
|
|
) . "\n"; |
3340
|
|
|
|
|
|
|
} |
3341
|
|
|
|
|
|
|
} |
3342
|
5
|
|
|
|
|
20
|
|
3343
|
5
|
|
|
|
|
241
|
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
|
|
|
|
|
115
|
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
|
|
173
|
sub __search_rest_raw { |
3372
|
50
|
|
|
|
|
94
|
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
|
|
|
|
104
|
|
3376
|
|
|
|
|
|
|
%args |
3377
|
|
|
|
|
|
|
or return HTTP::Response->new( HTTP_PRECONDITION_FAILED, NO_CAT_ID ); |
3378
|
|
|
|
|
|
|
|
3379
|
50
|
50
|
|
|
|
122
|
exists $args{class} |
3380
|
|
|
|
|
|
|
or $args{class} = DEFAULT_SPACE_TRACK_REST_SEARCH_CLASS; |
3381
|
|
|
|
|
|
|
$args{class} ne 'satcat' |
3382
|
50
|
50
|
33
|
|
|
204
|
or exists $args{CURRENT} |
3383
|
|
|
|
|
|
|
or $args{CURRENT} = 'Y'; |
3384
|
50
|
50
|
|
|
|
108
|
exists $args{format} |
3385
|
|
|
|
|
|
|
or $args{format} = 'json'; |
3386
|
50
|
50
|
|
|
|
117
|
exists $args{predicates} |
3387
|
|
|
|
|
|
|
or $args{predicates} = 'all'; |
3388
|
50
|
50
|
|
|
|
109
|
exists $args{orderby} |
3389
|
|
|
|
|
|
|
or $args{orderby} = 'OBJECT_NUMBER asc'; |
3390
|
|
|
|
|
|
|
# exists $args{limit} |
3391
|
|
|
|
|
|
|
# or $args{limit} = 1000; |
3392
|
50
|
|
|
|
|
129
|
|
3393
|
|
|
|
|
|
|
my $resp = $self->spacetrack_query_v2( |
3394
|
|
|
|
|
|
|
basicspacedata => 'query', |
3395
|
|
|
|
|
|
|
_sort_rest_arguments( \%args ), |
3396
|
|
|
|
|
|
|
); |
3397
|
|
|
|
|
|
|
# $resp->content( $content ); |
3398
|
50
|
|
|
|
|
218
|
# $self->_convert_content( $resp ); |
3399
|
|
|
|
|
|
|
$self->_add_pragmata( $resp, |
3400
|
|
|
|
|
|
|
'spacetrack-type' => 'orbit', |
3401
|
|
|
|
|
|
|
'spacetrack-source' => 'spacetrack', |
3402
|
|
|
|
|
|
|
'spacetrack-interface' => 2, |
3403
|
50
|
|
|
|
|
178
|
); |
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
|
7496
|
sub search_date { ## no critic (RequireArgUnpacking) |
3544
|
12
|
|
|
|
|
39
|
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
|
8459
|
sub search_id { ## no critic (RequireArgUnpacking) |
3660
|
14
|
|
|
|
|
41
|
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
|
34
|
sub search_name { ## no critic (RequireArgUnpacking) |
|
10
|
|
|
10
|
|
8366
|
|
3717
|
10
|
|
|
|
|
37
|
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
|
37
|
## my ( $self, @args ) = @_; |
|
12
|
|
|
12
|
|
1373
|
|
3798
|
12
|
|
|
|
|
41
|
splice @_, 1, 0, OBJECT_NUMBER => sub { return $_[0] }; |
3799
|
|
|
|
|
|
|
goto &_search_rest; |
3800
|
|
|
|
|
|
|
} |
3801
|
|
|
|
|
|
|
|
3802
|
1
|
|
|
1
|
|
5
|
sub _check_range { |
3803
|
1
|
50
|
|
|
|
5
|
my ( $self, $lo, $hi ) = @_; |
3804
|
1
|
50
|
|
|
|
4
|
($lo, $hi) = ($hi, $lo) if $lo > $hi; |
3805
|
1
|
50
|
|
|
|
4
|
$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
|
|
|
|
|
7
|
}; |
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
|
20627
|
sub set { ## no critic (ProhibitAmbiguousNames) |
3843
|
56
|
|
|
|
|
211
|
my ($self, @args) = @_; |
3844
|
56
|
|
|
|
|
182
|
delete $self->{_pragmata}; |
3845
|
62
|
|
|
|
|
130
|
while ( @args > 1 ) { |
3846
|
|
|
|
|
|
|
my $name = shift @args; |
3847
|
|
|
|
|
|
|
Carp::croak "Attribute $name may not be set. Legal attributes are ", |
3848
|
62
|
50
|
|
|
|
214
|
join (', ', sort keys %mutator), ".\n" |
3849
|
62
|
|
|
|
|
106
|
unless $mutator{$name}; |
3850
|
62
|
|
|
|
|
234
|
my $value = $args[0]; |
3851
|
62
|
|
|
|
|
179
|
$mutator{$name}->( $self, $name, $value, \@args ); |
3852
|
|
|
|
|
|
|
shift @args; |
3853
|
|
|
|
|
|
|
} |
3854
|
56
|
50
|
|
|
|
171
|
@args |
3855
|
56
|
|
|
|
|
234
|
and Carp::croak __PACKAGE__, "->set() specifies no value for @args"; |
3856
|
56
|
|
|
|
|
3018
|
my $resp = HTTP::Response->new( HTTP_OK, COPACETIC, undef, COPACETIC ); |
3857
|
|
|
|
|
|
|
$self->_add_pragmata( $resp, |
3858
|
|
|
|
|
|
|
'spacetrack-type' => 'set', |
3859
|
56
|
|
|
|
|
188
|
); |
3860
|
56
|
|
|
|
|
232
|
$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
|
|
|
6
|
my ( $verb ) = @_; |
4018
|
|
|
|
|
|
|
return $alias{$verb} || $verb; |
4019
|
|
|
|
|
|
|
} |
4020
|
|
|
|
|
|
|
} |
4021
|
|
|
|
|
|
|
|
4022
|
1
|
|
|
1
|
1
|
4
|
sub shell { |
4023
|
1
|
50
|
|
|
|
5
|
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
|
|
|
|
|
17
|
|
4030
|
1
|
|
|
|
|
3
|
my $stdout = \*STDOUT; |
4031
|
|
|
|
|
|
|
my $read; |
4032
|
1
|
50
|
33
|
|
|
6
|
|
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
|
|
|
|
|
8
|
# from a terminal. So: |
4040
|
1
|
|
|
|
|
2
|
my $interactive = -t STDIN; |
4041
|
4
|
|
|
|
|
7
|
while (1) { |
4042
|
4
|
50
|
|
|
|
10
|
my $buffer; |
4043
|
4
|
|
|
|
|
7
|
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
|
|
|
|
|
12
|
|
4054
|
4
|
|
|
|
|
12
|
$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
|
|
|
|
|
14
|
|
4063
|
|
|
|
|
|
|
my @cmdarg = Text::ParseWords::parse_line( '\s+', 1, $buffer ); |
4064
|
|
|
|
|
|
|
|
4065
|
|
|
|
|
|
|
# Pull off any redirections. |
4066
|
2
|
|
|
|
|
326
|
|
4067
|
|
|
|
|
|
|
my $redir = ''; |
4068
|
2
|
|
|
|
|
6
|
@cmdarg = map { |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
4069
|
4
|
50
|
|
|
|
18
|
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
|
|
|
|
|
5
|
|
|
4
|
|
|
|
|
173
|
|
4078
|
2
|
50
|
|
|
|
123
|
@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
|
|
|
|
|
5
|
|
4082
|
2
|
|
|
|
|
5
|
$redir =~ s/ \A (>+) ~ /$1$ENV{HOME}/smx; |
4083
|
|
|
|
|
|
|
my $verb = lc shift @cmdarg; |
4084
|
2
|
|
|
|
|
8
|
|
4085
|
|
|
|
|
|
|
my %meta_command = ( |
4086
|
|
|
|
|
|
|
before => [], |
4087
|
|
|
|
|
|
|
after => [], |
4088
|
|
|
|
|
|
|
); |
4089
|
2
|
|
|
|
|
7
|
|
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
|
|
|
12
|
|
4102
|
1
|
|
|
|
|
3
|
last if $verb eq 'exit' || $verb eq 'bye'; |
4103
|
1
|
50
|
|
|
|
4
|
$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
|
|
|
14
|
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
|
|
|
|
|
3
|
}; |
4121
|
1
|
50
|
|
|
|
3
|
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
|
|
|
|
|
3
|
} |
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
|
|
|
|
|
3
|
eval { |
4147
|
1
|
|
|
|
|
4
|
$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
|
|
|
|
10
|
|
|
|
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
|
|
|
10
|
or not $self->{filter} |
4166
|
1
|
|
|
|
|
8
|
or next; |
4167
|
1
|
|
|
|
|
20
|
my $content = $rslt->content; |
4168
|
1
|
|
|
|
|
3
|
chomp $content; |
|
1
|
|
|
|
|
57
|
|
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
|
|
|
54
|
and not $self->{filter} |
|
0
|
|
|
|
|
0
|
|
4180
|
1
|
|
|
|
|
6
|
and print { $stdout } "\n"; |
4181
|
|
|
|
|
|
|
return; |
4182
|
|
|
|
|
|
|
} |
4183
|
|
|
|
|
|
|
|
4184
|
1
|
|
|
1
|
|
11
|
sub _get_readline { ## no critic (Subroutines::RequireArgUnpacking) |
4185
|
1
|
|
|
|
|
578
|
my ( $self ) = @_; |
4186
|
1
|
|
33
|
|
|
2643
|
require Term::ReadLine; |
4187
|
|
|
|
|
|
|
$rdln ||= Term::ReadLine->new ( |
4188
|
1
|
50
|
0
|
|
|
13819
|
'SpaceTrack orbital element access'); |
4189
|
|
|
|
|
|
|
@_ > 1 |
4190
|
1
|
50
|
|
|
|
7
|
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
|
|
104
|
|
|
10
|
|
|
|
|
23
|
|
|
10
|
|
|
|
|
129978
|
|
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
|
|
37
|
} |
|
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
|
|
19
|
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
|
1736
|
sub spacetrack { |
4334
|
|
|
|
|
|
|
my ( $self, @args ) = @_; |
4335
|
5
|
|
|
|
|
27
|
|
4336
|
|
|
|
|
|
|
my ( $opt, $catalog ) = _parse_args( @args ); |
4337
|
5
|
|
|
|
|
21
|
|
4338
|
|
|
|
|
|
|
_retrieval_format( tle => $opt ); |
4339
|
|
|
|
|
|
|
|
4340
|
5
|
100
|
66
|
|
|
58
|
defined $catalog |
4341
|
|
|
|
|
|
|
and my $info = $catalogs{spacetrack}[2]{$catalog} |
4342
|
|
|
|
|
|
|
or return $self->_no_such_catalog( spacetrack => 2, $catalog ); |
4343
|
|
|
|
|
|
|
|
4344
|
4
|
50
|
|
|
|
14
|
defined $info->{deprecate} |
4345
|
|
|
|
|
|
|
and Carp::croak "Catalog '$catalog' is deprecated in favor of '$info->{deprecate}'"; |
4346
|
|
|
|
|
|
|
|
4347
|
4
|
100
|
|
|
|
20
|
defined $info->{favorite} |
4348
|
|
|
|
|
|
|
and return $self->favorite( $opt, $info->{favorite} ); |
4349
|
|
|
|
|
|
|
|
4350
|
3
|
|
|
|
|
7
|
my %retrieve_opt = %{ |
|
3
|
|
|
|
|
12
|
|
4351
|
|
|
|
|
|
|
$self->_convert_retrieve_options_to_rest( $opt ) |
4352
|
|
|
|
|
|
|
}; |
4353
|
|
|
|
|
|
|
|
4354
|
3
|
|
|
|
|
15
|
$info->{tle} |
4355
|
3
|
50
|
|
|
|
16
|
and @retrieve_opt{ keys %{ $info->{tle} } } = |
|
3
|
|
|
|
|
9
|
|
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
|
|
|
|
|
13
|
|
4395
|
|
|
|
|
|
|
$rslt = $self->spacetrack_query_v2( |
4396
|
|
|
|
|
|
|
basicspacedata => 'query', |
4397
|
|
|
|
|
|
|
_sort_rest_arguments( \%retrieve_opt ), |
4398
|
|
|
|
|
|
|
); |
4399
|
3
|
100
|
|
|
|
15
|
|
4400
|
|
|
|
|
|
|
$rslt->is_success() |
4401
|
|
|
|
|
|
|
or return $rslt; |
4402
|
1
|
|
|
|
|
17
|
|
4403
|
|
|
|
|
|
|
$self->_convert_content( $rslt ); |
4404
|
1
|
|
|
|
|
6
|
|
4405
|
|
|
|
|
|
|
$self->_add_pragmata( $rslt, |
4406
|
|
|
|
|
|
|
'spacetrack-type' => 'orbit', |
4407
|
|
|
|
|
|
|
'spacetrack-source' => 'spacetrack', |
4408
|
|
|
|
|
|
|
'spacetrack-interface' => 2, |
4409
|
|
|
|
|
|
|
); |
4410
|
|
|
|
|
|
|
|
4411
|
|
|
|
|
|
|
} |
4412
|
1
|
|
|
|
|
9
|
|
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
|
|
158
|
sub _spacetrack_delay { |
4471
|
95
|
50
|
|
|
|
244
|
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
|
342
|
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
|
|
|
|
|
275
|
# we're not actually executing the query. |
4498
|
|
|
|
|
|
|
$self->_spacetrack_delay(); |
4499
|
95
|
|
|
|
|
184
|
|
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
|
|
|
|
|
223
|
|
4510
|
95
|
|
|
|
|
14954
|
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
|
|
|
|
13487
|
|
4516
|
|
|
|
|
|
|
if ( my $resp = $self->_dump_request( |
4517
|
|
|
|
|
|
|
args => \@args, |
4518
|
|
|
|
|
|
|
method => 'GET', |
4519
|
|
|
|
|
|
|
url => $uri, |
4520
|
|
|
|
|
|
|
version => 2, |
4521
|
48
|
|
|
|
|
3068
|
) ) { |
4522
|
|
|
|
|
|
|
return $resp; |
4523
|
|
|
|
|
|
|
} |
4524
|
|
|
|
|
|
|
|
4525
|
47
|
100
|
|
|
|
134
|
$self->_check_cookie_generic( 2 ) |
4526
|
1
|
|
|
|
|
6
|
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
|
|
|
|
|
134
|
# my $resp = $self->_get_agent()->get( $url ); |
4533
|
|
|
|
|
|
|
my $resp = $self->_get_agent()->get( $uri ); |
4534
|
47
|
50
|
|
|
|
162
|
|
4535
|
|
|
|
|
|
|
if ( $resp->is_success() ) { |
4536
|
47
|
50
|
33
|
|
|
466
|
|
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
|
|
|
|
|
6
|
basicspacedata => '' ); |
4549
|
|
|
|
|
|
|
my $class = _find_rest_arg_value( \@args, |
4550
|
|
|
|
|
|
|
class => '' ); |
4551
|
2
|
100
|
33
|
|
|
14
|
|
|
|
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
|
|
|
|
|
5
|
|
4562
|
|
|
|
|
|
|
$self->_add_pragmata( $resp, |
4563
|
|
|
|
|
|
|
'spacetrack-type' => 'orbit', |
4564
|
|
|
|
|
|
|
'spacetrack-source' => 'spacetrack', |
4565
|
|
|
|
|
|
|
'spacetrack-interface' => 2, |
4566
|
|
|
|
|
|
|
); |
4567
|
|
|
|
|
|
|
|
4568
|
|
|
|
|
|
|
} |
4569
|
|
|
|
|
|
|
} |
4570
|
|
|
|
|
|
|
} |
4571
|
47
|
|
|
|
|
145
|
|
4572
|
47
|
|
|
|
|
170
|
$self->__dump_response( $resp ); |
4573
|
|
|
|
|
|
|
return $resp; |
4574
|
|
|
|
|
|
|
} |
4575
|
|
|
|
|
|
|
} |
4576
|
|
|
|
|
|
|
|
4577
|
4
|
|
|
4
|
|
12
|
sub _find_rest_arg_value { |
4578
|
4
|
|
|
|
|
13
|
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
|
|
501
|
sub _add_pragmata { |
4759
|
153
|
|
|
|
|
416
|
my ($self, $resp, @args) = @_; |
4760
|
331
|
|
|
|
|
6383
|
while (@args) { |
4761
|
331
|
|
|
|
|
687
|
my ( $name, $value ) = splice @args, 0, 2; |
4762
|
331
|
|
|
|
|
691
|
$name = lc $name; |
4763
|
331
|
|
|
|
|
863
|
$name =~ s/ _ /-/smxg; |
4764
|
331
|
|
|
|
|
1237
|
$self->{_pragmata}{$name} = $value; |
4765
|
|
|
|
|
|
|
$resp->push_header(pragma => "$name = $value"); |
4766
|
153
|
|
|
|
|
5660
|
} |
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
|
|
168
|
sub _accumulator_for { |
4800
|
83
|
|
66
|
|
|
318
|
my ( $format, $opt ) = @_; |
4801
|
83
|
|
50
|
|
|
564
|
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
|
|
39
|
|| sub { |
4806
|
20
|
|
|
|
|
68
|
my ( undef, $context ) = @_; |
4807
|
83
|
|
100
|
|
|
444
|
return $context->{data}; |
4808
|
83
|
|
100
|
|
|
353
|
}; |
4809
|
|
|
|
|
|
|
my $context = { |
4810
|
|
|
|
|
|
|
format => $format, |
4811
|
|
|
|
|
|
|
opt => $opt || {}, |
4812
|
|
|
|
|
|
|
}; |
4813
|
106
|
|
|
106
|
|
208
|
return sub { |
4814
|
106
|
100
|
|
|
|
260
|
my ( $self, $resp ) = @_; |
4815
|
|
|
|
|
|
|
defined $resp |
4816
|
54
|
|
|
|
|
141
|
or return $returner->( $self, $context ); |
4817
|
54
|
50
|
33
|
|
|
795
|
my $content = $resp->content(); |
4818
|
|
|
|
|
|
|
defined $content |
4819
|
|
|
|
|
|
|
and $content ne '' |
4820
|
54
|
|
|
|
|
120
|
or return; |
4821
|
|
|
|
|
|
|
my $data = $accumulator->( $self, $content, $context ); |
4822
|
54
|
100
|
100
|
|
|
178
|
$context->{opt}{file} |
4823
|
|
|
|
|
|
|
and $data |
4824
|
54
|
|
|
|
|
375
|
and _accumulate_file_of_record( $self, $context, $data ); |
4825
|
|
|
|
|
|
|
return; |
4826
|
83
|
|
|
|
|
400
|
} |
4827
|
|
|
|
|
|
|
} |
4828
|
|
|
|
|
|
|
|
4829
|
|
|
|
|
|
|
} |
4830
|
|
|
|
|
|
|
|
4831
|
1
|
|
|
1
|
|
5
|
sub _accumulate_file_of_record { |
4832
|
1
|
50
|
|
|
|
5
|
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
|
|
|
|
|
12
|
$context->{file} = List::Util::max( -1, |
4841
|
1
|
|
|
|
|
4
|
map { $_->{FILE} } |
4842
|
1
|
|
|
|
|
3
|
grep { defined $_->{FILE} } |
|
1
|
|
|
|
|
3
|
|
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
|
|
148
|
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
|
|
|
140
|
pretty => $context->{opt}{pretty}, |
4905
|
|
|
|
|
|
|
); |
4906
|
33
|
|
|
|
|
812
|
|
4907
|
|
|
|
|
|
|
my $data = $json->decode( $content ); |
4908
|
33
|
50
|
|
|
|
166
|
|
4909
|
|
|
|
|
|
|
ARRAY_REF eq ref $data |
4910
|
|
|
|
|
|
|
or $data = [ $data ]; |
4911
|
33
|
100
|
|
|
|
51
|
|
|
33
|
|
|
|
|
79
|
|
4912
|
|
|
|
|
|
|
@{ $data } |
4913
|
|
|
|
|
|
|
or return; |
4914
|
32
|
100
|
|
|
|
79
|
|
4915
|
1
|
|
|
|
|
2
|
if ( $context->{data} ) { |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
2
|
|
4916
|
|
|
|
|
|
|
push @{ $context->{data} }, @{ $data }; |
4917
|
31
|
|
|
|
|
51
|
} else { |
4918
|
|
|
|
|
|
|
$context->{data} = $data; |
4919
|
|
|
|
|
|
|
} |
4920
|
32
|
|
|
|
|
60
|
|
4921
|
|
|
|
|
|
|
return $data; |
4922
|
|
|
|
|
|
|
} |
4923
|
|
|
|
|
|
|
|
4924
|
|
|
|
|
|
|
# Accessed via __PACKAGE__->can( "accumulate_${name}_return" ) in |
4925
|
|
|
|
|
|
|
# _accumulator_for(), above |
4926
|
32
|
|
|
32
|
|
51
|
sub _accumulate_json_return { ## no critic (ProhibitUnusedPrivateSubroutines) |
4927
|
|
|
|
|
|
|
my ( $self, $context ) = @_; |
4928
|
|
|
|
|
|
|
|
4929
|
|
|
|
|
|
|
my $json = $context->{json} ||= $self->_get_json_object( |
4930
|
32
|
|
33
|
|
|
90
|
pretty => $context->{opt}{pretty}, |
4931
|
|
|
|
|
|
|
); |
4932
|
32
|
|
100
|
|
|
72
|
|
4933
|
|
|
|
|
|
|
$context->{data} ||= []; # In case we did not find anything. |
4934
|
|
|
|
|
|
|
return wantarray |
4935
|
32
|
100
|
|
|
|
523
|
? ( $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
|
|
46
|
sub _accumulate_tle_data { ## no critic (ProhibitUnusedPrivateSubroutines) |
4950
|
21
|
|
|
|
|
68
|
my ( undef, $content, $context ) = @_; # Invocant unused |
4951
|
21
|
|
|
|
|
39
|
$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
|
|
7
|
sub _record_cookie_generic { |
4974
|
|
|
|
|
|
|
my ( $self, $version ) = @_; |
4975
|
2
|
50
|
|
|
|
7
|
defined $version |
4976
|
2
|
|
|
|
|
7
|
or $version = $self->{space_track_version}; |
4977
|
2
|
|
|
|
|
6
|
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
|
|
|
|
|
4
|
|
4981
|
|
|
|
|
|
|
my ( $cookie, $expires ); |
4982
|
2
|
50
|
|
2
|
|
68
|
$self->_get_agent()->cookie_jar->scan( sub { |
4983
|
|
|
|
|
|
|
$self->{dump_headers} & DUMP_COOKIE |
4984
|
2
|
50
|
|
|
|
8
|
and $self->_dump_cookie( "_record_cookie_generic:\n", @_ ); |
4985
|
|
|
|
|
|
|
$_[4] eq $domain |
4986
|
2
|
50
|
|
|
|
6
|
or return; |
4987
|
|
|
|
|
|
|
$_[3] eq SESSION_PATH |
4988
|
2
|
50
|
|
|
|
6
|
or return; |
4989
|
|
|
|
|
|
|
$_[1] eq $cookie_name |
4990
|
2
|
|
|
|
|
9
|
or return; |
4991
|
2
|
|
|
|
|
6
|
( $cookie, $expires ) = @_[2, 8]; |
4992
|
2
|
|
|
|
|
9
|
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
|
|
|
38
|
# 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
|
|
|
|
8
|
|
5002
|
2
|
|
|
|
|
5
|
if ( defined $cookie ) { |
5003
|
2
|
50
|
|
|
|
8
|
$interface_info->{session_cookie} = $cookie; |
5004
|
|
|
|
|
|
|
$self->{dump_headers} & DUMP_TRACE |
5005
|
2
|
50
|
|
|
|
6
|
and warn "Session cookie: $cookie\n"; ## no critic (RequireCarping) |
5006
|
2
|
|
|
|
|
5
|
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
|
|
|
|
|
10
|
" ($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
|
|
76
|
sub _check_cookie_generic { |
5023
|
|
|
|
|
|
|
my ( $self, $version ) = @_; |
5024
|
47
|
50
|
|
|
|
115
|
defined $version |
5025
|
47
|
|
|
|
|
80
|
or $version = $self->{space_track_version}; |
5026
|
|
|
|
|
|
|
my $interface_info = $self->{_space_track_interface}[$version]; |
5027
|
47
|
50
|
|
|
|
107
|
|
5028
|
|
|
|
|
|
|
if ( exists $interface_info->{cookie_expires} ) { |
5029
|
47
|
|
66
|
|
|
252
|
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
|
|
89
|
sub _convert_content { |
5044
|
33
|
|
|
|
|
143
|
my ( undef, @args ) = @_; # Invocant unused |
5045
|
33
|
|
|
|
|
90
|
local $/ = undef; # Slurp mode. |
5046
|
33
|
|
|
|
|
129
|
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
|
|
|
|
450
|
# left in in case something else leaks through. |
5052
|
33
|
|
|
|
|
5759
|
defined $buffer or $buffer = ''; |
5053
|
33
|
|
|
|
|
179
|
$buffer =~ s/$lookfor/\n/smxgo; |
5054
|
33
|
|
|
|
|
16532
|
1 while ($buffer =~ s/ \A \n+ //smx); |
5055
|
33
|
100
|
|
|
|
535
|
$buffer =~ s/ \s+ \n /\n/smxg; |
5056
|
33
|
|
|
|
|
139
|
$buffer =~ m/ \n \z /smx or $buffer .= "\n"; |
5057
|
33
|
|
|
|
|
800
|
$resp->content ($buffer); |
5058
|
|
|
|
|
|
|
$resp->header ( |
5059
|
|
|
|
|
|
|
'content-length' => length ($buffer), |
5060
|
|
|
|
|
|
|
); |
5061
|
33
|
|
|
|
|
2022
|
} |
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' => 1, |
5081
|
|
|
|
|
|
|
'--end_epoch' => 1, |
5082
|
|
|
|
|
|
|
'--last5' => 1, |
5083
|
|
|
|
|
|
|
'--sort' => 1, |
5084
|
|
|
|
|
|
|
'--start_epoch' => 1, |
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
|
|
227
|
sub _deprecation_notice { |
5098
|
96
|
100
|
|
|
|
279
|
my ( undef, $method, $argument ) = @_; # Invocant unused |
5099
|
|
|
|
|
|
|
my $level = $deprecate{$method} |
5100
|
90
|
|
|
|
|
143
|
or return; |
5101
|
90
|
50
|
|
|
|
251
|
my $desc = $method; |
5102
|
90
|
50
|
|
|
|
203
|
if ( ref $level ) { |
5103
|
90
|
50
|
|
|
|
264
|
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
|
|
344
|
sub __dump_response { |
5167
|
|
|
|
|
|
|
my ( $self, $resp, $message ) = @_; |
5168
|
133
|
50
|
|
|
|
443
|
|
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
|
|
|
|
|
256
|
} |
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
|
|
535
|
sub _dump_request { |
5207
|
121
|
100
|
|
|
|
566
|
my ( $self, %args ) = @_; |
5208
|
|
|
|
|
|
|
$self->{dump_headers} & DUMP_REQUEST |
5209
|
|
|
|
|
|
|
or return; |
5210
|
48
|
|
|
|
|
98
|
|
5211
|
48
|
50
|
|
|
|
108
|
my $message = delete $args{message}; |
5212
|
|
|
|
|
|
|
defined $message |
5213
|
48
|
|
|
|
|
281
|
or $message = 'Request object'; |
5214
|
|
|
|
|
|
|
$message =~ s/ \s* \z /:\n/smx; |
5215
|
48
|
50
|
|
|
|
133
|
|
5216
|
|
|
|
|
|
|
my $json = $self->_get_json_object( pretty => 1 ) |
5217
|
|
|
|
|
|
|
or return; |
5218
|
48
|
|
|
|
|
136
|
|
5219
|
192
|
50
|
|
|
|
436
|
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
|
|
|
|
629
|
|
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
|
|
260
|
sub _get_json_object { |
5236
|
|
|
|
|
|
|
my ( $self, %arg ) = @_; |
5237
|
83
|
100
|
|
|
|
193
|
defined $arg{pretty} |
5238
|
83
|
|
|
|
|
616
|
or $arg{pretty} = $self->{pretty}; |
5239
|
|
|
|
|
|
|
my $json = JSON->new()->utf8()->convert_blessed(); |
5240
|
83
|
100
|
|
|
|
291
|
$arg{pretty} |
5241
|
83
|
|
|
|
|
264
|
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
|
|
142
|
sub _expand_oid_list { |
5253
|
|
|
|
|
|
|
my ( $self, @args ) = @_; |
5254
|
46
|
|
|
|
|
69
|
|
5255
|
46
|
|
|
|
|
101
|
my @rslt; |
|
211
|
|
|
|
|
1124
|
|
5256
|
211
|
100
|
|
|
|
831
|
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
|
|
|
|
5
|
) { |
5260
|
|
|
|
|
|
|
( $lo, $hi ) = $self->_check_range( $lo, $hi ) |
5261
|
|
|
|
|
|
|
and push @rslt, $lo .. $hi; |
5262
|
210
|
|
|
|
|
525
|
} elsif ( $arg =~ m/ \A \s* ( \d+ ) \s* \z /smx ) { |
5263
|
|
|
|
|
|
|
push @rslt, $1; |
5264
|
|
|
|
|
|
|
} else { |
5265
|
|
|
|
|
|
|
# TODO -- ignore? die? what? |
5266
|
|
|
|
|
|
|
} |
5267
|
46
|
|
|
|
|
236
|
} |
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
|
|
75
|
sub _extract_keys { |
5280
|
28
|
50
|
|
|
|
102
|
my ( $lgl_opts ) = @_; |
5281
|
28
|
|
|
|
|
46
|
if ( ARRAY_REF eq ref $lgl_opts ) { |
|
28
|
|
|
|
|
56
|
|
5282
|
28
|
|
|
|
|
45
|
my $len = @{ $lgl_opts }; |
5283
|
28
|
|
|
|
|
85
|
my @rslt; |
5284
|
210
|
|
|
|
|
860
|
for ( my $inx = 0; $inx < $len; $inx += 2 ) { |
5285
|
210
|
|
|
|
|
616
|
( my $key = $lgl_opts->[$inx] ) =~ s/ $strip //smxo; |
5286
|
|
|
|
|
|
|
push @rslt, $key, 1; |
5287
|
28
|
|
|
|
|
239
|
} |
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
|
|
32
|
sub _format_international_id_rest { |
5306
|
14
|
|
|
|
|
33
|
my ( $intl_id ) = @_; |
5307
|
14
|
100
|
|
|
|
56
|
my @parts = _parse_international_id( $intl_id ); |
5308
|
|
|
|
|
|
|
@parts >= 3 |
5309
|
10
|
100
|
|
|
|
70
|
and return sprintf '%04d-%03d%s', @parts; |
5310
|
|
|
|
|
|
|
@parts >= 2 |
5311
|
1
|
|
|
|
|
6
|
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
|
|
28
|
sub _format_launch_date_rest { |
5320
|
14
|
50
|
|
|
|
31
|
my ( $date ) = @_; |
5321
|
|
|
|
|
|
|
my @parts = _parse_launch_date( $date ) |
5322
|
14
|
50
|
|
|
|
117
|
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
|
|
127
|
sub _get_agent { |
5347
|
|
|
|
|
|
|
my ( $self ) = @_; |
5348
|
66
|
100
|
|
|
|
321
|
$self->{agent} |
5349
|
7
|
|
|
|
|
37
|
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
|
|
|
|
|
1687
|
|
5356
|
|
|
|
|
|
|
$agent->env_proxy(); |
5357
|
7
|
50
|
|
|
|
98108
|
|
5358
|
|
|
|
|
|
|
$agent->cookie_jar() |
5359
|
|
|
|
|
|
|
or $agent->cookie_jar( {} ); |
5360
|
7
|
|
|
|
|
47711
|
|
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
|
|
87
|
sub _get_from_net { |
5402
|
12
|
|
|
|
|
44
|
my ( $self, %arg ) = @_; |
5403
|
|
|
|
|
|
|
delete $self->{_pragmata}; |
5404
|
12
|
50
|
|
|
|
127
|
|
5405
|
12
|
|
|
|
|
92
|
my $method = defined $arg{method} ? $arg{method} : ( caller 1)[3]; |
5406
|
|
|
|
|
|
|
$method =~ s/ .* :: //smx; |
5407
|
12
|
|
|
|
|
44
|
|
5408
|
|
|
|
|
|
|
my $url; |
5409
|
12
|
100
|
|
|
|
54
|
my $info; |
|
|
50
|
|
|
|
|
|
5410
|
6
|
|
|
|
|
19
|
if ( defined $arg{url} ) { |
5411
|
6
|
|
|
|
|
14
|
$url = $arg{url}; |
5412
|
|
|
|
|
|
|
$info = {}; |
5413
|
|
|
|
|
|
|
} elsif ( exists $arg{catalog} ) { |
5414
|
|
|
|
|
|
|
defined $arg{catalog} |
5415
|
|
|
|
|
|
|
and $catalogs{$method} |
5416
|
6
|
50
|
33
|
|
|
122
|
and $info = $catalogs{$method}{$arg{catalog}} |
|
|
|
33
|
|
|
|
|
5417
|
6
|
|
|
|
|
41
|
or return $self->_no_such_catalog( $method, $arg{catalog} ); |
5418
|
|
|
|
|
|
|
$self->_deprecation_notice( $method => $arg{catalog} ); |
5419
|
6
|
50
|
|
|
|
30
|
$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
|
|
|
|
290
|
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
|
|
|
|
|
77
|
|
5434
|
12
|
|
|
|
|
102
|
my $agent = $self->_get_agent(); |
5435
|
12
|
|
|
|
|
1861
|
my $rqst = HTTP::Request->new( GET => $url ); |
5436
|
12
|
100
|
|
|
|
63
|
my $file_time; |
5437
|
1
|
50
|
|
|
|
27
|
if ( defined $arg{file} ) { |
5438
|
1
|
|
|
|
|
7
|
if ( my @stat = stat $arg{file} ) { |
5439
|
1
|
|
|
|
|
30
|
$file_time = HTTP::Date::time2str( $stat[9] ); |
5440
|
|
|
|
|
|
|
$rqst->header( if_modified_since => $file_time ); |
5441
|
|
|
|
|
|
|
} |
5442
|
|
|
|
|
|
|
} |
5443
|
12
|
|
|
|
|
104
|
|
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
|
|
|
|
119
|
) |
5466
|
12
|
|
|
|
|
164
|
and return $resp; |
5467
|
12
|
|
|
|
|
7703327
|
$resp = $agent->request( $rqst ); |
5468
|
|
|
|
|
|
|
$self->__dump_response( |
5469
|
|
|
|
|
|
|
$resp, '_get_from_net() initial response object' ); |
5470
|
12
|
50
|
|
|
|
62
|
|
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
|
|
|
242
|
and defined $arg{post_process} |
5488
|
12
|
100
|
|
|
|
8190
|
and $resp = $arg{post_process}->( $self, $resp, $info ); |
5489
|
|
|
|
|
|
|
$resp->is_success() # $resp may be a different object now. |
5490
|
11
|
|
|
|
|
163
|
or return $resp; |
5491
|
11
|
100
|
|
|
|
69
|
$self->_convert_content( $resp ); |
5492
|
|
|
|
|
|
|
if ( defined $arg{file} ) { |
5493
|
1
|
50
|
|
|
|
112
|
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
|
|
|
|
|
8
|
|
5497
|
1
|
|
|
|
|
454
|
print { $fh } $resp->content(); |
5498
|
1
|
|
|
|
|
11
|
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
|
|
|
|
72
|
$info->{spacetrack_source} : |
|
|
100
|
|
|
|
|
|
5507
|
|
|
|
|
|
|
$method; |
5508
|
|
|
|
|
|
|
|
5509
|
|
|
|
|
|
|
$self->_add_pragmata( $resp, |
5510
|
11
|
|
|
|
|
45
|
map { |
5511
|
33
|
100
|
|
|
|
185
|
defined $arg{$_} ? ( $_ => $arg{$_} ) : |
|
|
100
|
|
|
|
|
|
5512
|
|
|
|
|
|
|
defined $info->{$_} ? ( $_ => $info->{$_} ) : |
5513
|
|
|
|
|
|
|
() |
5514
|
|
|
|
|
|
|
} |
5515
|
11
|
|
|
|
|
46
|
qw{ spacetrack_type spacetrack_source spacetrack_cache_hit } ); |
5516
|
|
|
|
|
|
|
$self->__dump_response( $resp, |
5517
|
11
|
|
|
|
|
609
|
'_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
|
|
183
|
sub _get_space_track_domain { |
5527
|
|
|
|
|
|
|
my ( $self, $version ) = @_; |
5528
|
99
|
100
|
|
|
|
248
|
defined $version |
5529
|
99
|
|
|
|
|
574
|
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
|
|
114
|
## my ( $invocant, %arg ) = @_; # Arguments unused |
5542
|
|
|
|
|
|
|
my $json = JSON->new()->utf8( 1 ); |
5543
|
48
|
|
|
48
|
|
3364
|
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
|
|
6
|
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
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
19
|
|
5566
|
1
|
|
|
|
|
6
|
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
|
|
|
|
|
4
|
$id =~ m/ \A \s* \d+ \z /smx or next; |
5570
|
1
|
|
|
|
|
2
|
my $name = substr $_, 5; |
5571
|
1
|
|
|
|
|
3
|
$name =~ s/ \A \s+ //smx; |
5572
|
1
|
|
|
|
|
36
|
push @catnum, $id; |
5573
|
|
|
|
|
|
|
push @data, [ $id, $name ]; |
5574
|
1
|
|
|
|
|
3
|
} |
5575
|
1
|
50
|
|
|
|
5
|
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
|
|
|
|
|
5
|
} 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
|
|
|
|
|
4
|
} |
5596
|
|
|
|
|
|
|
$self->__dump_response( $resp ); |
5597
|
|
|
|
|
|
|
} |
5598
|
1
|
50
|
|
|
|
27
|
} |
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
|
|
4
|
sub _instance { |
5606
|
1
|
50
|
|
|
|
5
|
my ( $object, $class ) = @_; |
5607
|
1
|
50
|
|
|
|
6
|
ref $object or return; |
5608
|
1
|
|
|
|
|
14
|
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
|
|
198
|
sub _make_space_track_base_url { |
5618
|
99
|
|
|
|
|
339
|
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
|
|
67
|
# not modify the contents of @_. Modifying @_ itself is fine. |
5645
|
17
|
|
|
|
|
58
|
sub _mutate_attrib { |
5646
|
|
|
|
|
|
|
$_[0]->_deprecation_notice( attribute => $_[1] ); |
5647
|
|
|
|
|
|
|
return ($_[0]{$_[1]} = $_[2]); |
5648
|
|
|
|
|
|
|
} |
5649
|
23
|
|
|
23
|
|
54
|
|
5650
|
23
|
50
|
|
|
|
68
|
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
|
|
|
|
50
|
push @{ $args }, $value; # Since caller pops it. |
5668
|
|
|
|
|
|
|
} else { |
5669
|
|
|
|
|
|
|
$value =~ m/ \A 0 (?: [0-7]+ | x [[:xdigit:]]+ ) \z /smx |
5670
|
23
|
|
|
|
|
69
|
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
|
|
63
|
|
5713
|
|
|
|
|
|
|
sub _mutate_identity { |
5714
|
20
|
50
|
|
|
|
71
|
my ( $self, $name, $value ) = @_; |
5715
|
20
|
50
|
33
|
|
|
130
|
defined $value |
5716
|
0
|
|
|
|
|
0
|
or $value = $ENV{SPACETRACK_IDENTITY}; |
|
0
|
|
|
|
|
0
|
|
5717
|
|
|
|
|
|
|
if ( $value and my $identity = __spacetrack_identity() ) { |
5718
|
20
|
|
|
|
|
60
|
$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
|
|
27
|
# off to _mutate attrib. |
5801
|
4
|
|
|
|
|
180
|
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
|
|
13
|
sub _mutate_iridium_status_format { |
5809
|
2
|
|
|
|
|
12
|
Carp::croak "Error - Illegal status format '$_[2]'" |
5810
|
2
|
|
|
|
|
13
|
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
|
|
6
|
|
5831
|
2
|
50
|
|
|
|
9
|
sub _mutate_space_track_version { |
5832
|
|
|
|
|
|
|
my ( $self, $name, $value ) = @_; |
5833
|
|
|
|
|
|
|
$value |
5834
|
2
|
50
|
33
|
|
|
34
|
or $value = DEFAULT_SPACE_TRACK_VERSION; |
5835
|
|
|
|
|
|
|
$value =~ m/ \A \d+ \z /smx |
5836
|
|
|
|
|
|
|
and $self->{_space_track_interface}[$value] |
5837
|
2
|
50
|
|
|
|
12
|
or Carp::croak "Invalid Space Track version $value"; |
5838
|
|
|
|
|
|
|
## $self->_deprecation_notice( $name => $value ); |
5839
|
2
|
|
|
|
|
7
|
$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
|
|
|
|
15
|
my ( $self, $source, @args ) = @_; |
5869
|
|
|
|
|
|
|
|
5870
|
|
|
|
|
|
|
my $info = $catalogs{$source} |
5871
|
2
|
100
|
|
|
|
14
|
or Carp::confess "Bug - No such source as '$source'"; |
5872
|
1
|
|
|
|
|
3
|
|
5873
|
1
|
50
|
|
|
|
4
|
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
|
|
|
|
|
8
|
} |
5879
|
|
|
|
|
|
|
|
5880
|
2
|
|
33
|
|
|
14
|
my ( $catalog, $note ) = @args; |
5881
|
|
|
|
|
|
|
|
5882
|
|
|
|
|
|
|
my $name = $no_such_name{$source} || $source; |
5883
|
2
|
50
|
|
|
|
18
|
|
|
|
50
|
|
|
|
|
|
5884
|
|
|
|
|
|
|
my $lead = defined $catalog ? |
5885
|
|
|
|
|
|
|
$info->{$catalog} ? |
5886
|
|
|
|
|
|
|
"$name '$catalog' missing" : |
5887
|
2
|
100
|
|
|
|
13
|
"$name '$catalog' not found" : |
5888
|
|
|
|
|
|
|
"$name item not defined"; |
5889
|
|
|
|
|
|
|
$lead .= defined $note ? " ($note)." : '.'; |
5890
|
2
|
50
|
|
|
|
19
|
|
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
|
|
278
|
|
5915
|
109
|
100
|
|
|
|
352
|
sub _parse_args { |
5916
|
20
|
|
|
|
|
69
|
my ( $lgl_opts, @args ) = @_; |
5917
|
20
|
|
|
|
|
378
|
unless ( ARRAY_REF eq ref $lgl_opts ) { |
5918
|
20
|
|
|
|
|
98
|
unshift @args, $lgl_opts; |
5919
|
20
|
50
|
|
|
|
235
|
( my $caller = ( caller 1 )[3] ) =~ s/ ( .* ) :: //smx; |
5920
|
|
|
|
|
|
|
my $pkg = $1; |
5921
|
20
|
|
|
|
|
92
|
my $code = $pkg->can( "_${caller}_opts" ) |
5922
|
|
|
|
|
|
|
or Carp::confess "Bug - _${caller}_opts not found"; |
5923
|
109
|
|
|
|
|
177
|
$lgl_opts = $code->(); |
5924
|
109
|
100
|
|
|
|
303
|
} |
5925
|
18
|
|
|
|
|
29
|
my $opt; |
|
18
|
|
|
|
|
71
|
|
5926
|
|
|
|
|
|
|
if ( HASH_REF eq ref $args[0] ) { |
5927
|
|
|
|
|
|
|
$opt = { %{ shift @args } }; # Poor man's clone. |
5928
|
18
|
50
|
|
|
|
77
|
# Validation is new, so I insert a hack to turn it off if need |
5929
|
18
|
|
|
|
|
47
|
# be. |
5930
|
18
|
|
|
|
|
49
|
unless ( $ENV{SPACETRACK_SKIP_OPTION_HASH_VALIDATION} ) { |
5931
|
18
|
|
|
|
|
32
|
my %lgl = _extract_keys( $lgl_opts ); |
|
18
|
|
|
|
|
55
|
|
5932
|
47
|
50
|
|
|
|
103
|
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
|
|
|
|
66
|
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
|
|
|
|
|
171
|
} |
5952
|
91
|
|
|
|
|
153
|
} else { |
|
91
|
|
|
|
|
560
|
|
5953
|
91
|
50
|
|
|
|
570
|
$opt = {}; |
5954
|
|
|
|
|
|
|
my %lgl = @{ $lgl_opts }; |
5955
|
|
|
|
|
|
|
$go->getoptionsfromarray( |
5956
|
|
|
|
|
|
|
\@args, |
5957
|
|
|
|
|
|
|
$opt, |
5958
|
|
|
|
|
|
|
keys %lgl, |
5959
|
|
|
|
|
|
|
) |
5960
|
109
|
|
|
|
|
72000
|
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
|
|
25
|
|
6007
|
14
|
|
|
|
|
23
|
sub _parse_international_id { |
6008
|
|
|
|
|
|
|
my ( $intl_id ) = @_; |
6009
|
14
|
50
|
|
|
|
113
|
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
|
|
|
|
|
57
|
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
|
|
|
|
47
|
} |
|
|
50
|
|
|
|
|
|
6023
|
14
|
|
|
|
|
31
|
|
6024
|
14
|
100
|
|
|
|
33
|
$year += $year < 57 ? 2000 : $year < 100 ? 1900 : 0; |
6025
|
|
|
|
|
|
|
my @parts = ( $year ); |
6026
|
13
|
|
|
|
|
27
|
$launch |
6027
|
13
|
100
|
|
|
|
33
|
or return @parts; |
6028
|
|
|
|
|
|
|
push @parts, $launch; |
6029
|
13
|
|
|
|
|
38
|
$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
|
|
28
|
|
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
|
|
|
|
|
30
|
or return; |
6045
|
14
|
50
|
|
|
|
35
|
$year += $year < 57 ? 2000 : $year < 100 ? 1900 : 0; |
6046
|
|
|
|
|
|
|
my @parts = ( $year ); |
6047
|
14
|
|
|
|
|
24
|
defined $month |
6048
|
14
|
50
|
|
|
|
35
|
or return @parts; |
6049
|
14
|
|
|
|
|
54
|
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
|
|
224
|
|
6078
|
85
|
100
|
|
|
|
270
|
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
|
|
|
|
218
|
( my $opt, @args ) = _parse_args( |
|
50
|
|
|
|
|
222
|
|
6085
|
|
|
|
|
|
|
( $extra_options ? |
6086
|
|
|
|
|
|
|
[ @legal_retrieve_options, @{ $extra_options } ] : |
6087
|
|
|
|
|
|
|
\@legal_retrieve_options ), |
6088
|
85
|
|
66
|
|
|
441
|
@args ); |
6089
|
|
|
|
|
|
|
|
6090
|
85
|
|
|
|
|
231
|
$opt->{sort} ||= _validate_sort( $opt->{sort} ); |
6091
|
|
|
|
|
|
|
|
6092
|
85
|
|
|
|
|
278
|
_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
|
|
215
|
|
6116
|
|
|
|
|
|
|
sub _retrieval_format { |
6117
|
94
|
50
|
|
|
|
300
|
my ( $table, $opt ) = @_; |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
6118
|
|
|
|
|
|
|
defined $table |
6119
|
|
|
|
|
|
|
or $table = defined $opt->{tle} ? $opt->{tle} ? 'tle' : |
6120
|
|
|
|
|
|
|
'satcat' : 'tle'; |
6121
|
94
|
50
|
100
|
|
|
250
|
$opt->{json} |
|
|
|
66
|
|
|
|
|
6122
|
|
|
|
|
|
|
and defined $opt->{format} |
6123
|
94
|
50
|
|
|
|
242
|
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
|
|
|
|
306
|
defined $opt->{format} |
|
|
100
|
|
|
|
|
|
6128
|
|
|
|
|
|
|
or $opt->{format} = $opt->{json} ? 'json' : |
6129
|
94
|
100
|
|
|
|
299
|
$format{$table}{default}; |
6130
|
|
|
|
|
|
|
exists $opt->{json} |
6131
|
94
|
50
|
|
|
|
267
|
or $opt->{json} = 'json' eq $opt->{format}; |
6132
|
94
|
100
|
|
|
|
217
|
$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
|
|
142
|
my %valid = map { $_ => 1 } qw{ catnum epoch }; |
6143
|
68
|
50
|
|
|
|
292
|
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
|
|
55
|
|
6166
|
|
|
|
|
|
|
sub _parse_retrieve_dates { |
6167
|
34
|
|
|
|
|
53
|
my ( $opt ) = @_; |
6168
|
34
|
|
|
|
|
63
|
|
6169
|
|
|
|
|
|
|
my $found; |
6170
|
68
|
100
|
|
|
|
156
|
foreach my $key ( qw{ end_epoch start_epoch } ) { |
6171
|
|
|
|
|
|
|
|
6172
|
6
|
50
|
|
|
|
32
|
next unless $opt->{$key}; |
6173
|
6
|
|
|
|
|
14
|
|
6174
|
6
|
50
|
|
|
|
35
|
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
|
|
|
|
|
29
|
\z >smx |
6180
|
6
|
|
|
|
|
14
|
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
|
|
|
|
21
|
or $_ = 0; |
|
|
0
|
|
|
|
|
|
6185
|
6
|
|
|
|
|
11
|
} |
6186
|
|
|
|
|
|
|
if ( $time[5] > 1900 ) { |
6187
|
0
|
|
|
|
|
0
|
$time[5] -= 1900; |
6188
|
|
|
|
|
|
|
} elsif ( $time[5] < 57 ) { |
6189
|
6
|
|
|
|
|
11
|
$time[5] += 100; |
6190
|
6
|
50
|
|
|
|
13
|
} |
6191
|
6
|
|
|
|
|
23
|
$time[4] -= 1; |
6192
|
6
|
|
|
|
|
257
|
eval { |
6193
|
|
|
|
|
|
|
$opt->{$key} = Time::Local::timegm( @time ); |
6194
|
|
|
|
|
|
|
1; |
6195
|
|
|
|
|
|
|
} or Carp::croak "Error - Illegal date '$str'"; |
6196
|
6
|
|
|
|
|
14
|
} |
6197
|
|
|
|
|
|
|
|
6198
|
|
|
|
|
|
|
$found++; |
6199
|
34
|
100
|
|
|
|
70
|
} |
6200
|
|
|
|
|
|
|
|
6201
|
5
|
100
|
|
|
|
14
|
if ( $found ) { |
6202
|
4
|
|
66
|
|
|
17
|
|
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
|
|
|
|
16
|
} |
6207
|
|
|
|
|
|
|
|
6208
|
|
|
|
|
|
|
$opt->{start_epoch} <= $opt->{end_epoch} or Carp::croak <<'EOD'; |
6209
|
|
|
|
|
|
|
Error - End epoch must not be before start epoch. |
6210
|
5
|
|
|
|
|
11
|
EOD |
6211
|
|
|
|
|
|
|
|
6212
|
10
|
|
|
|
|
50
|
foreach my $key ( qw{ start_epoch end_epoch } ) { |
6213
|
10
|
|
|
|
|
24
|
|
6214
|
10
|
|
|
|
|
17
|
my @time = reverse( ( gmtime $opt->{$key} )[ 0 .. 5 ] ); |
6215
|
10
|
|
|
|
|
33
|
$time[0] += 1900; |
6216
|
|
|
|
|
|
|
$time[1] += 1; |
6217
|
|
|
|
|
|
|
$opt->{"_$key"} = \@time; |
6218
|
|
|
|
|
|
|
|
6219
|
|
|
|
|
|
|
} |
6220
|
34
|
|
|
|
|
65
|
} |
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
|
|
99
|
|
6249
|
50
|
|
|
|
|
68
|
sub _convert_search_options_to_rest { |
6250
|
|
|
|
|
|
|
my ( undef, $opt ) = @_; # Invocant unused |
6251
|
50
|
50
|
|
|
|
121
|
my %rest; |
6252
|
|
|
|
|
|
|
|
6253
|
50
|
50
|
|
|
|
132
|
if ( defined $opt->{status} ) { |
6254
|
|
|
|
|
|
|
defined ( my $query = $status_query{$opt->{status}} ) |
6255
|
50
|
100
|
|
|
|
146
|
or Carp::croak "Unknown status '$opt->{status}'"; |
6256
|
|
|
|
|
|
|
$query |
6257
|
|
|
|
|
|
|
and $rest{DECAY} = $query; |
6258
|
|
|
|
|
|
|
} |
6259
|
50
|
|
|
|
|
74
|
|
|
50
|
|
|
|
|
66
|
|
6260
|
|
|
|
|
|
|
{ |
6261
|
50
|
100
|
66
|
|
|
119
|
my %incl; |
|
50
|
|
|
|
|
189
|
|
6262
|
12
|
|
|
|
|
42
|
|
|
72
|
|
|
|
|
126
|
|
6263
|
12
|
|
|
|
|
28
|
if ( $opt->{exclude} && @{ $opt->{exclude} } ) { |
|
12
|
|
|
|
|
25
|
|
6264
|
18
|
50
|
|
|
|
42
|
%incl = map { $_ => 1 } keys %include_map; |
6265
|
|
|
|
|
|
|
foreach ( @{ $opt->{exclude} } ) { |
6266
|
18
|
|
|
|
|
48
|
$include_map{$_} |
6267
|
|
|
|
|
|
|
or Carp::croak "Unknown exclusion '$_'"; |
6268
|
|
|
|
|
|
|
delete $incl{$_}; |
6269
|
|
|
|
|
|
|
} |
6270
|
50
|
100
|
66
|
|
|
116
|
} |
|
50
|
|
|
|
|
128
|
|
6271
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
3
|
|
6272
|
1
|
50
|
|
|
|
4
|
if ( $opt->{include} && @{ $opt->{include} } ) { |
6273
|
|
|
|
|
|
|
foreach ( @{ $opt->{include} } ) { |
6274
|
1
|
|
|
|
|
3
|
$include_map{$_} |
6275
|
|
|
|
|
|
|
or Carp::croak "Unknown inclusion '$_'"; |
6276
|
|
|
|
|
|
|
$incl{$_} = 1; |
6277
|
|
|
|
|
|
|
} |
6278
|
|
|
|
|
|
|
} |
6279
|
|
|
|
|
|
|
|
6280
|
50
|
100
|
|
|
|
176
|
keys %incl |
|
55
|
|
|
|
|
123
|
|
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
|
|
134
|
|
6303
|
|
|
|
|
|
|
sub _parse_search_args { |
6304
|
50
|
50
|
|
|
|
135
|
my ( $self, @args ) = @_; |
6305
|
|
|
|
|
|
|
|
6306
|
50
|
|
|
|
|
96
|
my $extra = ARRAY_REF eq ref $args[0] ? shift @args : []; |
|
50
|
|
|
|
|
196
|
|
6307
|
|
|
|
|
|
|
@args = $self->_parse_retrieve_args( |
6308
|
50
|
|
|
|
|
134
|
[ @legal_search_args, @{ $extra } ], @args ); |
6309
|
|
|
|
|
|
|
|
6310
|
50
|
|
100
|
|
|
201
|
my $opt = $args[0]; |
6311
|
|
|
|
|
|
|
|
6312
|
50
|
50
|
|
|
|
132
|
$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
|
|
|
|
|
90
|
EOD |
6318
|
100
|
|
100
|
|
|
408
|
|
6319
|
100
|
|
|
|
|
144
|
foreach my $key ( qw{ exclude include } ) { |
|
16
|
|
|
|
|
64
|
|
|
100
|
|
|
|
|
209
|
|
6320
|
100
|
|
|
|
|
190
|
$opt->{$key} ||= []; |
|
100
|
|
|
|
|
225
|
|
6321
|
19
|
50
|
|
|
|
53
|
$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
|
|
|
|
123
|
|
6330
|
|
|
|
|
|
|
defined $opt->{tle} |
6331
|
50
|
|
|
|
|
153
|
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
|
|
28
|
# get the TLEs. |
6344
|
14
|
|
|
|
|
18
|
sub _remove_search_options { |
|
14
|
|
|
|
|
84
|
|
6345
|
14
|
|
|
|
|
61
|
my ( $opt ) = @_; |
6346
|
14
|
|
|
|
|
40
|
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
|
|
163
|
|
6362
|
|
|
|
|
|
|
sub _sort_rest_arguments { |
6363
|
89
|
50
|
|
|
|
228
|
my ( $rest_args ) = @_; |
6364
|
|
|
|
|
|
|
|
6365
|
|
|
|
|
|
|
HASH_REF eq ref $rest_args |
6366
|
89
|
|
|
|
|
128
|
or return; |
6367
|
|
|
|
|
|
|
|
6368
|
89
|
|
|
|
|
202
|
my @rslt; |
6369
|
|
|
|
|
|
|
|
6370
|
178
|
50
|
|
|
|
342
|
foreach my $key ( keys %special ) { |
6371
|
|
|
|
|
|
|
@rslt |
6372
|
178
|
50
|
|
|
|
406
|
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
|
|
|
|
|
1125
|
|
6377
|
1001
|
|
|
|
|
1572
|
|
6378
|
|
|
|
|
|
|
push @rslt, map { ( $_->[0], $rest_args->{$_->[0]} ) } |
6379
|
567
|
|
|
|
|
885
|
sort { $a->[1] cmp $b->[1] } |
6380
|
567
|
|
|
|
|
1018
|
# Oh, for 5.14 and tr///r |
6381
|
89
|
|
|
|
|
159
|
map { [ $_, _swap_upper_and_lower( $_ ) ] } |
|
89
|
|
|
|
|
239
|
|
6382
|
|
|
|
|
|
|
grep { ! $special{$_} } |
6383
|
89
|
|
|
|
|
614
|
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
|
|
131
|
push @builtins, qw{ bye exit show }; |
|
10
|
|
|
|
|
35
|
|
|
10
|
|
|
|
|
14610
|
|
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
|
|
21
|
|
6506
|
10
|
|
|
|
|
15
|
sub _rest_date { |
|
10
|
|
|
|
|
57
|
|
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
|
|
869
|
|
6518
|
567
|
|
|
|
|
855
|
sub _swap_upper_and_lower { |
6519
|
567
|
|
|
|
|
1456
|
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
|
|
123
|
|
6558
|
|
|
|
|
|
|
sub _stringify_oid_list { |
6559
|
47
|
|
|
|
|
100
|
my ( $opt, @args ) = @_; |
6560
|
|
|
|
|
|
|
|
6561
|
|
|
|
|
|
|
my @rslt = ( -99 ); # Prime the pump |
6562
|
47
|
50
|
|
|
|
121
|
|
6563
|
|
|
|
|
|
|
@args |
6564
|
47
|
50
|
|
|
|
119
|
or return @args; |
6565
|
47
|
|
|
|
|
73
|
|
6566
|
|
|
|
|
|
|
my $separator = defined $opt->{separator} ? $opt->{separator} : ','; |
6567
|
47
|
50
|
|
|
|
83
|
my $range_operator = $opt->{range_operator}; |
6568
|
47
|
|
|
|
|
138
|
|
|
201
|
|
|
|
|
274
|
|
6569
|
213
|
100
|
|
|
|
355
|
if ( defined $range_operator ) { |
6570
|
151
|
100
|
|
|
|
228
|
foreach my $arg ( sort { $a <=> $b } @args ) { |
6571
|
147
|
|
|
|
|
214
|
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
|
|
|
|
161
|
} |
6578
|
11
|
|
|
|
|
32
|
} else { |
6579
|
|
|
|
|
|
|
if ( $arg == $rslt[-1] + 1 ) { |
6580
|
51
|
50
|
|
|
|
158
|
$rslt[-1] = [ $rslt[-1], $arg ]; |
6581
|
|
|
|
|
|
|
} else { |
6582
|
|
|
|
|
|
|
$arg > $rslt[-1] |
6583
|
|
|
|
|
|
|
and push @rslt, $arg; |
6584
|
|
|
|
|
|
|
} |
6585
|
47
|
|
|
|
|
79
|
} |
6586
|
|
|
|
|
|
|
} |
6587
|
|
|
|
|
|
|
shift @rslt; # Drop the pump priming. |
6588
|
47
|
|
|
|
|
91
|
|
6589
|
|
|
|
|
|
|
return join( $separator, |
6590
|
|
|
|
|
|
|
map { ref $_ ? |
6591
|
55
|
100
|
|
|
|
283
|
$_->[1] > $_->[0] + 1 ? |
|
1
|
100
|
|
|
|
7
|
|
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
|
|
23
|
|
6621
|
5
|
|
|
|
|
23
|
sub _trim { |
6622
|
5
|
50
|
|
|
|
22
|
my @args = @_; |
6623
|
5
|
|
|
|
|
21
|
foreach ( @args ) { |
6624
|
5
|
|
|
|
|
29
|
defined $_ or $_ = ''; |
6625
|
|
|
|
|
|
|
s/ \A \s+ //smx; |
6626
|
5
|
|
|
|
|
19
|
s/ \s+ \z //smx; |
6627
|
|
|
|
|
|
|
} |
6628
|
|
|
|
|
|
|
return @args; |
6629
|
|
|
|
|
|
|
} |
6630
|
|
|
|
|
|
|
|
6631
|
|
|
|
|
|
|
1; |
6632
|
|
|
|
|
|
|
|
6633
|
|
|
|
|
|
|
__END__ |