line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#ABSTRACT: Subroutines for FR24-Bot |
2
|
|
|
|
|
|
|
package FR24::Bot; |
3
|
3
|
|
|
3
|
|
2329
|
use v5.12; |
|
3
|
|
|
|
|
10
|
|
4
|
3
|
|
|
3
|
|
21
|
use warnings; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
83
|
|
5
|
3
|
|
|
3
|
|
2331
|
use JSON::PP; |
|
3
|
|
|
|
|
44689
|
|
|
3
|
|
|
|
|
201
|
|
6
|
3
|
|
|
3
|
|
1334
|
use Data::Dumper; |
|
3
|
|
|
|
|
12699
|
|
|
3
|
|
|
|
|
164
|
|
7
|
3
|
|
|
3
|
|
20
|
use Exporter qw(import); |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
73
|
|
8
|
3
|
|
|
3
|
|
2362
|
use HTTP::Tiny; |
|
3
|
|
|
|
|
141364
|
|
|
3
|
|
|
|
|
146
|
|
9
|
3
|
|
|
3
|
|
1513
|
use File::Which; |
|
3
|
|
|
|
|
2953
|
|
|
3
|
|
|
|
|
164
|
|
10
|
3
|
|
|
3
|
|
1501
|
use FR24::Utils; |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
315
|
|
11
|
3
|
|
|
3
|
|
21
|
use Carp qw(confess); |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
2474
|
|
12
|
|
|
|
|
|
|
our $VERSION = "0.0.2"; |
13
|
|
|
|
|
|
|
my $UPDATE_MS = 10 * 1000; |
14
|
|
|
|
|
|
|
# Export version |
15
|
|
|
|
|
|
|
our @EXPORT = qw($VERSION); |
16
|
|
|
|
|
|
|
our @EXPORT_OK = qw(new get); |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
sub new { |
20
|
2
|
|
|
2
|
1
|
1372
|
my $class = shift @_; |
21
|
|
|
|
|
|
|
|
22
|
2
|
|
|
|
|
4
|
my $name = undef; |
23
|
2
|
|
|
|
|
4
|
my $config = undef; |
24
|
2
|
|
|
|
|
3
|
my $refresh = $UPDATE_MS; |
25
|
2
|
|
|
|
|
4
|
my $test_mode = 0; |
26
|
|
|
|
|
|
|
# Descriptive instantiation with parameters -param => value |
27
|
2
|
50
|
|
|
|
10
|
if (substr($_[0], 0, 1) eq '-') { |
28
|
2
|
|
|
|
|
10
|
my %data = @_; |
29
|
|
|
|
|
|
|
# Try parsing |
30
|
2
|
|
|
|
|
7
|
for my $i (keys %data) { |
31
|
5
|
100
|
|
|
|
32
|
if ($i =~ /^-conf/i) { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
32
|
|
|
|
|
|
|
#Can be -conf, -config and other crazy stuff, hope not -confused |
33
|
2
|
|
|
|
|
11
|
$config = $data{$i}; |
34
|
2
|
50
|
|
|
|
7
|
if (ref($config) ne "HASH") { |
35
|
2
|
|
|
|
|
16
|
$config = FR24::Utils::loadconfig($config); |
36
|
|
|
|
|
|
|
} |
37
|
|
|
|
|
|
|
} elsif ($i =~ /^-(name|id)$/i) { |
38
|
2
|
|
|
|
|
7
|
$name = $data{$i}; |
39
|
|
|
|
|
|
|
} elsif ($i =~ /^-refresh$/i) { |
40
|
|
|
|
|
|
|
# Receive seconds, convert to milliseconds |
41
|
0
|
|
|
|
|
0
|
$refresh = 1000 * $data{$i}; |
42
|
|
|
|
|
|
|
} elsif ($i =~ /^-test$/i) { |
43
|
|
|
|
|
|
|
# Receive seconds, convert to milliseconds |
44
|
1
|
|
|
|
|
3
|
$test_mode = 1; |
45
|
|
|
|
|
|
|
} else { |
46
|
0
|
|
|
|
|
0
|
confess "ERROR FR24::Bot: Unknown parameter $i\n"; |
47
|
|
|
|
|
|
|
} |
48
|
|
|
|
|
|
|
} |
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
|
54
|
2
|
|
|
|
|
9
|
my $self = bless {}, $class; |
55
|
|
|
|
|
|
|
|
56
|
2
|
50
|
|
|
|
8
|
if (not defined $config->{telegram}->{apikey}) { |
57
|
0
|
|
|
|
|
0
|
confess "ERROR FR24::Bot: No config provided or no apikey found\n"; |
58
|
|
|
|
|
|
|
} |
59
|
2
|
|
|
|
|
12
|
$self->{apikey} = $config->{telegram}->{apikey}; |
60
|
2
|
|
|
|
|
4
|
$self->{name} = $name; |
61
|
2
|
|
|
|
|
4
|
$self->{config} = $config; |
62
|
2
|
|
|
|
|
4
|
$self->{ip} = $config->{server}->{ip}; |
63
|
2
|
|
|
|
|
4
|
$self->{port} = $config->{server}->{port}; |
64
|
2
|
|
|
|
|
3
|
$self->{localip} = undef; |
65
|
2
|
|
|
|
|
3
|
$self->{refresh} = $refresh; |
66
|
2
|
|
|
|
|
6
|
$self->{total} = 0; |
67
|
2
|
|
|
|
|
3
|
$self->{uploaded} = 0; |
68
|
2
|
|
|
|
|
3
|
$self->{flights} = {}; |
69
|
2
|
|
|
|
|
5
|
$self->{callsigns} = {}; |
70
|
2
|
|
|
|
|
15
|
$self->{flights_url} = "http://" . $self->{ip} . ":" . $self->{port} . "/flights.json"; |
71
|
|
|
|
|
|
|
|
72
|
2
|
|
|
|
|
6
|
$self->{users} = {}; |
73
|
2
|
|
|
|
|
2
|
$self->{last_updated} = 0; |
74
|
2
|
|
|
|
|
4
|
$self->{last_url} = undef; |
75
|
2
|
|
|
|
|
4
|
$self->{test_mode} = $test_mode; |
76
|
2
|
|
|
|
|
6
|
$self->update(); |
77
|
2
|
|
|
|
|
32
|
return $self; |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
sub _timestamp_milliseconds { |
82
|
4
|
|
|
4
|
|
13
|
return int(time * 1000); |
83
|
|
|
|
|
|
|
} |
84
|
|
|
|
|
|
|
sub update { |
85
|
2
|
|
|
2
|
1
|
4
|
my $self = shift; |
86
|
|
|
|
|
|
|
|
87
|
2
|
|
|
|
|
4
|
my $timestamp = _timestamp_milliseconds(); |
88
|
2
|
50
|
|
|
|
16
|
if ($timestamp - $self->{last_updated} < $self->{refresh}) { |
89
|
|
|
|
|
|
|
# Update only once per second |
90
|
0
|
|
|
|
|
0
|
return; |
91
|
|
|
|
|
|
|
} |
92
|
2
|
|
|
|
|
4
|
$self->{last_updated} = $timestamp; |
93
|
2
|
|
|
|
|
7
|
my $url = $self->{flights_url} . "?time=" . _timestamp_milliseconds(); |
94
|
2
|
|
|
|
|
4
|
$self->{last_url} = $url; |
95
|
2
|
50
|
|
|
|
6
|
confess "No URL specified for update\n" unless defined $url; |
96
|
|
|
|
|
|
|
|
97
|
2
|
|
|
|
|
10
|
my $content = _curl($url); |
98
|
2
|
|
|
|
|
6
|
$self->{content} = $content; |
99
|
2
|
|
|
|
|
8
|
my $data = FR24::Utils::parse_flights($content, $self->{test_mode}); |
100
|
|
|
|
|
|
|
# Parse the content here |
101
|
|
|
|
|
|
|
# Example: extracting flight information |
102
|
|
|
|
|
|
|
#my @flights = extract_flights($content); |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
# Update the object properties |
105
|
2
|
|
|
|
|
6
|
$self->{flights} = $data->{data}; |
106
|
2
|
|
|
|
|
4
|
$self->{callsigns} = $data->{callsigns}; |
107
|
2
|
|
|
|
|
4
|
$self->{total} = $data->{total}; |
108
|
2
|
|
|
|
|
4
|
$self->{uploaded} = $data->{uploaded}; |
109
|
|
|
|
|
|
|
|
110
|
2
|
|
|
|
|
20
|
return; |
111
|
|
|
|
|
|
|
} |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
# Write a $self->update() method to update the object |
116
|
|
|
|
|
|
|
sub getflight { |
117
|
2
|
|
|
2
|
0
|
422
|
my ($self, $callsign) = @_; |
118
|
2
|
100
|
|
|
|
7
|
if (not defined $self->{'callsigns'}->{$callsign}) { |
119
|
1
|
|
|
|
|
7
|
return 0; |
120
|
|
|
|
|
|
|
} |
121
|
|
|
|
|
|
|
|
122
|
1
|
|
|
|
|
7
|
return $self->{'flights'}->{ $self->{'callsigns'}->{$callsign} }; |
123
|
|
|
|
|
|
|
} |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
sub _curl { |
126
|
2
|
|
|
2
|
|
16
|
my $url = shift; |
127
|
2
|
|
|
|
|
3
|
my $response = ""; |
128
|
2
|
|
|
|
|
4
|
eval { |
129
|
2
|
|
|
|
|
19
|
my $http = HTTP::Tiny->new(); |
130
|
2
|
|
|
|
|
234
|
my $response = $http->get($url); |
131
|
|
|
|
|
|
|
|
132
|
2
|
50
|
|
|
|
4424
|
if ($response->{success}) { |
133
|
0
|
|
|
|
|
0
|
return $response->{content}; |
134
|
|
|
|
|
|
|
} else { |
135
|
2
|
|
|
|
|
20
|
return "Failed to retrieve URL: $response->{status} $response->{reason}\n"; |
136
|
|
|
|
|
|
|
} |
137
|
|
|
|
|
|
|
}; |
138
|
|
|
|
|
|
|
} |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
__END__ |