File: Regex.pm

package info (click to toggle)
libcatmandu-perl 1.2024-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 3,552 kB
  • sloc: perl: 17,037; makefile: 24; sh: 1
file content (66 lines) | stat: -rw-r--r-- 1,070 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
package Catmandu::Util::Regex;

use Catmandu::Sane;

our $VERSION = '1.2024';

use Exporter qw(import);

our @EXPORT_OK = qw(
    escape_regex
    as_regex
    substituter
);

our %EXPORT_TAGS = (all => \@EXPORT_OK,);

sub _escape_regex {
    my ($str) = @_;
    $str =~ s/\//\\\//g;
    $str =~ s/\\$/\\\\/;    # pattern can't end with an escape
    $str;
}

sub as_regex {
    my ($str) = @_;
    $str = _escape_regex($str);
    qr/$str/;
}

sub substituter {
    my ($search, $replace) = @_;
    $search  = as_regex($search);
    $replace = _escape_regex($replace);
    eval
        qq|sub {my \$str = \$_[0]; utf8::upgrade(\$str); \$str =~ s/$search/$replace/g; \$str}|;
}

1;

__END__

=pod

=head1 NAME

Catmandu::Util::Regex - Regex related utility functions

=head1 FUNCTIONS

=over 4

=item as_regex($str)

Escapes and quotes the given string as a regex.

=item substituter($search, $replace)

Builds a function that performs a regex substitution.

    my $ltrimmer = substituter('^[\h\v]+', '');
    $ltrimmer->("        eek! ");
    # => "eek! "

=back

=cut