dropLineBreaks

#!/usr/bin/env perl -w
#
# droplinebreaks: remove newlines before/after lines containing regex.
# 2006-12-13: Written by Steven J. DeRose.
#
use strict;
use Getopt::Long;

our %metadata = (
    'title'        => "droplinebreaks",
    'rightsHolder' => "Steven J. DeRose",
    'creator'      => "http://viaf.org/viaf/50334488",
    'type'         => "http://purl.org/dc/dcmitype/Software",
    'language'     => "Perl 5",
    'created'      => "2006-12-13",
    'modified'     => "2024-06-22",
    'publisher'    => "http://github.com/sderose",
    'license'      => "https://creativecommons.org/licenses/by-sa/3.0/"
);
our $VERSION_DATE = $metadata{'modified'};

=pod

=head1 Usage

droplinebreak [options] -e 'regex' [files]

Delete the linebreak at the end
of lines that match the (Perl-style) regex.

By default, the linebreak is replaced by a single space (but see I<--r>).
If no regex is specified, all input lines are considered to match.

At option, can delete/replace the line break before rather than at the end of
matched lines, or both.

The line need not match in its entirety -- use ^ and \\$ if you want that.


=head1 Options

=over

=item * B<-b> OR B<--both>

Drop line-ends both preceding *and* following each matched line.

=item * B<-e> [regex]

The regular expression to match against. If omitted, all lines match.

=item * B<-f> OR B<--following>

Drop line-end following each matched line (the default).

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

Assume the input data is in this character encoding. Default: "utf-8".
See also I<--listEncodings>.

=item * B<--ignoreCase> OR B<-i>

Ignore case distinctions for regex matching.

=item * B<--linends> I<t>

Output M (mac), D (dos), or U (*nix default) line-ends.

=item * B<--listEncodings>

Display a list of all available character encodings, and exit.

=item * B<--rstrip>

When dropping a line break, also drop leading whitespace.

=item * B<-p> OR B<--preceding>

Drop line-end preceding each matched line.

=item * B<--quiet> OR B<-q>
Suppress most messages.

=item * B<--rstrip>

When dropping a line break, also drop trailing whitespace.

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

Put in this string in place of the dropped line breaks.

=item * B<--strip>

Shorthand for I<--lstrip> I<--rstrip>.

=item * B<--version>

Display version info and exit.

=back


=head1 Related commands

My C<splitAtMatches>, C<joinAt>, C<wrap>.


=head1 Known bugs and limitations

The I<-r> option is not fully tested.


=head1 To do

Option to *replace* the linebreaks instead of just dropping them,
such as to put in a field-delimiter.

Rename --lineends to --outlineends, support input lineend types.


=head1 History

    2006-12-13: Written by Steven J. DeRose.
    2008-08-31 sjd: BSD.
    2011-10-04 sjd: Fix ARGV to _ in GetOpt.
    2024-06-22: Update layout, metadata. Let regex default.
Add --iencoding, --ignoreCase.
    2024-07-01: Support file-list, not just STDIN. Default -r to ' '. stripping.
Add "Waiting STDIN" message. Add long option synonyms. Move arg to -e.


=head1 Ownership

Copyright 2006-12-13 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<http://creativecommons.org/licenses/by-sa/3.0/>.

For the most recent version, see L<http://www.derose.net/steve/utilities/>.

=cut


###############################################################################
# Options
#
my $expr          = "";
my $dropPreceding = 0;
my $dropFollowing = 1;
my $iencoding     = "utf-8";
my $ignoreCase    = 0;
my $lineends      = "U";
my $lstrip        = 0;
my $quiet         = 0;
my $replace       = " ";
my $rstrip        = 0;
my $verbose       = 0;

Getopt::Long::Configure ("ignore_case");
my $result = GetOptions(
    "b|both!"        => sub { $dropPreceding = 1; $dropFollowing = 1; },
    "e|expression=s" => \$expr,
    "f|following!"   => sub { $dropPreceding = 0; $dropFollowing = 1; },
    "p|preceding!"   => sub { $dropPreceding = 1; $dropFollowing = 0; },
    "iencoding=s"    => \$iencoding,
    "ignoreCase|i!"  => \$ignoreCase,
    "linends=s"      => sub { $lineends = uc(substr($_[1]."U",0,1)); },
    "h|help|?"       => sub { system "perldoc $0"; exit; },
    "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;
    },
    "lstrip!"        => \$lstrip,
    "q|quiet!"       => \$quiet,
    "replace=s"      => \$replace,
    "rstrip!"        => \$rstrip,
    "strip"          => sub { $lstrip = $rstrip = 1; },
    "v|verbose+"     => \$verbose,
    "version"        => sub {
        die "Version of $VERSION_DATE, by Steven J. DeRose.\n";
    }
);
($result) || die "Bad options.\n";

if ($iencoding ne "") {
    print "";
    binmode(STDOUT, ":encoding($iencoding)");
}
$lineends = substr($lineends."U",0,1);
(index("MDU",$lineends) >= 0) ||
    die "Unknown line-end type $lineends.\n";

if ($verbose) {
    warn "Matching against: /$expr/\n";
    warn "Dropping:  preceding $dropPreceding, following $dropFollowing.\n";
}

my $recnum = 0;
my $pendingBreak = 0; # No pending line-break from prior line.
if ( scalar @ARGV == 0 ) {
    (-t STDIN) && (!$quiet) && warn("Waiting on STDIN...\n");
    open my $fh, "<&STDIN";
    binmode($fh, ":encoding($iencoding)");
    doOneFile($fh);
}
else {
    foreach my $file (@ARGV) {
        if (! -e "$file") {
            warn "File not found: $file.\n";
            next;
        }
        open my $fh, "<$file";
        binmode($fh, ":encoding($iencoding)");
        $pendingBreak = 0; # No pending line-break from prior line.
        doOneFile($fh);
        if ($pendingBreak) { printBreak(); }
        close $fh;
    }
}
($quiet) || warn "Total input records: $recnum.\n";

exit;


###############################################################################
#
sub doOneFile {
    my ($fh) = @_;

    my $itMatches = 1;
    while (my $rec = <$fh>) {
        chomp($rec);
        $recnum++;
        if ($expr) {
            if ($ignoreCase) { $itMatches = ( $rec =~ m/$expr/i); }
            else { $itMatches = ( $rec =~ m/$expr/); }
        }
        if (!$itMatches) {
            print($rec);
        }
        else {
            ($verbose) && warn "Matches (pending lb from prior: $pendingBreak)\n";
            handlePreceding();
            if ($lstrip) { $rec =~ s/^\s+//; }  # TODO Maybe only w/ dropPreceding?
            if ($rstrip) { $rec =~ s/\s+$//; }
            print $rec;
            handleFollowing();
        }
    } # while not EOF
}

sub handlePreceding {
    if ($pendingBreak) { printBreak(); $pendingBreak = 0; }
    if ($dropPreceding) {
        if ($replace) { print "$replace"; }
    }
    elsif ($pendingBreak) {
        ($verbose) && print "¶";
        printBreak();
        $pendingBreak = 0;
    }
}

sub handleFollowing {
    if ($dropFollowing) {
        $pendingBreak = 0; # Definitely drop this trailing one
        if ($replace) { print "$replace"; }
    }
    else {
        ($verbose) && print "⁋";
        $pendingBreak = 1; # keep this newline, unless next line's pre drops it.
    }
}

sub printBreak {
    if    ($lineends eq "M") { print "\r";   }
    elsif ($lineends eq "D") { print "\r\n"; }
    else                     { print "\n";   }
}