File Coverage

blib/lib/GQRX/Remote.pm
Criterion Covered Total %
statement 72 113 63.7
branch 18 40 45.0
condition 4 7 57.1
subroutine 17 22 77.2
pod 0 17 0.0
total 111 199 55.7


line stmt bran cond sub pod time code
1             package GQRX::Remote;
2              
3 1     1   36810 use IO::Socket::INET;
  1         2  
  1         4  
4              
5 1     1   374 use warnings;
  1         1  
  1         28  
6 1     1   3 use strict;
  1         4  
  1         880  
7              
8             our $VERSION = '1.0.1';
9              
10              
11             sub new {
12 1     1 0 1451 my $class = shift();
13 1         120 my %options = @_;
14 1         20 my $self = {
15             _connection => undef, # IO::Socket connection to GQRX
16             _last_error => undef,
17              
18             # Options definable on init:
19             exit_on_error => 0 # When true, exit on any error
20             };
21              
22 1         16 bless ($self, $class);
23              
24 1         18 foreach (keys %options) {
25 0         0 $self->{$_} = $options{$_};
26             }
27              
28 1         15 return ($self);
29             }
30              
31              
32             sub DESTROY {
33             # Automatically disconnect when the object is destroyed
34 1     1   533 my ($self) = @_;
35              
36 1         4 $self->disconnect();
37             }
38              
39              
40             sub _set_error {
41 2     2   9 my ($self, $error) = @_;
42              
43 2 50       8 if ($self->{exit_on_error}) {
44 0         0 die "GQRX::Remote: ERROR: $error\n";
45             }
46              
47 2         4 $self->{_last_error} = $error;
48             }
49              
50              
51             sub error {
52 2     2 0 4 my ($self) = @_;
53              
54 2         8 return ($self->{_last_error});
55             }
56              
57              
58             sub connect {
59 2     2 0 3 my $self = shift();
60 2         9 my (%option) = @_;
61 2         2 my $connection;
62              
63 2 100       5 if ($self->{_connection}) { # Close any existent connection
64 1         2 $self->disconnect();
65             }
66              
67             $connection = new IO::Socket::INET(
68             PeerHost => $option{host} || '127.0.0.1',
69 2   50     45 PeerPort => $option{port} || 7356,
      50        
70             Proto => 'tcp'
71             );
72              
73 2 50       726 if (! $connection) {
74 0         0 $self->_set_error("Failed to establish connection to gqrx: $@");
75 0         0 return (undef);
76             }
77              
78 2         3 $self->{_connection} = $connection;
79              
80 2         10 return (1);
81             }
82              
83              
84             sub disconnect {
85 4     4 0 934 my ($self) = @_;
86              
87 4 100 66     54 if ($self->{_connection} && $self->{_connection}->connected()) {
88 2         38 $self->{_connection}->send("c\n"); # Send the close command to the server
89 2         122 $self->{_connection}->close();
90             }
91              
92 4         128 $self->{_connection} = undef;
93             }
94              
95              
96             sub read_line {
97 7     7 0 13 my ($self) = shift();
98 7         4 my $buf;
99              
100 7 50       320 if (! $self->{_connection}->connected()) {
101 0         0 $self->_set_error("Connection lost");
102 0         0 return (undef);
103             }
104              
105 7         258 $buf = $self->{_connection}->getline();
106              
107 7 50       4922 if (! defined($buf)) {
108 0         0 return (undef);
109             }
110             else {
111 7         13 chomp($buf);
112 7         32 return ($buf);
113             }
114             }
115              
116              
117             sub command {
118 8     8 0 12 my $self = shift();
119 8         13 my $command = shift();
120 8         13 my (%opt) = @_;
121 8         6 my $buf;
122              
123 8 100       45 if (! $self->{_connection}) {
    50          
124 1         6 $self->_set_error("Failed to send: Not connected");
125 1         4 return (undef);
126             }
127             elsif (! $self->{_connection}->connected()) {
128 0         0 $self->_set_error("Failed to send: Connection lost");
129 0         0 return (undef);
130             }
131              
132 7         86 $self->{_connection}->send($command . "\n");
133              
134 7         315 return ($self->read_line(%opt));
135             }
136              
137              
138             sub set_frequency {
139 1     1 0 3 my ($self, $frequency) = @_;
140 1         8 my $response = $self->command("F $frequency");
141              
142 1 50       7 if (! defined($response)) {
    50          
143 0         0 return (undef);
144             }
145             elsif ($response ne 'RPRT 0') {
146 0         0 $self->_set_error("Set frequency failed. Unexpected response: $response");
147 0         0 return (undef);
148             }
149              
150 1         6 return (1);
151             }
152              
153              
154             sub get_frequency {
155 2     2 0 5 my ($self) = @_;
156              
157 2         7 return ($self->command("f"));
158             }
159              
160              
161             sub set_demodulator_mode {
162 2     2 0 5 my ($self, $mode) = @_;
163 2         7 my $response = $self->command("M $mode");
164              
165 2 50       12 if (! defined($response)) {
    100          
166 0         0 return (undef);
167             }
168             elsif ($response ne 'RPRT 0') {
169 1         7 $self->_set_error("Set demodulator mode failed. Unexpected response: $response");
170 1         13 return (undef);
171             }
172              
173 1         4 return (1);
174             }
175              
176              
177             sub get_demodulator_mode {
178 1     1 0 3 my ($self) = @_;
179              
180 1         3 return ($self->command("m"));
181             }
182              
183              
184             sub get_signal_strength {
185 0     0 0 0 my ($self) = @_;
186              
187 0         0 return ($self->command("l STRENGTH"));
188             }
189              
190              
191             sub get_squelch_threshold {
192 1     1 0 2 my ($self) = @_;
193              
194 1         3 return ($self->command("l SQL"));
195             }
196              
197              
198             sub set_squelch_threshold {
199 1     1 0 2 my ($self, $level) = @_;
200 1         4 my $response = $self->command("L SQL $level");
201              
202 1 50       9 if (! defined($response)) {
    50          
203 0         0 return (undef);
204             }
205             elsif ($response ne 'RPRT 0') {
206 0         0 $self->_set_error("Set demodulator mode failed. Unexpected response: $response");
207 0         0 return (undef);
208             }
209              
210 1         6 return (1);
211             }
212              
213              
214             sub get_recorder_status {
215 0     0 0   my ($self) = @_;
216              
217 0           return ($self->command("u RECORD"));
218             }
219              
220              
221             sub set_recorder_status {
222 0     0 0   my ($self, $status) = @_;
223 0           my $response = $self->command("U RECORD $status");
224              
225              
226 0 0         if (! defined($response)) {
    0          
227 0           return (undef);
228             }
229             elsif ($response ne 'RPRT 0') {
230 0           $self->_set_error("Failed to set recorder state. Unexpected response: $response");
231 0           return (undef);
232             }
233              
234 0           return (1);
235             }
236              
237              
238             sub start_recording {
239 0     0 0   my ($self) = @_;
240 0           my $response = $self->command("AOS");
241              
242 0 0         if (! defined($response)) {
    0          
243 0           return (undef);
244             }
245             elsif ($response ne 'RPRT 0') {
246 0           $self->_set_error("Failed to start recording. Unexpected response: $response");
247 0           return (undef);
248             }
249              
250 0           return (1);
251             }
252              
253              
254             sub stop_recording {
255 0     0 0   my ($self) = @_;
256 0           my $response = $self->command("LOS");
257              
258 0 0         if (! defined($response)) {
    0          
259 0           return (undef);
260             }
261             elsif ($response ne 'RPRT 0') {
262 0           $self->_set_error("Failed to stop recording. Unexpected response: $response");
263 0           return (undef);
264             }
265              
266 0           return (1);
267             }
268              
269              
270             1;
271              
272              
273             __END__