File Coverage

blib/lib/FR24/Bot.pm
Criterion Covered Total %
statement 68 96 70.8
branch 23 44 52.2
condition 6 9 66.6
subroutine 8 9 88.8
pod 4 5 80.0
total 109 163 66.8


line stmt bran cond sub pod time code
1             #ABSTRACT: Subroutines for FR24-Bot
2 5     5   3899 use v5.12;
  5         16  
3 5     5   25 use warnings;
  5         14  
  5         260  
4             package FR24::Bot;
5              
6             our $VERSION = "0.0.1";
7 5     5   4053 use JSON::PP;
  5         79626  
  5         431  
8 5     5   43 use Exporter qw(import);
  5         11  
  5         6441  
9             # Export version
10             our @EXPORT = qw($VERSION);
11             our @EXPORT_OK = qw(loadconfig saveconfig url_exists authorized parse_flights);
12              
13             sub parse_flights {
14 1     1 1 1968 my ($json_text, $test) = @_;
15 1 50       7 $json_text = '{"4067ef":["4067ef",0,0,0,37000,0,"0000",0,"","",1689143713,"","","",false,0,""],"4bb28f":["4bb28f",0,0,96.47746,19450,460,"4730",0,"","",1689143721,"","","",false,2240,""],"4cac55":["4cac55",0,0,0,34175,488,"3416",0,"","",1689143721,"","","",false,960,""],"3c5eee":["3c5eee",0,0,0,11775,0,"0000",0,"","",1689143665,"","","",false,0,""],"4ca848":["4ca848",51.35,1.024,90.472534,26025,482,"0572",0,"","",1689143719,"","","",false,-992,"RYR60UD"],"40775c":["40775c",53.42,-1.145,101.46763,23475,429,"3426",0,"","",1689143722,"","","",false,2112,"RUK72VQ"],"406d4e":["406d4e",0,0,123.77186,16475,388,"6226",0,"","",1689143698,"","","",false,-1472,""],"485789":["485789",51.94,0.9666,64.76496,38275,539,"6250",0,"","",1689143721,"","","",false,-1216,"KLM702"],"4d21ee":["4d21ee",51.99,1.463,65.96107,25875,464,"3460",0,"","",1689143712,"","","",false,2176,"RYR8YJ"],"4070e1":["4070e1",53.92,-1.082,139.22684,30100,478,"3446",0,"","",1689143721,"","","",false,2304,"EXS15RF"],"4791a0":["4791a0",51.94,1.264,73.30076,39225,512,"6241",0,"","",1689143722,"","","",false,640,"MDT12"],"4ca640":["4ca640",53.23,-0.6868,96.604836,34975,478,"4646",0,"","",1689143719,"","","",false,-64,"EIN3JE"],"4cadf4":["4cadf4",53.9,-0.5286,119.27368,37000,482,"3451",0,"","",1689143721,"","","",false,0,"RYR2BQ"],"406d90":["406d90",0,0,0,21000,0,"3423",0,"","",1689143706,"","","",false,0,""],"4079f7":["4079f7",51.7,0.9323,263.7267,15700,276,"4632",0,"","",1689143707,"","","",false,-1536,"BAW811"],"4019f0":["4019f0",0,0,0,2300,0,"7000",0,"","",1689143721,"","","",false,0,""],"4076b1":["4076b1",52.36,0.4034,92.24087,32300,500,"4740",0,"","",1689143712,"","","",false,1184,"TOM15H"],"4ca621":["4ca621",52.32,0.2067,100.06673,26950,451,"4653",0,"","",1689143722,"","","",false,1728,"RYR9YY"],"40769a":["40769a",52.24,1.311,99.09946,32450,500,"4741",0,"","",1689143722,"","","",false,896,"TOM11K"],"3c6753":["3c6753",53.29,0.1518,279.62204,36000,413,"2544",0,"","",1689143722,"","","",false,0,"DLH7MF"],"40756e":["40756e",53.2,-0.1399,103.48089,25050,450,"6342",0,"","",1689143722,"","","",false,0,"EZY42PG"],"aaf968":["aaf968",53,1.002,96.21782,36950,518,"6315",0,"","",1689143721,"","","",false,-2560,"DAL258"],"40799b":["40799b",0,0,0,37700,0,"4447",0,"","",1689143719,"","","",false,0,""],"471f35":["471f35",0,0,276.65442,13275,241,"6605",0,"","",1689143689,"","","",false,-64,"WZZ1154"],"485e30":["485e30",53.01,0.8713,110.196785,34850,503,"6251",0,"","",1689143722,"","","",false,-1344,"KLM602"],"ab4c1d":["ab4c1d",52.77,1.862,85.17478,27300,462,"6330",0,"","",1689143672,"","","",false,-960,"DAL48"],"3c6708":["3c6708",53.21,0.913,110.19787,43000,524,"2027",0,"","",1689143717,"","","",false,0,"DLH481"],"a4ffb7":["a4ffb7",0,0,98.704956,26850,420,"6312",0,"","",1689143674,"","","",false,-960,"DAL56"]}' if defined $test;
16 1         8 my $answer = {
17             'status' => 'UNKNOWN',
18             'total' => 0,
19             'data' => {},
20             'raw' => {},
21             };
22              
23 1 50       7 if (length($json_text) == 0) {
24 0         0 return $answer;
25             }
26              
27 1         7 my $json = JSON::PP->new->utf8->pretty->canonical;
28 1         240 my $json_data;
29 1         4 eval {
30 1         6 $json_data = $json->decode($json_text);
31             };
32 1 50       34861 if ($@) {
33 0         0 $answer->{'status'} = 'JSON_ERROR';
34 0         0 return $answer;
35             }
36              
37 1         3 $answer->{'status'} = 'OK';
38 1 50       14 $answer->{'total'} = scalar keys %{$json_data} if defined $json_data;
  1         5  
39            
40 1 50       4 if (not defined $json_data) {
41 0         0 return $answer;
42             }
43 1         2 for my $flight (sort keys %{$json_data}) {
  1         32  
44              
45 28         38 my $info = $json_data->{$flight};
46 28         118 my $flight_hash = {
47             'lat' => 0 + $info->[1],
48             'long' => 0 +$info->[2],
49             'alt' => 0 + $info->[4],
50             'callsign' => $info->[16],
51             };
52 28         47 $answer->{'data'}->{$flight} = $flight_hash;
53 28         45 $answer->{'raw'}->{$flight} = $info;
54             }
55 1         20 return $answer;
56             }
57              
58              
59             sub loadconfig {
60 4     4 1 2104 my $filename = shift;
61 4 50       87 if (! -e "$filename") {
62 0         0 return {};
63             }
64 4 50       171 open my $fh, '<', $filename or Carp::croak "Can't open $filename: $!";
65 4         23 my $config = {
66             'server' => {
67             'ip' => 'localhost',
68             },
69             'users' => {
70             'everyone' => 1,
71             },
72             };
73              
74 4         9 my $section = "default";
75 4         155 while (my $line = readline($fh)) {
76 36         58 chomp $line;
77            
78             # Skip comment lines
79            
80 36 50       66 next if $line =~ /^#/;
81 36 100       136 if ($line =~ /^\[(.*)\]$/) {
    100          
82 12         43 $config->{lc("$1")} = {};
83 12         26 $section = lc("$1");
84 12         36 next;
85             } elsif ($line =~/=/) {
86 14         40 my ($key, $value) = split /=/, $line;
87 14         79 $config->{"$section"}->{lc("$key")} = $value;
88             }
89            
90             }
91 4         64 return $config;
92             }
93              
94             sub authorized {
95 9     9 0 3575 my ($config, $user) = @_;
96 9         16 my $authorized = 0;
97 9 50       24 return $authorized if !defined $user;
98 9 100       51 return $authorized if $user !~ /^[0-9]+$/;
99             # If there is no "users" section, everyone is authorized
100 8 50       20 if (!defined $config->{'users'}) {
101 0         0 print STDERR "[WARNING] Bad configuration file: no 'users' section\n";
102 0         0 return 1;
103             }
104 8 100       16 if (defined $config->{'users'}->{'everyone'}) {
105 4         13 $authorized = 1;
106             }
107 8 100 100     35 if (defined $config->{'users'}->{$user} and $config->{'users'}->{$user} == 1 ) {
108 1         2 $authorized = 1;
109             }
110             # Banned?
111 8 100 100     27 if (defined $config->{'users'}->{$user} and $config->{'users'}->{$user} == 0 ) {
112 2         5 $authorized = 0;
113             }
114 8         18 return $authorized;
115             }
116             sub saveconfig {
117 1     1 1 3478 my ($filename, $config) = @_;
118 1 50       92 open my $fh, '>', $filename or Carp::croak "Can't open $filename: $!";
119              
120 1         6 foreach my $section (keys %$config) {
121 3         21 print $fh "[$section]\n";
122 3         6 foreach my $key (keys %{$config->{$section}}) {
  3         7  
123 3         19 my $value = $config->{$section}->{$key};
124 3         9 print $fh "$key=$value\n";
125             }
126 3         6 print $fh "\n";
127             }
128            
129 1         54 close $fh;
130             }
131              
132             sub url_exists {
133 0     0 1   my ($url) = @_;
134              
135             # Create an HTTP::Tiny object
136 0           my $http = HTTP::Tiny->new;
137              
138             # Send a HEAD request to check the URL
139 0           my $response = $http->head($url);
140            
141             # If the response status is success (2xx), the URL exists
142 0 0         if ($response->{success}) {
    0          
143 0           return 1;
144             } elsif ($response->{status} == 599) {
145             # Try anothe method: SSLeay 1.49 or higher required
146            
147 0           eval {
148 0           require LWP::UserAgent;
149 0           my $ua = LWP::UserAgent->new;
150 0           $ua->ssl_opts(verify_hostname => 0); # Disable SSL verification (optional)
151 0           my $response = $ua->get($url);
152            
153 0 0         if ($response->is_success) {
154 0           return 1;
155             } else {
156 0           return 0;
157             }
158             };
159 0 0         if ($@) {
160 0           my $cmd = qq(curl --silent -L -I $url);
161 0           my @output = `$cmd`;
162 0           for my $line (@output) {
163 0           chomp $line;
164 0 0 0       if ($line =~ /^HTTP/ and $line =~ /200/) {
165 0           return 1;
166             }
167             }
168             }
169              
170             } else {
171 0           return 0;
172             }
173             }
174             1;
175              
176             __END__