1package Test2::Compare::Pattern; 2use strict; 3use warnings; 4 5use base 'Test2::Compare::Base'; 6 7our $VERSION = '0.000162'; 8 9use Test2::Util::HashBase qw/pattern stringify_got/; 10 11# Overloads '!' for us. 12use Test2::Compare::Negatable; 13 14use Carp qw/croak/; 15 16sub init { 17 my $self = shift; 18 19 croak "'pattern' is a required attribute" unless $self->{+PATTERN}; 20 21 $self->{+STRINGIFY_GOT} ||= 0; 22 23 $self->SUPER::init(); 24} 25 26sub name { shift->{+PATTERN} . "" } 27sub operator { shift->{+NEGATE} ? '!~' : '=~' } 28 29sub verify { 30 my $self = shift; 31 my %params = @_; 32 my ($got, $exists) = @params{qw/got exists/}; 33 34 return 0 unless $exists; 35 return 0 unless defined($got); 36 return 0 if ref $got && !$self->stringify_got; 37 38 return $got !~ $self->{+PATTERN} 39 if $self->{+NEGATE}; 40 41 return $got =~ $self->{+PATTERN}; 42} 43 441; 45 46__END__ 47 48=pod 49 50=encoding UTF-8 51 52=head1 NAME 53 54Test2::Compare::Pattern - Use a pattern to validate values in a deep 55comparison. 56 57=head1 DESCRIPTION 58 59This allows you to use a regex to validate a value in a deep comparison. 60Sometimes a value just needs to look right, it may not need to be exact. An 61example is a memory address that might change from run to run. 62 63=head1 SOURCE 64 65The source code repository for Test2-Suite can be found at 66F<https://github.com/Test-More/Test2-Suite/>. 67 68=head1 MAINTAINERS 69 70=over 4 71 72=item Chad Granum E<lt>exodist@cpan.orgE<gt> 73 74=back 75 76=head1 AUTHORS 77 78=over 4 79 80=item Chad Granum E<lt>exodist@cpan.orgE<gt> 81 82=back 83 84=head1 COPYRIGHT 85 86Copyright 2018 Chad Granum E<lt>exodist@cpan.orgE<gt>. 87 88This program is free software; you can redistribute it and/or 89modify it under the same terms as Perl itself. 90 91See F<http://dev.perl.org/licenses/> 92 93=cut 94