view release on metacpan or  search on metacpan

lib/App/news.pm  view on Meta::CPAN

# Copyright (C) 2023  Alex Schroeder <alex@gnu.org>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.

package App::news;

use Modern::Perl '2018';

require Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(wrap html_unwrap ranges sranges);

our $VERSION = 1.09;

=head1 NAME

App::news - a web front-end for a news server

=head1 DESCRIPTION

This is a collection of functions for F<script/news>, which see.

    use App::news qw(wrap);
    $body = wrap($body);

B<wrap> does text wrapping appropriate for plain text message bodies as used in
mail and news articles.

If a line is shorter than 50 characters, it is not wrapped.

Lines are wrapped to be 72 characters or shorter.

Quotes are handled as long as only ">" is used for quoting.

B<ranges> translates a list of message numbers into an array of numbers or
arrays suitable for XOVER.

B<sranges> translates the output of I<ranges> into a string for humans to read,
i.e. "1-2,4".

=head1 AUTHOR

Alex Schroeder

=head1 LICENSE

GNU Affero General Public License

=cut

# Some US-ASCII coded characters 00-1F and 7F hexadecimal are excluded; the
# space character and all whitespace is excluded; angle-bracket "<" and ">" and
# double-quote (") characters are excluded; and the "unwise" characters are
# excluded. This regular expression is case-sensitive, so the scheme most be
# lower-case!
my $iri_re = qr((\b[a-z]+:[^\x00-\x1F\x7F[:space:]<>"{}|\\^\[\]`]+));

sub wrap {
  my @lines = split(/\n/, shift);
  my @result;
  my $min = 50;
  my $max = 72;
  my $buffer;
  my $prefix = '';
  for (@lines) {
    my ($new_prefix) = /^([> ]*)/;
    my $no_wrap = (/^$prefix\s*$/ or length() < $min);