xref: /openbsd-src/gnu/usr.bin/perl/cpan/Test2-Suite/lib/Test2/Compare/Pattern.pm (revision 3d61058aa5c692477b6d18acfbbdb653a9930ff9)
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