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__ |