File Coverage

blib/lib/Selenium/Screenshot.pm
Criterion Covered Total %
statement 42 140 30.0
branch 2 28 7.1
condition 2 30 6.6
subroutine 11 25 44.0
pod 7 7 100.0
total 64 230 27.8


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