File Coverage

lib/Biblio/RFID/Reader.pm
Criterion Covered Total %
statement 35 93 37.6
branch 3 24 12.5
condition 1 7 14.2
subroutine 10 16 62.5
pod 4 4 100.0
total 53 144 36.8


line stmt bran cond sub pod time code
1             package Biblio::RFID::Reader;
2              
3 2     2   47718 use warnings;
  2         4  
  2         65  
4 2     2   11 use strict;
  2         4  
  2         78  
5              
6 2     2   11 use Data::Dump qw(dump);
  2         4  
  2         85  
7 2     2   1408 use Time::HiRes;
  2         2524  
  2         12  
8 2     2   209 use lib 'lib';
  2         4  
  2         14  
9 2     2   616 use Biblio::RFID;
  2         5  
  2         201  
10 2     2   11 use Carp qw(confess);
  2         4  
  2         2359  
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 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 1     1 1 15 my ( $class, $filter ) = @_;
31 1         3 my $self = {};
32 1         3 bless $self, $class;
33 1         6 $self->{_readers} = [ $self->_available( $filter ) ];
34 0         0 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 0     0 1 0 my $self = shift;
48 0         0 my $triggers = {@_};
49              
50 0   0     0 $self->{_tags} ||= {};
51 0         0 $self->{_tags}->{$_}->{time} = 0 foreach keys %{$self->{_tags}};
  0         0  
52 0         0 my $t = time;
53              
54 0         0 foreach my $rfid ( @{ $self->{_readers} } ) {
  0         0  
55 0         0 warn "# inventory on $rfid";
56 0         0 my @tags = $rfid->inventory;
57              
58 0         0 foreach my $tag ( @tags ) {
59              
60 0 0       0 if ( ! exists $self->{_tags}->{$tag} ) {
61 0         0 eval {
62 0         0 my $blocks = $rfid->read_blocks($tag);
63 0   0     0 $self->{_tags}->{$tag}->{blocks} = $blocks->{$tag} || die "no $tag in ",dump($blocks);
64 0         0 my $afi = $rfid->read_afi($tag);
65 0         0 $self->{_tags}->{$tag}->{afi} = $afi;
66              
67             };
68 0 0       0 if ( $@ ) {
69 0         0 warn "ERROR reading $tag: $@\n";
70 0         0 $self->_invalidate_tag( $tag );
71 0         0 next;
72             }
73              
74 0 0       0 $triggers->{enter}->( $tag ) if $triggers->{enter};
75             }
76              
77 0         0 $self->{_tags}->{$tag}->{time} = $t;
78              
79             }
80            
81 0         0 foreach my $tag ( grep { $self->{_tags}->{$_}->{time} == 0 } keys %{ $self->{_tags} } ) {
  0         0  
  0         0  
82 0 0       0 $triggers->{leave}->( $tag ) if $triggers->{leave};
83 0         0 $self->_invalidate_tag( $tag );
84             }
85              
86             }
87              
88 0         0 warn "## _tags ",dump( $self->{_tags} );
89              
90 0         0 return grep { $self->{_tags}->{$_}->{time} } keys %{ $self->{_tags} };
  0         0  
  0         0  
91             }
92              
93             =head2 blocks
94              
95             my $blocks_arrayref = $rfid->blocks( $tag );
96              
97             =head2 afi
98              
99             my $afi = $rfid->afi( $tag );
100              
101             =cut
102              
103 0 0   0 1 0 sub blocks { $_[0]->{_tags}->{$_[1]}->{ 'blocks' } || confess "no blocks for $_[1]"; };
104 0 0   0 1 0 sub afi { $_[0]->{_tags}->{$_[1]}->{ 'afi' } || confess "no afi for $_[1]"; };
105              
106             =head1 PRIVATE
107              
108             =head2 _invalidate_tag
109              
110             $rfid->_invalidate_tag( $tag );
111              
112             =cut
113              
114             sub _invalidate_tag {
115 0     0   0 my ( $self, $tag ) = @_;
116 0         0 my @caller = caller(0);
117 0         0 warn "## _invalidate_tag caller $caller[0] $caller[1] +$caller[2]\n";
118 0         0 my $old = delete $self->{_tags}->{$tag};
119 0         0 warn "# _invalidate_tag $tag ", dump($old);
120             }
121              
122             =head2 _available
123              
124             Probe each RFID reader supported and returns succefull ones
125              
126             my $rfid_readers = Biblio::RFID::Reader->_available( $regex_filter );
127              
128             =cut
129              
130             my @readers = ( '3M810', 'CPRM02', 'librfid' );
131              
132             sub _available {
133 1     1   2 my ( $self, $filter ) = @_;
134              
135 1 50       5 $filter = '' unless defined $filter;
136              
137 1         14 warn "# filter: $filter";
138              
139 1         2 my @rfid;
140              
141 1         3 foreach my $reader ( @readers ) {
142 1 50 33     7 next if $filter && $reader !~ /$filter/i;
143 1         4 my $module = "Biblio::RFID::Reader::$reader";
144 1     1   134 eval "use $module";
  1         850  
  0            
  0            
145 1 50       387 die $@ if $@;
146 0 0       0 if ( my $rfid = $module->new ) {
147 0         0 push @rfid, $rfid;
148 0         0 warn "# added $module\n";
149             } else {
150 0         0 warn "# ignored $module\n";
151             }
152             }
153              
154 0 0       0 die "no readers found" unless @rfid;
155              
156 0         0 return @rfid;
157             }
158              
159             =head1 AUTOLOAD
160              
161             On any other function calls, we just marshall to all readers
162              
163             =cut
164              
165             # we don't want DESTROY to fallback into AUTOLOAD
166 0     0   0 sub DESTROY {}
167              
168             our $AUTOLOAD;
169             sub AUTOLOAD {
170 0     0   0 my $self = shift;
171 0         0 my $command = $AUTOLOAD;
172 0         0 $command =~ s/.*://;
173              
174 0         0 my @out;
175              
176 0         0 foreach my $r ( @{ $self->{_readers} } ) {
  0         0  
177 0         0 push @out, $r->$command(@_);
178             }
179              
180 0 0       0 $self->_invalidate_tag( $_[0] ) if $command =~ m/write/;
181              
182 0         0 return @out;
183             }
184              
185             1
186             __END__