80a78d765221c8988173b1355655d4ec2df07466
[Biblio-RFID.git] / lib / RFID / Serial.pm
1 package RFID::Serial;
2
3 use warnings;
4 use strict;
5
6 use base 'Exporter';
7 our @EXPORT = qw( hex2bytes as_hex hex_tag );
8
9 use Device::SerialPort qw(:STAT);
10 use Data::Dump qw(dump);
11
12 =head1 NAME
13
14 RFID::Serial - support serial RFID devices
15
16 =cut
17
18 our $VERSION = '0.01';
19
20 my $debug = 0;
21
22
23 =head1 SYNOPSIS
24
25 This module tries to support USB serial RFID readers wsing simple API
26 which is sutable for direct mapping to REST JSONP service.
27
28 Perhaps a little code snippet.
29
30     use RFID::Serial;
31
32     my $rfid = RFID::Serial->new(
33                 device => '/dev/ttyUSB0', # with fallback to RFID_DEVICE
34         );
35         my $visible = $rfid->scan;
36
37 =head1 SUBROUTINES/METHODS
38
39 =head2 new
40
41 =cut
42
43 sub new {
44         my $class = shift;
45         my $self = {@_};
46         bless $self, $class;
47
48         $self->port;
49
50         $self->init;
51
52         return $self;
53 }
54
55 =head2 port
56
57   my $serial_obj = $self->port;
58
59 =cut
60
61 sub port {
62         my $self = shift;
63
64         return $self->{port} if defined $self->{port};
65
66         my $settings = $self->serial_settings;
67         $settings->{device} ||= $ENV{RFID_DEVICE};
68         warn "# settings ",dump $settings;
69
70         $self->{port} = Device::SerialPort->new( $settings->{device} )
71         || die "can't open serial port: $!\n";
72
73         $self->{port}->$_( $settings->{$_} )
74         foreach ( qw/handshake baudrate databits parity stopbits/ );
75
76 }
77
78 =head2 scan
79
80   my $visible = $rfid->scan;
81
82 Returns hash with keys which match tag UID and values with blocks
83
84 =cut
85
86 sub scan {
87         my $self = shift;
88
89         warn "# scan tags in reader range\n";
90         my @tags = $self->inventory;
91
92         my $visible;
93         # FIXME this is naive implementation which just discards other tags
94         foreach my $tag ( @tags ) {
95                 my $blocks = $self->read_blocks( $tag );
96                 if ( ! $blocks ) {
97                         warn "ERROR: can't read tag $tag\n";
98                         delete $visible->{$tag};
99                 } else {
100                         $visible->{$tag} = $blocks->{$tag};
101                 }
102         }
103
104         return $visible;
105 }
106
107
108 =head1 MANDATORY IMPLEMENTATIONS
109
110 Each reader must implement following hooks as sub-classes.
111
112 =head2 init
113
114   $self->init;
115
116 =head2 inventory
117
118   my @tags = $self->invetory;
119
120 =head2 read_blocks
121
122   my $hash = $self->read_blocks $tag;
123
124 All blocks are under key which is tag UID
125
126   $hash = { 'E000000123456789' => [ undef, 'block1', 'block2', ... ] };
127
128 L<RFID::Serial::3M810> sends tag UID with data payload, so we might expect
129 to receive response from other tags from protocol specification, 
130
131
132 =head1 EXPORT
133
134 Formatting functions are exported
135
136 =head2 hex2bytes
137
138   my $bytes = hex2bytes($hex);
139
140 =cut
141
142 sub hex2bytes {
143         my $str = shift || die "no str?";
144         my $b = $str;
145         $b =~ s/\s+//g;
146         $b =~ s/(..)/\\x$1/g;
147         $b = "\"$b\"";
148         my $bytes = eval $b;
149         die $@ if $@;
150         warn "## str2bytes( $str ) => $b => ",as_hex($bytes) if $debug;
151         return $bytes;
152 }
153
154 =head2 as_hex
155
156   print as_hex( $bytes );
157
158 =cut
159
160 sub as_hex {
161         my @out;
162         foreach my $str ( @_ ) {
163                 my $hex = uc unpack( 'H*', $str );
164                 $hex =~ s/(..)/$1 /g if length( $str ) > 2;
165                 $hex =~ s/\s+$//;
166                 push @out, $hex;
167         }
168         return join(' | ', @out);
169 }
170
171 =head2 hex_tag
172
173   print hex_tag $8bytes;
174
175 =cut
176
177 sub hex_tag { uc(unpack('H16', shift)) }
178
179
180 =head1 AUTHOR
181
182 Dobrica Pavlinusic, C<< <dpavlin at rot13.org> >>
183
184 =head1 BUGS
185
186 Please report any bugs or feature requests to C<bug-rfid-serial at rt.cpan.org>, or through
187 the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=RFID-Serial>.  I will be notified, and then you'll
188 automatically be notified of progress on your bug as I make changes.
189
190
191
192
193 =head1 SUPPORT
194
195 You can find documentation for this module with the perldoc command.
196
197     perldoc RFID::Serial
198
199
200 You can also look for information at:
201
202 =over 4
203
204 =item * RT: CPAN's request tracker
205
206 L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=RFID-Serial>
207
208 =item * AnnoCPAN: Annotated CPAN documentation
209
210 L<http://annocpan.org/dist/RFID-Serial>
211
212 =item * CPAN Ratings
213
214 L<http://cpanratings.perl.org/d/RFID-Serial>
215
216 =item * Search CPAN
217
218 L<http://search.cpan.org/dist/RFID-Serial/>
219
220 =back
221
222
223 =head1 ACKNOWLEDGEMENTS
224
225
226 =head1 LICENSE AND COPYRIGHT
227
228 Copyright 2010 Dobrica Pavlinusic.
229
230 This program is free software; you can redistribute it and/or modify
231 it under the terms of the GNU General Public License as published by
232 the Free Software Foundation; version 2 dated June, 1991 or at your option
233 any later version.
234
235 This program is distributed in the hope that it will be useful,
236 but WITHOUT ANY WARRANTY; without even the implied warranty of
237 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
238 GNU General Public License for more details.
239
240 A copy of the GNU General Public License is available in the source tree;
241 if not, write to the Free Software Foundation, Inc.,
242 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
243
244
245 =cut
246
247 1; # End of RFID::Serial