f99d159369f4960b53f65dcbbed994260b3738bb
[Biblio-RFID.git] / 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   );
43
44 =cut
45
46 sub tags {
47         my $self = shift;
48         my $triggers = {@_};
49
50         $self->{_tags} ||= {};
51         $self->{_tags}->{$_}->{time} = 0 foreach keys %{$self->{_tags}};
52         my $t = time;
53
54         foreach my $rfid ( @{ $self->{_readers} } ) {
55                 warn "# inventory on $rfid";
56                 my @tags = $rfid->inventory;
57
58                 foreach my $tag ( @tags ) {
59
60                         if ( ! exists $self->{_tags}->{$tag} ) {
61                                 eval {
62                                         my $blocks = $rfid->read_blocks($tag);
63                                         $self->{_tags}->{$tag}->{blocks} = $blocks->{$tag} || die "no $tag in ",dump($blocks);
64                                         my $afi = $rfid->read_afi($tag);
65                                         $self->{_tags}->{$tag}->{afi} = $afi;
66                                         $self->{_tags}->{$tag}->{type} = $rfid->tag_type( $tag );
67                                         $self->{_tags}->{$tag}->{reader} = ref $rfid; # save reader info
68
69                                 };
70                                 if ( $@ ) {
71                                         warn "ERROR reading $tag: $@\n";
72                                         $self->_invalidate_tag( $tag );
73                                         next;
74                                 }
75
76                                 $triggers->{enter}->( $tag ) if $triggers->{enter};
77                         }
78
79                         $self->{_tags}->{$tag}->{time} = $t;
80
81                 }
82         
83         }
84
85         foreach my $tag ( grep { $self->{_tags}->{$_}->{time} == 0 } keys %{ $self->{_tags} } ) {
86                 $triggers->{leave}->( $tag ) if $triggers->{leave};
87                 $self->_invalidate_tag( $tag );
88         }
89
90         warn "## _tags ",dump( $self->{_tags} );
91
92         return grep { $self->{_tags}->{$_}->{time} } keys %{ $self->{_tags} };
93 }
94
95 =head2 blocks
96
97   my $blocks_arrayref = $rfid->blocks( $tag );
98
99 =head2 afi
100
101   my $afi = $rfid->afi( $tag );
102
103 =cut
104
105 sub blocks { $_[0]->{_tags}->{$_[1]}->{ 'blocks' } || confess "no blocks for $_[1]"; };
106 sub afi    { $_[0]->{_tags}->{$_[1]}->{ 'afi'    } || confess "no afi for $_[1]"; };
107
108 =head2 to_hash
109
110   $self->to_hash( $tag );
111
112 =cut
113
114 sub to_hash {
115         my ( $self, $tag ) = @_;
116         return unless exists $self->{_tags}->{$tag};
117         my $type = $self->{_tags}->{$tag}->{type} || confess "can't find type for tag $tag ",dump( $self->{_tags} );
118         my $decode = 'Biblio::RFID::' . $type;
119         my $hash = $decode->to_hash( $self->blocks( $tag ) );
120         $hash->{tag_type} = $type;
121         return $hash;
122 }
123
124 =head2 debug
125
126   $self->debug(1); # or more
127
128 =cut
129
130 sub debug {
131         my ( $self, $level ) = @_;
132         $debug = $level if $level > $debug;
133         warn "debug level $level\n" if $level;
134 }
135
136 =head2 from_reader
137
138   my $reader = $self->from_reader( $tag );
139
140 =cut
141
142 sub from_reader {
143         my ( $self, $tag ) = @_;
144         return unless exists $self->{_tags}->{$tag};
145         my $reader = $self->{_tags}->{$tag}->{reader};
146         $reader =~ s/^.*:://; # strip module prefix
147         return $reader;
148 }
149
150 =head1 PRIVATE
151
152 =head2 _invalidate_tag
153
154   $rfid->_invalidate_tag( $tag );
155
156 =cut
157
158 sub _invalidate_tag {
159         my ( $self, $tag ) = @_;
160         my @caller = caller(0);
161         warn "## _invalidate_tag caller $caller[0] $caller[1] +$caller[2]\n";
162         my $old = delete $self->{_tags}->{$tag};
163         warn "# _invalidate_tag $tag ", dump($old);
164 }
165
166 =head2 _available
167
168 Probe each RFID reader supported and returns succefull ones
169
170   my $rfid_readers = Biblio::RFID::Reader->_available( $regex_filter );
171
172 =cut
173
174 my @readers = ( '3M810', 'CPRM02', 'librfid' );
175
176 sub _available {
177         my ( $self, $filter ) = @_;
178
179         $filter = '' unless defined $filter;
180
181         warn "# filter: $filter";
182
183         my @rfid;
184
185         foreach my $reader ( @readers ) {
186                 next if $filter && $reader !~ /$filter/i;
187                 my $module = "Biblio::RFID::Reader::$reader";
188                 eval "use $module";
189                 die $@ if $@;
190                 if ( my $rfid = $module->new ) {
191                         push @rfid, $rfid;
192                         warn "# added $module\n";
193                 } else {
194                         warn "# ignored $module\n";
195                 }
196         }
197
198         die "no readers found" unless @rfid;
199
200         return @rfid;
201 }
202
203 =head1 AUTOLOAD
204
205 On any other function calls, we just marshall to all readers
206
207 =cut
208
209 # we don't want DESTROY to fallback into AUTOLOAD
210 sub DESTROY {}
211
212 our $AUTOLOAD;
213 sub AUTOLOAD {
214         my $self = shift;
215         my $command = $AUTOLOAD;
216         $command =~ s/.*://;
217
218         my @out;
219
220         foreach my $r ( @{ $self->{_readers} } ) {
221                 push @out, $r->$command(@_);
222         }
223
224         $self->_invalidate_tag( $_[0] ) if $command =~ m/write/;
225
226         return @out;
227 }
228
229 1
230 __END__
231
232 =head1 SEE ALSO
233
234 =head2 RFID reader implementations
235
236 L<Biblio::RFID::Reader::3M810>
237
238 L<Biblio::RFID::Reader::CPRM02>
239
240 L<Biblio::RFID::Reader::librfid>
241