Storage/Handler/Cellphone.pm

## -------------------------------------------------------------------------
##  $Id: MAPI.pm,v 1.1 2003/01/20 16:43:58 joko Exp $
## -------------------------------------------------------------------------
##  $Log: MAPI.pm,v $
## -------------------------------------------------------------------------


package Data::Storage::Handler::Cellphone;

use strict;
use warnings;

use base qw(
  Data::Storage::Handler
  DesignPattern::Bridge
);
#  Data::Storage::Handler::Abstract


use Data::Dumper;
use Win32::SerialPort;
use Time::HiRes;
use Data::Mungle::Transform::Encode qw( decode_hex_nybbles );
use File::Basename;
use Data::Mungle::Code::Symbol qw( export_symbols );


# get logger instance
my $logger;
eval('$logger = Log::Dispatch::Config->instance;');
#print $@ if ($@);

sub constructor {
  my $self = shift;

  if (!$self->{specfile}) {
    die("Please pass xml specfile to me.");
    exit;
  }

  print "Setting up actions... ";
  $self->actions_setup($self->{specfile});
  print "done", "\n";

  #\*$self->{rap}->_transport_setup_safe = \&$self->transport_setup_safe();

  # load api module (seperate namespace)
  my $api_module = (ref $self) . '::API';
  eval("use $api_module;");
  die($@) if $@;
  
  # - export api method(s) to rap's namespace
  # - prefix with '_' to publish them to {rap.xml}'s scope
  my $symbols = { transport_setup_safe => '_transport_setup_safe', send => '_send' };
  export_symbols($symbols, 'Data::Rap', $api_module);

  # inject reference to ourselves into rap's scope
  $self->{rap}->{Cellphone} = $self;

  # start the rapper
  #$self->{rap}->start();

  #$self->transport_setup_safe();

}

sub DESTROY {
  my $self = shift;
  $self->transport_shutdown();
}


sub transport_setup {
  my $self = shift;

  print "Setting up transport... ";
  
  # settings for serial port communication
  my $port = $self->{port} || 'COM1';
  my $baudrate = $self->{baudrate} || 9600;
  my $quiet = 1;
  
  print "[baudrate: $baudrate] ";
  
  # create new instance of serial port handle object
  $self->{transport} = new Win32::SerialPort($port, $quiet);
  
  $self->{transport}->baudrate($baudrate);
  #$self->{transport}->baudrate(57600);
  #$self->{transport}->baudrate(115200);
  $self->{transport}->databits(8);
  $self->{transport}->parity('none');
  $self->{transport}->stopbits(1);
  
  $self->{transport}->error_msg(1);
  $self->{transport}->user_msg(1);
  
  #$self->{transport}->debug(1);

  print "done", "\n";
}

sub transport_shutdown {
  my $self = shift;
  #print "shutdown", "\n";
  if (!$self->{transport}) { 
    #print "WARNING: Requested closing serial port while not open.", "\n";
    return; 
  }
  print "Shutting down transport... ";
  $self->{transport}->close();
  undef $self->{transport};
  print "ready.", "\n";
}


sub transport_read {
  my $self = shift;

  my $res_count = 1;
  #my $res_payload;

  my @buf;

  # sleep a bit
  #Time::HiRes::sleep(0.5);

  while (my $res_payload = $self->{transport}->input()) {

    chomp($res_payload);

    # sleep a bit
    #Time::HiRes::sleep(0.1);
    Time::HiRes::sleep(0.05);

    # read 500 bytes by dumb default
    #($res_count, $res_payload) = $cellular->read(500);
    #print "-" x 30, "\n";
    #print "> ", $res_payload, "\n";
    #print "-" x 30, "\n";
    
    # trace
    #print "-" x 60, "\n";
    #print "payload: $res_payload", "\n";

    if (my $data = $self->response_parse($res_payload)) {
      #print "-" x 30, "\n";
      #print $data, "\n";
      #print "-" x 30, "\n";
      push @buf, $data;
    }
    
  }
  
  $self->{payload} = join('', @buf);
  
  return $self->{payload};
  
}


sub response_read {
  my $self = shift;

  # sleep a bit
  #Time::HiRes::sleep(0.1);
  
  #my $response = $cellular->input();
  
  my $response = $self->transport_read();
  #print "response: ";
  #print "'$response'", "\n";
  
  # FIXME
  #cellphone::save();
  return $response;

}

sub response_parse {
  my $self = shift;
  
  my $data = shift;
  my $mode = shift;
  
  my @parts = split("\r\n", $data);
  
  #print Dumper(@parts);
  #exit;
  
  my $res = '';

BLOCK:

  # ignore first two lines of each block
  shift @parts if $mode->{SPBx};
  shift @parts;
  
  if (my $payload = shift @parts) {
    chomp($payload);
    if ($payload && $payload !~ m/^(OK|ERROR)/) {
      $res .= $payload;
    }
  }
  
  goto BLOCK if @parts;
  
  my $res_dec = $res;
  $res_dec = decode_hex_nybbles($res) if $mode->{SPBx};
  
  return $res_dec;
}


sub response_save {
  my $self = shift;
  open(FH, '>' . 'data.bmp');
  binmode FH;
  print FH $self->{payload};
  close(FH);
}

sub send_raw {
  my $self = shift;
  my $data = join('', @_);

  # sleep a bit
  Time::HiRes::sleep(0.05);
  
  #print "raw: $data", "\n";
  $self->{transport}->write($data);

  # sleep a bit
  Time::HiRes::sleep(0.05);

  # TODO: review!?
  return $self->response_read();
  #return $self->response_read();
}

sub send_line {
  my $self = shift;
  my @args = ();
  @args = @_;
  my $data = join('', @args);
  return $self->send_raw($data, "\r\n");
}


sub send_command {
  my $self = shift;
  my $data = shift;
  my $type = shift;
  
  $data ||= '';
  if ($type) {
    $self->{command_type} = $type;
  } else {
    $type ||= $self->{command_type};
    $type ||= '';
  }
  
  my $prefix = 'AT';
  #if $type == 'HAYES';
  $prefix = 'AT+' if $type eq 'GSM';
  $prefix = 'AT^' if $type eq 'SIEMENS';
  
  return $self->send_line($prefix, $data);
}

sub send {
  my $self = shift;
  my $data = shift;
  my $type = shift;
  return $self->send_command($data, $type);
}


sub actions_setup {
  my $self = shift;
  my $rapfile = shift;
  my $pkgfile = __FILE__;
  my $base = dirname($pkgfile) . '/';
  my $filename = $base . 'Cellphone/' . $rapfile;
  if (! -f $filename) {
    print "WARNING: File '$filename' does not exist.", "\n";
    #return;
  }
  print "[$filename] ";
  $self->{rap} = Data::Rap->new( filename => $filename );
}

1;
__END__
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__
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26