| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package Audio::Radio::XM::PCR; |
|
2
|
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
### This is the radio. This represents the radio and should be a "copy of the radio" |
|
4
|
|
|
|
|
|
|
### Use this just like you would use a radio with features like |
|
5
|
|
|
|
|
|
|
### power |
|
6
|
|
|
|
|
|
|
### tune |
|
7
|
|
|
|
|
|
|
### mute |
|
8
|
|
|
|
|
|
|
### The user shouldn't have to know anything about how the radio works in order to use this. |
|
9
|
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
|
|
12
|
1
|
|
|
1
|
|
22318
|
use 5.008003; |
|
|
1
|
|
|
|
|
5
|
|
|
|
1
|
|
|
|
|
40
|
|
|
13
|
1
|
|
|
1
|
|
6
|
use strict; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
32
|
|
|
14
|
1
|
|
|
1
|
|
5
|
use warnings; |
|
|
1
|
|
|
|
|
6
|
|
|
|
1
|
|
|
|
|
4729
|
|
|
15
|
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
require Exporter; |
|
17
|
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
our @ISA = qw(Exporter); |
|
19
|
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
# Items to export into callers namespace by default. Note: do not export |
|
21
|
|
|
|
|
|
|
# names by default without a very good reason. Use EXPORT_OK instead. |
|
22
|
|
|
|
|
|
|
# Do not simply export all your public functions/methods/constants. |
|
23
|
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
# This allows declaration use Radio::XM::PCR ':all'; |
|
25
|
|
|
|
|
|
|
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK |
|
26
|
|
|
|
|
|
|
# will save memory. |
|
27
|
|
|
|
|
|
|
our %EXPORT_TAGS = ( 'all' => [ qw( |
|
28
|
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
) ] ); |
|
30
|
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); |
|
32
|
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
our @EXPORT = qw( |
|
34
|
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
); |
|
36
|
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
our $VERSION = '0.02'; |
|
38
|
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
my $is_windows; |
|
41
|
|
|
|
|
|
|
if ($^O =~ /Win32/) { |
|
42
|
|
|
|
|
|
|
$is_windows = 1; |
|
43
|
|
|
|
|
|
|
} else { |
|
44
|
|
|
|
|
|
|
$is_windows = 0; |
|
45
|
|
|
|
|
|
|
} |
|
46
|
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
if ($is_windows) { |
|
48
|
|
|
|
|
|
|
require Win32::SerialPort; |
|
49
|
|
|
|
|
|
|
} else { |
|
50
|
|
|
|
|
|
|
require Device::SerialPort; |
|
51
|
|
|
|
|
|
|
} |
|
52
|
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
my $channel_cache_timeout = 30; |
|
54
|
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
my $channels = {}; |
|
56
|
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
my $response_codes = { # Power Settings |
|
58
|
|
|
|
|
|
|
'80' => 'power_on', |
|
59
|
|
|
|
|
|
|
'81' => 'power_off', |
|
60
|
|
|
|
|
|
|
# Basic Confirmation |
|
61
|
|
|
|
|
|
|
'90' => 'channel_changed', |
|
62
|
|
|
|
|
|
|
'93' => 'mute_set', |
|
63
|
|
|
|
|
|
|
# Channel info |
|
64
|
|
|
|
|
|
|
'a2' => 'ext_channel_info', |
|
65
|
|
|
|
|
|
|
'a5' => 'channel_info', |
|
66
|
|
|
|
|
|
|
#Idenxtification |
|
67
|
|
|
|
|
|
|
'b1' => 'radio_id', |
|
68
|
|
|
|
|
|
|
# Technical |
|
69
|
|
|
|
|
|
|
'c3' => 'signal_quality', |
|
70
|
|
|
|
|
|
|
# Monitor |
|
71
|
|
|
|
|
|
|
'd0' => 'label_changed', |
|
72
|
|
|
|
|
|
|
'd1' => 'channel_name_changed', |
|
73
|
|
|
|
|
|
|
'd2' => 'genre_changed', |
|
74
|
|
|
|
|
|
|
'd3' => 'artist_title_changed', |
|
75
|
|
|
|
|
|
|
'd4' => 'artist_changed', |
|
76
|
|
|
|
|
|
|
'd5' => 'title_changed', |
|
77
|
|
|
|
|
|
|
'd6' => 'song_time_changed', |
|
78
|
|
|
|
|
|
|
# Activation |
|
79
|
|
|
|
|
|
|
'e0' => 'activated', |
|
80
|
|
|
|
|
|
|
'e1' => 'deactivated', |
|
81
|
|
|
|
|
|
|
# Error |
|
82
|
|
|
|
|
|
|
'ff' => 'fatal_error'}; |
|
83
|
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
my $responses = { 'power_on' => {'reponse_octet' => '80', |
|
86
|
|
|
|
|
|
|
'unpack_template' => 'H2 H2 H2 H2 H2 H4 C H2 C H2 H2 H2 H2 H4 H2 A8 C', |
|
87
|
|
|
|
|
|
|
'unpack_method' => '_read_power', |
|
88
|
|
|
|
|
|
|
'on_trigger_method' => ''}, |
|
89
|
|
|
|
|
|
|
'power_off' => {'reponse_octet' => '81', |
|
90
|
|
|
|
|
|
|
'unpack_template' => 'H4', |
|
91
|
|
|
|
|
|
|
'unpack_method' => '_read_power', |
|
92
|
|
|
|
|
|
|
'on_trigger_method' => '',}, |
|
93
|
|
|
|
|
|
|
'channel_changed' => {'reponse_octet' => '90', |
|
94
|
|
|
|
|
|
|
'unpack_template' => 'H2 C C H2', |
|
95
|
|
|
|
|
|
|
'unpack_method' => '_read_channel', |
|
96
|
|
|
|
|
|
|
'on_trigger_method' => ''}, |
|
97
|
|
|
|
|
|
|
'mute_set' => {'reponse_octet' => '93', |
|
98
|
|
|
|
|
|
|
'unpack_template' => 'H2 C C C', |
|
99
|
|
|
|
|
|
|
'unpack_method' => '_read_mute', |
|
100
|
|
|
|
|
|
|
'on_trigger_method' => ''}, |
|
101
|
|
|
|
|
|
|
'ext_channel_info' => {'reponse_octet' => 'A2', |
|
102
|
|
|
|
|
|
|
'unpack_template' => 'H2 C H2 A32 H2 A38 H2 H*', |
|
103
|
|
|
|
|
|
|
'unpack_method' => '_read_channel', |
|
104
|
|
|
|
|
|
|
'on_trigger_method' => ''}, |
|
105
|
|
|
|
|
|
|
'channel_info' => {'reponse_octet' => 'A5', |
|
106
|
|
|
|
|
|
|
'unpack_template' => 'H2 C C H2 A16 H4 A16 H2 A16 A16 H2 H*', |
|
107
|
|
|
|
|
|
|
'unpack_method' => '_read_channel', |
|
108
|
|
|
|
|
|
|
'on_trigger_method' => ''}, |
|
109
|
|
|
|
|
|
|
'radio_id' => {'response_octet' => 'B1', |
|
110
|
|
|
|
|
|
|
'unpack_template' => 'H2 A9 H', |
|
111
|
|
|
|
|
|
|
'unpack_method' => '_read_radio_id', |
|
112
|
|
|
|
|
|
|
'on_trigger_method' => ''}, |
|
113
|
|
|
|
|
|
|
'signal_quality' => {'response_octet' => 'C3', |
|
114
|
|
|
|
|
|
|
'unpack_template' => 'H2 H2 H2 H2 H2 H2 H2 H2 H2 H2 H2 H2 H2 H2 H2 H2 H2 H2 H2 H2 H2 H2 H2 H2 H2 H2', |
|
115
|
|
|
|
|
|
|
'unpack_method' => '_read_signal_strength', |
|
116
|
|
|
|
|
|
|
'on_trigger_method' => ''}, |
|
117
|
|
|
|
|
|
|
'activated' => {'reponse_octet' => 'e0', |
|
118
|
|
|
|
|
|
|
'unpack_template' => 'H2', |
|
119
|
|
|
|
|
|
|
'unpack_method' => '_read_activated', |
|
120
|
|
|
|
|
|
|
'on_trigger_method' => '',}, |
|
121
|
|
|
|
|
|
|
'deactivated' => {'reponse_octet' => 'e1', |
|
122
|
|
|
|
|
|
|
'unpack_template' => 'H2', |
|
123
|
|
|
|
|
|
|
'unpack_method' => '_read_activated', |
|
124
|
|
|
|
|
|
|
'on_trigger_method' => '',}, |
|
125
|
|
|
|
|
|
|
'label_changed' => {'reponse_octet' => 'd0', |
|
126
|
|
|
|
|
|
|
'unpack_template' => 'H2', |
|
127
|
|
|
|
|
|
|
'unpack_method' => '_read_mon_label', |
|
128
|
|
|
|
|
|
|
'on_trigger_method' => '',}, |
|
129
|
|
|
|
|
|
|
'channel_name_changed' => {'reponse_octet' => 'd1', |
|
130
|
|
|
|
|
|
|
'unpack_template' => 'H2', |
|
131
|
|
|
|
|
|
|
'unpack_method' => '_read_mon_channel', |
|
132
|
|
|
|
|
|
|
'on_trigger_method' => '',}, |
|
133
|
|
|
|
|
|
|
'genre_changed' => {'reponse_octet' => 'd2', |
|
134
|
|
|
|
|
|
|
'unpack_template' => 'H2', |
|
135
|
|
|
|
|
|
|
'unpack_method' => '_read__mon_genre', |
|
136
|
|
|
|
|
|
|
'on_trigger_method' => '',}, |
|
137
|
|
|
|
|
|
|
'artist_title_changed' => {'reponse_octet' => 'd3', |
|
138
|
|
|
|
|
|
|
'unpack_template' => 'H2 A16 A16 H2 H2', |
|
139
|
|
|
|
|
|
|
'unpack_method' => '_read_mon_artist_title', |
|
140
|
|
|
|
|
|
|
'on_trigger_method' => '',}, |
|
141
|
|
|
|
|
|
|
'artist_changed' => {'reponse_octet' => 'd4', |
|
142
|
|
|
|
|
|
|
'unpack_template' => 'H2', |
|
143
|
|
|
|
|
|
|
'unpack_method' => '_read_mon_artist_title', |
|
144
|
|
|
|
|
|
|
'on_trigger_method' => '',}, |
|
145
|
|
|
|
|
|
|
'title_changed' => {'reponse_octet' => 'd5', |
|
146
|
|
|
|
|
|
|
'unpack_template' => 'H2', |
|
147
|
|
|
|
|
|
|
'unpack_method' => '_read_mon_artist_title', |
|
148
|
|
|
|
|
|
|
'on_trigger_method' => '',}, |
|
149
|
|
|
|
|
|
|
'song_time_changed' => {'reponse_octet' => 'd6', |
|
150
|
|
|
|
|
|
|
'unpack_template' => 'H2 H2 H2 CC CC CC', |
|
151
|
|
|
|
|
|
|
'unpack_method' => '_read_mon_song_time', |
|
152
|
|
|
|
|
|
|
'on_trigger_method' => '',}, |
|
153
|
|
|
|
|
|
|
'fatal_error' => {'response_octet' => 'FF', |
|
154
|
|
|
|
|
|
|
'unpack_template' => 'A*', |
|
155
|
|
|
|
|
|
|
'unpack_method' => '_read_fatal_error', |
|
156
|
|
|
|
|
|
|
'on_trigger_method' => ''} |
|
157
|
|
|
|
|
|
|
}; |
|
158
|
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
my $command_start = ['5A', 'A5']; |
|
161
|
|
|
|
|
|
|
my $command_end = ['ED', 'ED']; |
|
162
|
|
|
|
|
|
|
my $commands = {'on' => ['00', '10', '10', '24', '01'], |
|
163
|
|
|
|
|
|
|
'off' => ['01', '00'], |
|
164
|
|
|
|
|
|
|
'sleep' => ['01', '01'], |
|
165
|
|
|
|
|
|
|
'channel_change' => ['10', '02', 'CHANNEL', '00', '00', '01'], |
|
166
|
|
|
|
|
|
|
'mute_on' => ['13', '01'], |
|
167
|
|
|
|
|
|
|
'mute_off' => ['13', '00'], |
|
168
|
|
|
|
|
|
|
'ext_channel_info' => ['22', 'CHANNEL'], |
|
169
|
|
|
|
|
|
|
'this_channel_info' => ['25', '08', 'CHANNEL', '00'], |
|
170
|
|
|
|
|
|
|
'next_channel_info' => ['25', '09', 'CHANNEL', '00'], |
|
171
|
|
|
|
|
|
|
'radio_id' => ['31'], |
|
172
|
|
|
|
|
|
|
'signal_quality' => ['43'], |
|
173
|
|
|
|
|
|
|
'monitor' => ['50', 'CHANNEL', '01', '01', '01', '01'] |
|
174
|
|
|
|
|
|
|
}; |
|
175
|
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
# Preloaded methods go here. |
|
177
|
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
### Constructor |
|
179
|
|
|
|
|
|
|
sub new { |
|
180
|
1
|
|
|
1
|
|
13
|
my $class = shift; |
|
181
|
1
|
|
33
|
|
|
9
|
$class = ref($class) || $class; |
|
182
|
|
|
|
|
|
|
|
|
183
|
1
|
|
|
|
|
25
|
my $self = {'channels' => { '1' => {'name' => 'Preview', |
|
184
|
|
|
|
|
|
|
'genre' => 'Preview', |
|
185
|
|
|
|
|
|
|
'artist' => 'Preview', |
|
186
|
|
|
|
|
|
|
'title' => 'Preview', |
|
187
|
|
|
|
|
|
|
'enabled' => 1, |
|
188
|
|
|
|
|
|
|
'start_time' => 0, |
|
189
|
|
|
|
|
|
|
'end_time' => 0, |
|
190
|
|
|
|
|
|
|
'last_update' => 0}}, |
|
191
|
|
|
|
|
|
|
'power' => 'unknown', |
|
192
|
|
|
|
|
|
|
'activated' => 'unknown', |
|
193
|
|
|
|
|
|
|
'signal' => {'sat1' => 0, |
|
194
|
|
|
|
|
|
|
'sat2' => 0, |
|
195
|
|
|
|
|
|
|
'terr' => 0, |
|
196
|
|
|
|
|
|
|
'last_update' => 0}, |
|
197
|
|
|
|
|
|
|
'technical' => {'radio_id' => ''}, |
|
198
|
|
|
|
|
|
|
'mute' => 'unknown', |
|
199
|
|
|
|
|
|
|
'current_channel' => 1, |
|
200
|
|
|
|
|
|
|
'full_refresh' => {'last_update' => 0, |
|
201
|
|
|
|
|
|
|
'completed' => 0} |
|
202
|
|
|
|
|
|
|
}; |
|
203
|
1
|
|
|
|
|
4
|
bless $self, $class; |
|
204
|
|
|
|
|
|
|
|
|
205
|
1
|
|
|
|
|
3
|
return $self; |
|
206
|
|
|
|
|
|
|
} |
|
207
|
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
##### Private Stuff |
|
209
|
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
sub _close_port { |
|
211
|
0
|
|
|
0
|
|
|
my $self = shift; |
|
212
|
|
|
|
|
|
|
|
|
213
|
0
|
0
|
|
|
|
|
if ($self->port_state eq 'Open') { |
|
214
|
0
|
|
|
|
|
|
$self->{_radio}->close; |
|
215
|
0
|
|
|
|
|
|
undef $self->{_radio}; |
|
216
|
|
|
|
|
|
|
} |
|
217
|
0
|
|
|
|
|
|
$self->port_state('Closed'); |
|
218
|
0
|
|
|
|
|
|
return $self; |
|
219
|
|
|
|
|
|
|
} |
|
220
|
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
sub _write_port { |
|
222
|
0
|
|
|
0
|
|
|
my $self = shift; |
|
223
|
0
|
|
|
|
|
|
my $command = shift; |
|
224
|
0
|
|
|
|
|
|
my $channel = shift; |
|
225
|
0
|
|
0
|
|
|
|
my $rct = shift || 50; |
|
226
|
|
|
|
|
|
|
|
|
227
|
0
|
|
|
|
|
|
my @msg; |
|
228
|
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
# Copy from the master hash - don't mess up the master! |
|
230
|
0
|
|
|
|
|
|
foreach my $value (@{$commands->{$command}}) { |
|
|
0
|
|
|
|
|
|
|
|
231
|
0
|
|
|
|
|
|
push @msg, $value; |
|
232
|
|
|
|
|
|
|
} |
|
233
|
|
|
|
|
|
|
|
|
234
|
0
|
|
|
|
|
|
unshift @msg, sprintf("%04d", scalar(@msg)); |
|
235
|
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
# Set the channel |
|
237
|
0
|
0
|
|
|
|
|
@msg = map ( /CHANNEL/ ? sprintf("%02X", $channel) : $_, @msg); |
|
238
|
|
|
|
|
|
|
|
|
239
|
0
|
|
|
|
|
|
unshift @msg, @$command_start; |
|
240
|
0
|
|
|
|
|
|
push @msg, @$command_end; |
|
241
|
0
|
|
|
|
|
|
my $message = join('', @msg); |
|
242
|
|
|
|
|
|
|
|
|
243
|
0
|
|
|
|
|
|
$self->{_radio}->write(pack("H*", $message)); |
|
244
|
0
|
|
|
|
|
|
$self->{_radio}->read_const_time($rct); |
|
245
|
|
|
|
|
|
|
} |
|
246
|
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
sub _read_port { |
|
248
|
0
|
|
|
0
|
|
|
my $self = shift; |
|
249
|
|
|
|
|
|
|
|
|
250
|
0
|
|
|
|
|
|
my $radio = $self->{_radio}; |
|
251
|
|
|
|
|
|
|
|
|
252
|
0
|
|
|
|
|
|
my $count; |
|
253
|
|
|
|
|
|
|
my $reply; |
|
254
|
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
# Read the header first |
|
256
|
0
|
|
|
|
|
|
($count, $reply) = $radio->read(6); |
|
257
|
0
|
0
|
|
|
|
|
if ($count) { |
|
258
|
|
|
|
|
|
|
# Lop off the 0x5a & 0xa5 |
|
259
|
0
|
|
|
|
|
|
$reply = substr($reply,2); |
|
260
|
|
|
|
|
|
|
# Grab the length and code |
|
261
|
0
|
|
|
|
|
|
my $length = (unpack("C", substr($reply, 0, 1)) * 256) + unpack("C", substr($reply, 1, 1)); |
|
262
|
0
|
|
|
|
|
|
my $code = unpack("H*",substr($reply, 2, 1)); |
|
263
|
0
|
|
|
|
|
|
($count, $reply) = $radio->read($length); |
|
264
|
0
|
0
|
|
|
|
|
if ($count == $length) { |
|
265
|
0
|
|
|
|
|
|
return ($code, $reply); |
|
266
|
|
|
|
|
|
|
} else { |
|
267
|
0
|
|
|
|
|
|
return; |
|
268
|
|
|
|
|
|
|
} |
|
269
|
|
|
|
|
|
|
} |
|
270
|
0
|
|
|
|
|
|
return; |
|
271
|
|
|
|
|
|
|
} |
|
272
|
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
sub _read { |
|
274
|
0
|
|
|
0
|
|
|
my $self = shift; |
|
275
|
0
|
|
|
|
|
|
my $query = shift; |
|
276
|
0
|
|
|
|
|
|
while (my ($code, $result) = $self->_read_port) { |
|
277
|
0
|
|
|
|
|
|
my $response_code = $response_codes->{$code}; |
|
278
|
0
|
|
|
|
|
|
my $unpack_template = $responses->{$response_code}->{'unpack_template'}; |
|
279
|
0
|
|
|
|
|
|
my $unpack_method = $responses->{$response_code}->{'unpack_method'}; |
|
280
|
0
|
|
|
|
|
|
my $on_trigger_method = $responses->{$response_code}->{'on_trigger_method'}; |
|
281
|
0
|
|
|
|
|
|
my @params = unpack($unpack_template, $result); |
|
282
|
|
|
|
|
|
|
|
|
283
|
0
|
|
|
|
|
|
$self->$unpack_method($code,@params); |
|
284
|
|
|
|
|
|
|
|
|
285
|
0
|
0
|
|
|
|
|
if (ref($on_trigger_method) ne "") { |
|
286
|
0
|
|
|
|
|
|
&{$on_trigger_method}; |
|
|
0
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
} |
|
288
|
|
|
|
|
|
|
} |
|
289
|
|
|
|
|
|
|
} |
|
290
|
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
sub _write { |
|
292
|
0
|
|
|
0
|
|
|
my $self = shift; |
|
293
|
|
|
|
|
|
|
|
|
294
|
0
|
|
|
|
|
|
return $self->_write_port(@_); |
|
295
|
|
|
|
|
|
|
} |
|
296
|
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
sub _open_port { |
|
298
|
0
|
|
|
0
|
|
|
my $self = shift; |
|
299
|
0
|
|
|
|
|
|
my $port_handle; |
|
300
|
|
|
|
|
|
|
|
|
301
|
0
|
0
|
|
|
|
|
if ($is_windows) { |
|
302
|
0
|
|
0
|
|
|
|
$port_handle = new Win32::SerialPort ("$self->{_device}") |
|
303
|
|
|
|
|
|
|
|| die "Can't open Serial Port! ($self->{_device} $!\n"; |
|
304
|
|
|
|
|
|
|
} else { |
|
305
|
0
|
|
0
|
|
|
|
$port_handle = new Device::SerialPort ("$self->{_device}") |
|
306
|
|
|
|
|
|
|
|| die "Can't open USB Port! ($self->{_device} $!\n"; |
|
307
|
|
|
|
|
|
|
} |
|
308
|
0
|
0
|
|
|
|
|
if (!defined $port_handle) { |
|
309
|
0
|
|
|
|
|
|
return 0; |
|
310
|
|
|
|
|
|
|
} |
|
311
|
|
|
|
|
|
|
|
|
312
|
0
|
|
|
|
|
|
$port_handle->baudrate(9600); |
|
313
|
0
|
|
|
|
|
|
$port_handle->parity("none"); |
|
314
|
0
|
|
|
|
|
|
$port_handle->databits(8); |
|
315
|
0
|
|
|
|
|
|
$port_handle->stopbits(1); |
|
316
|
0
|
|
|
|
|
|
$port_handle->handshake("none"); |
|
317
|
0
|
|
|
|
|
|
$port_handle->write_settings; |
|
318
|
|
|
|
|
|
|
|
|
319
|
0
|
|
|
|
|
|
if (1) { # Should test to see if it's really open and talking... |
|
320
|
0
|
|
|
|
|
|
$self->{_radio} = $port_handle; |
|
321
|
0
|
|
|
|
|
|
$self->port_state('Open'); |
|
322
|
0
|
|
|
|
|
|
return 1; |
|
323
|
|
|
|
|
|
|
} else { |
|
324
|
|
|
|
|
|
|
$self->port_state('Closed'); |
|
325
|
|
|
|
|
|
|
return 0; |
|
326
|
|
|
|
|
|
|
} |
|
327
|
0
|
|
|
|
|
|
return 1; |
|
328
|
|
|
|
|
|
|
} |
|
329
|
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
sub _monitor { |
|
331
|
0
|
|
|
0
|
|
|
my $self = shift; |
|
332
|
0
|
|
0
|
|
|
|
my $reps = shift || 1; |
|
333
|
0
|
|
|
|
|
|
my $count = 0; |
|
334
|
|
|
|
|
|
|
# Check to see if there's anything waiting on the pipe |
|
335
|
0
|
|
|
|
|
|
while (++$count <= $reps) { |
|
336
|
0
|
|
|
|
|
|
$self->_read(); |
|
337
|
|
|
|
|
|
|
} |
|
338
|
|
|
|
|
|
|
} |
|
339
|
|
|
|
|
|
|
### Private Reader Methods |
|
340
|
|
|
|
|
|
|
sub _read_power { |
|
341
|
0
|
|
|
0
|
|
|
my $self = shift; |
|
342
|
0
|
|
|
|
|
|
my $code = shift; |
|
343
|
0
|
|
|
|
|
|
my @params = @_; |
|
344
|
|
|
|
|
|
|
|
|
345
|
0
|
0
|
|
|
|
|
if ($code eq '80') { |
|
|
|
0
|
|
|
|
|
|
|
346
|
0
|
|
|
|
|
|
my $last_channel = {'audio' => $params[6], |
|
347
|
|
|
|
|
|
|
'data' => $params[8]}; |
|
348
|
|
|
|
|
|
|
|
|
349
|
0
|
|
|
|
|
|
$self->{'power'} = 'on'; |
|
350
|
0
|
|
|
|
|
|
$self->{'current_channel'} = $last_channel->{'audio'}; |
|
351
|
0
|
|
|
|
|
|
$self->{'technical'}->{'SDEC'} = { 'version' => $params[2], |
|
352
|
|
|
|
|
|
|
'date' => $params[3] . '-' . $params[4] . '-' . $params[5]}; |
|
353
|
0
|
|
|
|
|
|
$self->{'technical'}->{'XMSTK'} = { 'version' => $params[10], |
|
354
|
|
|
|
|
|
|
'date' => $params[11] . '-' . $params[12] . '-' . $params[13]}; |
|
355
|
0
|
|
|
|
|
|
$self->{'technical'}->{'radio_id'} = $params[15]; |
|
356
|
|
|
|
|
|
|
|
|
357
|
0
|
|
|
|
|
|
return 1; |
|
358
|
|
|
|
|
|
|
} elsif ($code eq '81') { |
|
359
|
0
|
|
|
|
|
|
$self->{'power'} = 'off'; |
|
360
|
0
|
|
|
|
|
|
return 1; |
|
361
|
|
|
|
|
|
|
} else { |
|
362
|
0
|
|
|
|
|
|
return 0; |
|
363
|
|
|
|
|
|
|
} |
|
364
|
|
|
|
|
|
|
} |
|
365
|
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
sub _read_activated { |
|
367
|
0
|
|
|
0
|
|
|
my $self = shift; |
|
368
|
0
|
|
|
|
|
|
my $code = shift; |
|
369
|
0
|
|
|
|
|
|
my @params = @_; |
|
370
|
|
|
|
|
|
|
|
|
371
|
0
|
0
|
|
|
|
|
if ($code eq 'e0') { |
|
|
|
0
|
|
|
|
|
|
|
372
|
0
|
|
|
|
|
|
$self->{'activated'} = 'yes'; |
|
373
|
|
|
|
|
|
|
} elsif ($code eq 'e1') { |
|
374
|
0
|
|
|
|
|
|
$self->{'activated'} = 'no'; |
|
375
|
|
|
|
|
|
|
} else { |
|
376
|
0
|
|
|
|
|
|
return 0; |
|
377
|
|
|
|
|
|
|
} |
|
378
|
0
|
|
|
|
|
|
return 1; |
|
379
|
|
|
|
|
|
|
} |
|
380
|
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
sub _read_channel { |
|
382
|
0
|
|
|
0
|
|
|
my $self = shift; |
|
383
|
0
|
|
|
|
|
|
my $code = shift; |
|
384
|
0
|
|
|
|
|
|
my @params = @_; |
|
385
|
|
|
|
|
|
|
|
|
386
|
0
|
0
|
|
|
|
|
if ($code eq '90') { |
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
387
|
0
|
|
|
|
|
|
$self->{'current_channel'} = $params[1]; |
|
388
|
0
|
|
|
|
|
|
$self->{'current_service'} = $params[2]; |
|
389
|
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
} elsif ($code eq 'a2') { |
|
391
|
|
|
|
|
|
|
# Do Nothing - The ext_channel_info doesn't work yet. |
|
392
|
|
|
|
|
|
|
} elsif ($code eq 'a5') { |
|
393
|
0
|
|
|
|
|
|
my $channel = $params[1]; |
|
394
|
0
|
0
|
|
|
|
|
if ($channel == 0) { |
|
395
|
0
|
|
|
|
|
|
$self->{'full_refresh'}->{'completed'} = 1; |
|
396
|
0
|
|
|
|
|
|
$self->{'full_refresh'}->{'last_updated'} = time(); |
|
397
|
|
|
|
|
|
|
} |
|
398
|
|
|
|
|
|
|
|
|
399
|
0
|
|
|
|
|
|
$self->{'channels'}->{$channel}->{'service_id'} = $params[2]; |
|
400
|
0
|
|
|
|
|
|
$self->{'channels'}->{$channel}->{'channel'} = $channel; |
|
401
|
0
|
|
|
|
|
|
$self->{'channels'}->{$channel}->{'name'} = $params[4]; |
|
402
|
0
|
|
|
|
|
|
$self->{'channels'}->{$channel}->{'genre'} = $params[6]; |
|
403
|
0
|
|
|
|
|
|
$self->{'channels'}->{$channel}->{'artist'} = $params[8]; |
|
404
|
0
|
|
|
|
|
|
$self->{'channels'}->{$channel}->{'title'} = $params[9]; |
|
405
|
0
|
|
|
|
|
|
$self->{'channels'}->{$channel}->{'enabled'} = 1; |
|
406
|
0
|
|
|
|
|
|
$self->{'channels'}->{$channel}->{'last_update'} = time(); |
|
407
|
|
|
|
|
|
|
} else { |
|
408
|
0
|
|
|
|
|
|
return 0; |
|
409
|
|
|
|
|
|
|
} |
|
410
|
0
|
|
|
|
|
|
return 1; |
|
411
|
|
|
|
|
|
|
} |
|
412
|
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
sub _read_mute { |
|
414
|
0
|
|
|
0
|
|
|
my $self = shift; |
|
415
|
0
|
|
|
|
|
|
my $code = shift; |
|
416
|
0
|
|
|
|
|
|
my @params = @_; |
|
417
|
|
|
|
|
|
|
|
|
418
|
0
|
0
|
|
|
|
|
if ($code eq '93') { |
|
419
|
0
|
0
|
|
|
|
|
if ($params[1]) { |
|
420
|
0
|
|
|
|
|
|
$self->{'mute'} = '1'; |
|
421
|
|
|
|
|
|
|
} else { |
|
422
|
0
|
|
|
|
|
|
$self->{'mute'} = '0'; |
|
423
|
|
|
|
|
|
|
} |
|
424
|
|
|
|
|
|
|
} else { |
|
425
|
0
|
|
|
|
|
|
return 0; |
|
426
|
|
|
|
|
|
|
} |
|
427
|
0
|
|
|
|
|
|
return 1; |
|
428
|
|
|
|
|
|
|
} |
|
429
|
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
sub _read_radio_id { |
|
431
|
0
|
|
|
0
|
|
|
my $self = shift; |
|
432
|
0
|
|
|
|
|
|
my $code = shift; |
|
433
|
0
|
|
|
|
|
|
my @params = @_; |
|
434
|
|
|
|
|
|
|
|
|
435
|
0
|
0
|
|
|
|
|
if ($code eq 'b1') { |
|
436
|
0
|
|
|
|
|
|
$self->{'technical'}->{'radio_id'} = $params[1]; |
|
437
|
|
|
|
|
|
|
} else { |
|
438
|
0
|
|
|
|
|
|
return 0; |
|
439
|
|
|
|
|
|
|
} |
|
440
|
0
|
|
|
|
|
|
return 1; |
|
441
|
|
|
|
|
|
|
} |
|
442
|
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
sub _read_signal_strength { |
|
446
|
0
|
|
|
0
|
|
|
my $self = shift; |
|
447
|
0
|
|
|
|
|
|
my $code = shift; |
|
448
|
0
|
|
|
|
|
|
my @params = @_; |
|
449
|
0
|
|
|
|
|
|
my $levels = {'00' => 'Poor', |
|
450
|
|
|
|
|
|
|
'01' => 'Fair', |
|
451
|
|
|
|
|
|
|
'02' => 'Good', |
|
452
|
|
|
|
|
|
|
'03' => 'Excellent'}; |
|
453
|
|
|
|
|
|
|
|
|
454
|
|
|
|
|
|
|
# Populate the hash |
|
455
|
0
|
|
|
|
|
|
$self->{'signal_strength'} = {'sat' => {'quality' => $levels->{$params[1]}, |
|
456
|
|
|
|
|
|
|
'1' => {'demod' => $params[3], |
|
457
|
|
|
|
|
|
|
'TDM' => $params[6], |
|
458
|
|
|
|
|
|
|
'BER' => $params[9], |
|
459
|
|
|
|
|
|
|
'AGC' => $params[12], |
|
460
|
|
|
|
|
|
|
'CN' => $params[14]}, |
|
461
|
|
|
|
|
|
|
'2' => {'demod' => $params[4], |
|
462
|
|
|
|
|
|
|
'TDM' => $params[7], |
|
463
|
|
|
|
|
|
|
'BER' => $params[10], |
|
464
|
|
|
|
|
|
|
'AGC' => $params[13], |
|
465
|
|
|
|
|
|
|
'CN' => $params[15]}}, |
|
466
|
|
|
|
|
|
|
'terr' => {'quality' => $levels->{$params[2]}, |
|
467
|
|
|
|
|
|
|
'1' => {'demod' => $params[5], |
|
468
|
|
|
|
|
|
|
'TDM' => $params[8], |
|
469
|
|
|
|
|
|
|
'BER' => $params[11]}}}; |
|
470
|
|
|
|
|
|
|
# Calculate others |
|
471
|
|
|
|
|
|
|
# Percentages |
|
472
|
|
|
|
|
|
|
# Satellite |
|
473
|
0
|
|
|
|
|
|
my @sat_db; |
|
474
|
0
|
|
|
|
|
|
$sat_db[1] = $self->{'signal_strength'}->{'sat'}->{'1'}->{'CN'} / 4; |
|
475
|
0
|
|
|
|
|
|
$sat_db[2] = $self->{'signal_strength'}->{'sat'}->{'2'}->{'CN'} / 4; |
|
476
|
|
|
|
|
|
|
|
|
477
|
0
|
|
|
|
|
|
$self->{'signal_strength'}->{'sat'}->{'1'}->{'db'} = $sat_db[1]; |
|
478
|
0
|
|
|
|
|
|
$self->{'signal_strength'}->{'sat'}->{'2'}->{'db'} = $sat_db[2]; |
|
479
|
|
|
|
|
|
|
|
|
480
|
0
|
|
|
|
|
|
for (my $x=1; $x<=2; $x++) { |
|
481
|
0
|
0
|
|
|
|
|
if ($sat_db[$x] < 12) { |
|
|
|
0
|
|
|
|
|
|
|
482
|
0
|
|
|
|
|
|
$self->{'signal_strength'}->{'sat'}->{$x}->{'percent'} = $sat_db[$x] * 80 / 12; |
|
483
|
|
|
|
|
|
|
} elsif ($sat_db[$x] < 16) { |
|
484
|
0
|
|
|
|
|
|
$self->{'signal_strength'}->{'sat'}->{$x}->{'percent'} = ((($sat_db[$x] - 48) * 20 / 4) + 80); |
|
485
|
|
|
|
|
|
|
} else { |
|
486
|
0
|
|
|
|
|
|
$self->{'signal_strength'}->{'sat'}->{$x}->{'percent'} = 99.9; |
|
487
|
|
|
|
|
|
|
} |
|
488
|
|
|
|
|
|
|
} |
|
489
|
|
|
|
|
|
|
# Terrestrial |
|
490
|
0
|
|
|
|
|
|
my $terr_signal = $self->{'signal_strength'}->{'terr'}->{1}->{'BER'} / 68; |
|
491
|
|
|
|
|
|
|
|
|
492
|
0
|
|
|
|
|
|
$terr_signal = 100 - ($terr_signal * 10); |
|
493
|
|
|
|
|
|
|
|
|
494
|
0
|
0
|
|
|
|
|
if ($terr_signal <= 0) { |
|
|
|
0
|
|
|
|
|
|
|
495
|
0
|
|
|
|
|
|
$terr_signal = 0; |
|
496
|
|
|
|
|
|
|
} elsif ($terr_signal >= 100) { |
|
497
|
0
|
|
|
|
|
|
$terr_signal = 100; |
|
498
|
|
|
|
|
|
|
} |
|
499
|
|
|
|
|
|
|
|
|
500
|
0
|
|
|
|
|
|
$self->{'signal_strength'}->{'terr'}->{1}->{'percent'} = $terr_signal; |
|
501
|
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
# Summary Information |
|
503
|
0
|
0
|
|
|
|
|
if ($self->{'signal_strength'}->{'sat'}->{'1'}->{'db'} > $self->{'signal_strength'}->{'sat'}->{'2'}->{'db'}) { |
|
504
|
0
|
|
|
|
|
|
$self->{'signal_strength'}->{'sat'}->{'db'} = $self->{'signal_strength'}->{'sat'}->{'1'}->{'db'}; |
|
505
|
0
|
|
|
|
|
|
$self->{'signal_strength'}->{'sat'}->{'percent'} = $self->{'signal_strength'}->{'sat'}->{'1'}->{'percent'}; |
|
506
|
|
|
|
|
|
|
} else { |
|
507
|
0
|
|
|
|
|
|
$self->{'signal_strength'}->{'sat'}->{'db'} = $self->{'signal_strength'}->{'sat'}->{'2'}->{'db'}; |
|
508
|
0
|
|
|
|
|
|
$self->{'signal_strength'}->{'sat'}->{'percent'} = $self->{'signal_strength'}->{'sat'}->{'2'}->{'percent'}; |
|
509
|
|
|
|
|
|
|
} |
|
510
|
0
|
|
|
|
|
|
$self->{'signal_strength'}->{'terr'}->{'percent'} = $self->{'signal_strength'}->{'terr'}->{'1'}->{'percent'}; |
|
511
|
|
|
|
|
|
|
} |
|
512
|
|
|
|
|
|
|
|
|
513
|
|
|
|
|
|
|
sub _read_mon_song_time { |
|
514
|
0
|
|
|
0
|
|
|
my $self = shift; |
|
515
|
0
|
|
|
|
|
|
my $code = shift; |
|
516
|
0
|
|
|
|
|
|
my @params = @_; |
|
517
|
|
|
|
|
|
|
|
|
518
|
0
|
0
|
|
|
|
|
if ($code eq 'd6') { |
|
519
|
0
|
|
|
|
|
|
my $current_time = time; |
|
520
|
0
|
|
|
|
|
|
my $total_duration = $params[3]*256 + $params[4]; |
|
521
|
0
|
|
|
|
|
|
my $used_duration = $params[5]*256 + $params[6]; |
|
522
|
0
|
|
|
|
|
|
my $remain_duration = $total_duration - $used_duration; |
|
523
|
0
|
|
|
|
|
|
my $start = $current_time - $used_duration; |
|
524
|
0
|
|
|
|
|
|
my $end = $start + $total_duration; |
|
525
|
0
|
|
|
|
|
|
$self->{'channels'}->{$self->{'current_channel'}}->{'start_time'} = $start; |
|
526
|
0
|
|
|
|
|
|
$self->{'channels'}->{$self->{'current_channel'}}->{'end_time'} = $end; |
|
527
|
0
|
|
|
|
|
|
$self->{'channels'}->{$self->{'current_channel'}}->{'duration'} = $total_duration; |
|
528
|
0
|
|
|
|
|
|
$self->{'channels'}->{$self->{'current_channel'}}->{'remaining'} = $remain_duration; |
|
529
|
0
|
|
|
|
|
|
$self->{'channels'}->{$self->{'current_channel'}}->{'last_update'} = $current_time; |
|
530
|
|
|
|
|
|
|
} else { |
|
531
|
0
|
|
|
|
|
|
return 0; |
|
532
|
|
|
|
|
|
|
} |
|
533
|
0
|
|
|
|
|
|
return 1; |
|
534
|
|
|
|
|
|
|
} |
|
535
|
|
|
|
|
|
|
|
|
536
|
|
|
|
|
|
|
sub _read_mon_artist_title { |
|
537
|
0
|
|
|
0
|
|
|
my $self = shift; |
|
538
|
0
|
|
|
|
|
|
my $code = shift; |
|
539
|
0
|
|
|
|
|
|
my @params = @_; |
|
540
|
|
|
|
|
|
|
|
|
541
|
0
|
0
|
|
|
|
|
if ($code eq 'd3') { |
|
542
|
0
|
|
|
|
|
|
$self->{'channels'}->{$self->{'current_channel'}}->{'artist'} = $params[1]; |
|
543
|
0
|
|
|
|
|
|
$self->{'channels'}->{$self->{'current_channel'}}->{'title'} = $params[2]; |
|
544
|
0
|
|
|
|
|
|
$self->{'channels'}->{$self->{'current_channel'}}->{'enabled'} = 1; |
|
545
|
0
|
|
|
|
|
|
$self->{'channels'}->{$self->{'current_channel'}}->{'last_update'} = time(); |
|
546
|
|
|
|
|
|
|
} else { |
|
547
|
0
|
|
|
|
|
|
return 0; |
|
548
|
|
|
|
|
|
|
} |
|
549
|
0
|
|
|
|
|
|
return 1; |
|
550
|
|
|
|
|
|
|
} |
|
551
|
|
|
|
|
|
|
sub _read_mon_label { |
|
552
|
0
|
|
|
0
|
|
|
return 1; |
|
553
|
|
|
|
|
|
|
} |
|
554
|
|
|
|
|
|
|
|
|
555
|
|
|
|
|
|
|
sub _read__mon_genre { |
|
556
|
0
|
|
|
0
|
|
|
return 1; |
|
557
|
|
|
|
|
|
|
} |
|
558
|
|
|
|
|
|
|
|
|
559
|
|
|
|
|
|
|
sub _read_mon_channel { |
|
560
|
0
|
|
|
0
|
|
|
return 1; |
|
561
|
|
|
|
|
|
|
} |
|
562
|
|
|
|
|
|
|
|
|
563
|
|
|
|
|
|
|
sub _read_monitored_data { |
|
564
|
0
|
|
|
0
|
|
|
return 1; |
|
565
|
|
|
|
|
|
|
} |
|
566
|
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
sub _read_fatal_error { |
|
568
|
0
|
|
|
0
|
|
|
my $self = shift; |
|
569
|
0
|
|
|
|
|
|
my $code = shift; |
|
570
|
0
|
|
|
|
|
|
my @params = @_; |
|
571
|
|
|
|
|
|
|
|
|
572
|
|
|
|
|
|
|
### Can't really do anything about it... |
|
573
|
0
|
|
|
|
|
|
return 1; |
|
574
|
|
|
|
|
|
|
} |
|
575
|
|
|
|
|
|
|
|
|
576
|
|
|
|
|
|
|
### Stuff that the user can do - Public methods |
|
577
|
|
|
|
|
|
|
|
|
578
|
|
|
|
|
|
|
sub open { |
|
579
|
0
|
|
|
0
|
|
|
my $self = shift; |
|
580
|
0
|
|
|
|
|
|
$self->connect; |
|
581
|
0
|
|
|
|
|
|
$self->power('on'); |
|
582
|
0
|
|
|
|
|
|
$self->tune(1); |
|
583
|
0
|
|
|
|
|
|
$self->mute('off'); |
|
584
|
|
|
|
|
|
|
} |
|
585
|
|
|
|
|
|
|
|
|
586
|
|
|
|
|
|
|
sub close { |
|
587
|
0
|
|
|
0
|
|
|
my $self = shift; |
|
588
|
0
|
|
|
|
|
|
$self->connect; |
|
589
|
0
|
|
|
|
|
|
$self->power('off'); |
|
590
|
|
|
|
|
|
|
} |
|
591
|
|
|
|
|
|
|
|
|
592
|
|
|
|
|
|
|
## Connect/Disconnect/Port Actions |
|
593
|
|
|
|
|
|
|
sub connect { |
|
594
|
0
|
|
|
0
|
|
|
my $self = shift; |
|
595
|
0
|
|
|
|
|
|
my %args = @_; |
|
596
|
|
|
|
|
|
|
|
|
597
|
0
|
|
|
|
|
|
$self->open_port(%args); |
|
598
|
|
|
|
|
|
|
} |
|
599
|
|
|
|
|
|
|
|
|
600
|
|
|
|
|
|
|
sub open_port { |
|
601
|
0
|
|
|
0
|
|
|
my $self = shift; |
|
602
|
0
|
|
|
|
|
|
my %args = @_; |
|
603
|
0
|
0
|
|
|
|
|
if ($self->port_state() eq 'Open') { |
|
604
|
0
|
|
|
|
|
|
return 1; |
|
605
|
|
|
|
|
|
|
} else { |
|
606
|
0
|
0
|
|
|
|
|
if (defined ($args{device})) { |
|
607
|
0
|
|
|
|
|
|
$self->{_device} = $args{device}; |
|
608
|
|
|
|
|
|
|
} else { |
|
609
|
0
|
0
|
|
|
|
|
if ($is_windows) { |
|
610
|
0
|
|
|
|
|
|
$self->{_device} = 'COM5'; |
|
611
|
|
|
|
|
|
|
} else { |
|
612
|
0
|
|
|
|
|
|
$self->{_device} = '/dev/ttyUSB0'; |
|
613
|
|
|
|
|
|
|
} |
|
614
|
|
|
|
|
|
|
} |
|
615
|
0
|
|
|
|
|
|
return $self->_open_port(); |
|
616
|
|
|
|
|
|
|
} |
|
617
|
|
|
|
|
|
|
} |
|
618
|
|
|
|
|
|
|
|
|
619
|
|
|
|
|
|
|
sub close_port { |
|
620
|
0
|
|
|
0
|
|
|
my $self = shift; |
|
621
|
0
|
|
|
|
|
|
return $self->_close_port; |
|
622
|
|
|
|
|
|
|
} |
|
623
|
|
|
|
|
|
|
|
|
624
|
|
|
|
|
|
|
sub port_state { |
|
625
|
0
|
|
|
0
|
|
|
my $self = shift; |
|
626
|
0
|
|
|
|
|
|
my $val = shift; |
|
627
|
|
|
|
|
|
|
|
|
628
|
0
|
0
|
|
|
|
|
if (!defined($self->{'_port_state'})) { |
|
629
|
0
|
|
|
|
|
|
$self->{'_port_state'} = 'Closed'; |
|
630
|
|
|
|
|
|
|
} |
|
631
|
|
|
|
|
|
|
|
|
632
|
0
|
0
|
|
|
|
|
$self->{_port_state} = $val if (defined($val)); |
|
633
|
|
|
|
|
|
|
|
|
634
|
0
|
|
|
|
|
|
return $self->{_port_state}; |
|
635
|
|
|
|
|
|
|
} |
|
636
|
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
sub command { |
|
638
|
0
|
|
|
0
|
|
|
my $self = shift; |
|
639
|
0
|
|
|
|
|
|
my $command = shift; |
|
640
|
0
|
|
|
|
|
|
my $channel = shift; |
|
641
|
|
|
|
|
|
|
|
|
642
|
0
|
|
|
|
|
|
$self->_write($command, $channel); |
|
643
|
0
|
|
|
|
|
|
$self->_monitor; |
|
644
|
|
|
|
|
|
|
} |
|
645
|
|
|
|
|
|
|
|
|
646
|
|
|
|
|
|
|
|
|
647
|
|
|
|
|
|
|
|
|
648
|
|
|
|
|
|
|
sub set_trigger { |
|
649
|
0
|
|
|
0
|
|
|
my $self=shift; |
|
650
|
0
|
|
|
|
|
|
my $action = shift; |
|
651
|
0
|
|
|
|
|
|
my $sub = shift; |
|
652
|
|
|
|
|
|
|
|
|
653
|
0
|
|
|
|
|
|
$responses->{$action}->{'on_trigger_method'} = $sub; |
|
654
|
|
|
|
|
|
|
|
|
655
|
|
|
|
|
|
|
} |
|
656
|
|
|
|
|
|
|
|
|
657
|
|
|
|
|
|
|
sub get_trigger { |
|
658
|
0
|
|
|
0
|
|
|
my $self = shift; |
|
659
|
0
|
|
|
|
|
|
my $action = shift; |
|
660
|
0
|
|
|
|
|
|
return $responses->{$action}->{'on_trigger_method'}; |
|
661
|
|
|
|
|
|
|
} |
|
662
|
|
|
|
|
|
|
|
|
663
|
|
|
|
|
|
|
sub monitor { |
|
664
|
0
|
|
|
0
|
|
|
my $self=shift; |
|
665
|
0
|
|
|
|
|
|
my $current_channel = $self->{'current_channel'}; |
|
666
|
|
|
|
|
|
|
|
|
667
|
|
|
|
|
|
|
#get any old stuff |
|
668
|
0
|
|
|
|
|
|
$self->_monitor(); |
|
669
|
|
|
|
|
|
|
|
|
670
|
|
|
|
|
|
|
} |
|
671
|
|
|
|
|
|
|
|
|
672
|
|
|
|
|
|
|
sub full_refresh { |
|
673
|
0
|
|
|
0
|
|
|
my $self = shift; |
|
674
|
0
|
|
|
|
|
|
my $current_channel = $self->{'current_channel'}; |
|
675
|
|
|
|
|
|
|
|
|
676
|
0
|
|
|
|
|
|
$self->{'full_refresh'}->{'completed'} = 0; |
|
677
|
|
|
|
|
|
|
|
|
678
|
|
|
|
|
|
|
# clear the flags |
|
679
|
0
|
|
|
|
|
|
foreach my $channel (keys %{$self->{'channels'}}) { |
|
|
0
|
|
|
|
|
|
|
|
680
|
0
|
0
|
|
|
|
|
if ($channel != $current_channel) { |
|
681
|
0
|
|
|
|
|
|
$self->{'channels'}->{$channel}->{'last_update'} = 0; |
|
682
|
|
|
|
|
|
|
} |
|
683
|
|
|
|
|
|
|
} |
|
684
|
|
|
|
|
|
|
# Iterate - We're out of sync so make a guess |
|
685
|
0
|
|
|
|
|
|
my $last_channel = 1; |
|
686
|
0
|
|
|
|
|
|
while ($self->{'full_refresh'}->{'completed'} == 0) { |
|
687
|
0
|
|
|
|
|
|
for (my $channel = 1; $channel < 256; $channel++) { |
|
688
|
0
|
0
|
|
|
|
|
next if $channel == $current_channel; |
|
689
|
0
|
0
|
|
|
|
|
next if !defined $self->{'channels'}->{$channel}; |
|
690
|
0
|
0
|
|
|
|
|
next if $self->{'channels'}->{$channel}->{'last_update'} == 0; |
|
691
|
0
|
|
|
|
|
|
$last_channel = $channel; |
|
692
|
|
|
|
|
|
|
} |
|
693
|
0
|
|
|
|
|
|
$self->command('next_channel_info', $last_channel); |
|
694
|
0
|
|
|
|
|
|
$self->_monitor; |
|
695
|
|
|
|
|
|
|
} |
|
696
|
0
|
|
|
|
|
|
$self->{'last_full_refresh'} = time; |
|
697
|
0
|
|
|
|
|
|
$self->command('monitor', $current_channel); |
|
698
|
|
|
|
|
|
|
} |
|
699
|
|
|
|
|
|
|
|
|
700
|
|
|
|
|
|
|
### --Power-- |
|
701
|
|
|
|
|
|
|
### Turn on or off the power |
|
702
|
|
|
|
|
|
|
### power(action) where action is: |
|
703
|
|
|
|
|
|
|
### on - Power On |
|
704
|
|
|
|
|
|
|
### off - Power Off |
|
705
|
|
|
|
|
|
|
### sleep - Power Saving Mode |
|
706
|
|
|
|
|
|
|
sub power { |
|
707
|
0
|
|
|
0
|
|
|
my $self = shift; |
|
708
|
0
|
|
|
|
|
|
my $command = lc(shift); |
|
709
|
|
|
|
|
|
|
|
|
710
|
0
|
0
|
0
|
|
|
|
if (!defined $command || $command eq 'on') { |
|
|
|
0
|
0
|
|
|
|
|
|
711
|
0
|
|
|
|
|
|
$command = 'on'; |
|
712
|
|
|
|
|
|
|
} elsif ($command ne 'off' && $command ne 'sleep') { |
|
713
|
0
|
|
|
|
|
|
return -1; |
|
714
|
|
|
|
|
|
|
} |
|
715
|
|
|
|
|
|
|
|
|
716
|
0
|
|
|
|
|
|
$self->command($command); |
|
717
|
0
|
|
|
|
|
|
while($self->{'power'} ne $command) { |
|
718
|
0
|
|
|
|
|
|
$self->monitor(); |
|
719
|
|
|
|
|
|
|
} |
|
720
|
|
|
|
|
|
|
} |
|
721
|
|
|
|
|
|
|
|
|
722
|
|
|
|
|
|
|
### --Mute-- |
|
723
|
|
|
|
|
|
|
### Mute the sound |
|
724
|
|
|
|
|
|
|
### mute(action) where action is: |
|
725
|
|
|
|
|
|
|
### on - silence the radio |
|
726
|
|
|
|
|
|
|
### off - allow the sound to play |
|
727
|
|
|
|
|
|
|
sub mute { |
|
728
|
0
|
|
|
0
|
|
|
my $self = shift; |
|
729
|
0
|
|
|
|
|
|
my $op = lc(shift); |
|
730
|
|
|
|
|
|
|
|
|
731
|
0
|
|
|
|
|
|
my $command; |
|
732
|
|
|
|
|
|
|
|
|
733
|
0
|
0
|
0
|
|
|
|
if (!defined $op || $op eq 'on') { |
|
|
|
0
|
|
|
|
|
|
|
734
|
0
|
|
|
|
|
|
$command = 'mute_on'; |
|
735
|
|
|
|
|
|
|
} |
|
736
|
|
|
|
|
|
|
elsif ($op eq 'off') { |
|
737
|
0
|
|
|
|
|
|
$command = 'mute_off'; |
|
738
|
|
|
|
|
|
|
} else { |
|
739
|
0
|
|
|
|
|
|
return -1; |
|
740
|
|
|
|
|
|
|
} |
|
741
|
0
|
|
|
|
|
|
$self->command($command); |
|
742
|
|
|
|
|
|
|
} |
|
743
|
|
|
|
|
|
|
|
|
744
|
|
|
|
|
|
|
### --Tune-- |
|
745
|
|
|
|
|
|
|
### Change the channel |
|
746
|
|
|
|
|
|
|
### tune(channel) where channel is the new channel |
|
747
|
|
|
|
|
|
|
### note that this not only tunes the channel, but it also sets up for the monitoring loop |
|
748
|
|
|
|
|
|
|
sub tune { |
|
749
|
0
|
|
|
0
|
|
|
my $self = shift; |
|
750
|
0
|
|
|
|
|
|
my $channel = shift; |
|
751
|
|
|
|
|
|
|
|
|
752
|
|
|
|
|
|
|
# Is the channel valid? |
|
753
|
0
|
0
|
0
|
|
|
|
if (!defined $channel || |
|
|
|
|
0
|
|
|
|
|
|
754
|
|
|
|
|
|
|
$channel < 1 || |
|
755
|
|
|
|
|
|
|
$channel > 256) { |
|
756
|
0
|
|
|
|
|
|
return; |
|
757
|
|
|
|
|
|
|
} |
|
758
|
|
|
|
|
|
|
|
|
759
|
|
|
|
|
|
|
# Change the channel |
|
760
|
0
|
|
|
|
|
|
$self->command('channel_change', $channel); |
|
761
|
0
|
|
|
|
|
|
$self->get_channel_info($channel); |
|
762
|
|
|
|
|
|
|
|
|
763
|
0
|
|
|
|
|
|
$self->command('monitor', $channel); |
|
764
|
0
|
|
|
|
|
|
while ($self->{'current_channel'} != $channel) { |
|
765
|
0
|
|
|
|
|
|
$self->_monitor; |
|
766
|
|
|
|
|
|
|
} |
|
767
|
0
|
|
|
|
|
|
return 1; |
|
768
|
|
|
|
|
|
|
} |
|
769
|
|
|
|
|
|
|
|
|
770
|
|
|
|
|
|
|
### Get Data |
|
771
|
|
|
|
|
|
|
|
|
772
|
|
|
|
|
|
|
# --- get_current_channel --- |
|
773
|
|
|
|
|
|
|
# Returns: channel_hash |
|
774
|
|
|
|
|
|
|
sub get_current_channel { |
|
775
|
0
|
|
|
0
|
|
|
my $self = shift; |
|
776
|
0
|
|
|
|
|
|
my $channel = $self->{'current_channel'}; |
|
777
|
0
|
0
|
|
|
|
|
if (defined $self->{'channels'}->{$channel}) { |
|
778
|
|
|
|
|
|
|
# I'm assuming that the current channel is COMPLETELY up to date |
|
779
|
0
|
|
|
|
|
|
return $self->{'channels'}->{$channel}; |
|
780
|
|
|
|
|
|
|
} else { |
|
781
|
0
|
|
|
|
|
|
return $self->get_channel_info($channel); |
|
782
|
|
|
|
|
|
|
} |
|
783
|
|
|
|
|
|
|
} |
|
784
|
|
|
|
|
|
|
|
|
785
|
|
|
|
|
|
|
# --- get_channel_info --- |
|
786
|
|
|
|
|
|
|
# Args: channel |
|
787
|
|
|
|
|
|
|
# Returns: channel_hash |
|
788
|
|
|
|
|
|
|
sub get_channel_info { |
|
789
|
0
|
|
|
0
|
|
|
my $self = shift; |
|
790
|
0
|
|
|
|
|
|
my $channel = shift; |
|
791
|
|
|
|
|
|
|
|
|
792
|
0
|
0
|
|
|
|
|
if ($channel eq "") { |
|
793
|
|
|
|
|
|
|
# You should have called get_current_channel |
|
794
|
0
|
|
|
|
|
|
return $self->get_current_channel(); |
|
795
|
|
|
|
|
|
|
} |
|
796
|
|
|
|
|
|
|
|
|
797
|
0
|
0
|
0
|
|
|
|
if ($channel > 256 || |
|
798
|
|
|
|
|
|
|
$channel < 1) { |
|
799
|
0
|
|
|
|
|
|
return; |
|
800
|
|
|
|
|
|
|
} |
|
801
|
0
|
|
|
|
|
|
my $channel_hash = $self->{'channels'}->{$channel}; |
|
802
|
0
|
0
|
|
|
|
|
if ($self->command('this_channel_info',$channel)) { |
|
803
|
0
|
|
|
|
|
|
$self->command('ext_channel_info', $channel); |
|
804
|
0
|
|
|
|
|
|
return $self->{'channels'}->{$channel}; |
|
805
|
|
|
|
|
|
|
} |
|
806
|
|
|
|
|
|
|
} |
|
807
|
|
|
|
|
|
|
|
|
808
|
|
|
|
|
|
|
sub get_next_channel_info { |
|
809
|
0
|
|
|
0
|
|
|
my $self = shift; |
|
810
|
0
|
|
|
|
|
|
my $channel = shift; |
|
811
|
|
|
|
|
|
|
|
|
812
|
0
|
0
|
0
|
|
|
|
if ($channel > 256 || |
|
813
|
|
|
|
|
|
|
$channel < 1) { |
|
814
|
0
|
|
|
|
|
|
return; |
|
815
|
|
|
|
|
|
|
} |
|
816
|
|
|
|
|
|
|
|
|
817
|
0
|
|
|
|
|
|
my $channel_hash = $self->{'channels'}->{$channel}; |
|
818
|
0
|
0
|
|
|
|
|
if ($self->command('next_channel_info',$channel)) { |
|
819
|
0
|
|
|
|
|
|
return $self->{'channels'}->{$channel}; |
|
820
|
|
|
|
|
|
|
} |
|
821
|
|
|
|
|
|
|
} |
|
822
|
|
|
|
|
|
|
|
|
823
|
|
|
|
|
|
|
sub get_radio_id { |
|
824
|
0
|
|
|
0
|
|
|
my $self = shift; |
|
825
|
0
|
0
|
|
|
|
|
if ($self->{'technical'}->{'radio_id'} eq '') { |
|
826
|
0
|
|
|
|
|
|
$self->command('radio_id'); |
|
827
|
|
|
|
|
|
|
} |
|
828
|
0
|
|
|
|
|
|
return $self->{'technical'}->{'radio_id'}; |
|
829
|
|
|
|
|
|
|
} |
|
830
|
|
|
|
|
|
|
|
|
831
|
|
|
|
|
|
|
|
|
832
|
|
|
|
|
|
|
sub get_signal_quality { |
|
833
|
0
|
|
|
0
|
|
|
my $self = shift; |
|
834
|
0
|
|
|
|
|
|
$self->command('signal_quality'); |
|
835
|
0
|
|
|
|
|
|
return $self->{'signal_strength'}; |
|
836
|
|
|
|
|
|
|
} |
|
837
|
|
|
|
|
|
|
|
|
838
|
|
|
|
|
|
|
|
|
839
|
|
|
|
|
|
|
1; |
|
840
|
|
|
|
|
|
|
__END__ |