1 |
joko |
1.1 |
## ------------------------------------------------------------------------- |
2 |
|
|
## $Id: MAPI.pm,v 1.1 2003/01/20 16:43:58 joko Exp $ |
3 |
|
|
## ------------------------------------------------------------------------- |
4 |
|
|
## $Log: MAPI.pm,v $ |
5 |
|
|
## ------------------------------------------------------------------------- |
6 |
|
|
|
7 |
|
|
|
8 |
|
|
package Data::Storage::Handler::Cellphone; |
9 |
|
|
|
10 |
|
|
use strict; |
11 |
|
|
use warnings; |
12 |
|
|
|
13 |
|
|
use base qw( |
14 |
|
|
Data::Storage::Handler |
15 |
|
|
DesignPattern::Bridge |
16 |
|
|
); |
17 |
|
|
# Data::Storage::Handler::Abstract |
18 |
|
|
|
19 |
|
|
|
20 |
|
|
use Data::Dumper; |
21 |
|
|
use Win32::SerialPort; |
22 |
|
|
use Time::HiRes; |
23 |
|
|
use Data::Mungle::Transform::Encode qw( decode_hex_nybbles ); |
24 |
|
|
use File::Basename; |
25 |
|
|
use Data::Mungle::Code::Symbol qw( export_symbols ); |
26 |
|
|
|
27 |
|
|
|
28 |
|
|
# get logger instance |
29 |
|
|
my $logger; |
30 |
|
|
eval('$logger = Log::Dispatch::Config->instance;'); |
31 |
|
|
#print $@ if ($@); |
32 |
|
|
|
33 |
|
|
sub constructor { |
34 |
|
|
my $self = shift; |
35 |
|
|
|
36 |
|
|
if (!$self->{specfile}) { |
37 |
|
|
die("Please pass xml specfile to me."); |
38 |
|
|
exit; |
39 |
|
|
} |
40 |
|
|
|
41 |
|
|
print "Setting up actions... "; |
42 |
|
|
$self->actions_setup($self->{specfile}); |
43 |
|
|
print "done", "\n"; |
44 |
|
|
|
45 |
|
|
#\*$self->{rap}->_transport_setup_safe = \&$self->transport_setup_safe(); |
46 |
|
|
|
47 |
|
|
# load api module (seperate namespace) |
48 |
|
|
my $api_module = (ref $self) . '::API'; |
49 |
|
|
eval("use $api_module;"); |
50 |
|
|
die($@) if $@; |
51 |
|
|
|
52 |
|
|
# - export api method(s) to rap's namespace |
53 |
|
|
# - prefix with '_' to publish them to {rap.xml}'s scope |
54 |
|
|
my $symbols = { transport_setup_safe => '_transport_setup_safe', send => '_send' }; |
55 |
|
|
export_symbols($symbols, 'Data::Rap', $api_module); |
56 |
|
|
|
57 |
|
|
# inject reference to ourselves into rap's scope |
58 |
|
|
$self->{rap}->{Cellphone} = $self; |
59 |
|
|
|
60 |
|
|
# start the rapper |
61 |
|
|
#$self->{rap}->start(); |
62 |
|
|
|
63 |
|
|
#$self->transport_setup_safe(); |
64 |
|
|
|
65 |
|
|
} |
66 |
|
|
|
67 |
|
|
sub DESTROY { |
68 |
|
|
my $self = shift; |
69 |
|
|
$self->transport_shutdown(); |
70 |
|
|
} |
71 |
|
|
|
72 |
|
|
|
73 |
|
|
sub transport_setup { |
74 |
|
|
my $self = shift; |
75 |
|
|
|
76 |
|
|
print "Setting up transport... "; |
77 |
|
|
|
78 |
|
|
# settings for serial port communication |
79 |
|
|
my $port = $self->{port} || 'COM1'; |
80 |
|
|
my $baudrate = $self->{baudrate} || 9600; |
81 |
|
|
my $quiet = 1; |
82 |
|
|
|
83 |
|
|
print "[baudrate: $baudrate] "; |
84 |
|
|
|
85 |
|
|
# create new instance of serial port handle object |
86 |
|
|
$self->{transport} = new Win32::SerialPort($port, $quiet); |
87 |
|
|
|
88 |
|
|
$self->{transport}->baudrate($baudrate); |
89 |
|
|
#$self->{transport}->baudrate(57600); |
90 |
|
|
#$self->{transport}->baudrate(115200); |
91 |
|
|
$self->{transport}->databits(8); |
92 |
|
|
$self->{transport}->parity('none'); |
93 |
|
|
$self->{transport}->stopbits(1); |
94 |
|
|
|
95 |
|
|
$self->{transport}->error_msg(1); |
96 |
|
|
$self->{transport}->user_msg(1); |
97 |
|
|
|
98 |
|
|
#$self->{transport}->debug(1); |
99 |
|
|
|
100 |
|
|
print "done", "\n"; |
101 |
|
|
} |
102 |
|
|
|
103 |
|
|
sub transport_shutdown { |
104 |
|
|
my $self = shift; |
105 |
|
|
#print "shutdown", "\n"; |
106 |
|
|
if (!$self->{transport}) { |
107 |
|
|
#print "WARNING: Requested closing serial port while not open.", "\n"; |
108 |
|
|
return; |
109 |
|
|
} |
110 |
|
|
print "Shutting down transport... "; |
111 |
|
|
$self->{transport}->close(); |
112 |
|
|
undef $self->{transport}; |
113 |
|
|
print "ready.", "\n"; |
114 |
|
|
} |
115 |
|
|
|
116 |
|
|
|
117 |
|
|
sub transport_read { |
118 |
|
|
my $self = shift; |
119 |
|
|
|
120 |
|
|
my $res_count = 1; |
121 |
|
|
#my $res_payload; |
122 |
|
|
|
123 |
|
|
my @buf; |
124 |
|
|
|
125 |
|
|
# sleep a bit |
126 |
|
|
#Time::HiRes::sleep(0.5); |
127 |
|
|
|
128 |
|
|
while (my $res_payload = $self->{transport}->input()) { |
129 |
|
|
|
130 |
|
|
chomp($res_payload); |
131 |
|
|
|
132 |
|
|
# sleep a bit |
133 |
|
|
#Time::HiRes::sleep(0.1); |
134 |
|
|
Time::HiRes::sleep(0.05); |
135 |
|
|
|
136 |
|
|
# read 500 bytes by dumb default |
137 |
|
|
#($res_count, $res_payload) = $cellular->read(500); |
138 |
|
|
#print "-" x 30, "\n"; |
139 |
|
|
#print "> ", $res_payload, "\n"; |
140 |
|
|
#print "-" x 30, "\n"; |
141 |
|
|
|
142 |
|
|
# trace |
143 |
|
|
#print "-" x 60, "\n"; |
144 |
|
|
#print "payload: $res_payload", "\n"; |
145 |
|
|
|
146 |
|
|
if (my $data = $self->response_parse($res_payload)) { |
147 |
|
|
#print "-" x 30, "\n"; |
148 |
|
|
#print $data, "\n"; |
149 |
|
|
#print "-" x 30, "\n"; |
150 |
|
|
push @buf, $data; |
151 |
|
|
} |
152 |
|
|
|
153 |
|
|
} |
154 |
|
|
|
155 |
|
|
$self->{payload} = join('', @buf); |
156 |
|
|
|
157 |
|
|
return $self->{payload}; |
158 |
|
|
|
159 |
|
|
} |
160 |
|
|
|
161 |
|
|
|
162 |
|
|
sub response_read { |
163 |
|
|
my $self = shift; |
164 |
|
|
|
165 |
|
|
# sleep a bit |
166 |
|
|
#Time::HiRes::sleep(0.1); |
167 |
|
|
|
168 |
|
|
#my $response = $cellular->input(); |
169 |
|
|
|
170 |
|
|
my $response = $self->transport_read(); |
171 |
|
|
#print "response: "; |
172 |
|
|
#print "'$response'", "\n"; |
173 |
|
|
|
174 |
|
|
# FIXME |
175 |
|
|
#cellphone::save(); |
176 |
|
|
return $response; |
177 |
|
|
|
178 |
|
|
} |
179 |
|
|
|
180 |
|
|
sub response_parse { |
181 |
|
|
my $self = shift; |
182 |
|
|
|
183 |
|
|
my $data = shift; |
184 |
|
|
my $mode = shift; |
185 |
|
|
|
186 |
|
|
my @parts = split("\r\n", $data); |
187 |
|
|
|
188 |
|
|
#print Dumper(@parts); |
189 |
|
|
#exit; |
190 |
|
|
|
191 |
|
|
my $res = ''; |
192 |
|
|
|
193 |
|
|
BLOCK: |
194 |
|
|
|
195 |
|
|
# ignore first two lines of each block |
196 |
|
|
shift @parts if $mode->{SPBx}; |
197 |
|
|
shift @parts; |
198 |
|
|
|
199 |
|
|
if (my $payload = shift @parts) { |
200 |
|
|
chomp($payload); |
201 |
|
|
if ($payload && $payload !~ m/^(OK|ERROR)/) { |
202 |
|
|
$res .= $payload; |
203 |
|
|
} |
204 |
|
|
} |
205 |
|
|
|
206 |
|
|
goto BLOCK if @parts; |
207 |
|
|
|
208 |
|
|
my $res_dec = $res; |
209 |
|
|
$res_dec = decode_hex_nybbles($res) if $mode->{SPBx}; |
210 |
|
|
|
211 |
|
|
return $res_dec; |
212 |
|
|
} |
213 |
|
|
|
214 |
|
|
|
215 |
|
|
sub response_save { |
216 |
|
|
my $self = shift; |
217 |
|
|
open(FH, '>' . 'data.bmp'); |
218 |
|
|
binmode FH; |
219 |
|
|
print FH $self->{payload}; |
220 |
|
|
close(FH); |
221 |
|
|
} |
222 |
|
|
|
223 |
|
|
sub send_raw { |
224 |
|
|
my $self = shift; |
225 |
|
|
my $data = join('', @_); |
226 |
|
|
|
227 |
|
|
# sleep a bit |
228 |
|
|
Time::HiRes::sleep(0.05); |
229 |
|
|
|
230 |
|
|
#print "raw: $data", "\n"; |
231 |
|
|
$self->{transport}->write($data); |
232 |
|
|
|
233 |
|
|
# sleep a bit |
234 |
|
|
Time::HiRes::sleep(0.05); |
235 |
|
|
|
236 |
|
|
# TODO: review!? |
237 |
|
|
return $self->response_read(); |
238 |
|
|
#return $self->response_read(); |
239 |
|
|
} |
240 |
|
|
|
241 |
|
|
sub send_line { |
242 |
|
|
my $self = shift; |
243 |
|
|
my @args = (); |
244 |
|
|
@args = @_; |
245 |
|
|
my $data = join('', @args); |
246 |
|
|
return $self->send_raw($data, "\r\n"); |
247 |
|
|
} |
248 |
|
|
|
249 |
|
|
|
250 |
|
|
sub send_command { |
251 |
|
|
my $self = shift; |
252 |
|
|
my $data = shift; |
253 |
|
|
my $type = shift; |
254 |
|
|
|
255 |
|
|
$data ||= ''; |
256 |
|
|
if ($type) { |
257 |
|
|
$self->{command_type} = $type; |
258 |
|
|
} else { |
259 |
|
|
$type ||= $self->{command_type}; |
260 |
|
|
$type ||= ''; |
261 |
|
|
} |
262 |
|
|
|
263 |
|
|
my $prefix = 'AT'; |
264 |
|
|
#if $type == 'HAYES'; |
265 |
|
|
$prefix = 'AT+' if $type eq 'GSM'; |
266 |
|
|
$prefix = 'AT^' if $type eq 'SIEMENS'; |
267 |
|
|
|
268 |
|
|
return $self->send_line($prefix, $data); |
269 |
|
|
} |
270 |
|
|
|
271 |
|
|
sub send { |
272 |
|
|
my $self = shift; |
273 |
|
|
my $data = shift; |
274 |
|
|
my $type = shift; |
275 |
|
|
return $self->send_command($data, $type); |
276 |
|
|
} |
277 |
|
|
|
278 |
|
|
|
279 |
|
|
sub actions_setup { |
280 |
|
|
my $self = shift; |
281 |
|
|
my $rapfile = shift; |
282 |
|
|
my $pkgfile = __FILE__; |
283 |
|
|
my $base = dirname($pkgfile) . '/'; |
284 |
|
|
my $filename = $base . 'Cellphone/' . $rapfile; |
285 |
|
|
if (! -f $filename) { |
286 |
|
|
print "WARNING: File '$filename' does not exist.", "\n"; |
287 |
|
|
#return; |
288 |
|
|
} |
289 |
|
|
print "[$filename] "; |
290 |
|
|
$self->{rap} = Data::Rap->new( filename => $filename ); |
291 |
|
|
} |
292 |
|
|
|
293 |
|
|
1; |
294 |
|
|
__END__ |