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

package Selenium::Screenshot;
$Selenium::Screenshot::VERSION = '0.08';
# ABSTRACT: Compare and contrast Webdriver screenshots in PNG format
use Moo;
use Image::Compare;
use Imager qw/:handy/;
use Imager::Color;
use Imager::Fountain;
use Carp qw/croak carp confess/;
use Cwd qw/abs_path/;
use MIME::Base64;
use Scalar::Util qw/blessed/;


has png => (
    is => 'rwp',
    lazy => 1,
    coerce => sub {
        my ($png_or_image) = @_;

        # We are prepared to handle an Imager object, or a base64
        # encoded png.
        if ( blessed( $png_or_image ) && $png_or_image->isa('Imager')) {
            return $png_or_image;
        }
        else {
            my $data = decode_base64($png_or_image);
            my $image = Imager->new(data => $data);

            if (! $image && Imager->errstr) {
                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;
            }
            else {
                return $image;
            }
        }
    },
    required => 1
);


has exclude => (
    is => 'ro',
    lazy => 1,
    default => sub { [ ] },
    coerce => sub {
        my ($exclude) = @_;

        foreach my $rect (@{ $exclude }) {
            croak 'Each exclude region must have size and location.'
              unless exists $rect->{size} && exists $rect->{location};
        }

        return $exclude;
    },
    predicate => 1
);


# TODO: add threshold tests
# TODO: provide reference images

has threshold => (
    is => 'ro',
    lazy => 1,
    coerce => sub {
        my ($threshold) = @_;

        my $scaling = 255 * sqrt(3) / 100;
        return $threshold * $scaling;
    },
    default => sub { 5 }
);


has folder => (
    is => 'rw',
    coerce => sub {
        my ($folder) = @_;
        $folder //= 'screenshots/';
        mkdir $folder unless -d $folder;

        return abs_path($folder) . '/';
    },
    default => sub { 'screenshots/' }
);


has metadata => (
    is => 'ro',
    lazy => 1,
    default => sub { {} },
    predicate => 'has_metadata'
);

has _cmp => (
    is => 'ro',
    lazy => 1,
    init_arg => undef,
    builder => sub {
        my ($self) = @_;
        my $cmp = Image::Compare->new;


        if ($self->has_exclude) {
            my $png = $self->_img_exclude($self->png);
            $self->_set_png($png);
        }

        $cmp->set_image1(
            img => $self->png,
            type => 'png'
        );

        return $cmp;
    }
);

with 'Selenium::Screenshot::CanPad';


around BUILDARGS => sub {
    my ($orig, $self, %args) = @_;

    if ($args{target} && $self->_coerce_target($args{target})) {
        my $cropped_png = $self->_crop_to_target($args{png}, $args{target});
        return $self->$orig(%args, png => $cropped_png);
    }
    else {
        return $self->$orig(%args);
    }
};


sub compare {
    my ($self, $opponent) = @_;
    $opponent = $self->_set_opponent($opponent);

    if (not defined $opponent) {
        carp 'No reference was provided or found, so no comparison was done. We\'ve saved a reference at ' . $self->reference;
        return $self->save_reference;
    }
    else {
        $self->_cmp->set_method(
            method => &Image::Compare::AVG_THRESHOLD,
            args   => {
                type  => &Image::Compare::AVG_THRESHOLD::MEAN,
                value => $self->threshold,
            }
        );

        return $self->_cmp->compare;
    }
}


sub difference {
    my ($self, $opponent) = @_;
    $opponent = $self->_set_opponent($opponent);

    # We want to range from transparent (no difference) to fuschia at
    # 100% change.
    my $white = Imager::Color->new(255, 255, 255);
    my $fuschia = Imager::Color->new(240,  18, 190);
    my $scale = Imager::Fountain->simple(
        positions => [    0.0,      1.0 ],
        colors    => [ $white, $fuschia ]
    );

    $self->_cmp->set_method(
        method => &Image::Compare::IMAGE,
        args => $scale
    );

    # Do the actual pixel by pixel comparison. This can take a while.
    my $diff = $self->_cmp->compare;

    # Post processing to overlay the difference onto the
    # opponent. First, subtract a white box from our difference image;
    # to make everything white transparent instead.
    my $work = Imager->new(
        xsize    => $diff->getwidth,
        ysize    => $diff->getheight,
        channels => $diff->getchannels
    );
    $work->box(filled => 1, color => $white );
    $diff = $work->difference(other => $diff);

    # Place the transparent diff image on top of our opponent -
    # anything changed will show up on top of the opponent image in
    # varying degrees of pink.
    $opponent->compose(src => $diff);

    my $name = $self->_diff_filename;
    $opponent->write(file => $name);

    return $name;
}


sub find_opponent {
    my ($self) = @_;

    my $default_reference = $self->reference;
    if (-e $default_reference) {
        return Imager->new(file => $default_reference);
    }
}

sub _diff_filename {
    my ($self) = @_;

    my $diff = $self->filename;
    $diff =~ s/\.png$/-diff.png/;

    return $diff;
}

sub _set_opponent {
    my ($self, $opponent) = @_;
    $opponent //= $self->find_opponent;

    # No opponent was provided, and we can't find one.
    return unless $opponent;

    $opponent = $self->_extract_image( $opponent );

    # Before setting this $opponent as our image2, we must ensure that
    # our $self->png image and this $opponent are the same size.
    if (! $self->cmp_image_dims( $self->png, $opponent )) {
        my ($new_png, $new_opp) = $self->coerce_image_size( $self->png, $opponent );
        $self->_set_png( $new_png );
        $opponent = $new_opp;
    }

    $opponent = $self->_img_exclude( $opponent ) if $self->has_exclude;

    $self->_cmp->set_image2( img => $opponent );

    return $opponent;
}


sub filename {
    my ($self, %overrides) = @_;

    my @filename_parts;
    if ($self->has_metadata or %overrides) {
        my $metadata = {
            %{ $self->metadata},
            %overrides
        };

        foreach (sort keys %{ $metadata }) {
            push @filename_parts, $self->_sanitize_string($metadata->{$_});
        }
    }
    else {
        push @filename_parts, time
    }

    my $filename = $self->folder . join('-', @filename_parts) . '.png';
    $filename =~ s/\-+/-/g;
    return $filename;
}


sub reference {
    my ($self) = @_;

    my $default_reference = $self->filename;
    $default_reference =~ s/\.png$/-reference.png/;

    return $default_reference;
}


sub save {
    my ($self, %overrides) = @_;

    my $png = $self->png;
    my $filename =  $self->filename(%overrides);
    $png->write(file => $filename);

    return $filename;
}


sub save_reference {
    my ($self) = @_;

    my $png = $self->png;
    $png->write(file => $self->reference);

    return $self->reference;
}

sub _img_exclude {
    my ($self, $img, $exclude) = @_;
    $exclude //= $self->exclude;

    my $copy = $img->copy;

    foreach my $rect (@{ $exclude }) {
        my ($size, $loc) = ($rect->{size}, $rect->{location});

        # skip items that don't have the valid keys
        unless (exists $loc->{x}
                && exists $loc->{y}
                && exists $size->{width}
                && exists $size->{height}) {
            next;
        }

        my $top_left = {
            x => $loc->{x},
            y => $loc->{y}
        };

        my $bottom_right = {
            x => $loc->{x} + $size->{width},
            y => $loc->{y} + $size->{height}
        };

        $copy->box(
            xmin => $top_left->{x},
            ymin => $top_left->{y},
            xmax => $bottom_right->{x},
            ymax => $bottom_right->{y},
            filled => 1,
            color => 'black'
        );
    }

    return $copy;
}

sub _crop_to_target {
    my ($self, $img, $target) = @_;
    $img = $self->_extract_image( $img );

    my ($size, $loc) = ($target->{size}, $target->{location});

    my $left = $loc->{x};
    my $top = $loc->{y};
    my $right = $left + $size->{width};
    my $bottom = $top + $size->{height};

    # copy returns the cropped image, unlike box
    return $img->crop(
        left => $left,
        top => $top,
        right => $right,
        bottom => $bottom
    );
}

sub _img_target {
    my ($self) = shift;
    return $self->_crop_to_target( @_ );
}

sub _coerce_target {
    my ($self, $target) = @_;
    my ($size, $loc) = ($target->{size}, $target->{location});

    unless (exists $loc->{x}
            && exists $loc->{y}
            && exists $size->{width}
            && exists $size->{height}) {
        croak 'Target is of incorrect format';
    }

    return 1;
}

sub _sanitize_string {
    my ($self, $dirty_string) = @_;

    $dirty_string =~ s/[^A-z0-9\.\-]/-/g;
    return $dirty_string;
}

sub _extract_image {
    my ($self, $file_or_image) = @_;

    my $err_msg = 'We were expecting one of: a filename, Imager object, or Selenium::Screenshot object';
    croak $err_msg unless defined $file_or_image;

    if ( blessed( $file_or_image ) ) {
        if ($file_or_image->isa('Selenium::Screenshot')) {
            return $file_or_image->png;
        }
        elsif ($file_or_image->isa('Imager')) {
            return $file_or_image;
        }
        else {
            croak $err_msg;
        }
    }
    else {
        if ($file_or_image !~ /\n/ && -e $file_or_image) {
            return Imager->new(file => $file_or_image);
        }
        else {
            return Imager->new(data => decode_base64($file_or_image));
        }

    }
}


1;

__END__