From: Dobrica Pavlinusic Date: Thu, 29 Jul 2010 11:42:49 +0000 (+0200) Subject: rename to RFID::Biblio X-Git-Tag: RFID-Biblio-0.02~125 X-Git-Url: http://git.rot13.org/?p=Biblio-RFID.git;a=commitdiff_plain;h=dd0ff7b7d37f0dcf436cd6921f8ffcaa16332a24 rename to RFID::Biblio --- diff --git a/Changes b/Changes index 8f43c6a..fe7dcca 100644 --- a/Changes +++ b/Changes @@ -1,4 +1,4 @@ -Revision history for RFID-Serial +Revision history for RFID-Biblio 0.01 Date/time First version, released on an unsuspecting world. diff --git a/MANIFEST b/MANIFEST index a3c642a..d894db8 100644 --- a/MANIFEST +++ b/MANIFEST @@ -2,7 +2,7 @@ Changes MANIFEST Makefile.PL README -lib/RFID/Serial.pm +lib/RFID/Biblio.pm t/00-load.t t/manifest.t t/pod-coverage.t diff --git a/Makefile.PL b/Makefile.PL index 5b529d7..c924072 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -1,7 +1,7 @@ use inc::Module::Install; -name 'RFID-Serial'; -all_from 'lib/RFID/Serial.pm'; +name 'RFID-Biblio'; +all_from 'lib/RFID/Biblio.pm'; author q{Dobrica Pavlinusic }; license 'gpl'; diff --git a/README b/README index 6ba324c..ba6c49c 100644 --- a/README +++ b/README @@ -1,4 +1,4 @@ -RFID-Serial +RFID-Biblio The README is used to introduce the module and provide instructions on how to install the module, any machine dependencies it may have (for @@ -26,21 +26,21 @@ SUPPORT AND DOCUMENTATION After installing, you can find documentation for this module with the perldoc command. - perldoc RFID::Serial + perldoc RFID::Biblio You can also look for information at: RT, CPAN's request tracker - http://rt.cpan.org/NoAuth/Bugs.html?Dist=RFID-Serial + http://rt.cpan.org/NoAuth/Bugs.html?Dist=RFID-Biblio AnnoCPAN, Annotated CPAN documentation - http://annocpan.org/dist/RFID-Serial + http://annocpan.org/dist/RFID-Biblio CPAN Ratings - http://cpanratings.perl.org/d/RFID-Serial + http://cpanratings.perl.org/d/RFID-Biblio Search CPAN - http://search.cpan.org/dist/RFID-Serial/ + http://search.cpan.org/dist/RFID-Biblio/ LICENSE AND COPYRIGHT diff --git a/ignore.txt b/ignore.txt index ada7e37..bf53570 100644 --- a/ignore.txt +++ b/ignore.txt @@ -9,4 +9,4 @@ pm_to_blib* .lwpcookies cover_db pod2htm*.tmp -RFID-Serial-* +RFID-Biblio-* diff --git a/lib/RFID/Biblio.pm b/lib/RFID/Biblio.pm new file mode 100644 index 0000000..b3723fe --- /dev/null +++ b/lib/RFID/Biblio.pm @@ -0,0 +1,247 @@ +package RFID::Biblio; + +use warnings; +use strict; + +use base 'Exporter'; +our @EXPORT = qw( hex2bytes as_hex hex_tag ); + +use Device::SerialPort qw(:STAT); +use Data::Dump qw(dump); + +=head1 NAME + +RFID::Biblio - support serial RFID devices + +=cut + +our $VERSION = '0.01'; + +my $debug = 0; + + +=head1 SYNOPSIS + +This module tries to support USB serial RFID readers wsing simple API +which is sutable for direct mapping to REST JSONP service. + +Perhaps a little code snippet. + + use RFID::Biblio; + + my $rfid = RFID::Biblio->new( + device => '/dev/ttyUSB0', # with fallback to RFID_DEVICE + ); + my $visible = $rfid->scan; + +=head1 SUBROUTINES/METHODS + +=head2 new + +=cut + +sub new { + my $class = shift; + my $self = {@_}; + bless $self, $class; + + $self->port; + + $self->init; + + return $self; +} + +=head2 port + + my $serial_obj = $self->port; + +=cut + +sub port { + my $self = shift; + + return $self->{port} if defined $self->{port}; + + my $settings = $self->serial_settings; + $settings->{device} ||= $ENV{RFID_DEVICE}; + warn "# settings ",dump $settings; + + $self->{port} = Device::SerialPort->new( $settings->{device} ) + || die "can't open serial port: $!\n"; + + $self->{port}->$_( $settings->{$_} ) + foreach ( qw/handshake baudrate databits parity stopbits/ ); + +} + +=head2 scan + + my $visible = $rfid->scan; + +Returns hash with keys which match tag UID and values with blocks + +=cut + +sub scan { + my $self = shift; + + warn "# scan tags in reader range\n"; + my @tags = $self->inventory; + + my $visible; + # FIXME this is naive implementation which just discards other tags + foreach my $tag ( @tags ) { + my $blocks = $self->read_blocks( $tag ); + if ( ! $blocks ) { + warn "ERROR: can't read tag $tag\n"; + delete $visible->{$tag}; + } else { + $visible->{$tag} = $blocks->{$tag}; + } + } + + return $visible; +} + + +=head1 MANDATORY IMPLEMENTATIONS + +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 + + $hash = { 'E000000123456789' => [ undef, 'block1', 'block2', ... ] }; + +L sends tag UID with data payload, so we might expect +to receive response from other tags from protocol specification, + + +=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 AUTHOR + +Dobrica Pavlinusic, C<< >> + +=head1 BUGS + +Please report any bugs or feature requests to C, or through +the web interface at L. 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 RFID::Biblio + + +You can also look for information at: + +=over 4 + +=item * RT: CPAN's request tracker + +L + +=item * AnnoCPAN: Annotated CPAN documentation + +L + +=item * CPAN Ratings + +L + +=item * Search CPAN + +L + +=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 RFID::Biblio diff --git a/lib/RFID/Biblio/3M810.pm b/lib/RFID/Biblio/3M810.pm new file mode 100644 index 0000000..db1ef9e --- /dev/null +++ b/lib/RFID/Biblio/3M810.pm @@ -0,0 +1,292 @@ +package RFID::Biblio::3M810; + +use base 'RFID::Biblio'; +use RFID::Biblio; + +use Data::Dump qw(dump); +use Carp qw(confess); +use Time::HiRes; +use Digest::CRC; + +sub serial_settings {{ + device => "/dev/ttyUSB1", # FIXME comment out before shipping + baudrate => "19200", + databits => "8", + parity => "none", + stopbits => "1", + handshake => "none", +}} + +my $port; +sub init { + my $self = shift; + $port = $self->port; + + # 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"; + + setup(); + +} + +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 wait_device { + Time::HiRes::sleep 0.015; +} + +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"; + $port->write( $bytes ); + + wait_device; + + my $r_len = $port->read(3); + + while ( length($r_len) < 3 ) { + wait_device; + $r_len = $port->read( 3 - length($r_len) ); + } + + wait_device; + + my $len = ord( substr($r_len,2,1) ); + $data = $port->read( $len ); + + while ( length($data) < $len ) { + warn "# short read ", length($data), " < $len\n"; + wait_device; + $data .= $port->read( $len - length($data) ); + } + + 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"; + + + $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 setup { + +cmd( +'D5 00 05 04 00 11 8C66', 'hw version', sub { + my $data = shift; + my $rest = assert $data => '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' +)}); +} + +=head2 inventory + + my @tags = inventory; + +=cut + +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); + 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 ( my $rest = _matched $data => 'FE 00 00 05 01' ) { + warn "FIXME ready? ",as_hex $test; + } elsif ( my $rest = _matched $data => '02 06' ) { + warn "ERROR ",as_hex($rest); + } else { + warn "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 = join('', @_); + + 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 ( my $rest = _matched $data => '04 06' ) { + warn "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 ( my $rest = _matched $data => '0A 06' ) { + warn "ERROR reading security from $tag ", as_hex($data); + } else { + warn "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 = substr($rest,0,8); + $afi = substr($rest,8,1); + + warn "# SECURITY ", hex_tag($tag), " AFI: ", as_hex($afi); + + } elsif ( my $rest = _matched $data => '0A 06' ) { + warn "ERROR writing AFI to $tag ", as_hex($data); + undef $afi; + } else { + warn "IGNORED ",as_hex($data); + undef $afi; + } + }); + warn "## write_afi ", dump( $tag, $afi ); + return $afi; +} + +1 diff --git a/lib/RFID/Biblio/CPRM02.pm b/lib/RFID/Biblio/CPRM02.pm new file mode 100644 index 0000000..c5d1e24 --- /dev/null +++ b/lib/RFID/Biblio/CPRM02.pm @@ -0,0 +1,183 @@ +package RFID::Biblio::CPRM02; + +use base 'RFID::Biblio'; +use RFID::Biblio; + +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' ); + +} + +sub read_blocks { + my $tag = shift; + $tag = shift if ref $tag; + + my $max_block; + + cpr( "FF B0 2B 01 $tag", "Get System Information $tag", sub { + my $data = shift; + + warn "# data ",as_hex($data); + + my $DSFID = substr($data,5-2,1); + my $UID = substr($data,6-2,8); + my $AFI = substr($data,14-2,1); + my $MEM = substr($data,15-2,1); + my $SIZE = substr($data,16-2,1); + my $IC_REF = substr($data,17-2,1); + + warn "# split ",as_hex( $DSFID, $UID, $AFI, $MEM, $SIZE, $IC_REF ); + + $max_block = ord($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 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; +} + +1 diff --git a/lib/RFID/Biblio/Decode/RFID501.pm b/lib/RFID/Biblio/Decode/RFID501.pm new file mode 100644 index 0000000..9232db1 --- /dev/null +++ b/lib/RFID/Biblio/Decode/RFID501.pm @@ -0,0 +1,73 @@ +package RFID::Biblio::Decode::RFID501; + +use warnings; +use strict; + +=head1 NAME + +RFID::501 - RFID Standard for Libraries + +=head1 DESCRIPTION + +This module tries to decode tag format as specified in document + + RFID 501: RFID Standards for Libraries + +However, document is lacking real specification, so tag decoding +was done to be compliant with 3M implementation + +=head1 METHODS + +=head2 decode_tag + + my $hash = RFID::Biblio::Decode::RFID501->to_hash( $bytes ); + + my $hash = RFID::Biblio::Decode::RFID501->to_hash( [ 'blk1', 'blk2', ... , 'blk7' ] ); + +=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 $data\n"; + + my ( $u1, $set_item, $u2, $type, $content, $br_lib, $custom ) = unpack('C4Z16Nl>',$data); + my $hash = { + u1 => $u1, # FIXME + u2 => $u2, # FIXME + set => ( $set_item & 0xf0 ) >> 4, + total => ( $set_item & 0x0f ), + + type => $type, + type_label => $item_type->{$type}, + content => $content, + + branch => $br_lib >> 20, + library => $br_lib & 0x000fffff, + + custom => $custom, + }; + + return $hash; +} + +1; diff --git a/lib/RFID/Serial.pm b/lib/RFID/Serial.pm deleted file mode 100644 index 80a78d7..0000000 --- a/lib/RFID/Serial.pm +++ /dev/null @@ -1,247 +0,0 @@ -package RFID::Serial; - -use warnings; -use strict; - -use base 'Exporter'; -our @EXPORT = qw( hex2bytes as_hex hex_tag ); - -use Device::SerialPort qw(:STAT); -use Data::Dump qw(dump); - -=head1 NAME - -RFID::Serial - support serial RFID devices - -=cut - -our $VERSION = '0.01'; - -my $debug = 0; - - -=head1 SYNOPSIS - -This module tries to support USB serial RFID readers wsing simple API -which is sutable for direct mapping to REST JSONP service. - -Perhaps a little code snippet. - - use RFID::Serial; - - my $rfid = RFID::Serial->new( - device => '/dev/ttyUSB0', # with fallback to RFID_DEVICE - ); - my $visible = $rfid->scan; - -=head1 SUBROUTINES/METHODS - -=head2 new - -=cut - -sub new { - my $class = shift; - my $self = {@_}; - bless $self, $class; - - $self->port; - - $self->init; - - return $self; -} - -=head2 port - - my $serial_obj = $self->port; - -=cut - -sub port { - my $self = shift; - - return $self->{port} if defined $self->{port}; - - my $settings = $self->serial_settings; - $settings->{device} ||= $ENV{RFID_DEVICE}; - warn "# settings ",dump $settings; - - $self->{port} = Device::SerialPort->new( $settings->{device} ) - || die "can't open serial port: $!\n"; - - $self->{port}->$_( $settings->{$_} ) - foreach ( qw/handshake baudrate databits parity stopbits/ ); - -} - -=head2 scan - - my $visible = $rfid->scan; - -Returns hash with keys which match tag UID and values with blocks - -=cut - -sub scan { - my $self = shift; - - warn "# scan tags in reader range\n"; - my @tags = $self->inventory; - - my $visible; - # FIXME this is naive implementation which just discards other tags - foreach my $tag ( @tags ) { - my $blocks = $self->read_blocks( $tag ); - if ( ! $blocks ) { - warn "ERROR: can't read tag $tag\n"; - delete $visible->{$tag}; - } else { - $visible->{$tag} = $blocks->{$tag}; - } - } - - return $visible; -} - - -=head1 MANDATORY IMPLEMENTATIONS - -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 - - $hash = { 'E000000123456789' => [ undef, 'block1', 'block2', ... ] }; - -L sends tag UID with data payload, so we might expect -to receive response from other tags from protocol specification, - - -=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 AUTHOR - -Dobrica Pavlinusic, C<< >> - -=head1 BUGS - -Please report any bugs or feature requests to C, or through -the web interface at L. 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 RFID::Serial - - -You can also look for information at: - -=over 4 - -=item * RT: CPAN's request tracker - -L - -=item * AnnoCPAN: Annotated CPAN documentation - -L - -=item * CPAN Ratings - -L - -=item * Search CPAN - -L - -=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 RFID::Serial diff --git a/lib/RFID/Serial/3M810.pm b/lib/RFID/Serial/3M810.pm deleted file mode 100644 index 8fffb78..0000000 --- a/lib/RFID/Serial/3M810.pm +++ /dev/null @@ -1,292 +0,0 @@ -package RFID::Serial::3M810; - -use base 'RFID::Serial'; -use RFID::Serial; - -use Data::Dump qw(dump); -use Carp qw(confess); -use Time::HiRes; -use Digest::CRC; - -sub serial_settings {{ - device => "/dev/ttyUSB1", # FIXME comment out before shipping - baudrate => "19200", - databits => "8", - parity => "none", - stopbits => "1", - handshake => "none", -}} - -my $port; -sub init { - my $self = shift; - $port = $self->port; - - # 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"; - - setup(); - -} - -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 wait_device { - Time::HiRes::sleep 0.015; -} - -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"; - $port->write( $bytes ); - - wait_device; - - my $r_len = $port->read(3); - - while ( length($r_len) < 3 ) { - wait_device; - $r_len = $port->read( 3 - length($r_len) ); - } - - wait_device; - - my $len = ord( substr($r_len,2,1) ); - $data = $port->read( $len ); - - while ( length($data) < $len ) { - warn "# short read ", length($data), " < $len\n"; - wait_device; - $data .= $port->read( $len - length($data) ); - } - - 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"; - - - $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 setup { - -cmd( -'D5 00 05 04 00 11 8C66', 'hw version', sub { - my $data = shift; - my $rest = assert $data => '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' -)}); -} - -=head2 inventory - - my @tags = inventory; - -=cut - -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); - 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 ( my $rest = _matched $data => 'FE 00 00 05 01' ) { - warn "FIXME ready? ",as_hex $test; - } elsif ( my $rest = _matched $data => '02 06' ) { - warn "ERROR ",as_hex($rest); - } else { - warn "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 = join('', @_); - - 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 ( my $rest = _matched $data => '04 06' ) { - warn "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 ( my $rest = _matched $data => '0A 06' ) { - warn "ERROR reading security from $tag ", as_hex($data); - } else { - warn "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 = substr($rest,0,8); - $afi = substr($rest,8,1); - - warn "# SECURITY ", hex_tag($tag), " AFI: ", as_hex($afi); - - } elsif ( my $rest = _matched $data => '0A 06' ) { - warn "ERROR writing AFI to $tag ", as_hex($data); - undef $afi; - } else { - warn "IGNORED ",as_hex($data); - undef $afi; - } - }); - warn "## write_afi ", dump( $tag, $afi ); - return $afi; -} - -1 diff --git a/lib/RFID/Serial/CPRM02.pm b/lib/RFID/Serial/CPRM02.pm deleted file mode 100644 index 6f5f792..0000000 --- a/lib/RFID/Serial/CPRM02.pm +++ /dev/null @@ -1,183 +0,0 @@ -package RFID::Serial::CPRM02; - -use base 'RFID::Serial'; -use RFID::Serial; - -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' ); - -} - -sub read_blocks { - my $tag = shift; - $tag = shift if ref $tag; - - my $max_block; - - cpr( "FF B0 2B 01 $tag", "Get System Information $tag", sub { - my $data = shift; - - warn "# data ",as_hex($data); - - my $DSFID = substr($data,5-2,1); - my $UID = substr($data,6-2,8); - my $AFI = substr($data,14-2,1); - my $MEM = substr($data,15-2,1); - my $SIZE = substr($data,16-2,1); - my $IC_REF = substr($data,17-2,1); - - warn "# split ",as_hex( $DSFID, $UID, $AFI, $MEM, $SIZE, $IC_REF ); - - $max_block = ord($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 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; -} - -1 diff --git a/lib/RFID/Serial/Decode/RFID501.pm b/lib/RFID/Serial/Decode/RFID501.pm deleted file mode 100644 index 14f5bf3..0000000 --- a/lib/RFID/Serial/Decode/RFID501.pm +++ /dev/null @@ -1,73 +0,0 @@ -package RFID::Serial::Decode::RFID501; - -use warnings; -use strict; - -=head1 NAME - -RFID::501 - RFID Standard for Libraries - -=head1 DESCRIPTION - -This module tries to decode tag format as specified in document - - RFID 501: RFID Standards for Libraries - -However, document is lacking real specification, so tag decoding -was done to be compliant with 3M implementation - -=head1 METHODS - -=head2 decode_tag - - my $hash = RFID::Serial::Decode::RFID501->to_hash( $bytes ); - - my $hash = RFID::Serial::Decode::RFID501->to_hash( [ 'blk1', 'blk2', ... , 'blk7' ] ); - -=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 $data\n"; - - my ( $u1, $set_item, $u2, $type, $content, $br_lib, $custom ) = unpack('C4Z16Nl>',$data); - my $hash = { - u1 => $u1, # FIXME - u2 => $u2, # FIXME - set => ( $set_item & 0xf0 ) >> 4, - total => ( $set_item & 0x0f ), - - type => $type, - type_label => $item_type->{$type}, - content => $content, - - branch => $br_lib >> 20, - library => $br_lib & 0x000fffff, - - custom => $custom, - }; - - return $hash; -} - -1; diff --git a/scripts/RFID-JSONP-server.pl b/scripts/RFID-JSONP-server.pl index 7b0119a..37dc0dc 100755 --- a/scripts/RFID-JSONP-server.pl +++ b/scripts/RFID-JSONP-server.pl @@ -25,9 +25,9 @@ my $server_url = "http://localhost:$listen_port"; use lib 'lib'; -use RFID::Serial::Decode::RFID501; -use RFID::Serial::3M810; -my $rfid = RFID::Serial::3M810->new; +use RFID::Biblio::Decode::RFID501; +use RFID::Biblio::3M810; +my $rfid = RFID::Biblio::3M810->new; my $index_html; { @@ -73,7 +73,7 @@ sub http_server { my $tags = $rfid->scan; my $json = { time => time() }; foreach my $tag ( keys %$tags ) { - my $hash = RFID::Serial::Decode::RFID501->to_hash( $tags->{$tag} ); + my $hash = RFID::Biblio::Decode::RFID501->to_hash( $tags->{$tag} ); $hash->{sid} = $tag; $hash->{security} = uc unpack 'H*', $rfid->read_afi( $tag ); push @{ $json->{tags} }, $hash; diff --git a/scripts/scan.pl b/scripts/scan.pl index 572864e..47da568 100755 --- a/scripts/scan.pl +++ b/scripts/scan.pl @@ -19,7 +19,7 @@ my @rfid; foreach my $reader ( @readers ) { next if $only && $only ne $reader; - my $module = "RFID::Serial::$reader"; + my $module = "RFID::Biblio::$reader"; eval "use $module"; die $@ if $@; if ( my $rfid = $module->new( device => '/dev/ttyUSB0' ) ) { diff --git a/t/00-load.t b/t/00-load.t index dcaa690..ee6e029 100644 --- a/t/00-load.t +++ b/t/00-load.t @@ -3,8 +3,8 @@ use Test::More tests => 1; BEGIN { - use_ok( 'RFID::Serial' ) || print "Bail out! + use_ok( 'RFID::Biblio' ) || print "Bail out! "; } -diag( "Testing RFID::Serial $RFID::Serial::VERSION, Perl $], $^X" ); +diag( "Testing RFID::Biblio $RFID::Biblio::VERSION, Perl $], $^X" ); diff --git a/t/05-RFID501.t b/t/05-RFID501.t index 2e43df3..d342698 100755 --- a/t/05-RFID501.t +++ b/t/05-RFID501.t @@ -6,13 +6,13 @@ use Data::Dump qw(dump); use lib 'lib'; BEGIN { - use_ok( 'RFID::Serial::Decode::RFID501' ); + use_ok( 'RFID::Biblio::Decode::RFID501' ); } -ok( my $hash = RFID::Serial::Decode::RFID501->to_hash( "\x04\x11\x00\x00200912310123\x00\x00\x00\x00" ), 'decode_tag' ); +ok( my $hash = RFID::Biblio::Decode::RFID501->to_hash( "\x04\x11\x00\x00200912310123\x00\x00\x00\x00" ), 'decode_tag' ); diag dump $hash; -ok( $hash = RFID::Serial::Decode::RFID501->to_hash( "\x04\x11\x00\x011301234567\x00\x00\x00\x00\x00\x00" ), 'decode_tag' ); +ok( $hash = RFID::Biblio::Decode::RFID501->to_hash( "\x04\x11\x00\x011301234567\x00\x00\x00\x00\x00\x00" ), 'decode_tag' ); diag dump $hash; my $tag = [ @@ -26,6 +26,6 @@ my $tag = [ "\0\0\0\0", ]; -ok( $hash = RFID::Serial::Decode::RFID501->to_hash( $tag ), 'decode_tag' ); +ok( $hash = RFID::Biblio::Decode::RFID501->to_hash( $tag ), 'decode_tag' ); diag dump $hash; diff --git a/t/10-3M-810.t b/t/10-3M-810.t index 52d8b4b..b65b271 100755 --- a/t/10-3M-810.t +++ b/t/10-3M-810.t @@ -6,10 +6,10 @@ use Data::Dump qw(dump); use lib 'lib'; BEGIN { - use_ok( 'RFID::Serial::3M810' ); + use_ok( 'RFID::Biblio::3M810' ); } -ok( my $o = RFID::Serial::3M810->new( device => '/dev/ttyUSB0' ), 'new' ); +ok( my $o = RFID::Biblio::3M810->new( device => '/dev/ttyUSB0' ), 'new' ); ok( my @tags = $o->inventory, 'inventory' ); diag dump @tags; diff --git a/t/20-CPR-M02.t b/t/20-CPR-M02.t index fe4663d..9e85f61 100755 --- a/t/20-CPR-M02.t +++ b/t/20-CPR-M02.t @@ -6,10 +6,10 @@ use Data::Dump qw(dump); use lib 'lib'; BEGIN { - use_ok( 'RFID::Serial::CPRM02' ); + use_ok( 'RFID::Biblio::CPRM02' ); } -ok( my $o = RFID::Serial::CPRM02->new( device => '/dev/ttyUSB0' ), 'new' ); +ok( my $o = RFID::Biblio::CPRM02->new( device => '/dev/ttyUSB0' ), 'new' ); ok( my @tags = $o->inventory, 'inventory' ); diff --git a/t/boilerplate.t b/t/boilerplate.t index 480c407..b08c192 100644 --- a/t/boilerplate.t +++ b/t/boilerplate.t @@ -48,7 +48,7 @@ TODO: { "placeholder date/time" => qr(Date/time) ); - module_boilerplate_ok('lib/RFID/Serial.pm'); + module_boilerplate_ok('lib/RFID/Biblio.pm'); }