File Coverage

blib/lib/Selenium/Screenshot.pm
Criterion Covered Total %
statement 42 137 30.6
branch 2 30 6.6
condition 2 30 6.6
subroutine 11 23 47.8
pod 7 7 100.0
total 64 227 28.1


line stmt bran cond sub pod time code
1             package Selenium::Screenshot;
2             $Selenium::Screenshot::VERSION = '0.06';
3             # ABSTRACT: Compare and contrast Webdriver screenshots in PNG format
4 1     1   1311 use Moo;
  1         11445  
  1         6  
5 1     1   1782 use Image::Compare;
  1         51775  
  1         64  
6 1     1   11 use Imager qw/:handy/;
  1         1  
  1         12  
7 1     1   176 use Imager::Color;
  1         1  
  1         21  
8 1     1   4 use Imager::Fountain;
  1         2  
  1         21  
9 1     1   4 use Carp qw/croak carp confess/;
  1         2  
  1         55  
10 1     1   3 use Cwd qw/abs_path/;
  1         2  
  1         44  
11 1     1   4 use MIME::Base64;
  1         2  
  1         45  
12 1     1   5 use Scalar::Util qw/blessed/;
  1         0  
  1         1575  
13              
14              
15             has png => (
16             is => 'rwp',
17             lazy => 1,
18             coerce => sub {
19             my ($png_or_image) = @_;
20              
21             # We are prepared to handle an Imager object, or a base64
22             # encoded png.
23             if ( blessed( $png_or_image ) && $png_or_image->isa('Imager')) {
24             return $png_or_image;
25             }
26             else {
27             my $data = decode_base64($png_or_image);
28             my $image = Imager->new(data => $data);
29              
30             if (! $image && Imager->errstr) {
31             confess "you must provide a base64 encoded png. We were not able to create an Imager object after base64 decoding your input; Imager's error message was:\n\n" . Imager->errstr;
32             }
33             else {
34             return $image;
35             }
36             }
37             },
38             required => 1
39             );
40              
41              
42             has exclude => (
43             is => 'ro',
44             lazy => 1,
45             default => sub { [ ] },
46             coerce => sub {
47             my ($exclude) = @_;
48              
49             foreach my $rect (@{ $exclude }) {
50             croak 'Each exclude region must have size and location keys.'
51             unless exists $rect->{size} && exists $rect->{location};
52             }
53              
54             return $exclude;
55             },
56             predicate => 1
57             );
58              
59              
60             has target => (
61             is => 'ro',
62             lazy => 1,
63             default => sub { {} },
64             coerce => sub {
65             my ($rect) = @_;
66              
67             croak 'Each exclude region must have size and location keys.'
68             unless exists $rect->{size} && exists $rect->{location};
69              
70             return $rect;
71             },
72             predicate => 1
73             );
74              
75              
76             # TODO: add threshold tests
77             # TODO: provide reference images
78              
79             has threshold => (
80             is => 'ro',
81             lazy => 1,
82             coerce => sub {
83             my ($threshold) = @_;
84              
85             my $scaling = 255 * sqrt(3) / 100;
86             return $threshold * $scaling;
87             },
88             default => sub { 5 }
89             );
90              
91              
92             has folder => (
93             is => 'rw',
94             coerce => sub {
95             my ($folder) = @_;
96             $folder //= 'screenshots/';
97             mkdir $folder unless -d $folder;
98              
99             return abs_path($folder) . '/';
100             },
101             default => sub { 'screenshots/' }
102             );
103              
104              
105             has metadata => (
106             is => 'ro',
107             lazy => 1,
108             default => sub { {} },
109             predicate => 'has_metadata'
110             );
111              
112             has _cmp => (
113             is => 'ro',
114             lazy => 1,
115             init_arg => undef,
116             builder => sub {
117 0     0   0 my ($self) = @_;
118 0         0 my $cmp = Image::Compare->new;
119              
120 0 0       0 if ($self->has_target) {
121 0         0 my $png = $self->_img_target($self->png);
122 0         0 $self->_set_png($png);
123             }
124              
125 0 0       0 if ($self->has_exclude) {
126 0         0 my $png = $self->_img_exclude($self->png);
127 0         0 $self->_set_png($png);
128             }
129              
130             $cmp->set_image1(
131 0         0 img => $self->png,
132             type => 'png'
133             );
134              
135 0         0 return $cmp;
136             }
137             );
138              
139             with 'Selenium::Screenshot::CanPad';
140              
141              
142             sub compare {
143 0     0 1 0 my ($self, $opponent) = @_;
144 0         0 $opponent = $self->_set_opponent($opponent);
145              
146 0 0       0 if (not defined $opponent) {
147 0         0 carp 'No reference was provided or found, so no comparison was done. We\'ve saved a reference at ' . $self->reference;
148 0         0 return $self->save_reference;
149             }
150             else {
151 0         0 $self->_cmp->set_method(
152             method => &Image::Compare::AVG_THRESHOLD,
153             args => {
154             type => &Image::Compare::AVG_THRESHOLD::MEAN,
155             value => $self->threshold,
156             }
157             );
158              
159 0         0 return $self->_cmp->compare;
160             }
161             }
162              
163              
164             sub difference {
165 0     0 1 0 my ($self, $opponent) = @_;
166 0         0 $opponent = $self->_set_opponent($opponent);
167              
168             # We want to range from transparent (no difference) to fuschia at
169             # 100% change.
170 0         0 my $white = Imager::Color->new(255, 255, 255);
171 0         0 my $fuschia = Imager::Color->new(240, 18, 190);
172 0         0 my $scale = Imager::Fountain->simple(
173             positions => [ 0.0, 1.0 ],
174             colors => [ $white, $fuschia ]
175             );
176              
177 0         0 $self->_cmp->set_method(
178             method => &Image::Compare::IMAGE,
179             args => $scale
180             );
181              
182             # Do the actual pixel by pixel comparison. This can take a while.
183 0         0 my $diff = $self->_cmp->compare;
184              
185             # Post processing to overlay the difference onto the
186             # opponent. First, subtract a white box from our difference image;
187             # to make everything white transparent instead.
188 0         0 my $work = Imager->new(
189             xsize => $diff->getwidth,
190             ysize => $diff->getheight,
191             channels => $diff->getchannels
192             );
193 0         0 $work->box(filled => 1, color => $white );
194 0         0 $diff = $work->difference(other => $diff);
195              
196             # Place the transparent diff image on top of our opponent -
197             # anything changed will show up on top of the opponent image in
198             # varying degrees of pink.
199 0         0 $opponent->compose(src => $diff);
200              
201 0         0 my $name = $self->_diff_filename;
202 0         0 $opponent->write(file => $name);
203              
204 0         0 return $name;
205             }
206              
207              
208             sub find_opponent {
209 0     0 1 0 my ($self) = @_;
210              
211 0         0 my $default_reference = $self->reference;
212 0 0       0 if (-e $default_reference) {
213 0         0 return Imager->new(file => $default_reference);
214             }
215             }
216              
217             sub _diff_filename {
218 0     0   0 my ($self) = @_;
219              
220 0         0 my $diff = $self->filename;
221 0         0 $diff =~ s/\.png$/-diff.png/;
222              
223 0         0 return $diff;
224             }
225              
226             sub _set_opponent {
227 0     0   0 my ($self, $opponent) = @_;
228 0   0     0 $opponent //= $self->find_opponent;
229              
230             # No opponent was provided, and we can't find one.
231 0 0       0 return unless $opponent;
232              
233 0         0 $opponent = $self->_extract_image( $opponent );
234              
235             # Before setting this $opponent as our image2, we must ensure that
236             # our $self->png image and this $opponent are the same size.
237 0 0       0 if (! $self->cmp_image_dims( $self->png, $opponent )) {
238 0         0 my ($new_png, $new_opp) = $self->coerce_image_size( $self->png, $opponent );
239 0         0 $self->_set_png( $new_png );
240 0         0 $opponent = $new_opp;
241             }
242              
243 0 0       0 $opponent = $self->_img_target( $opponent ) if $self->has_target;
244 0 0       0 $opponent = $self->_img_exclude( $opponent ) if $self->has_exclude;
245              
246 0         0 $self->_cmp->set_image2( img => $opponent );
247              
248 0         0 return $opponent;
249             }
250              
251              
252             sub filename {
253 3     3 1 36 my ($self, %overrides) = @_;
254              
255 3         4 my @filename_parts;
256 3 100 66     16 if ($self->has_metadata or %overrides) {
257             my $metadata = {
258 2         3 %{ $self->metadata},
  2         21  
259             %overrides
260             };
261              
262 2         402 foreach (sort keys %{ $metadata }) {
  2         7  
263 2         6 push @filename_parts, $self->_sanitize_string($metadata->{$_});
264             }
265             }
266             else {
267 1         21 push @filename_parts, time
268             }
269              
270 3         38 my $filename = $self->folder . join('-', @filename_parts) . '.png';
271 3         478 $filename =~ s/\-+/-/g;
272 3         10 return $filename;
273             }
274              
275              
276             sub reference {
277 0     0 1 0 my ($self) = @_;
278              
279 0         0 my $default_reference = $self->filename;
280 0         0 $default_reference =~ s/\.png$/-reference.png/;
281              
282 0         0 return $default_reference;
283             }
284              
285              
286             sub save {
287 0     0 1 0 my ($self, %overrides) = @_;
288              
289 0         0 my $png = $self->png;
290 0         0 my $filename = $self->filename(%overrides);
291 0         0 $png->write(file => $filename);
292              
293 0         0 return $filename;
294             }
295              
296              
297             sub save_reference {
298 0     0 1 0 my ($self) = @_;
299              
300 0         0 my $png = $self->png;
301 0         0 $png->write(file => $self->reference);
302              
303 0         0 return $self->reference;
304             }
305              
306             sub _img_exclude {
307 0     0   0 my ($self, $img, $exclude) = @_;
308 0   0     0 $exclude //= $self->exclude;
309              
310 0         0 my $copy = $img->copy;
311              
312 0         0 foreach my $rect (@{ $exclude }) {
  0         0  
313 0         0 my ($size, $loc) = ($rect->{size}, $rect->{location});
314              
315             # skip items that don't have the valid keys
316 0 0 0     0 unless (exists $loc->{x}
      0        
      0        
317             && exists $loc->{y}
318             && exists $size->{width}
319             && exists $size->{height}) {
320 0         0 next;
321             }
322              
323             my $top_left = {
324             x => $loc->{x},
325             y => $loc->{y}
326 0         0 };
327              
328             my $bottom_right = {
329             x => $loc->{x} + $size->{width},
330             y => $loc->{y} + $size->{height}
331 0         0 };
332              
333             $copy->box(
334             xmin => $top_left->{x},
335             ymin => $top_left->{y},
336             xmax => $bottom_right->{x},
337             ymax => $bottom_right->{y},
338 0         0 filled => 1,
339             color => 'black'
340             );
341             }
342              
343 0         0 return $copy;
344             }
345              
346             sub _img_target {
347 0     0   0 my ($self, $img, $target) = @_;
348 0   0     0 $target //= $self->target;
349              
350 0         0 my ($size, $loc) = ($target->{size}, $target->{location});
351              
352 0 0 0     0 unless (exists $loc->{x}
      0        
      0        
353             && exists $loc->{y}
354             && exists $size->{width}
355             && exists $size->{height}) {
356 0         0 next;
357             }
358              
359 0         0 my $left = $loc->{x};
360 0         0 my $top = $loc->{y};
361 0         0 my $right = $left + $size->{width};
362 0         0 my $bottom = $top + $size->{height};
363              
364             # copy returns the cropped image, unlike box
365 0         0 return $img->crop(
366             left => $left,
367             top => $top,
368             right => $right,
369             bottom => $bottom
370             );
371             }
372              
373             sub _sanitize_string {
374 2     2   3 my ($self, $dirty_string) = @_;
375              
376 2         5 $dirty_string =~ s/[^A-z0-9\.\-]/-/g;
377 2         5 return $dirty_string;
378             }
379              
380             sub _extract_image {
381 0     0     my ($self, $file_or_image) = @_;
382              
383 0           my $err_msg = 'We were expecting one of: a filename, Imager object, or Selenium::Screenshot object';
384 0 0         croak $err_msg unless defined $file_or_image;
385              
386 0 0         if ( blessed( $file_or_image ) ) {
387 0 0         if ($file_or_image->isa('Selenium::Screenshot')) {
    0          
388 0           return $file_or_image->png;
389             }
390             elsif ($file_or_image->isa('Imager')) {
391 0           return $file_or_image;
392             }
393             else {
394 0           croak $err_msg;
395             }
396             }
397             else {
398 0           return Imager->new(file => $file_or_image);
399             }
400             }
401              
402              
403             1;
404              
405             __END__