rename to RFID::Biblio
authorDobrica Pavlinusic <dpavlin@rot13.org>
Thu, 29 Jul 2010 11:42:49 +0000 (13:42 +0200)
committerDobrica Pavlinusic <dpavlin@rot13.org>
Thu, 29 Jul 2010 11:42:49 +0000 (13:42 +0200)
20 files changed:
Changes
MANIFEST
Makefile.PL
README
ignore.txt
lib/RFID/Biblio.pm [new file with mode: 0644]
lib/RFID/Biblio/3M810.pm [new file with mode: 0644]
lib/RFID/Biblio/CPRM02.pm [new file with mode: 0644]
lib/RFID/Biblio/Decode/RFID501.pm [new file with mode: 0644]
lib/RFID/Serial.pm [deleted file]
lib/RFID/Serial/3M810.pm [deleted file]
lib/RFID/Serial/CPRM02.pm [deleted file]
lib/RFID/Serial/Decode/RFID501.pm [deleted file]
scripts/RFID-JSONP-server.pl
scripts/scan.pl
t/00-load.t
t/05-RFID501.t
t/10-3M-810.t
t/20-CPR-M02.t
t/boilerplate.t

diff --git a/Changes b/Changes
index 8f43c6a..fe7dcca 100644 (file)
--- 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.
index a3c642a..d894db8 100644 (file)
--- 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
index 5b529d7..c924072 100644 (file)
@@ -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 <dpavlin@rot13.org>};
 license  'gpl';
 
diff --git a/README b/README
index 6ba324c..ba6c49c 100644 (file)
--- 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
index ada7e37..bf53570 100644 (file)
@@ -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 (file)
index 0000000..b3723fe
--- /dev/null
@@ -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<RFID::Biblio::3M810> 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<< <dpavlin at rot13.org> >>
+
+=head1 BUGS
+
+Please report any bugs or feature requests to C<bug-rfid-serial at rt.cpan.org>, or through
+the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=RFID-Biblio>.  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<http://rt.cpan.org/NoAuth/Bugs.html?Dist=RFID-Biblio>
+
+=item * AnnoCPAN: Annotated CPAN documentation
+
+L<http://annocpan.org/dist/RFID-Biblio>
+
+=item * CPAN Ratings
+
+L<http://cpanratings.perl.org/d/RFID-Biblio>
+
+=item * Search CPAN
+
+L<http://search.cpan.org/dist/RFID-Biblio/>
+
+=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 (file)
index 0000000..db1ef9e
--- /dev/null
@@ -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 (file)
index 0000000..c5d1e24
--- /dev/null
@@ -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 (file)
index 0000000..9232db1
--- /dev/null
@@ -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 (file)
index 80a78d7..0000000
+++ /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<RFID::Serial::3M810> 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<< <dpavlin at rot13.org> >>
-
-=head1 BUGS
-
-Please report any bugs or feature requests to C<bug-rfid-serial at rt.cpan.org>, or through
-the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=RFID-Serial>.  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<http://rt.cpan.org/NoAuth/Bugs.html?Dist=RFID-Serial>
-
-=item * AnnoCPAN: Annotated CPAN documentation
-
-L<http://annocpan.org/dist/RFID-Serial>
-
-=item * CPAN Ratings
-
-L<http://cpanratings.perl.org/d/RFID-Serial>
-
-=item * Search CPAN
-
-L<http://search.cpan.org/dist/RFID-Serial/>
-
-=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 (file)
index 8fffb78..0000000
+++ /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 (file)
index 6f5f792..0000000
+++ /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 (file)
index 14f5bf3..0000000
+++ /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;
index 7b0119a..37dc0dc 100755 (executable)
@@ -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;
index 572864e..47da568 100755 (executable)
@@ -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' ) ) {
index dcaa690..ee6e029 100644 (file)
@@ -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" );
index 2e43df3..d342698 100755 (executable)
@@ -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;
 
index 52d8b4b..b65b271 100755 (executable)
@@ -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;
index fe4663d..9e85f61 100755 (executable)
@@ -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' );
 
index 480c407..b08c192 100644 (file)
@@ -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');
 
 
 }