changeCase

#!/usr/bin/env perl -w
#
# changeCase: Unicode case change; token, word, record, and sentence case.
# 2009-08-04: Written by Steven J. DeRose.
#
use strict;
use Getopt::Long;

our %metadata = (
    'title'        => "changeCase",
    'description'  => "Unicode case change; token, word, record, and sentence case.",
    'rightsHolder' => "Steven J. DeRose",
    'creator'      => "http://viaf.org/viaf/50334488",
    'type'         => "http://purl.org/dc/dcmitype/Software",
    'language'     => "Perl 5.18",
    'created'      => "2009-08-04",
    'modified'     => "2020-01-18",
    'publisher'    => "http://github.com/sderose",
    'license'      => "https://creativecommons.org/licenses/by-sa/3.0/"
);
our $VERSION_DATE = $metadata{'modified'};

=pod

=head1 Usage

changeCase [options] file

Force the input to one or another patterns of upper- and lower-case.
Should support Unicode just fine (uses Perl lc() and uc()).


=head1 Options

(prefix 'no' to negate where applicable)

=over

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

Force to one of [ULWRS]:
all Upper, all Lower, Words upper,
Records upper, or Sentences upper (default U). 'Sentence' is approximate.

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

Charset to use for input. Default: "utf8".

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

Assume Unix, Dos, or Mac line-breaks for input.

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

Charset to use for output. Default: "utf8".

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

Write Unix, Dos, or Mac line-breaks for output.

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

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

Print a message after every n input records. Default: 0 (off).

=item * B<--unicode>

Assume input is utf8.

=item * B<--verbose> OR B<-v>
Add more messages (repeatable).

=item * B<--version>

Show version/license info and exit.

=back


=head1 Known Bugs/Limitations

Just uses Perl's built-in uc() ucfirst(), and lc(), which afaik are not responsive
to locale settings.

I<--case S> (capitalize sentences) is approximate, based on a regex that looks for
sentence-end configurations. It is overly simplistic, though hopefully good enough
to be useful. Use an NLP sentence splitter for better results.


=head1 History

    2009-08-04: Written by Steven J. DeRose.
    2010-08-25 sjd: perldoc.
    2012-09-12: ?
    2020-01-18: Drop --ignoreCase.
    2022-09-13: New layout. Better option handling, default to utf8,....
    

=head1 To do


=head1 Related commands

My shell functions (see ShellSetup/setupFunctions) C<upcase>, C<downcase>. 

*nix C<tr>, C<iconv>.

See L<https://perldoc.perl.org/5.8.4/perlunicode> re. how Perl handles Unicode.


=head1 Ownership

This work by Steven J. DeRose 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/>
or L<http://github.com/sderose>.

=cut


###############################################################################
# Options
#
my $case             = "U";
my $iencoding        = "utf8";
my $ilineends        = "U";
my $oencoding        = "utf8";
my $olineends        = "U";
my $quiet            = 0;
my $tickInterval     = 0;
my $verbose          = 0;

Getopt::Long::Configure ("ignore_case");
my $result = GetOptions(
    "case=s"                  => \$case,
    "h|help"                  => sub { system "perldoc $0"; exit; },
    "iencoding=s"             => \$iencoding,
    "ilineends=s"             => \$ilineends,
    "oencoding=s"             => \$oencoding,
    "olineends=s"             => \$olineends,
    "q!"                      => \$quiet,
    "tickInterval=o"          => \$tickInterval,
    "unicode!"                => sub { $iencoding = "utf8"; },
    "v+"                      => \$verbose,
    "version"                 => sub { showLicense(); exit; }
    );

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

my $file = shift;
if ($file) {
    (-f $file) || die "Can't find input file '$file'.\n";
}
else {
    $file = "-";
}
my $fh;
open($fh, "<$file") || die "Unable to open '$file'.\n";

$case = substr(uc($case)."U", 0, 1);

if ($iencoding ne "") {
    binmode($fh, ":$iencoding");
}
if ($oencoding ne "") {
    print "";
    binmode(STDOUT, ":$oencoding");
}

$ilineends = uc(substr($ilineends."U", 0, 1));
if    ($ilineends eq "M") { $/ = chr(13); }
elsif ($ilineends eq "D") { $/ = chr(13).chr(10); }
else { }

$olineends = uc(substr($olineends."U", 0, 1));
if    ($olineends eq "M") { $\ = chr(13); }
elsif ($olineends eq "D") { $\ = chr(13).chr(10); }
else { }

$case = uc($case);
($case =~ m/^[ULWSR]$/) ||
    die "Unknown value '$case' for -case option, must be [ULWSR].\n";


###############################################################################
# Main
#
my $recnum = 0;
my $lastToken = ""; # For sentence that breaks at record boundary.

while (my $rec = <$fh>) {
    $recnum++;
    if ($tickInterval>0 && $recnum % $tickInterval == 0) {
        warn "At record $recnum.\n";
    }
    if ($case eq "U") {
        print uc($rec);
    }
    elsif ($case eq "L") {
        print lc($rec);
    }
    elsif ($case eq "R") {
        print ucfirst(substr($rec, 0, 1)) .
            (length($rec)>1) ? lc(substr($rec, 1)):"";
    }
    elsif ($case eq "W") {
        my @tokens = split(/(\s+)/, $rec);
        my $buf = "";
        for my $t (@tokens) {
            $buf .= ucfirst(substr($t, 0, 1));
            if (length($t) > 1) {
                $buf .= lc(substr($t, 1));
            }
        }

        print $buf;
    }
    elsif ($case eq "S") { # Imperfect
        my @tokens = split(/([.?!]\"?\'?\s+)/, $rec);
        my $buf = "";
        for my $t (@tokens) {
            if ($lastToken eq "" ||
                $lastToken =~ m/([.?!]\"?\'?\s+)/) {
               $buf .= ucfirst(substr($t, 0, 1));
            }
            else {
               $buf .= substr($t, 0, 1);
            }
            if (length($t) > 1) {
                $buf .= lc(substr($t, 1));
            }
            $lastToken = $t;
        }
        print $buf;
    }
    else {
       die "Unknown -case value '$case'.\n";
    }
} # EOF

($quiet) || warn "Done, $recnum records processed.\n";