view release on metacpan or  search on metacpan

lib/Text/Lossy.pm  view on Meta::CPAN

Adding filters to the object after calling C<as_coderef> will also change
the behaviour of the code reference.

=cut

sub as_coderef {
    my ($self) = @_;
    return sub {
        return $self->process(@_);
    }
}

=head1 FILTERS

The following filters are defined by this module. Other modules may define
more filters.
Each of these filters can be added to the set via the L</add> method.

=head2 lower

Corresponds exactly to the L<lc|perlfun/lc> builtin in Perl, up
to and including its Unicode handling.

=cut

sub lower {
    my ($text) = @_;
    return lc($text);
}

=head2 whitespace

Collapses any whitespace (C<\s> in regular expressions) to a single space, C<U+0020>.
Whitespace at the beginning of the text is stripped completely. Whitespace at the end
is also collapsed to a single space, to help separate lines. Text consisting only
of whitespace results in an empty string.

=cut

sub whitespace {
    my ($text) = @_;
    $text =~ s{ \s+ }{ }xmsg;
    # the above line also works for the end of the text
    $text =~ s{ \A \s+ }{}xms;
    return $text;
}

=head2 whitespace_nl

A variant of the L</whitespace> filter that leaves newlines on the end of the text
alone. Other whitespace at the end will get collapsed into a single newline.
If the text ends in whitespace that does not contain a new line, it is replaced
by a space, as before.

This filter is most useful if you are creating a Unix-style text filter, and do not
want to buffer the entire input before writing the (only) line to C<stdout>. The
newline at the end will allow downstream processes to work on new lines, too.
Otherwise, this filter is not quite as efficient as the L<whitespace> filter.

Any newlines in the middle of text are collapsed to a space, too. This is especially
useful if you are reading in "paragraph mode", e.g. C<$/ = ''>, as you will get
one long line per former paragraph.

=cut

sub whitespace_nl {
    my ($text) = @_;
    # Remember whether a newline was present
    my $has_nl = ($text =~ m{ \n \s* \z }xms) ? 1 : 0;
    $text =~ s{ \s+ }{ }xmsg;
    $text =~ s{ \A \s+ }{}xms;
    # whitespace-at-end is now a space
    if ($has_nl) {
        # replace this space with a newline
        $text =~ s{ \s+ \z }{\n}xms;
    }
    return $text;
}

=head2 punctuation

Strips punctuation, that is anything matching C<\p{Punctuation}>. It is replaced by
nothing, removing it completely.

=cut

sub punctuation {
    my ($text) = @_;
    # Turns out '\p{Punctuation}' fails on Perl 5.6, use the abbreviation '\pP' instead
    $text =~ s{ \pP }{}xmsg;
    return $text;
}

=head2 punctuation_sp

A variant of L</punctuation> that replaces punctuation with a space character, C<U+0020>,
instead of removing it completely. This is usually less efficient for compression, but
retains more readability, for example in the presence of URLs or email addresses.

=cut

sub punctuation_sp {
    my ($text) = @_;
    # Turns out '\p{Punctuation}' fails on Perl 5.6, use the abbreviation '\pP' instead
    $text =~ s{ \pP }{ }xmsg;
    return $text;
}

=head2 alphabetize

Leaves the first and last letters of a word alone, but replaces the interior letters with
the same set, sorted by the L<sort|perlfun/sort> function. This is done on the observation
(source uncertain at the time) that words can still be made out if the letters are present, but
in a different order, as long as the outer ones remain the same.

This filter may not work as proposed with every language or writing system. Specifically, it
uses end-of-word matches C<\b> to determine which letters to leave alone.

=cut

sub alphabetize {