File Coverage

blib/lib/Imager/Search/Image.pm
Criterion Covered Total %
statement 53 62 85.4
branch 11 22 50.0
condition 1 3 33.3
subroutine 9 9 100.0
pod 1 3 33.3
total 75 99 75.7


line stmt bran cond sub pod time code
1             package Imager::Search::Image;
2              
3             =pod
4              
5             =head1 NAME
6              
7             Imager::Search::Image - Generic interface for a searchable image
8              
9             =head1 DESCRIPTION
10              
11             L is an abstract base class for objects that
12             implement an image to be searched.
13              
14             =head1 METHODS
15              
16             =cut
17              
18 5     5   30443 use 5.006;
  5         15  
  5         180  
19 5     5   26 use strict;
  5         9  
  5         174  
20 5     5   954 use Params::Util qw{ _IDENTIFIER _POSINT _INSTANCE _DRIVER };
  5         5542  
  5         341  
21              
22 5     5   27 use vars qw{$VERSION};
  5         9  
  5         496  
23             BEGIN {
24 5     5   150 $VERSION = '1.01';
25             }
26              
27 5         35 use Object::Tiny::XS qw{
28             name
29             driver
30             file
31             image
32             height
33             width
34             string
35 5     5   782 };
  5         4187  
36              
37              
38              
39              
40              
41             ######################################################################
42             # Constructor and Accessors
43              
44             sub new {
45 4     4 0 2228 my $class = shift;
46 4         23 my $self = bless { @_ }, $class;
47              
48             # Check the driver
49 4 50       169 if ( _IDENTIFIER($self->driver) ) {
50 0         0 $self->{driver} = "Imager::Search::Driver::" . $self->driver;
51             }
52 4 50       158 if ( _DRIVER($self->driver, 'Imager::Search::Driver') ) {
53 4         612 $self->{driver} = $self->driver->new;
54             }
55 4 50       61 unless ( _INSTANCE($self->driver, 'Imager::Search::Driver') ) {
56 0         0 Carp::croak("Did not provide a valid driver");
57             }
58 4 50 33     87 if ( defined $self->file and not defined $self->image ) {
59             # Load the image from a file
60 4         28 $self->{image} = Imager->new;
61 4         102 $self->{image}->read( file => $self->file );
62             }
63 4 50       1180 if ( defined $self->image ) {
64 4 50       47 unless( _INSTANCE($self->image, 'Imager') ) {
65 0         0 Carp::croak("Did not provide a valid image");
66             }
67 4         63 $self->{height} = $self->image->getheight;
68 4         77 $self->{width} = $self->image->getwidth;
69 4         113 $self->{string} = $self->driver->image_string($self->image);
70             }
71 4 50       173 unless ( _POSINT($self->height) ) {
72 0         0 Carp::croak("Invalid or missing image height");
73             }
74 4 50       182 unless ( _POSINT($self->width) ) {
75 0         0 Carp::croak("Invalid or missing image width");
76             }
77              
78 4         43 return $self;
79             }
80              
81              
82              
83              
84              
85             #####################################################################
86             # Search Methods
87              
88             =pod
89              
90             =head2 find
91              
92             The C method compiles the search and target images in memory, and
93             executes a single search, returning the position of the first match as a
94             L object.
95              
96             =cut
97              
98             sub find {
99 3     3 1 1911 my $self = shift;
100 3         28 my $pattern = _INSTANCE(shift, 'Imager::Search::Pattern');
101 3 50       15 unless ( $pattern ) {
102 0         0 die "Did not pass a Pattern object to find";
103             }
104              
105             # Run the search
106 3         8 my @match = ();
107 3         12 my $string = $self->string;
108 3         21 my $regexp = $pattern->regexp( $self );
109 3         3092 while ( scalar $$string =~ /$regexp/g ) {
110 7         25 my $p = $-[0];
111 7         88 push @match, $self->driver->match_object( $self, $pattern, $p );
112 7         3354 pos $$string = $p + 1;
113             }
114              
115 3         22 return @match;
116             }
117              
118             sub find_any {
119 3     3 0 19 my $self = shift;
120 3         25 my $pattern = _INSTANCE(shift, 'Imager::Search::Pattern');
121 3 50       11 unless ( $pattern ) {
122 0         0 die "Did not pass a Pattern object to find";
123             }
124              
125             # Run the search
126 3         12 my $string = $self->string;
127 3         11 my $regexp = $pattern->regexp( $self );
128 3         3452 while ( scalar $$string =~ /$regexp/gs ) {
129 3         10 my $p = $-[0];
130 3 50       28 if ( defined $self->driver->match_object( $self, $pattern, $p ) ) {
131 3         13 return 1;
132             }
133 0           pos $$string = $p + 1;
134             }
135 0           return '';
136             }
137              
138             1;
139              
140             =pod
141              
142             =head1 SUPPORT
143              
144             See the SUPPORT section of the main L module.
145              
146             =head1 AUTHOR
147              
148             Adam Kennedy Eadamk@cpan.orgE
149              
150             =head1 COPYRIGHT
151              
152             Copyright 2007 - 2011 Adam Kennedy.
153              
154             This program is free software; you can redistribute
155             it and/or modify it under the same terms as Perl itself.
156              
157             The full text of the license can be found in the
158             LICENSE file included with this module.
159              
160             =cut