File Coverage

blib/lib/GQRX/Remote.pm
Criterion Covered Total %
statement 72 107 67.2
branch 15 28 53.5
condition 4 7 57.1
subroutine 17 22 77.2
pod 0 17 0.0
total 108 181 59.6


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