/[RFID]/3m-810.pl
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /3m-810.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 18 by dpavlin, Fri Oct 3 12:31:58 2008 UTC revision 19 by dpavlin, Fri Oct 3 15:38:08 2008 UTC
# Line 6  use warnings; Line 6  use warnings;
6    
7  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
8  use Carp qw/confess/;  use Carp qw/confess/;
9    use Getopt::Long;
10    
11  my $debug = 0;  my $debug = 0;
12    
13    my $device    = "/dev/ttyUSB0";
14    my $baudrate  = "19200";
15    my $databits  = "8";
16    my $parity        = "none";
17    my $stopbits  = "1";
18    my $handshake = "none";
19    
20  my $response = {  my $response = {
21          'd500090400110a0500027250'                              => 'version?',          'd500090400110a0500027250'                              => 'version?',
22          'd60007fe00000500c97b'                                  => 'no tag in range',          'd60007fe00000500c97b'                                  => 'no tag in range',
# Line 21  my $response = { Line 29  my $response = {
29          'd60017fe00000502e00401003123aa26e00401003123aa283124' => 'tag #1 + tag red-stripe',          'd60017fe00000502e00401003123aa26e00401003123aa283124' => 'tag #1 + tag red-stripe',
30  };  };
31    
32    GetOptions(
33            'd|debug+'      => \$debug,
34            'device=s'    => \$device,
35            'baudrate=i'  => \$baudrate,
36            'databits=i'  => \$databits,
37            'parity=s'    => \$parity,
38            'stopbits=i'  => \$stopbits,
39            'handshake=s' => \$handshake,
40    ) or die $!;
41    
42  =head1 NAME  =head1 NAME
43    
44  3m-810 - support for 3M 810 RFID reader  3m-810 - support for 3M 810 RFID reader
45    
46  =head1 SYNOPSIS  =head1 SYNOPSIS
47    
48  3m-810.pl [DEVICE [BAUD [DATA [PARITY [STOP [FLOW]]]]]]  3m-810.pl --device /dev/ttyUSB0
49    
50  =head1 DESCRIPTION  =head1 DESCRIPTION
51    
# Line 52  it under the same terms ans Perl itself. Line 70  it under the same terms ans Perl itself.
70    
71  =cut  =cut
72    
73  # your serial port.  my $port=new Device::SerialPort($device) || die "can't open serial port $device: $!\n";
74  my ($device,$baudrate,$databits,$parity,$stopbits,$handshake)=@ARGV;  warn "using $device $handshake $baudrate $databits $parity $stopbits" if $debug;
 $device    ||= "/dev/ttyUSB0";  
 $baudrate  ||= "19200";  
 $databits  ||= "8";  
 $parity    ||= "none";  
 $stopbits  ||= "1";  
 $handshake ||= "none";  
   
 my $port=new Device::SerialPort($device) || die "new($device): $!\n";  
75  $handshake=$port->handshake($handshake);  $handshake=$port->handshake($handshake);
76  $baudrate=$port->baudrate($baudrate);  $baudrate=$port->baudrate($baudrate);
77  $databits=$port->databits($databits);  $databits=$port->databits($databits);
# Line 108  dispatch( Line 118  dispatch(
118                          warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;                          warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;
119                          print "seen $nr tags: ", join(',', @tags ) , "\n";                          print "seen $nr tags: ", join(',', @tags ) , "\n";
120    
121                          # XXX read first tag                          # read data from tag
122                          read_tag( @tags );                          read_tag( $_ ) foreach @tags;
123    
124                  }                  }
125  ) }  ) }
# Line 158  if (0) { Line 168  if (0) {
168    
169  }  }
170    
171    exit;
172    
173  for ( 1 .. 3 ) {  for ( 1 .. 3 ) {
174    
175  #                                                              ++-->type 00-0a  #                                                              ++-->type 00-0a
# Line 188  sub writechunk Line 200  sub writechunk
200  {  {
201          my $str=shift;          my $str=shift;
202          my $count = $port->write($str);          my $count = $port->write($str);
203          print "#> ", as_hex( $str ), "\t[$count]" if $debug;          print "#> ", as_hex( $str ), "\t[$count]\n" if $debug;
204  }  }
205    
206  sub as_hex {  sub as_hex {
# Line 239  sub assert { Line 251  sub assert {
251  our $dispatch;  our $dispatch;
252  sub dispatch {  sub dispatch {
253          my ( $pattern, $coderef ) = @_;          my ( $pattern, $coderef ) = @_;
254    
255            $dispatch->{ $pattern } = $coderef;
256    
257          my $patt = substr( str2bytes($pattern), 3 ); # just payload          my $patt = substr( str2bytes($pattern), 3 ); # just payload
258          my $l = length($patt);          my $l = length($patt);
259          my $p = substr( $assert->{payload}, 0, $l );          my $p = substr( $assert->{payload}, 0, $l );
Legend:
Removed from v.18  
changed lines
  Added in v.19
  ViewVC Help
Powered by ViewVC 1.1.26