lib/Biblio/RFID/Reader.pm

   1 package Biblio::RFID::Reader;
   2
   3 use warnings;
   4 use strict;
   5
   6 use Data::Dump qw(dump);
   7 use Time::HiRes;
   8 use lib 'lib';
   9 use Biblio::RFID;
  10 use Carp qw(confess);
  11
  12 =head1 NAME
  13
  14 Biblio::RFID::Reader - simple way to write RFID applications in perl
  15
  16 =head1 DESCRIPTION
  17
  18 This module will probe all available readers and use calls from
  19 L<Biblio::RFID::Reader::API> to invoke correct reader.
  20
  21 =head1 FUNCTIONS
  22
  23 =head2 new
  24
  25   my $rfid = Biblio::RFID::Reader->new( 'optional reader filter' );
  26
  27 =cut
  28
  29 sub new {
  30         my ( $class, $filter ) = @_;
  31         my $self = {};
  32         bless $self, $class;
  33         $self->{_readers} = [ $self->_available( $filter ) ];
  34         return $self;
  35 }
  36
  37 =head2 tags
  38
  39   my @visible = $rfid->tags(
  40                 enter => sub { my $tag = shift; },
  41                 leave => sub { my $tag = shift; },
  42                 reader => sub { my $reader = shift; ref($reader) =~ m/something/ },
  43   );
  44
  45 =cut
  46
  47 sub tags {
  48         my $self = shift;
  49         my $triggers = {@_};
  50
  51         $self->{_tags} ||= {};
  52         $self->{_tags}->{$_}->{time} = 0 foreach keys %{$self->{_tags}};
  53         my $t = time;
  54
  55         foreach my $rfid ( @{ $self->{_readers} } ) {
  56
  57                 if ( exists $triggers->{reader} ) {
  58                         if ( ! $triggers->{reader}->($rfid) ) {
  59                                 # invalidate tags from other readers
  60                                 if ( exists $self->{_tags} ) {
  61                                         delete  $self->{_tags}->{$_} foreach (
  62                                                 grep { $self->{_tags}->{$_}->{reader} eq ref $rfid } keys %{ $self->{_tags} }
  63                                         );
  64                                 }
  65                                 next;
  66                         }
  67                 }
  68
  69                 warn "# inventory on $rfid";
  70                 my @tags = $rfid->inventory;
  71
  72                 foreach my $tag ( @tags ) {
  73
  74                         if ( ! exists $self->{_tags}->{$tag} ) {
  75                                 eval {
  76                                         my $blocks = $rfid->read_blocks($tag);
  77                                         $self->{_tags}->{$tag}->{blocks} = $blocks->{$tag} || die "no $tag in ",dump($blocks);
  78                                         my $afi = $rfid->read_afi($tag);
  79                                         $self->{_tags}->{$tag}->{afi} = $afi;
  80                                         $self->{_tags}->{$tag}->{type} = $rfid->tag_type( $tag );
  81                                         $self->{_tags}->{$tag}->{reader} = ref $rfid; # save reader info
  82
  83                                 };
  84                                 if ( $@ ) {
  85                                         warn "ERROR reading $tag: $@\n";
  86                                         $self->_invalidate_tag( $tag );
  87                                         next;
  88                                 }
  89
  90                                 $triggers->{enter}->( $tag ) if $triggers->{enter};
  91                         }
  92
  93                         $self->{_tags}->{$tag}->{time} = $t;
  94
  95                 }
  96
  97         }
  98
  99         foreach my $tag ( grep { $self->{_tags}->{$_}->{time} == 0 } keys %{ $self->{_tags} } ) {
 100                 $triggers->{leave}->( $tag ) if $triggers->{leave};
 101                 $self->_invalidate_tag( $tag );
 102         }
 103
 104         warn "## _tags ",dump( $self->{_tags} );
 105
 106         return grep { $self->{_tags}->{$_}->{time} } keys %{ $self->{_tags} };
 107 }
 108
 109 =head2 blocks
 110
 111   my $blocks_arrayref = $rfid->blocks( $tag );
 112
 113 =head2 afi
 114
 115   my $afi = $rfid->afi( $tag );
 116
 117 =cut
 118
 119 sub blocks { $_[0]->{_tags}->{$_[1]}->{ 'blocks' } || confess "no blocks for $_[1]"; };
 120 sub afi    { $_[0]->{_tags}->{$_[1]}->{ 'afi'    } || confess "no afi for $_[1]"; };
 121
 122 =head2 to_hash
 123
 124   $self->to_hash( $tag );
 125
 126 =cut
 127
 128 sub to_hash {
 129         my ( $self, $tag ) = @_;
 130         return unless exists $self->{_tags}->{$tag};
 131         my $type = $self->{_tags}->{$tag}->{type} || confess "can't find type for tag $tag ",dump( $self->{_tags} );
 132         my $decode = 'Biblio::RFID::' . $type;
 133         my $hash = $decode->to_hash( $self->blocks( $tag ) );
 134         $hash->{tag_type} = $type;
 135         return $hash;
 136 }
 137
 138 =head2 debug
 139
 140   $self->debug(1); # or more
 141
 142 =cut
 143
 144 sub debug {
 145         my ( $self, $level ) = @_;
 146         $debug = $level if $level > $debug;
 147         warn "debug level $level\n" if $level;
 148 }
 149
 150 =head2 from_reader
 151
 152   my $reader = $self->from_reader( $tag );
 153
 154 =cut
 155
 156 sub from_reader {
 157         my ( $self, $tag ) = @_;
 158         return unless exists $self->{_tags}->{$tag};
 159         my $reader = $self->{_tags}->{$tag}->{reader};
 160         $reader =~ s/^.*:://; # strip module prefix
 161         return $reader;
 162 }
 163
 164 =head1 PRIVATE
 165
 166 =head2 _invalidate_tag
 167
 168   $rfid->_invalidate_tag( $tag );
 169
 170 =cut
 171
 172 sub _invalidate_tag {
 173         my ( $self, $tag ) = @_;
 174         my @caller = caller(0);
 175         warn "## _invalidate_tag caller $caller[0] $caller[1] +$caller[2]\n";
 176         my $old = delete $self->{_tags}->{$tag};
 177         warn "# _invalidate_tag $tag ", dump($old);
 178 }
 179
 180 =head2 _available
 181
 182 Probe each RFID reader supported and returns succefull ones
 183
 184   my $rfid_readers = Biblio::RFID::Reader->_available( $regex_filter );
 185
 186 =cut
 187
 188 #my @readers = ( '3M810', 'CPRM02', 'librfid' );
 189 my @readers = ( '3M810', 'librfid' );
 190
 191 sub _available {
 192         my ( $self, $filter ) = @_;
 193
 194         $filter = '' unless defined $filter;
 195
 196         warn "# filter: $filter";
 197
 198         my @rfid;
 199
 200         foreach my $reader ( @readers ) {
 201                 next if $filter && $reader !~ /$filter/i;
 202                 my $module = "Biblio::RFID::Reader::$reader";
 203                 eval "use $module";
 204                 die $@ if $@;
 205                 if ( my $rfid = $module->new ) {
 206                         push @rfid, $rfid;
 207                         warn "# added $module\n";
 208                 } else {
 209                         warn "# ignored $module\n";
 210                 }
 211         }
 212
 213         die "no readers found" unless @rfid;
 214
 215         return @rfid;
 216 }
 217
 218 =head1 AUTOLOAD
 219
 220 On any other function calls, we just marshall to all readers
 221
 222 =cut
 223
 224 # we don't want DESTROY to fallback into AUTOLOAD
 225 sub DESTROY {}
 226
 227 our $AUTOLOAD;
 228 sub AUTOLOAD {
 229         my $self = shift;
 230         my $command = $AUTOLOAD;
 231         $command =~ s/.*://;
 232
 233         my @out;
 234
 235         foreach my $r ( @{ $self->{_readers} } ) {
 236                 push @out, $r->$command(@_);
 237         }
 238
 239         $self->_invalidate_tag( $_[0] ) if $command =~ m/write/;
 240
 241         return @out;
 242 }
 243
 244 1
 245 __END__
 246
 247 =head1 SEE ALSO
 248
 249 =head2 RFID reader implementations
 250
 251 L<Biblio::RFID::Reader::3M810>
 252
 253 L<Biblio::RFID::Reader::CPRM02>
 254
 255 L<Biblio::RFID::Reader::librfid>
 256