view release on metacpan or  search on metacpan

bin/diff_spreadsheets  view on Meta::CPAN

#!/usr/bin/env perl
# License: Public Domain or CC0
# See https://creativecommons.org/publicdomain/zero/1.0/
# The author, Jim Avera (jim.avera at gmail) has waived all copyright and
# related or neighboring rights.  Attribution is requested but is not required.
use strict; use warnings FATAL => 'all';

our $VERSION = '1.028'; # VERSION
our $DATE = '2026-01-13'; # DATE

#use 5.12; # for unicode_strings
use v5.18; # for lexical_subs

use strict; use warnings;
use feature qw(state say lexical_subs fc);
use feature qw(unicode_strings unicode_eval evalbytes);
no warnings "experimental::lexical_subs";

use Carp; $Carp::MaxArgNums = 0;
use Data::Dumper::Interp 6.007 qw/:DEFAULT dviso/;
use Path::Tiny 0.144;
#use File::Basename qw(basename dirname fileparse);
#use File::Path qw(make_path remove_tree);
#use File::Temp qw(tempfile tempdir);
#use File::Copy ();
#use File::Spec;
#use File::Spec::Functions qw(canonpath catfile catdir rootdir tmpdir);
use File::Spec::Functions qw(tmpdir);
use FindBin qw/$Bin $Script/;
use Getopt::Long qw/GetOptions/;
use Guard qw(guard scope_guard);
use List::Util qw/min max any first/;
use List::MoreUtils qw/indexes/;
use Scalar::Util qw/openhandle/;
use Pod::Usage qw/pod2usage/;
use Spreadsheet::Edit 1000.020 qw(title2ident);
use Spreadsheet::Edit::IO 1000.020 qw/convert_spreadsheet
             sheetname_from_spec filepath_from_spec form_spec_with_sheetname/;
use Spreadsheet::Edit::Log ':btw';
use Term::ReadKey ();
use Encode 3.00 qw/decode/; # for ONLY_PRAGMA_WARNINGS
require PerlIO;
sub oops(@) { unshift @_, "oops "; require Carp; goto &Carp::confess; }
#$SIG{__WARN__} = sub{ Carp::cluck @_ };

sub main::Differ::compile_if_regex(@); #forward

# Replace invalid/undesirable filename characters with underscore
sub sanitize_filename(_) { local $_ = shift; s/[^-._[:word:]]/_/g; s/_$//; $_ }

use utf8;

my ($visible_space, $RArrow);

# By default set output encoding to match the user's terminal/locale,
# and suppress the "...does not mapt to..." warnings if unsupported characters
# are displayed e.g. in spreadsheet data diff displays (\x{hex} escapes will
# be displayed for un-encodeable characters).
# May be overridden by the --output-encoding option!

# https://rt.cpan.org/Public/Bug/Display.html?id=88592
$PerlIO::encoding::fallback |= Encode::ONLY_PRAGMA_WARNINGS;
no warnings 'utf8';
use open ':std', ':locale';

select STDERR; $| = 1; select STDOUT; $| = 1;

my $stdout_encoding;
sub decode_foruser($) {
  my $octets = shift;
  $stdout_encoding
    ? decode($stdout_encoding, $octets, Encode::FB_DEFAULT|Encode::LEAVE_SRC)
    : $octets
}
sub encode_foruser($) {
  my $chars = shift;
  $stdout_encoding
    ? encode($stdout_encoding, $chars, Encode::FB_DEFAULT|Encode::LEAVE_SRC)
    : $chars
}

#-------- Get Arguments ---------------
sub call_pod2usage {
  confess "bug" if (scalar(@_) % 2) != 0;
  my %opts = @_;
#  if (! $opts{-msg}) {
#    if (my $podpath = pod_where({-inc => 1},"App::diff_spreadsheets")) {
#      $opts{-input} = $podpath;
#    } else {
#      warn "Could not find App::diff_spreadsheets in \@INC\n",
#           "\@INC:\n", join("\n   ",@INC), "\n";
#    }
#  }
  pod2usage(\%opts);
}

sub badargs_exit(@) {
  call_pod2usage(-output => \*STDERR, -exitval => 2, @_);
}

# We could use Term::Encoding to detect the terminal's encoding
# but that would create a possibly-undesirable dependency.
# We just assume UTF-8, which these days is probably correct.
#my $rightarrow = '->';
#my $rightarrow = "\N{RIGHTWARDS ARROW}\N{THIN SPACE}";
#my $rightarrow = "\N{RIGHTWARDS ARROW}\N{NARROW NO-BREAK SPACE}";
#my $rightarrow = "\N{RIGHTWARDS ARROW}\N{HAIR SPACE}";

sub _get_terminal_width() {  # returns undef if unknowable
  if (u($ENV{COLUMNS}) =~ /^[1-9]\d*$/) {
    return $ENV{COLUMNS}; # overrides actual terminal width
  } else {
    local *_; # Try to avoid clobbering special filehandle "_"
    # This does not actualy work; https://github.com/Perl/perl5/issues/19142

    my $fh =
      -t STDOUT ? *STDOUT :
      -t STDERR ? *STDERR :
       # under Windows the filehandle must be an *output* handle
       do{my $fh; for("/dev/tty",'CONOUT$') { last if open $fh, $_ } $fh}
         || (-t STDIN && *STDIN)
       ;
    my ($width, $height);
    if ($fh) {