--- /dev/null
+package Biblio::RFID;
+
+use warnings;
+use strict;
+
+use base 'Exporter';
+our @EXPORT = qw( hex2bytes as_hex hex_tag $debug );
+
+use Data::Dump qw(dump);
+
+=head1 NAME
+
+Biblio::RFID - perl tools to use different RFID readers for library use
+
+=cut
+
+our $VERSION = '0.02';
+
+our $debug = 0;
+
+
+=head1 DESCRIPTION
+
+Main idea is to develop simple API to reader, and than provide useful
+abstractions on top of it to quickly write applications to respond on
+tags which come in range of RFID reader using L<Biblio::RFID::Reader>.
+
+Writing support for new RFID readers should be easy.
+L<Biblio::RFID::Reader::API> provides documentation on writing support
+for different readers.
+
+Currently, two serial RFID readers based on L<Biblio::RFID::Reader::Serial>
+are implemented:
+
+=over 4
+
+=item *
+
+L<Biblio::RFID::Reader::3M810>
+
+=item *
+
+L<Biblio::RFID::Reader::CPRM02>
+
+=back
+
+There is also simple read-only reader using shell commands in
+L<Biblio::RFID::Reader::librfid>.
+
+For implementing application take a look at L<Biblio::RFID::Reader>
+
+C<scripts/RFID-JSONP-server.pl> is example of such application. It's local
+interface to RFID reader and JSONP REST server.
+
+C<examples/koha-rfid.js> is jQuery based JavaScript code which can be inserted
+in Koha Library System to provide overlay with tags in range and
+check-in/check-out form-fill functionality.
+
+Applications can use L<Biblio::RFID::RFID501> which is some kind of
+semi-standard 3M layout or blocks on RFID tags.
+
+=for readme stop
+
+=head1 EXPORT
+
+Formatting functions are exported
+
+=head2 hex2bytes
+
+ my $bytes = hex2bytes($hex);
+
+=cut
+
+sub hex2bytes {
+ my $str = shift || die "no str?";
+ my $b = $str;
+ $b =~ s/\s+//g;
+ $b =~ s/(..)/\\x$1/g;
+ $b = "\"$b\"";
+ my $bytes = eval $b;
+ die $@ if $@;
+ warn "## str2bytes( $str ) => $b => ",as_hex($bytes) if $debug;
+ return $bytes;
+}
+
+=head2 as_hex
+
+ print as_hex( $bytes );
+
+=cut
+
+sub as_hex {
+ my @out;
+ foreach my $str ( @_ ) {
+ my $hex = uc unpack( 'H*', $str );
+ $hex =~ s/(..)/$1 /g if length( $str ) > 2;
+ $hex =~ s/\s+$//;
+ push @out, $hex;
+ }
+ return join(' | ', @out);
+}
+
+=head2 hex_tag
+
+ print hex_tag $8bytes;
+
+=cut
+
+sub hex_tag { uc(unpack('H16', shift)) }
+
+=head1 WARN
+
+We are installing L<perldoc/warn> handler to controll debug output
+based on C<$Biblio::RFID::debug> level
+
+=cut
+
+BEGIN {
+ $SIG{'__WARN__'} = sub {
+ my $msg = join(' ', @_);
+ if ( $msg =~ m/^(#+)/ ) {
+ my $l = length $1;
+ return if $l > $debug;
+ }
+ warn join(' ', @_);
+ }
+}
+
+=for readme continue
+
+=head1 HARDWARE SUPPORT
+
+=head2 3M 810
+
+L<Biblio::RFID::Reader::3M810>
+
+=head2 CPR-M02
+
+L<Biblio::RFID::Reader::CPRM02>
+
+=head2 librfid
+
+L<Biblio::RFID::Reader::librfid>
+
+
+=head1 AUTHOR
+
+Dobrica Pavlinusic, C<< <dpavlin at rot13.org> >>
+
+L<http://blog.rot13.org/>
+
+=head1 BUGS
+
+Please report any bugs or feature requests to C<bug-rfid-biblio at rt.cpan.org>, or through
+the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Biblio-RFID>. I will be notified, and then you'll
+automatically be notified of progress on your bug as I make changes.
+
+
+
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+ perldoc Biblio::RFID
+ perldoc Biblio::RFID::Reader
+ perldoc Biblio::RFID::Reader::API
+
+
+You can also look for information at:
+
+=over 4
+
+=item * RT: CPAN's request tracker
+
+L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Biblio-RFID>
+
+=item * AnnoCPAN: Annotated CPAN documentation
+
+L<http://annocpan.org/dist/Biblio-RFID>
+
+=item * CPAN Ratings
+
+L<http://cpanratings.perl.org/d/Biblio-RFID>
+
+=item * Search CPAN
+
+L<http://search.cpan.org/dist/Biblio-RFID/>
+
+=back
+
+
+=head1 ACKNOWLEDGEMENTS
+
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright 2010 Dobrica Pavlinusic.
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; version 2 dated June, 1991 or at your option
+any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+A copy of the GNU General Public License is available in the source tree;
+if not, write to the Free Software Foundation, Inc.,
+59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+
+=cut
+
+1; # End of Biblio::RFID
--- /dev/null
+package Biblio::RFID::RFID501;
+
+use warnings;
+use strict;
+
+use Data::Dump qw(dump);
+
+=head1 NAME
+
+Biblio::RFID::RFID501 - RFID Standard for Libraries
+
+=head1 DESCRIPTION
+
+This module tries to decode tag format as described in document
+
+ RFID 501: RFID Standards for Libraries
+
+L<http://solutions.3m.com/wps/portal/3M/en_US/3MLibrarySystems/Home/Resources/CaseStudiesAndWhitePapers/RFID501/>
+
+Goal is to be compatibile with existing 3M Alphanumeric tag format
+which, as far as I know, isn't specificed anywhere. My documentation about
+this format is available at
+
+L<http://saturn.ffzg.hr/rot13/index.cgi?hitchhikers_guide_to_rfid>
+
+=head1 Data model
+
+=head2 3M Alphanumeric tag
+
+ 0 04 is 00 tt i [4 bit] = number of item in set [1 .. i .. s]
+ s [4 bit] = total items in set
+ tt [8 bit] = item type
+
+ 1 dd dd dd dd dd [16 bytes] = barcode data
+ 2 dd dd dd dd
+ 3 dd dd dd dd
+ 4 dd dd dd dd
+
+ 5 bb bl ll ll b [12 bit] = branch [unsigned]
+ l [20 bit] = library [unsigned]
+
+ 6 cc cc cc cc c [32 bit] = custom signed integer
+
+=head2 3M Manufacturing Blank
+
+ 0 55 55 55 55
+ 1 55 55 55 55
+ 2 55 55 55 55
+ 3 55 55 55 55
+ 4 55 55 55 55
+ 5 55 55 55 55
+ 6 00 00 00 00
+
+=head2 Generic blank
+
+ 0 00 00 00 00
+ 1 00 00 00 00
+ 2 00 00 00 00
+
+=head1 Security
+
+AFI byte on RFID tag is used for security.
+
+In my case, we have RFID door which can only read AFI bytes from tag and issue
+alarm sound or ignore it depending on value of byte.
+
+=over 8
+
+=item 0xD7 214
+
+secured item (door will beep)
+
+=item 0xDA 218
+
+unsecured (door will ignore it)
+
+=back
+
+
+=head1 METHODS
+
+=head2 to_hash
+
+ my $hash = Biblio::RFID::Decode::RFID501->to_hash( $bytes );
+
+ my $hash = Biblio::RFID::Decode::RFID501->to_hash( [ 'blk1', 'blk2', ... , 'blk7' ] );
+
+=head2 from_hash
+
+ my $blocks = Biblio::RFID::Decode::RFID->from_hash({ content => "1301234567" });
+
+=head2 blank_3m
+
+=head2 blank
+
+ my $blocks = Biblio::RFID::Decode::RFID->blank;
+
+=cut
+
+my $item_type = {
+ 1 => 'Book',
+ 6 => 'CD/CD ROM',
+ 2 => 'Magazine',
+ 13 => 'Book with Audio Tape',
+ 9 => 'Book with CD/CD ROM',
+ 0 => 'Other',
+
+ 5 => 'Video',
+ 4 => 'Audio Tape',
+ 3 => 'Bound Journal',
+ 8 => 'Book with Diskette',
+ 7 => 'Diskette',
+};
+
+sub to_hash {
+ my ( $self, $data ) = @_;
+
+ return unless $data;
+
+ $data = join('', @$data) if ref $data eq 'ARRAY';
+
+ warn "## to_hash ",dump($data);
+
+ my ( $u1, $set_item, $u2, $type, $content, $br_lib, $custom, $zero ) = unpack('C4Z16Nl>l',$data);
+ my $hash = {
+ u1 => $u1, # FIXME 0x04
+ set => ( $set_item & 0xf0 ) >> 4,
+ total => ( $set_item & 0x0f ),
+
+ u2 => $u2, # FIXME 0x00
+
+ type => $type,
+ type_label => $item_type->{$type},
+
+ content => $content,
+
+ branch => $br_lib >> 20,
+ library => $br_lib & 0x000fffff,
+
+ custom => $custom,
+ };
+
+ warn "expected first byte to be 0x04, not $u1\n" if $u1 != 4;
+ warn "expected third byte to be 0x00, not $u2\n" if $u2 != 0;
+ warn "expected last block to be zero, not $zero\n" if $zero != 0;
+
+ return $hash;
+}
+
+sub from_hash {
+ my ( $self, $hash ) = @_;
+
+ warn "## from_hash ",dump($hash);
+
+ return pack('C4Z16Nl>l',
+ 0x04,
+ ( $hash->{set} << 4 ) | ( $hash->{total} & 0x0f ),
+ 0x00,
+ $hash->{type},
+
+ $hash->{content},
+
+ ( $hash->{branch} << 20 ) | ( $hash->{library} & 0x000fffff ),
+
+ $hash->{custom},
+ 0x00,
+ );
+}
+
+sub blank_3m {
+ return ( "\x55" x ( 6 * 4 ) ) . ( "\x00" x 4 );
+}
+
+sub blank {
+ return "\x00" x ( 4 * 3 );
+}
+
+1;
--- /dev/null
+package Biblio::RFID::Reader;
+
+use warnings;
+use strict;
+
+use Data::Dump qw(dump);
+use Time::HiRes;
+use lib 'lib';
+use Biblio::RFID;
+use Carp qw(confess);
+
+=head1 NAME
+
+Biblio::RFID::Reader - simple way to write RFID applications in perl
+
+=head1 DESCRIPTION
+
+This module will probe all available readers and use calls from
+L<Biblio::RFID::Reader::API> to invoke correct reader.
+
+=head1 FUNCTIONS
+
+=head2 new
+
+ my $rfid = Biblio::RFID::Reader->new( 'optional reader filter' );
+
+=cut
+
+sub new {
+ my ( $class, $filter ) = @_;
+ my $self = {};
+ bless $self, $class;
+ $self->{_readers} = [ $self->_available( $filter ) ];
+ return $self;
+}
+
+=head2 tags
+
+ my @visible = $rfid->tags(
+ enter => sub { my $tag = shift; },
+ leave => sub { my $tag = shift; },
+ );
+
+=cut
+
+sub tags {
+ my $self = shift;
+ my $triggers = {@_};
+
+ $self->{_tags} ||= {};
+ $self->{_tags}->{$_}->{time} = 0 foreach keys %{$self->{_tags}};
+ my $t = time;
+
+ foreach my $rfid ( @{ $self->{_readers} } ) {
+ warn "# inventory on $rfid";
+ my @tags = $rfid->inventory;
+
+ foreach my $tag ( @tags ) {
+
+ if ( ! exists $self->{_tags}->{$tag} ) {
+ eval {
+ my $blocks = $rfid->read_blocks($tag);
+ $self->{_tags}->{$tag}->{blocks} = $blocks->{$tag} || die "no $tag in ",dump($blocks);
+ my $afi = $rfid->read_afi($tag);
+ $self->{_tags}->{$tag}->{afi} = $afi;
+
+ };
+ if ( $@ ) {
+ warn "ERROR reading $tag: $@\n";
+ $self->_invalidate_tag( $tag );
+ next;
+ }
+
+ $triggers->{enter}->( $tag ) if $triggers->{enter};
+ }
+
+ $self->{_tags}->{$tag}->{time} = $t;
+
+ }
+
+ foreach my $tag ( grep { $self->{_tags}->{$_}->{time} == 0 } keys %{ $self->{_tags} } ) {
+ $triggers->{leave}->( $tag ) if $triggers->{leave};
+ $self->_invalidate_tag( $tag );
+ }
+
+ }
+
+ warn "## _tags ",dump( $self->{_tags} );
+
+ return grep { $self->{_tags}->{$_}->{time} } keys %{ $self->{_tags} };
+}
+
+=head2 blocks
+
+ my $blocks_arrayref = $rfid->blocks( $tag );
+
+=head2 afi
+
+ my $afi = $rfid->afi( $tag );
+
+=cut
+
+sub blocks { $_[0]->{_tags}->{$_[1]}->{ 'blocks' } || confess "no blocks for $_[1]"; };
+sub afi { $_[0]->{_tags}->{$_[1]}->{ 'afi' } || confess "no afi for $_[1]"; };
+
+=head1 PRIVATE
+
+=head2 _invalidate_tag
+
+ $rfid->_invalidate_tag( $tag );
+
+=cut
+
+sub _invalidate_tag {
+ my ( $self, $tag ) = @_;
+ my @caller = caller(0);
+ warn "## _invalidate_tag caller $caller[0] $caller[1] +$caller[2]\n";
+ my $old = delete $self->{_tags}->{$tag};
+ warn "# _invalidate_tag $tag ", dump($old);
+}
+
+=head2 _available
+
+Probe each RFID reader supported and returns succefull ones
+
+ my $rfid_readers = Biblio::RFID::Reader->_available( $regex_filter );
+
+=cut
+
+my @readers = ( '3M810', 'CPRM02', 'librfid' );
+
+sub _available {
+ my ( $self, $filter ) = @_;
+
+ $filter = '' unless defined $filter;
+
+ warn "# filter: $filter";
+
+ my @rfid;
+
+ foreach my $reader ( @readers ) {
+ next if $filter && $reader !~ /$filter/i;
+ my $module = "Biblio::RFID::Reader::$reader";
+ eval "use $module";
+ die $@ if $@;
+ if ( my $rfid = $module->new ) {
+ push @rfid, $rfid;
+ warn "# added $module\n";
+ } else {
+ warn "# ignored $module\n";
+ }
+ }
+
+ die "no readers found" unless @rfid;
+
+ return @rfid;
+}
+
+=head1 AUTOLOAD
+
+On any other function calls, we just marshall to all readers
+
+=cut
+
+# we don't want DESTROY to fallback into AUTOLOAD
+sub DESTROY {}
+
+our $AUTOLOAD;
+sub AUTOLOAD {
+ my $self = shift;
+ my $command = $AUTOLOAD;
+ $command =~ s/.*://;
+
+ my @out;
+
+ foreach my $r ( @{ $self->{_readers} } ) {
+ push @out, $r->$command(@_);
+ }
+
+ $self->_invalidate_tag( $_[0] ) if $command =~ m/write/;
+
+ return @out;
+}
+
+1
+__END__
+
+=head1 SEE ALSO
+
+=head2 RFID reader implementations
+
+L<Biblio::RFID::Reader::3M810>
+
+L<Biblio::RFID::Reader::CPRM02>
+
+L<Biblio::RFID::Reader::librfid>
+
--- /dev/null
+package Biblio::RFID::Reader::3M810;
+
+=head1 NAME
+
+Biblio::RFID::Reader::3M810 - support for 3M 810 RFID reader
+
+=head1 DESCRIPTION
+
+This module uses L<Biblio::RFID::Reader::Serial> over USB/serial adapter
+with 3M 810 RFID reader, often used in library applications.
+
+This is most mature implementation which supports full API defined
+in L<Biblio::RFID::Reader::API>. This include scanning for all tags in reader
+range, reading and writing of data, and AFI security manipulation.
+
+This implementation is developed using Portmon on Windows to capture serial traffic
+L<http://technet.microsoft.com/en-us/sysinternals/bb896644.aspx>
+
+Checksum for this reader is developed using help from C<selwyn>
+L<http://stackoverflow.com/questions/149617/how-could-i-guess-a-checksum-algorithm>
+
+More inforation about process of reverse engeeniring protocol with
+this reader is available at L<http://blog.rot13.org/rfid/>
+
+=cut
+
+use warnings;
+use strict;
+
+use base 'Biblio::RFID::Reader::Serial';
+use Biblio::RFID;
+
+use Data::Dump qw(dump);
+use Carp qw(confess);
+use Time::HiRes;
+use Digest::CRC;
+
+sub serial_settings {{
+ baudrate => "19200",
+ databits => "8",
+ parity => "none",
+ stopbits => "1",
+ handshake => "none",
+}}
+
+sub assert;
+
+my $port;
+sub init {
+ my $self = shift;
+ $port = $self->port;
+
+ # disable timeouts
+ $port->read_char_time(0);
+ $port->read_const_time(0);
+
+ # drain on startup
+ my ( $count, $str ) = $port->read(3);
+ my $data = $port->read( ord(substr($str,2,1)) );
+ warn "drain ",as_hex( $str, $data ),"\n";
+
+ $port->read_char_time(100); # 0.1 s char timeout
+ $port->read_const_time(500); # 0.5 s read timeout
+
+ $port->write( hex2bytes( 'D5 00 05 04 00 11 8C66' ) );
+ # hw-version expect: 'D5 00 09 04 00 11 0A 05 00 02 7250'
+ my $data = $port->read( 12 );
+ return unless $data;
+
+ warn "# probe response: ",as_hex($data);
+ if ( my $rest = assert $data => 'D5 00 09 04 00 11' ) {
+ my $hw_ver = join('.', unpack('CCCC', $rest));
+ warn "# 3M 810 hardware version $hw_ver\n";
+
+ cmd(
+'13 04 01 00 02 00 03 00 04 00','FIXME: stats? rf-on?', sub { assert(shift,
+'13 00 02 01 01 03 02 02 03 00'
+ )});
+
+ return $hw_ver;
+ }
+
+ return;
+}
+
+sub checksum {
+ my $bytes = shift;
+ my $crc = Digest::CRC->new(
+ # midified CCITT to xor with 0xffff instead of 0x0000
+ width => 16, init => 0xffff, xorout => 0xffff, refout => 0, poly => 0x1021, refin => 0,
+ ) or die $!;
+ $crc->add( $bytes );
+ pack('n', $crc->digest);
+}
+
+sub cmd {
+ my ( $hex, $description, $coderef ) = @_;
+ my $bytes = hex2bytes($hex);
+ if ( substr($bytes,0,1) !~ /(\xD5|\xD6)/ ) {
+ my $len = pack( 'n', length( $bytes ) + 2 );
+ $bytes = $len . $bytes;
+ my $checksum = checksum($bytes);
+ $bytes = "\xD6" . $bytes . $checksum;
+ }
+
+ warn ">> ", as_hex( $bytes ), "\t\t[$description]\n" if $debug;
+ $port->write( $bytes );
+
+ my $r_len = $port->read(3);
+
+ while ( length($r_len) < 3 ) {
+ $r_len = $port->read( 3 - length($r_len) );
+ }
+
+ my $len = ord( substr($r_len,2,1) );
+ my $data = $port->read( $len );
+
+ warn "<< ", as_hex($r_len,$data),
+ ' | ',
+ substr($data,-2,2) eq checksum(substr($r_len,1).substr($data,0,-2)) ? 'OK' : 'ERROR',
+ " $len bytes\n" if $debug;
+
+
+ $coderef->( $data ) if $coderef;
+
+}
+
+sub assert {
+ my ( $got, $expected ) = @_;
+ $expected = hex2bytes($expected);
+
+ my $len = length($got);
+ $len = length($expected) if length $expected < $len;
+
+ confess "got ", as_hex($got), " expected ", as_hex($expected)
+ unless substr($got,0,$len) eq substr($expected,0,$len);
+
+ return substr($got,$len);
+}
+
+
+sub inventory {
+
+ my @tags;
+
+cmd( 'FE 00 05', 'scan for tags', sub {
+ my $data = shift;
+ my $rest = assert $data => 'FE 00 00 05';
+ my $nr = ord( substr( $rest, 0, 1 ) );
+
+ if ( ! $nr ) {
+ warn "# no tags in range\n";
+ } else {
+ my $tags = substr( $rest, 1 );
+ my $tl = length( $tags );
+ die "wrong length $tl for $nr tags: ",dump( $tags ) if $tl =! $nr * 8;
+
+ foreach ( 0 .. $nr - 1 ) {
+ push @tags, hex_tag substr($tags, $_ * 8, 8);
+ }
+ }
+
+});
+
+ warn "# tags ",dump @tags;
+ return @tags;
+}
+
+
+# 3M defaults: 8,4
+# cards 16, stickers: 8
+my $max_rfid_block = 8;
+my $blocks = 8;
+
+sub _matched {
+ my ( $data, $hex ) = @_;
+ my $b = hex2bytes $hex;
+ my $l = length($b);
+ if ( substr($data,0,$l) eq $b ) {
+ warn "_matched $hex [$l] in ",as_hex($data) if $debug;
+ return substr($data,$l);
+ }
+}
+
+sub read_blocks {
+ my $tag = shift || confess "no tag?";
+ $tag = shift if ref($tag);
+
+ my $tag_blocks;
+ my $start = 0;
+ cmd(
+ sprintf( "02 $tag %02x %02x", $start, $blocks ) => "read_blocks $tag $start/$blocks", sub {
+ my $data = shift;
+ if ( my $rest = _matched $data => '02 00' ) {
+
+ my $tag = hex_tag substr($rest,0,8);
+ my $blocks = ord(substr($rest,8,1));
+ warn "# response from $tag $blocks blocks ",as_hex substr($rest,9);
+ foreach ( 1 .. $blocks ) {
+ my $pos = ( $_ - 1 ) * 6 + 9;
+ my $nr = unpack('v', substr($rest,$pos,2));
+ my $payload = substr($rest,$pos+2,4);
+ warn "## pos $pos block $nr ",as_hex($payload), $/;
+ $tag_blocks->{$tag}->[$nr] = $payload;
+ }
+ } elsif ( $rest = _matched $data => 'FE 00 00 05 01' ) {
+ warn "FIXME ready? ",as_hex $rest;
+ } elsif ( $rest = _matched $data => '02 06' ) {
+ die "ERROR ",as_hex($rest);
+ } else {
+ die "FIXME unsuported ",as_hex($rest);
+ }
+ });
+
+ warn "# tag_blocks ",dump($tag_blocks);
+ return $tag_blocks;
+}
+
+sub write_blocks {
+ my $tag = shift;
+ $tag = shift if ref $tag;
+
+ my $data = shift;
+ $data = join('', @$data) if ref $data eq 'ARRAY';
+
+ warn "## write_blocks ",dump($tag,$data);
+
+ if ( length($data) % 4 ) {
+ $data .= '\x00' x ( 4 - length($data) % 4 );
+ warn "# padded data to ",dump($data);
+ }
+
+ my $hex_data = as_hex $data;
+ my $blocks = sprintf('%02x', length($data) / 4 );
+
+ cmd(
+ "04 $tag 00 $blocks 00 $hex_data", "write_blocks $tag [$blocks] $hex_data", sub {
+ my $data = shift;
+ if ( my $rest = _matched $data => '04 00' ) {
+ my $tag = substr($rest,0,8);
+ my $blocks = substr($rest,8,1);
+ warn "# WRITE ",as_hex($tag), " [$blocks]\n";
+ } elsif ( $rest = _matched $data => '04 06' ) {
+ die "ERROR ",as_hex($rest);
+ } else {
+ die "UNSUPPORTED";
+ }
+ }
+ );
+
+}
+
+sub read_afi {
+ my $tag = shift;
+ $tag = shift if ref $tag;
+
+ my $afi;
+
+ cmd(
+ "0A $tag", "read_afi $tag", sub {
+ my $data = shift;
+
+ if ( my $rest = _matched $data => '0A 00' ) {
+
+ my $tag = substr($rest,0,8);
+ $afi = substr($rest,8,1);
+
+ warn "# SECURITY ", hex_tag($tag), " AFI: ", as_hex($afi);
+
+ } elsif ( $rest = _matched $data => '0A 06' ) {
+ die "ERROR reading security from $tag ", as_hex($data);
+ } else {
+ die "IGNORED ",as_hex($data);
+ }
+ });
+ warn "## read_afi ",dump($tag, $afi);
+ return $afi;
+}
+
+sub write_afi {
+ my $tag = shift;
+ $tag = shift if ref $tag;
+ my $afi = shift || die "no afi?";
+
+ $afi = as_hex $afi;
+
+ cmd(
+ "09 $tag $afi", "write_afi $tag $afi", sub {
+ my $data = shift;
+
+ if ( my $rest = _matched $data => '09 00' ) {
+ my $tag_back = hex_tag substr($rest,0,8);
+ die "write_afi got $tag_back expected $tag" if $tag_back ne $tag;
+ warn "# SECURITY ", hex_tag($tag), " AFI: ", as_hex($afi);
+ } elsif ( $rest = _matched $data => '0A 06' ) {
+ die "ERROR writing AFI to $tag ", as_hex($data);
+ } else {
+ die "IGNORED ",as_hex($data);
+ }
+ });
+ warn "## write_afi ", dump( $tag, $afi );
+ return $afi;
+}
+
+1
+
+__END__
+
+=head1 SEE ALSO
+
+L<Biblio::RFID::Reader::API>
--- /dev/null
+package Biblio::RFID::Reader::API;
+
+use warnings;
+use strict;
+
+=head1 NAME
+
+Biblio::RFID::Reader::API - low-level RFID reader documentation
+
+=cut
+
+=head1 MANDATORY METHODS
+
+Each reader must implement following hooks as sub-classes.
+
+=head2 init
+
+ $self->init;
+
+=head2 inventory
+
+ my @tags = $self->invetory;
+
+=head2 read_blocks
+
+ my $hash = $self->read_blocks( $tag );
+
+All blocks are under key which is tag UID with array of blocks returned from reader
+
+ $hash = { 'E000000123456789' => [ 'blk1', 'blk2', ... ] };
+
+L<Biblio::RFID::Reader::3M810> sends tag UID with data payload, so we might expect
+to receive response from other tags from protocol specification,
+
+=head2 write_blocks
+
+ $self->write_blocks( $tag => $bytes );
+
+ $self->write_blocks( $tag => [ 'blk1', 'blk2', ... ] );
+
+=head2 read_afi
+
+ my $afi = $self->read_afi( $tag );
+
+=head2 write_afi
+
+ $self->write_afi( $tag => $afi );
+
+
+=head1 METHODS
+
+=head2 new
+
+Just calls C<init> in reader implementation so this class
+can be used as simple stub base class like
+L<Biblio::RFID::Reader::librfid> does
+
+=cut
+
+sub new {
+ my $class = shift;
+ my $self = {@_};
+ bless $self, $class;
+ $self->init && return $self;
+}
+
+1;
--- /dev/null
+package Biblio::RFID::Reader::CPRM02;
+
+=head1 NAME
+
+Biblio::RFID::Reader::CPRM02 - support for CPR-M02 RFID reader
+
+=head1 DESCRIPTION
+
+This module implements serial protocol over usb/serial adapter with CPR-M02
+reader as described in document C<H20800-16e-ID-B.pdf>
+
+=cut
+
+use warnings;
+use strict;
+
+use base 'Biblio::RFID::Reader::Serial';
+use Biblio::RFID;
+
+use Time::HiRes;
+use Data::Dump qw(dump);
+
+my $debug = 1;
+
+sub serial_settings {{
+ device => "/dev/ttyUSB0",
+ baudrate => "38400",
+ databits => "8",
+ parity => "even",
+ stopbits => "1",
+ handshake => "none",
+}}
+
+sub cpr_m02_checksum {
+ my $data = shift;
+
+ my $preset = 0xffff;
+ my $polynom = 0x8408;
+
+ my $crc = $preset;
+ foreach my $i ( 0 .. length($data) - 1 ) {
+ $crc ^= ord(substr($data,$i,1));
+ for my $j ( 0 .. 7 ) {
+ if ( $crc & 0x0001 ) {
+ $crc = ( $crc >> 1 ) ^ $polynom;
+ } else {
+ $crc = $crc >> 1;
+ }
+ }
+# warn sprintf('%d %04x', $i, $crc & 0xffff);
+ }
+
+ return pack('v', $crc);
+}
+
+sub wait_device {
+ Time::HiRes::sleep 0.010;
+}
+
+our $port;
+
+sub cpr {
+ my ( $hex, $description, $coderef ) = @_;
+ my $bytes = hex2bytes($hex);
+ my $len = pack( 'c', length( $bytes ) + 3 );
+ my $send = $len . $bytes;
+ my $checksum = cpr_m02_checksum($send);
+ $send .= $checksum;
+
+ warn "##>> ", as_hex( $send ), "\t\t[$description]\n";
+ $port->write( $send );
+
+ wait_device;
+
+ my $r_len = $port->read(1);
+
+ my $count = 100;
+ while ( ! $r_len ) {
+ if ( $count-- == 0 ) {
+ warn "no response from device";
+ return;
+ }
+ wait_device;
+ $r_len = $port->read(1);
+ }
+
+ wait_device;
+
+ my $data_len = ord($r_len) - 1;
+ my $data = $port->read( $data_len );
+ warn "##<< ", as_hex( $r_len . $data ),"\n";
+
+ wait_device;
+
+ $coderef->( $data ) if $coderef;
+
+}
+
+# FF = COM-ADDR any
+
+sub init {
+ my $self = shift;
+
+ $port = $self->port;
+
+cpr( 'FF 52 00', 'Boud Rate Detection' );
+
+cpr( 'FF 65', 'Get Software Version' );
+
+cpr( 'FF 66 00', 'Get Reader Info - General hard and firware' );
+
+cpr( 'FF 69', 'RF Reset' );
+
+ return 1;
+}
+
+
+sub inventory {
+
+ my @tags;
+
+cpr( 'FF B0 01 00', 'ISO - Inventory', sub {
+ my $data = shift;
+ if (length($data) < 5 + 2 ) {
+ warn "# no tags in range\n";
+ return;
+ }
+
+ my $data_sets = ord(substr($data,3,1));
+ $data = substr($data,4);
+ foreach ( 1 .. $data_sets ) {
+ my $tr_type = substr($data,0,1);
+ die "FIXME only TR-TYPE=3 ISO 15693 supported" unless $tr_type eq "\x03";
+ my $dsfid = substr($data,1,1);
+ my $uid = substr($data,2,8);
+ $data = substr($data,10);
+ warn "# TAG $_ ",as_hex( $tr_type, $dsfid, $uid ),$/;
+ push @tags, hex_tag $uid;
+
+ }
+});
+
+ warn "# tags ",dump(@tags),$/;
+ return @tags;
+}
+
+
+sub _get_system_info {
+ my $tag = shift;
+
+ my $info;
+
+ cpr( "FF B0 2B 01 $tag", "Get System Information $tag", sub {
+ my $data = shift;
+
+ warn "# data ",as_hex($data);
+
+ return if length($data) < 17;
+
+ $info = {
+ DSFID => substr($data,5-2,1),
+ UID => substr($data,6-2,8),
+ AFI => substr($data,14-2,1),
+ MEM => substr($data,15-2,1),
+ SIZE => substr($data,16-2,1),
+ IC_REF => substr($data,17-2,1),
+ };
+
+ });
+
+ warn "# _get_system_info $tag ",dump( $info );
+
+ return $info;
+}
+
+
+sub read_blocks {
+ my $tag = shift;
+ $tag = shift if ref $tag;
+
+ my $info = _get_system_info $tag;
+
+ return unless $info->{SIZE};
+
+ my $max_block = ord($info->{SIZE});
+
+ my $tag_blocks;
+
+ my $block = 0;
+ while ( $block < $max_block ) {
+ cpr( sprintf("FF B0 23 01 $tag %02x 04", $block), "Read Multiple Blocks $block", sub {
+ my $data = shift;
+
+ my $DB_N = ord substr($data,5-2,1);
+ my $DB_SIZE = ord substr($data,6-2,1);
+
+ $data = substr($data,7-2,-2);
+# warn "# DB N: $DB_N SIZE: $DB_SIZE ", as_hex( $data ), " transponder_data: [$transponder_data] ",length($transponder_data),"\n";
+ foreach my $n ( 1 .. $DB_N ) {
+ my $sec = ord(substr($data,0,1));
+ my $db = substr($data,1,$DB_SIZE);
+ warn "## block $n ",dump( $sec, $db ) if $debug;
+ $tag_blocks->{$tag}->[$block+$n-1] = reverse split(//,$db);
+ $data = substr($data, $DB_SIZE + 1);
+ }
+ });
+ $block += 4;
+ }
+
+ warn "# tag_blocks ",dump($tag_blocks),$/;
+ return $tag_blocks;
+}
+
+
+sub write_blocks {
+ my $tag = shift;
+ $tag = shift if ref $tag;
+
+ my $data = shift;
+ $data = join('', @$data) if ref $data eq 'ARRAY';
+
+ my $DB_ADR = 0; # start at first block
+ my $DB_SIZE = 4; # bytes in one block FIXME this should be read from transponder and not hard-coded
+ if ( my $padding = length($data) % $DB_SIZE ) {
+ warn "WARNING: data block not padded to $DB_SIZE bytes";
+ $data .= "\x00" x $padding;
+ }
+ my $DB_N = length($data) / $DB_SIZE;
+
+ my $send_data;
+ foreach my $block ( 0 .. $DB_N ) {
+ $send_data .= reverse split(//, substr( $data, $block * $DB_SIZE, $DB_SIZE ) );
+ }
+
+ cpr( sprintf("FF B0 24 01 $tag %02x %02x %02x %s", $DB_ADR, $DB_N, $DB_SIZE, as_hex($send_data)), "Write Multiple Blocks $tag", sub {
+ my $data = shift;
+ warn dump( $data );
+ });
+
+}
+
+sub read_afi {
+ my $tag = shift;
+ $tag = shift if ref $tag;
+
+ my $info = _get_system_info $tag;
+ return $info->{AFI} || warn "no AFI for $tag in ",dump($info);
+
+}
+
+sub write_afi {
+ my $tag = shift;
+ $tag = shift if ref $tag;
+
+ my $afi = shift || die "no afi?";
+ $afi = as_hex $afi;
+
+ cpr( "FF B0 27 01 $tag $afi", "Write AFI $tag $afi", sub {
+ my $data = shift;
+ warn "## write_afi $tag got ",as_hex($data);
+ });
+
+}
+
+1
--- /dev/null
+package Biblio::RFID::Reader::Serial;
+
+use warnings;
+use strict;
+
+use Device::SerialPort qw(:STAT);
+use Data::Dump qw(dump);
+
+=head1 NAME
+
+Biblio::RFID::Reader::Serial - base class for serial RFID readers
+
+=head1 METHODS
+
+=head2 new
+
+Open serial port (if needed) and init reader
+
+=cut
+
+sub new {
+ my $class = shift;
+ my $self = {@_};
+ bless $self, $class;
+
+ $self->port && return $self;
+}
+
+
+=head2 port
+
+Tries to open usb serial ports C</dev/ttyUSB*>
+
+ my $serial_obj = $self->port;
+
+To try just one device use C<RFID_DEVICE=/dev/ttyUSB1> enviroment variable
+
+=cut
+
+our $serial_device;
+
+sub port {
+ my $self = shift;
+
+ return $self->{port} if defined $self->{port};
+
+ my $settings = $self->serial_settings;
+ my @devices = $ENV{RFID_DEVICE} ? ( $ENV{RFID_DEVICE} ) : glob '/dev/ttyUSB*';
+ warn "# port devices ",dump(@devices);
+
+ foreach my $device ( @devices ) {
+
+ next if $serial_device->{$device};
+
+ if ( my $port = Device::SerialPort->new($device) ) {
+
+ foreach my $opt ( qw/handshake baudrate databits parity stopbits/ ) {
+ $port->$opt( $settings->{$opt} );
+ }
+
+ $self->{port} = $port;
+
+ warn "# probe by init $device ",ref($self);
+ if ( $self->init ) {
+ warn "init OK ", ref($self), " $device settings ",dump $settings;
+ $serial_device->{$device} = $port;
+ last;
+ } else {
+ $self->{port} = 0;
+ }
+ }
+ }
+
+ warn "# serial_device ",dump($serial_device);
+
+ return $self->{port};
+}
+
+1
+__END__
+
+=head1 SEE ALSO
+
+L<Biblio::RFID::Reader::3M810>
+
+L<Biblio::RFID::Reader::CPRM01>
+
+L<Biblio::RFID::Reader::API>
+
--- /dev/null
+package Biblio::RFID::Reader::librfid;
+
+use warnings;
+use strict;
+
+use base 'Biblio::RFID::Reader::API';
+use Biblio::RFID;
+
+use Data::Dump qw(dump);
+
+=head1 NAME
+
+Biblio::RFID::Reader::librfid - execute librfid-tool
+
+=head1 DESCRIPTION
+
+This is wrapper around C<librfid-tool> from
+
+L<http://openmrtd.org/projects/librfid/>
+
+Due to limitation of L<librfid-tool> only
+L<Biblio::RFID::Reader::API/inventory> and
+L<Biblio::RFID::Reader::API/read_blocks> is supported.
+
+However, this code might provide template for integration
+with any command-line utilities for different RFID readers.
+
+Currently tested with only with Omnikey CardMan 5321 which
+has problems. After a while it stops responding to commands
+by C<librfid-tool> so I provided small C program to reset it:
+
+C<examples/usbreset.c>
+
+=cut
+
+sub serial_settings {} # don't open serial
+
+our $bin = '/rest/cvs/librfid/utils/librfid-tool';
+
+sub init {
+ my $self = shift;
+ if ( -e $bin ) {
+ warn "# using $bin";
+ return 1;
+ } else {
+ warn "# no $bin found\n";
+ return 0;
+ }
+}
+
+sub _grep_tool {
+ my ( $param, $coderef ) = @_;
+
+ warn "# _grep_tool $bin $param\n";
+ open(my $s, '-|', "$bin $param") || die $!;
+ while(<$s>) {
+ chomp;
+ warn "## $_\n";
+
+ my $sid;
+ if ( m/success.+:\s+(.+)/ ) {
+ $sid = $1;
+ $sid =~ s/\s*'\s*//g;
+ $sid = uc join('', reverse split(/\s+/, $sid));
+ }
+
+ $coderef->( $sid );
+ }
+
+
+}
+
+sub inventory {
+
+ my @tags;
+ _grep_tool '--scan' => sub {
+ my $sid = shift;
+ push @tags, $sid if $sid;
+ };
+ warn "# invetory ",dump(@tags);
+ return @tags;
+}
+
+sub read_blocks {
+
+ my $sid;
+ my $blocks;
+ _grep_tool '--read -1' => sub {
+ $sid ||= shift;
+ $blocks->{$sid}->[$1] = hex2bytes($2)
+ if m/block\[\s*(\d+):.+data.+:\s*(.+)/;
+
+ };
+ warn "# read_blocks ",dump($blocks);
+ return $blocks;
+}
+
+sub write_blocks {}
+sub read_afi { -1 }
+sub write_afi {}
+
+1
+++ /dev/null
-package Biblio::RFID;
-
-use warnings;
-use strict;
-
-use base 'Exporter';
-our @EXPORT = qw( hex2bytes as_hex hex_tag $debug );
-
-use Data::Dump qw(dump);
-
-=head1 NAME
-
-Biblio::RFID - perl tools to use different RFID readers for library use
-
-=cut
-
-our $VERSION = '0.02';
-
-our $debug = 0;
-
-
-=head1 DESCRIPTION
-
-Main idea is to develop simple API to reader, and than provide useful
-abstractions on top of it to quickly write applications to respond on
-tags which come in range of RFID reader using L<Biblio::RFID::Reader>.
-
-Writing support for new RFID readers should be easy.
-L<Biblio::RFID::Reader::API> provides documentation on writing support
-for different readers.
-
-Currently, two serial RFID readers based on L<Biblio::RFID::Reader::Serial>
-are implemented:
-
-=over 4
-
-=item *
-
-L<Biblio::RFID::Reader::3M810>
-
-=item *
-
-L<Biblio::RFID::Reader::CPRM02>
-
-=back
-
-There is also simple read-only reader using shell commands in
-L<Biblio::RFID::Reader::librfid>.
-
-For implementing application take a look at L<Biblio::RFID::Reader>
-
-C<scripts/RFID-JSONP-server.pl> is example of such application. It's local
-interface to RFID reader and JSONP REST server.
-
-C<examples/koha-rfid.js> is jQuery based JavaScript code which can be inserted
-in Koha Library System to provide overlay with tags in range and
-check-in/check-out form-fill functionality.
-
-Applications can use L<Biblio::RFID::RFID501> which is some kind of
-semi-standard 3M layout or blocks on RFID tags.
-
-=for readme stop
-
-=head1 EXPORT
-
-Formatting functions are exported
-
-=head2 hex2bytes
-
- my $bytes = hex2bytes($hex);
-
-=cut
-
-sub hex2bytes {
- my $str = shift || die "no str?";
- my $b = $str;
- $b =~ s/\s+//g;
- $b =~ s/(..)/\\x$1/g;
- $b = "\"$b\"";
- my $bytes = eval $b;
- die $@ if $@;
- warn "## str2bytes( $str ) => $b => ",as_hex($bytes) if $debug;
- return $bytes;
-}
-
-=head2 as_hex
-
- print as_hex( $bytes );
-
-=cut
-
-sub as_hex {
- my @out;
- foreach my $str ( @_ ) {
- my $hex = uc unpack( 'H*', $str );
- $hex =~ s/(..)/$1 /g if length( $str ) > 2;
- $hex =~ s/\s+$//;
- push @out, $hex;
- }
- return join(' | ', @out);
-}
-
-=head2 hex_tag
-
- print hex_tag $8bytes;
-
-=cut
-
-sub hex_tag { uc(unpack('H16', shift)) }
-
-=head1 WARN
-
-We are installing L<perldoc/warn> handler to controll debug output
-based on C<$Biblio::RFID::debug> level
-
-=cut
-
-BEGIN {
- $SIG{'__WARN__'} = sub {
- my $msg = join(' ', @_);
- if ( $msg =~ m/^(#+)/ ) {
- my $l = length $1;
- return if $l > $debug;
- }
- warn join(' ', @_);
- }
-}
-
-=for readme continue
-
-=head1 HARDWARE SUPPORT
-
-=head2 3M 810
-
-L<Biblio::RFID::Reader::3M810>
-
-=head2 CPR-M02
-
-L<Biblio::RFID::Reader::CPRM02>
-
-=head2 librfid
-
-L<Biblio::RFID::Reader::librfid>
-
-
-=head1 AUTHOR
-
-Dobrica Pavlinusic, C<< <dpavlin at rot13.org> >>
-
-L<http://blog.rot13.org/>
-
-=head1 BUGS
-
-Please report any bugs or feature requests to C<bug-rfid-biblio at rt.cpan.org>, or through
-the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Biblio-RFID>. I will be notified, and then you'll
-automatically be notified of progress on your bug as I make changes.
-
-
-
-
-=head1 SUPPORT
-
-You can find documentation for this module with the perldoc command.
-
- perldoc Biblio::RFID
- perldoc Biblio::RFID::Reader
- perldoc Biblio::RFID::Reader::API
-
-
-You can also look for information at:
-
-=over 4
-
-=item * RT: CPAN's request tracker
-
-L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Biblio-RFID>
-
-=item * AnnoCPAN: Annotated CPAN documentation
-
-L<http://annocpan.org/dist/Biblio-RFID>
-
-=item * CPAN Ratings
-
-L<http://cpanratings.perl.org/d/Biblio-RFID>
-
-=item * Search CPAN
-
-L<http://search.cpan.org/dist/Biblio-RFID/>
-
-=back
-
-
-=head1 ACKNOWLEDGEMENTS
-
-
-=head1 LICENSE AND COPYRIGHT
-
-Copyright 2010 Dobrica Pavlinusic.
-
-This program is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; version 2 dated June, 1991 or at your option
-any later version.
-
-This program is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-A copy of the GNU General Public License is available in the source tree;
-if not, write to the Free Software Foundation, Inc.,
-59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-
-
-=cut
-
-1; # End of Biblio::RFID
+++ /dev/null
-package Biblio::RFID::RFID501;
-
-use warnings;
-use strict;
-
-use Data::Dump qw(dump);
-
-=head1 NAME
-
-Biblio::RFID::RFID501 - RFID Standard for Libraries
-
-=head1 DESCRIPTION
-
-This module tries to decode tag format as described in document
-
- RFID 501: RFID Standards for Libraries
-
-L<http://solutions.3m.com/wps/portal/3M/en_US/3MLibrarySystems/Home/Resources/CaseStudiesAndWhitePapers/RFID501/>
-
-Goal is to be compatibile with existing 3M Alphanumeric tag format
-which, as far as I know, isn't specificed anywhere. My documentation about
-this format is available at
-
-L<http://saturn.ffzg.hr/rot13/index.cgi?hitchhikers_guide_to_rfid>
-
-=head1 Data model
-
-=head2 3M Alphanumeric tag
-
- 0 04 is 00 tt i [4 bit] = number of item in set [1 .. i .. s]
- s [4 bit] = total items in set
- tt [8 bit] = item type
-
- 1 dd dd dd dd dd [16 bytes] = barcode data
- 2 dd dd dd dd
- 3 dd dd dd dd
- 4 dd dd dd dd
-
- 5 bb bl ll ll b [12 bit] = branch [unsigned]
- l [20 bit] = library [unsigned]
-
- 6 cc cc cc cc c [32 bit] = custom signed integer
-
-=head2 3M Manufacturing Blank
-
- 0 55 55 55 55
- 1 55 55 55 55
- 2 55 55 55 55
- 3 55 55 55 55
- 4 55 55 55 55
- 5 55 55 55 55
- 6 00 00 00 00
-
-=head2 Generic blank
-
- 0 00 00 00 00
- 1 00 00 00 00
- 2 00 00 00 00
-
-=head1 Security
-
-AFI byte on RFID tag is used for security.
-
-In my case, we have RFID door which can only read AFI bytes from tag and issue
-alarm sound or ignore it depending on value of byte.
-
-=over 8
-
-=item 0xD7 214
-
-secured item (door will beep)
-
-=item 0xDA 218
-
-unsecured (door will ignore it)
-
-=back
-
-
-=head1 METHODS
-
-=head2 to_hash
-
- my $hash = Biblio::RFID::Decode::RFID501->to_hash( $bytes );
-
- my $hash = Biblio::RFID::Decode::RFID501->to_hash( [ 'blk1', 'blk2', ... , 'blk7' ] );
-
-=head2 from_hash
-
- my $blocks = Biblio::RFID::Decode::RFID->from_hash({ content => "1301234567" });
-
-=head2 blank_3m
-
-=head2 blank
-
- my $blocks = Biblio::RFID::Decode::RFID->blank;
-
-=cut
-
-my $item_type = {
- 1 => 'Book',
- 6 => 'CD/CD ROM',
- 2 => 'Magazine',
- 13 => 'Book with Audio Tape',
- 9 => 'Book with CD/CD ROM',
- 0 => 'Other',
-
- 5 => 'Video',
- 4 => 'Audio Tape',
- 3 => 'Bound Journal',
- 8 => 'Book with Diskette',
- 7 => 'Diskette',
-};
-
-sub to_hash {
- my ( $self, $data ) = @_;
-
- return unless $data;
-
- $data = join('', @$data) if ref $data eq 'ARRAY';
-
- warn "## to_hash ",dump($data);
-
- my ( $u1, $set_item, $u2, $type, $content, $br_lib, $custom, $zero ) = unpack('C4Z16Nl>l',$data);
- my $hash = {
- u1 => $u1, # FIXME 0x04
- set => ( $set_item & 0xf0 ) >> 4,
- total => ( $set_item & 0x0f ),
-
- u2 => $u2, # FIXME 0x00
-
- type => $type,
- type_label => $item_type->{$type},
-
- content => $content,
-
- branch => $br_lib >> 20,
- library => $br_lib & 0x000fffff,
-
- custom => $custom,
- };
-
- warn "expected first byte to be 0x04, not $u1\n" if $u1 != 4;
- warn "expected third byte to be 0x00, not $u2\n" if $u2 != 0;
- warn "expected last block to be zero, not $zero\n" if $zero != 0;
-
- return $hash;
-}
-
-sub from_hash {
- my ( $self, $hash ) = @_;
-
- warn "## from_hash ",dump($hash);
-
- return pack('C4Z16Nl>l',
- 0x04,
- ( $hash->{set} << 4 ) | ( $hash->{total} & 0x0f ),
- 0x00,
- $hash->{type},
-
- $hash->{content},
-
- ( $hash->{branch} << 20 ) | ( $hash->{library} & 0x000fffff ),
-
- $hash->{custom},
- 0x00,
- );
-}
-
-sub blank_3m {
- return ( "\x55" x ( 6 * 4 ) ) . ( "\x00" x 4 );
-}
-
-sub blank {
- return "\x00" x ( 4 * 3 );
-}
-
-1;
+++ /dev/null
-package Biblio::RFID::Reader;
-
-use warnings;
-use strict;
-
-use Data::Dump qw(dump);
-use Time::HiRes;
-use lib 'lib';
-use Biblio::RFID;
-use Carp qw(confess);
-
-=head1 NAME
-
-Biblio::RFID::Reader - simple way to write RFID applications in perl
-
-=head1 DESCRIPTION
-
-This module will probe all available readers and use calls from
-L<Biblio::RFID::Reader::API> to invoke correct reader.
-
-=head1 FUNCTIONS
-
-=head2 new
-
- my $rfid = Biblio::RFID::Reader->new( 'optional reader filter' );
-
-=cut
-
-sub new {
- my ( $class, $filter ) = @_;
- my $self = {};
- bless $self, $class;
- $self->{_readers} = [ $self->_available( $filter ) ];
- return $self;
-}
-
-=head2 tags
-
- my @visible = $rfid->tags(
- enter => sub { my $tag = shift; },
- leave => sub { my $tag = shift; },
- );
-
-=cut
-
-sub tags {
- my $self = shift;
- my $triggers = {@_};
-
- $self->{_tags} ||= {};
- $self->{_tags}->{$_}->{time} = 0 foreach keys %{$self->{_tags}};
- my $t = time;
-
- foreach my $rfid ( @{ $self->{_readers} } ) {
- warn "# inventory on $rfid";
- my @tags = $rfid->inventory;
-
- foreach my $tag ( @tags ) {
-
- if ( ! exists $self->{_tags}->{$tag} ) {
- eval {
- my $blocks = $rfid->read_blocks($tag);
- $self->{_tags}->{$tag}->{blocks} = $blocks->{$tag} || die "no $tag in ",dump($blocks);
- my $afi = $rfid->read_afi($tag);
- $self->{_tags}->{$tag}->{afi} = $afi;
-
- };
- if ( $@ ) {
- warn "ERROR reading $tag: $@\n";
- $self->_invalidate_tag( $tag );
- next;
- }
-
- $triggers->{enter}->( $tag ) if $triggers->{enter};
- }
-
- $self->{_tags}->{$tag}->{time} = $t;
-
- }
-
- foreach my $tag ( grep { $self->{_tags}->{$_}->{time} == 0 } keys %{ $self->{_tags} } ) {
- $triggers->{leave}->( $tag ) if $triggers->{leave};
- $self->_invalidate_tag( $tag );
- }
-
- }
-
- warn "## _tags ",dump( $self->{_tags} );
-
- return grep { $self->{_tags}->{$_}->{time} } keys %{ $self->{_tags} };
-}
-
-=head2 blocks
-
- my $blocks_arrayref = $rfid->blocks( $tag );
-
-=head2 afi
-
- my $afi = $rfid->afi( $tag );
-
-=cut
-
-sub blocks { $_[0]->{_tags}->{$_[1]}->{ 'blocks' } || confess "no blocks for $_[1]"; };
-sub afi { $_[0]->{_tags}->{$_[1]}->{ 'afi' } || confess "no afi for $_[1]"; };
-
-=head1 PRIVATE
-
-=head2 _invalidate_tag
-
- $rfid->_invalidate_tag( $tag );
-
-=cut
-
-sub _invalidate_tag {
- my ( $self, $tag ) = @_;
- my @caller = caller(0);
- warn "## _invalidate_tag caller $caller[0] $caller[1] +$caller[2]\n";
- my $old = delete $self->{_tags}->{$tag};
- warn "# _invalidate_tag $tag ", dump($old);
-}
-
-=head2 _available
-
-Probe each RFID reader supported and returns succefull ones
-
- my $rfid_readers = Biblio::RFID::Reader->_available( $regex_filter );
-
-=cut
-
-my @readers = ( '3M810', 'CPRM02', 'librfid' );
-
-sub _available {
- my ( $self, $filter ) = @_;
-
- $filter = '' unless defined $filter;
-
- warn "# filter: $filter";
-
- my @rfid;
-
- foreach my $reader ( @readers ) {
- next if $filter && $reader !~ /$filter/i;
- my $module = "Biblio::RFID::Reader::$reader";
- eval "use $module";
- die $@ if $@;
- if ( my $rfid = $module->new ) {
- push @rfid, $rfid;
- warn "# added $module\n";
- } else {
- warn "# ignored $module\n";
- }
- }
-
- die "no readers found" unless @rfid;
-
- return @rfid;
-}
-
-=head1 AUTOLOAD
-
-On any other function calls, we just marshall to all readers
-
-=cut
-
-# we don't want DESTROY to fallback into AUTOLOAD
-sub DESTROY {}
-
-our $AUTOLOAD;
-sub AUTOLOAD {
- my $self = shift;
- my $command = $AUTOLOAD;
- $command =~ s/.*://;
-
- my @out;
-
- foreach my $r ( @{ $self->{_readers} } ) {
- push @out, $r->$command(@_);
- }
-
- $self->_invalidate_tag( $_[0] ) if $command =~ m/write/;
-
- return @out;
-}
-
-1
-__END__
-
-=head1 SEE ALSO
-
-=head2 RFID reader implementations
-
-L<Biblio::RFID::Reader::3M810>
-
-L<Biblio::RFID::Reader::CPRM02>
-
-L<Biblio::RFID::Reader::librfid>
-
+++ /dev/null
-package Biblio::RFID::Reader::3M810;
-
-=head1 NAME
-
-Biblio::RFID::Reader::3M810 - support for 3M 810 RFID reader
-
-=head1 DESCRIPTION
-
-This module uses L<Biblio::RFID::Reader::Serial> over USB/serial adapter
-with 3M 810 RFID reader, often used in library applications.
-
-This is most mature implementation which supports full API defined
-in L<Biblio::RFID::Reader::API>. This include scanning for all tags in reader
-range, reading and writing of data, and AFI security manipulation.
-
-This implementation is developed using Portmon on Windows to capture serial traffic
-L<http://technet.microsoft.com/en-us/sysinternals/bb896644.aspx>
-
-Checksum for this reader is developed using help from C<selwyn>
-L<http://stackoverflow.com/questions/149617/how-could-i-guess-a-checksum-algorithm>
-
-More inforation about process of reverse engeeniring protocol with
-this reader is available at L<http://blog.rot13.org/rfid/>
-
-=cut
-
-use warnings;
-use strict;
-
-use base 'Biblio::RFID::Reader::Serial';
-use Biblio::RFID;
-
-use Data::Dump qw(dump);
-use Carp qw(confess);
-use Time::HiRes;
-use Digest::CRC;
-
-sub serial_settings {{
- baudrate => "19200",
- databits => "8",
- parity => "none",
- stopbits => "1",
- handshake => "none",
-}}
-
-sub assert;
-
-my $port;
-sub init {
- my $self = shift;
- $port = $self->port;
-
- # disable timeouts
- $port->read_char_time(0);
- $port->read_const_time(0);
-
- # drain on startup
- my ( $count, $str ) = $port->read(3);
- my $data = $port->read( ord(substr($str,2,1)) );
- warn "drain ",as_hex( $str, $data ),"\n";
-
- $port->read_char_time(100); # 0.1 s char timeout
- $port->read_const_time(500); # 0.5 s read timeout
-
- $port->write( hex2bytes( 'D5 00 05 04 00 11 8C66' ) );
- # hw-version expect: 'D5 00 09 04 00 11 0A 05 00 02 7250'
- my $data = $port->read( 12 );
- return unless $data;
-
- warn "# probe response: ",as_hex($data);
- if ( my $rest = assert $data => 'D5 00 09 04 00 11' ) {
- my $hw_ver = join('.', unpack('CCCC', $rest));
- warn "# 3M 810 hardware version $hw_ver\n";
-
- cmd(
-'13 04 01 00 02 00 03 00 04 00','FIXME: stats? rf-on?', sub { assert(shift,
-'13 00 02 01 01 03 02 02 03 00'
- )});
-
- return $hw_ver;
- }
-
- return;
-}
-
-sub checksum {
- my $bytes = shift;
- my $crc = Digest::CRC->new(
- # midified CCITT to xor with 0xffff instead of 0x0000
- width => 16, init => 0xffff, xorout => 0xffff, refout => 0, poly => 0x1021, refin => 0,
- ) or die $!;
- $crc->add( $bytes );
- pack('n', $crc->digest);
-}
-
-sub cmd {
- my ( $hex, $description, $coderef ) = @_;
- my $bytes = hex2bytes($hex);
- if ( substr($bytes,0,1) !~ /(\xD5|\xD6)/ ) {
- my $len = pack( 'n', length( $bytes ) + 2 );
- $bytes = $len . $bytes;
- my $checksum = checksum($bytes);
- $bytes = "\xD6" . $bytes . $checksum;
- }
-
- warn ">> ", as_hex( $bytes ), "\t\t[$description]\n" if $debug;
- $port->write( $bytes );
-
- my $r_len = $port->read(3);
-
- while ( length($r_len) < 3 ) {
- $r_len = $port->read( 3 - length($r_len) );
- }
-
- my $len = ord( substr($r_len,2,1) );
- my $data = $port->read( $len );
-
- warn "<< ", as_hex($r_len,$data),
- ' | ',
- substr($data,-2,2) eq checksum(substr($r_len,1).substr($data,0,-2)) ? 'OK' : 'ERROR',
- " $len bytes\n" if $debug;
-
-
- $coderef->( $data ) if $coderef;
-
-}
-
-sub assert {
- my ( $got, $expected ) = @_;
- $expected = hex2bytes($expected);
-
- my $len = length($got);
- $len = length($expected) if length $expected < $len;
-
- confess "got ", as_hex($got), " expected ", as_hex($expected)
- unless substr($got,0,$len) eq substr($expected,0,$len);
-
- return substr($got,$len);
-}
-
-
-sub inventory {
-
- my @tags;
-
-cmd( 'FE 00 05', 'scan for tags', sub {
- my $data = shift;
- my $rest = assert $data => 'FE 00 00 05';
- my $nr = ord( substr( $rest, 0, 1 ) );
-
- if ( ! $nr ) {
- warn "# no tags in range\n";
- } else {
- my $tags = substr( $rest, 1 );
- my $tl = length( $tags );
- die "wrong length $tl for $nr tags: ",dump( $tags ) if $tl =! $nr * 8;
-
- foreach ( 0 .. $nr - 1 ) {
- push @tags, hex_tag substr($tags, $_ * 8, 8);
- }
- }
-
-});
-
- warn "# tags ",dump @tags;
- return @tags;
-}
-
-
-# 3M defaults: 8,4
-# cards 16, stickers: 8
-my $max_rfid_block = 8;
-my $blocks = 8;
-
-sub _matched {
- my ( $data, $hex ) = @_;
- my $b = hex2bytes $hex;
- my $l = length($b);
- if ( substr($data,0,$l) eq $b ) {
- warn "_matched $hex [$l] in ",as_hex($data) if $debug;
- return substr($data,$l);
- }
-}
-
-sub read_blocks {
- my $tag = shift || confess "no tag?";
- $tag = shift if ref($tag);
-
- my $tag_blocks;
- my $start = 0;
- cmd(
- sprintf( "02 $tag %02x %02x", $start, $blocks ) => "read_blocks $tag $start/$blocks", sub {
- my $data = shift;
- if ( my $rest = _matched $data => '02 00' ) {
-
- my $tag = hex_tag substr($rest,0,8);
- my $blocks = ord(substr($rest,8,1));
- warn "# response from $tag $blocks blocks ",as_hex substr($rest,9);
- foreach ( 1 .. $blocks ) {
- my $pos = ( $_ - 1 ) * 6 + 9;
- my $nr = unpack('v', substr($rest,$pos,2));
- my $payload = substr($rest,$pos+2,4);
- warn "## pos $pos block $nr ",as_hex($payload), $/;
- $tag_blocks->{$tag}->[$nr] = $payload;
- }
- } elsif ( $rest = _matched $data => 'FE 00 00 05 01' ) {
- warn "FIXME ready? ",as_hex $rest;
- } elsif ( $rest = _matched $data => '02 06' ) {
- die "ERROR ",as_hex($rest);
- } else {
- die "FIXME unsuported ",as_hex($rest);
- }
- });
-
- warn "# tag_blocks ",dump($tag_blocks);
- return $tag_blocks;
-}
-
-sub write_blocks {
- my $tag = shift;
- $tag = shift if ref $tag;
-
- my $data = shift;
- $data = join('', @$data) if ref $data eq 'ARRAY';
-
- warn "## write_blocks ",dump($tag,$data);
-
- if ( length($data) % 4 ) {
- $data .= '\x00' x ( 4 - length($data) % 4 );
- warn "# padded data to ",dump($data);
- }
-
- my $hex_data = as_hex $data;
- my $blocks = sprintf('%02x', length($data) / 4 );
-
- cmd(
- "04 $tag 00 $blocks 00 $hex_data", "write_blocks $tag [$blocks] $hex_data", sub {
- my $data = shift;
- if ( my $rest = _matched $data => '04 00' ) {
- my $tag = substr($rest,0,8);
- my $blocks = substr($rest,8,1);
- warn "# WRITE ",as_hex($tag), " [$blocks]\n";
- } elsif ( $rest = _matched $data => '04 06' ) {
- die "ERROR ",as_hex($rest);
- } else {
- die "UNSUPPORTED";
- }
- }
- );
-
-}
-
-sub read_afi {
- my $tag = shift;
- $tag = shift if ref $tag;
-
- my $afi;
-
- cmd(
- "0A $tag", "read_afi $tag", sub {
- my $data = shift;
-
- if ( my $rest = _matched $data => '0A 00' ) {
-
- my $tag = substr($rest,0,8);
- $afi = substr($rest,8,1);
-
- warn "# SECURITY ", hex_tag($tag), " AFI: ", as_hex($afi);
-
- } elsif ( $rest = _matched $data => '0A 06' ) {
- die "ERROR reading security from $tag ", as_hex($data);
- } else {
- die "IGNORED ",as_hex($data);
- }
- });
- warn "## read_afi ",dump($tag, $afi);
- return $afi;
-}
-
-sub write_afi {
- my $tag = shift;
- $tag = shift if ref $tag;
- my $afi = shift || die "no afi?";
-
- $afi = as_hex $afi;
-
- cmd(
- "09 $tag $afi", "write_afi $tag $afi", sub {
- my $data = shift;
-
- if ( my $rest = _matched $data => '09 00' ) {
- my $tag_back = hex_tag substr($rest,0,8);
- die "write_afi got $tag_back expected $tag" if $tag_back ne $tag;
- warn "# SECURITY ", hex_tag($tag), " AFI: ", as_hex($afi);
- } elsif ( $rest = _matched $data => '0A 06' ) {
- die "ERROR writing AFI to $tag ", as_hex($data);
- } else {
- die "IGNORED ",as_hex($data);
- }
- });
- warn "## write_afi ", dump( $tag, $afi );
- return $afi;
-}
-
-1
-
-__END__
-
-=head1 SEE ALSO
-
-L<Biblio::RFID::Reader::API>
+++ /dev/null
-package Biblio::RFID::Reader::API;
-
-use warnings;
-use strict;
-
-=head1 NAME
-
-Biblio::RFID::Reader::API - low-level RFID reader documentation
-
-=cut
-
-=head1 MANDATORY METHODS
-
-Each reader must implement following hooks as sub-classes.
-
-=head2 init
-
- $self->init;
-
-=head2 inventory
-
- my @tags = $self->invetory;
-
-=head2 read_blocks
-
- my $hash = $self->read_blocks( $tag );
-
-All blocks are under key which is tag UID with array of blocks returned from reader
-
- $hash = { 'E000000123456789' => [ 'blk1', 'blk2', ... ] };
-
-L<Biblio::RFID::Reader::3M810> sends tag UID with data payload, so we might expect
-to receive response from other tags from protocol specification,
-
-=head2 write_blocks
-
- $self->write_blocks( $tag => $bytes );
-
- $self->write_blocks( $tag => [ 'blk1', 'blk2', ... ] );
-
-=head2 read_afi
-
- my $afi = $self->read_afi( $tag );
-
-=head2 write_afi
-
- $self->write_afi( $tag => $afi );
-
-
-=head1 METHODS
-
-=head2 new
-
-Just calls C<init> in reader implementation so this class
-can be used as simple stub base class like
-L<Biblio::RFID::Reader::librfid> does
-
-=cut
-
-sub new {
- my $class = shift;
- my $self = {@_};
- bless $self, $class;
- $self->init && return $self;
-}
-
-1;
+++ /dev/null
-package Biblio::RFID::Reader::CPRM02;
-
-=head1 NAME
-
-Biblio::RFID::Reader::CPRM02 - support for CPR-M02 RFID reader
-
-=head1 DESCRIPTION
-
-This module implements serial protocol over usb/serial adapter with CPR-M02
-reader as described in document C<H20800-16e-ID-B.pdf>
-
-=cut
-
-use warnings;
-use strict;
-
-use base 'Biblio::RFID::Reader::Serial';
-use Biblio::RFID;
-
-use Time::HiRes;
-use Data::Dump qw(dump);
-
-my $debug = 1;
-
-sub serial_settings {{
- device => "/dev/ttyUSB0",
- baudrate => "38400",
- databits => "8",
- parity => "even",
- stopbits => "1",
- handshake => "none",
-}}
-
-sub cpr_m02_checksum {
- my $data = shift;
-
- my $preset = 0xffff;
- my $polynom = 0x8408;
-
- my $crc = $preset;
- foreach my $i ( 0 .. length($data) - 1 ) {
- $crc ^= ord(substr($data,$i,1));
- for my $j ( 0 .. 7 ) {
- if ( $crc & 0x0001 ) {
- $crc = ( $crc >> 1 ) ^ $polynom;
- } else {
- $crc = $crc >> 1;
- }
- }
-# warn sprintf('%d %04x', $i, $crc & 0xffff);
- }
-
- return pack('v', $crc);
-}
-
-sub wait_device {
- Time::HiRes::sleep 0.010;
-}
-
-our $port;
-
-sub cpr {
- my ( $hex, $description, $coderef ) = @_;
- my $bytes = hex2bytes($hex);
- my $len = pack( 'c', length( $bytes ) + 3 );
- my $send = $len . $bytes;
- my $checksum = cpr_m02_checksum($send);
- $send .= $checksum;
-
- warn "##>> ", as_hex( $send ), "\t\t[$description]\n";
- $port->write( $send );
-
- wait_device;
-
- my $r_len = $port->read(1);
-
- my $count = 100;
- while ( ! $r_len ) {
- if ( $count-- == 0 ) {
- warn "no response from device";
- return;
- }
- wait_device;
- $r_len = $port->read(1);
- }
-
- wait_device;
-
- my $data_len = ord($r_len) - 1;
- my $data = $port->read( $data_len );
- warn "##<< ", as_hex( $r_len . $data ),"\n";
-
- wait_device;
-
- $coderef->( $data ) if $coderef;
-
-}
-
-# FF = COM-ADDR any
-
-sub init {
- my $self = shift;
-
- $port = $self->port;
-
-cpr( 'FF 52 00', 'Boud Rate Detection' );
-
-cpr( 'FF 65', 'Get Software Version' );
-
-cpr( 'FF 66 00', 'Get Reader Info - General hard and firware' );
-
-cpr( 'FF 69', 'RF Reset' );
-
- return 1;
-}
-
-
-sub inventory {
-
- my @tags;
-
-cpr( 'FF B0 01 00', 'ISO - Inventory', sub {
- my $data = shift;
- if (length($data) < 5 + 2 ) {
- warn "# no tags in range\n";
- return;
- }
-
- my $data_sets = ord(substr($data,3,1));
- $data = substr($data,4);
- foreach ( 1 .. $data_sets ) {
- my $tr_type = substr($data,0,1);
- die "FIXME only TR-TYPE=3 ISO 15693 supported" unless $tr_type eq "\x03";
- my $dsfid = substr($data,1,1);
- my $uid = substr($data,2,8);
- $data = substr($data,10);
- warn "# TAG $_ ",as_hex( $tr_type, $dsfid, $uid ),$/;
- push @tags, hex_tag $uid;
-
- }
-});
-
- warn "# tags ",dump(@tags),$/;
- return @tags;
-}
-
-
-sub _get_system_info {
- my $tag = shift;
-
- my $info;
-
- cpr( "FF B0 2B 01 $tag", "Get System Information $tag", sub {
- my $data = shift;
-
- warn "# data ",as_hex($data);
-
- return if length($data) < 17;
-
- $info = {
- DSFID => substr($data,5-2,1),
- UID => substr($data,6-2,8),
- AFI => substr($data,14-2,1),
- MEM => substr($data,15-2,1),
- SIZE => substr($data,16-2,1),
- IC_REF => substr($data,17-2,1),
- };
-
- });
-
- warn "# _get_system_info $tag ",dump( $info );
-
- return $info;
-}
-
-
-sub read_blocks {
- my $tag = shift;
- $tag = shift if ref $tag;
-
- my $info = _get_system_info $tag;
-
- return unless $info->{SIZE};
-
- my $max_block = ord($info->{SIZE});
-
- my $tag_blocks;
-
- my $block = 0;
- while ( $block < $max_block ) {
- cpr( sprintf("FF B0 23 01 $tag %02x 04", $block), "Read Multiple Blocks $block", sub {
- my $data = shift;
-
- my $DB_N = ord substr($data,5-2,1);
- my $DB_SIZE = ord substr($data,6-2,1);
-
- $data = substr($data,7-2,-2);
-# warn "# DB N: $DB_N SIZE: $DB_SIZE ", as_hex( $data ), " transponder_data: [$transponder_data] ",length($transponder_data),"\n";
- foreach my $n ( 1 .. $DB_N ) {
- my $sec = ord(substr($data,0,1));
- my $db = substr($data,1,$DB_SIZE);
- warn "## block $n ",dump( $sec, $db ) if $debug;
- $tag_blocks->{$tag}->[$block+$n-1] = reverse split(//,$db);
- $data = substr($data, $DB_SIZE + 1);
- }
- });
- $block += 4;
- }
-
- warn "# tag_blocks ",dump($tag_blocks),$/;
- return $tag_blocks;
-}
-
-
-sub write_blocks {
- my $tag = shift;
- $tag = shift if ref $tag;
-
- my $data = shift;
- $data = join('', @$data) if ref $data eq 'ARRAY';
-
- my $DB_ADR = 0; # start at first block
- my $DB_SIZE = 4; # bytes in one block FIXME this should be read from transponder and not hard-coded
- if ( my $padding = length($data) % $DB_SIZE ) {
- warn "WARNING: data block not padded to $DB_SIZE bytes";
- $data .= "\x00" x $padding;
- }
- my $DB_N = length($data) / $DB_SIZE;
-
- my $send_data;
- foreach my $block ( 0 .. $DB_N ) {
- $send_data .= reverse split(//, substr( $data, $block * $DB_SIZE, $DB_SIZE ) );
- }
-
- cpr( sprintf("FF B0 24 01 $tag %02x %02x %02x %s", $DB_ADR, $DB_N, $DB_SIZE, as_hex($send_data)), "Write Multiple Blocks $tag", sub {
- my $data = shift;
- warn dump( $data );
- });
-
-}
-
-sub read_afi {
- my $tag = shift;
- $tag = shift if ref $tag;
-
- my $info = _get_system_info $tag;
- return $info->{AFI} || warn "no AFI for $tag in ",dump($info);
-
-}
-
-sub write_afi {
- my $tag = shift;
- $tag = shift if ref $tag;
-
- my $afi = shift || die "no afi?";
- $afi = as_hex $afi;
-
- cpr( "FF B0 27 01 $tag $afi", "Write AFI $tag $afi", sub {
- my $data = shift;
- warn "## write_afi $tag got ",as_hex($data);
- });
-
-}
-
-1
+++ /dev/null
-package Biblio::RFID::Reader::Serial;
-
-use warnings;
-use strict;
-
-use Device::SerialPort qw(:STAT);
-use Data::Dump qw(dump);
-
-=head1 NAME
-
-Biblio::RFID::Reader::Serial - base class for serial RFID readers
-
-=head1 METHODS
-
-=head2 new
-
-Open serial port (if needed) and init reader
-
-=cut
-
-sub new {
- my $class = shift;
- my $self = {@_};
- bless $self, $class;
-
- $self->port && return $self;
-}
-
-
-=head2 port
-
-Tries to open usb serial ports C</dev/ttyUSB*>
-
- my $serial_obj = $self->port;
-
-To try just one device use C<RFID_DEVICE=/dev/ttyUSB1> enviroment variable
-
-=cut
-
-our $serial_device;
-
-sub port {
- my $self = shift;
-
- return $self->{port} if defined $self->{port};
-
- my $settings = $self->serial_settings;
- my @devices = $ENV{RFID_DEVICE} ? ( $ENV{RFID_DEVICE} ) : glob '/dev/ttyUSB*';
- warn "# port devices ",dump(@devices);
-
- foreach my $device ( @devices ) {
-
- next if $serial_device->{$device};
-
- if ( my $port = Device::SerialPort->new($device) ) {
-
- foreach my $opt ( qw/handshake baudrate databits parity stopbits/ ) {
- $port->$opt( $settings->{$opt} );
- }
-
- $self->{port} = $port;
-
- warn "# probe by init $device ",ref($self);
- if ( $self->init ) {
- warn "init OK ", ref($self), " $device settings ",dump $settings;
- $serial_device->{$device} = $port;
- last;
- } else {
- $self->{port} = 0;
- }
- }
- }
-
- warn "# serial_device ",dump($serial_device);
-
- return $self->{port};
-}
-
-1
-__END__
-
-=head1 SEE ALSO
-
-L<Biblio::RFID::Reader::3M810>
-
-L<Biblio::RFID::Reader::CPRM01>
-
-L<Biblio::RFID::Reader::API>
-
+++ /dev/null
-package Biblio::RFID::Reader::librfid;
-
-use warnings;
-use strict;
-
-use base 'Biblio::RFID::Reader::API';
-use Biblio::RFID;
-
-use Data::Dump qw(dump);
-
-=head1 NAME
-
-Biblio::RFID::Reader::librfid - execute librfid-tool
-
-=head1 DESCRIPTION
-
-This is wrapper around C<librfid-tool> from
-
-L<http://openmrtd.org/projects/librfid/>
-
-Due to limitation of L<librfid-tool> only
-L<Biblio::RFID::Reader::API/inventory> and
-L<Biblio::RFID::Reader::API/read_blocks> is supported.
-
-However, this code might provide template for integration
-with any command-line utilities for different RFID readers.
-
-Currently tested with only with Omnikey CardMan 5321 which
-has problems. After a while it stops responding to commands
-by C<librfid-tool> so I provided small C program to reset it:
-
-C<examples/usbreset.c>
-
-=cut
-
-sub serial_settings {} # don't open serial
-
-our $bin = '/rest/cvs/librfid/utils/librfid-tool';
-
-sub init {
- my $self = shift;
- if ( -e $bin ) {
- warn "# using $bin";
- return 1;
- } else {
- warn "# no $bin found\n";
- return 0;
- }
-}
-
-sub _grep_tool {
- my ( $param, $coderef ) = @_;
-
- warn "# _grep_tool $bin $param\n";
- open(my $s, '-|', "$bin $param") || die $!;
- while(<$s>) {
- chomp;
- warn "## $_\n";
-
- my $sid;
- if ( m/success.+:\s+(.+)/ ) {
- $sid = $1;
- $sid =~ s/\s*'\s*//g;
- $sid = uc join('', reverse split(/\s+/, $sid));
- }
-
- $coderef->( $sid );
- }
-
-
-}
-
-sub inventory {
-
- my @tags;
- _grep_tool '--scan' => sub {
- my $sid = shift;
- push @tags, $sid if $sid;
- };
- warn "# invetory ",dump(@tags);
- return @tags;
-}
-
-sub read_blocks {
-
- my $sid;
- my $blocks;
- _grep_tool '--read -1' => sub {
- $sid ||= shift;
- $blocks->{$sid}->[$1] = hex2bytes($2)
- if m/block\[\s*(\d+):.+data.+:\s*(.+)/;
-
- };
- warn "# read_blocks ",dump($blocks);
- return $blocks;
-}
-
-sub write_blocks {}
-sub read_afi { -1 }
-sub write_afi {}
-
-1
projects / Biblio-RFID.git / commitdiff