splitAtMatches

#!/usr/bin/env perl -w
#
# splitAtMatches: Put a line break before/after/instead of each regex match.
# 2007-02-02: Written by Steven J. DeRose.
#
use strict;
use Getopt::Long;
use Encode;

our %metadata = (
    "title"        => "splitAtMatches",
    "description"  => "Put a line break at each regex match.",
    "rightsHolder" => "Steven J. DeRose",
    "creator"      => "http://viaf.org/viaf/50334488",
    "type"         => "http://purl.org/dc/dcmitype/Software",
    "language"     => "Perl 5",
    "created"      => "2007-02-02",
    "modified"     => "2022-03-03",
    "publisher"    => "http://github.com/sderose",
    "license"      => "https://creativecommons.org/licenses/by-sa/3.0/"
);
our $VERSION_DATE = $metadata{"modified"};


=pod

=head1 Usage

splitAtMatches [options] [-e 'regex'] [files?]

Insert a line-break (or other separator) before (or after, or both) 
each match of I<regex>. For example:

    splitAtMatches -e '/  [A-Z]/' myFile.txt

puts a line-break before each instance of two spaces followed by an
ASCII capital letter. So the following input:

    That's it.  Pretty simple.  Mostly.

becomes:

    That's it.
      Pretty simple.
      Mostly.

That amounts to a rudimentary sentence-splitter. For a better one, improve
the regex or try the C<--sentences> option.

Other options include:

=over

=item * insert a line-break I<--after> each match (or on I<--both> sides),

=item * I<--replace> each match with something,

=item * I<--insert> additional text before the new line-breaks.

=item * insert an I<--indent> after the new line-breaks, or

=item * add and remove line breaks so there is one sentence per line.

=item * Original line-breaks are kept unless you specify I<--nokeep> or I<--sentence>.

Includes most of the functionality of *nix C<fold>.
Handles character encodings (including knowing about
various kinds of Unicode spaces with I<--spaces>).

=back

For splitting one file into separate files, see I<disaggregate> instead.


=head1 Options

=over

=item * B<--after>

Put breaks I<after> instead of I<before> matches
(see also I<--both>, I<--replace>).
Takes precedence over I<--replace>.

=item * B<--both>

Put breaks both before and after matches (see also I<--replace>, I<--after>).
Takes precedence over I<--replace>.

=item * B<-e> I<regex>

A Perl regex to say what to split before (or after or both).
See also C<--sentences> for better support of sentence-breaking.

=item * B<--iencoding> I<e>

Assume the input is in character set I<e>.
See also I<--listEncodings>.
Unlike some of my scripts, this sets the output encoding too.

=item * B<--indent> I<n>

Indent after inserted newlines, by I<n> spaces (default: 0).
This does I<not> cause existing indentation to be removed, only added.
To remove all existing indentation, set a negative value for this option.

=item * B<--insert> I<string>

Inset I<string> before the line-break.

=item * B<--keep>

Keep original newlines (default: on). If off, spaces are substituted for
those newlines, so words don't join up across lines.

=item * B<--listEncodings>

Show all the encodings supported by I<--iencoding>, and exit.

=item * B<--olineends> I<type>

Write M(ac), D(OS), or default U(nix) breaks.

=item * B<--replace> I<s>

Replace the match with I<s> (possibly empty, and may have \-codes in it)
instead of inserting a line-break before it (see also I<--after>, I<--both>).

=item * B<--quiet> or B<-q>

Suppress most messages.

=item * B<--sentences>

Attempt to rewrite the file to one sentence per line, adding and removing
line-breaks as needed. This is imprecise, and does no fancy analysis.

=item * B<--spaces> or B<-s>

If no space can be found, this leaves a line
wider than the specified I<--width>.
Like *nix C<fold>.

=item * B<--unicode>

Synonym for I<--iencoding utf8>.

=item * B<--verbose> or B<-v>

Add more detailed messages.

=item * B<--version>

Display version info and exit.

=item * B<--width> I<n> or B<-w>

Break so no output line is longer then I<n> columns.
I<n> can be decimal, hex, or octal. See also I<--spaces>. Like C<fold>.

=back


=head1 Known bugs and limitations

If there is already a newline before the match, another is still added
(unless I<--nokeep> is in effect).

Perhaps I<--spaces> should have a way to control what happens if there are
no spaces to be found. Then again, C<fold> doesn't even I<say> what it does.

Does not support the equivalent of C<fold -b> (bytes). You really wouldn't
want to do that with Unicode.

C<--sentences> is simplistic. For example, it only knows a handful of
specific (English) abbreviations.


=head1 To Do

Change I<--keep> to allow setting what character (or none) to replace \n with.

Add --bytes like C<fold>?

Perhaps an option to insert spaces to align the start or end of the match to
a specific column?


=head1 Related commands

=over

=item * C<fold> -- Break lines at certain column width.

=item * C<sed> -- Can insert newlines, but you need to put them into the sed
expression literally, preceded by a backslash. No '\\n', etc.

=item * My C<Tokenizer.py> -- break text into words and other tokens.

=item * My C<disaggregate> -- Break a single I<file> into many I<files> based
on some rule (rather than breaking I<lines>).

=item * My C<globalChange> -- General regex changes on a mess of files.

=back


=head1 History

  2007-02-02: Written by Steven J. DeRose.
  2008-08-12 sjd: Doc.
  2010-06-23 sjd: perldoc.
  2010-10-12 sjd: Cleanup.
  2011-12-13? sjd: Cleanup. Add C<--iencoding>.
  2012-05-01 sjd: Typo. Add C<--listEncodings>. Add :encoding() for binmode.
Add C<--ignoreCase>. Unify STDIN case. Make C<--replace> take replacement text.
Make C<--keep> default to on.
  2012-11-14 sjd: use Encode.
  2013-03-12 sjd: Fix C<--keep>. Add C<--width>, C<--spaces>.
  2014-04-14: Drop default C<--expr>, complain if user doesn't provide one.
  2014-08-31: Cleanup.
  2018-01-23: Add C<--both>.
  2020-09-16: New layout. Add C<--sentences>.
  2020-10-15: Improve help. Support C<--indent -1> to unindent.
  2022-03-03: Add --insert. Tweak --sentences regex.


=head1 Rights

Copyright 2007-02-02 by Steven J. DeRose. This work is licensed under a
Creative Commons Attribution-Share Alike 3.0 Unported License.
For further information on this license, see
L<https://creativecommons.org/licenses/by-sa/3.0>.

For the most recent version, see L<http://www.derose.net/steve/utilities> or
L<https://github.com/sderose>.


=cut


###############################################################################
# Options
#
my $after                = 0;
my $both                 = 0;
my $expr                 = "";
my $iencoding            = "";
my $ignoreCase           = 0;
my $indent               = 0;
my $insert               = "";
my $keepOriginalNewlines = 1;
my $oLineends            = "U";
my $quiet                = 0;
my $replace              = undef;
my $sentences            = 0;
my $spaces               = 0;
my $verbose              = 0;
my $width                = 0;

Getopt::Long::Configure ("ignore_case");
my $result = GetOptions(
    "a|after!"                 => \$after,
    "b|both!"                  => \$both,
    "e=s"                      => \$expr,
    "h|help|?"                 => sub { system "perldoc $0"; exit; },
    "iencoding=s"              => \$iencoding,
    "i|indent=i"               => \$indent,
    "insert=s"                 => \$insert,
    "ignoreCase!"              => \$ignoreCase,
    "listEncodings"    => sub {
        warn "\nEncodings available:\n";
        my $last = ""; my $buf = "";
        for my $k (Encode->encodings(":all")) {
            my $cur = substr($k,0,2);
            if ($cur ne $last) {
                warn "$buf\n";
                $last = $cur; $buf = "";
            }
            $buf .= "$k ";
        }
        warn "$buf\n";
        exit;
    },
    "keep!"                    => \$keepOriginalNewlines,
    "olinends|olineends=s"     => \$oLineends,
    "q|quiet!"                 => \$quiet,
    "r|replace=s"              => \$replace,
    "sentences!"               => \$sentences,
    "s|spaces!"                => \$spaces,
    "unicode"                  => sub { $iencoding = "utf8"; },
    "v|verbose+"               => \$verbose,
    "version"                  => sub {
       die "Version of $VERSION_DATE, by Steven J. DeRose.\n";
    },
    "width=o"                  => \$width,
);

($result) || die "Bad options.\n";

($expr || $sentences) || die
    "Must provide a --expr to split at.\n";

if (defined $replace) {
    ($after) &&	die "Can't have both -a and -r.\n";
    ($verbose) && warn "Replacement text before: '$replace'\n";
    $replace = sjdUtils::unbackslash($replace);
    ($verbose) && warn "Replacement text after:  '$replace'\n";
}

my $newline = "\n";
$oLineends = uc(substr($oLineends."U",0,1));
if    ($oLineends eq "M") { $newline = chr(13);   }
elsif ($oLineends eq "D") { $newline = chr(13).chr(10); }
elsif ($oLineends eq "U") { $newline = chr(10); }
else {
	die "Unknown output line-end type '$oLineends'.\n";
}

if ($iencoding) {
    print "";
    binmode(STDOUT, ":encoding($iencoding)");
}

($verbose) && warn "Expression is /$expr/" . ($ignoreCase ? "i":"") . ".\n";


###############################################################################
# Main
#
my $filenum = 0;
my $recnum  = 0;
my $istring = $insert . $newline;
if ($indent > 0) { $istring .= (" " x $indent); }

if (scalar @ARGV == 0) { # stdin
    push @ARGV, "-";
    (!$quiet && -t STDIN) && warn "Waiting on STDIN...\n";
}

foreach my $f (@ARGV) {
    $filenum++;
    my $fh;
    if (!(open $fh, "<$f")) {
        warn "Cannot open file '$f'\n";
        next;
    }
    if ($iencoding) {
        binmode($fh, ":encoding($iencoding)");
    }
    while (my $rec = readline($fh)) {
        $recnum++;
        chomp $rec;
        if ($sentences) {
            # Consider --, :, and avoiding abbrs. Nice to also deal w/ list nums
            $rec =~ s/(?<!Dr|Mr|Ms|Fr|Sr|Jr|rs|\d)([.:])(\s|$)?/$1\n/g;
            print $rec;  # No newline at end.
            next;
        }
        if ($width && length($rec)>$width) {
            my $buf = "";
            while (length($rec)>$width) {
                my $lenToBreak = $width;
                if (!$spaces) {
                    while ($lenToBreak>0) {
                        (substr($rec,$lenToBreak,1) =~ m/\p{space}/) && last;
                        $lenToBreak--;
                    }
                    if ($lenToBreak<=0) { $lenToBreak = $width; } # No space
                }
                $buf .= substr($rec,0,$lenToBreak) . "\n";
                $rec = substr($rec, $lenToBreak);
            }
            $rec = $buf;
        }
        if ($ignoreCase) {
            if ($both) {
                $rec =~ s/($expr)/$istring$1$istring/gi;
            }
            elsif ($after) {
                $rec =~ s/($expr)/$1$istring/gi;
            }
            elsif (defined $replace) {
                $rec =~ s/($expr)/$replace/gi;
            }
            else {
                $rec =~ s/($expr)/$istring$1/gi;
            }
        }
        else {
            if ($both) {
                $rec =~ s/($expr)/$istring$1$istring/g;
            }
            elsif ($after) {
                $rec =~ s/($expr)/$1$istring/g;
            }
            elsif (defined $replace) {
                $rec =~ s/($expr)/$replace/g;
            }
            else {
                $rec =~ s/($expr)/$istring$1/g;
            }
        }
        if ($indent < 0) {
            $rec =~ s/$newline\s+/$newline/g;
        }
        print $rec . ($keepOriginalNewlines ? $newline:" ");
    }
    close $fh;
} # for @ARGV

($quiet) || warn "splitAtMatches: Done, $filenum files, $recnum records.\n";

exit;