view release on metacpan or  search on metacpan

bin/diff_spreadsheets  view on Meta::CPAN

   (map { ((/=/ ? $_ : "$_=s") => \&diffopt_withval) }
      qw/C|c|context=i D F GTYPE-group-format horizon-lines I ifdef
         ignore-matching-lines label line-format LTYPE-group-format
         show-function-line tabsize=i
        /),
   (map { ($_ => \&diffopt_noval) }
        qw/a B b brief d E e ed expand-tabs i ignore-blank-lines ignore-case
           ignore-space-change ignore-tab-expansion initial-tab l minimal n
           p paginate q rcs report-identical-files s show-c-function
           speed-large-files strip-trailing-cr T t text/),
    # valid only for 'git diff':
   (map { ((/[:=]/ ? $_ : "$_=s") => \&diffopt_comboptstr) }
        qw/color/),
   (map { ((/[:=]/ ? $_ : oops) => \&diffopt_comboptnum) }
        qw/u|U|unified:i/),
   (map { ((/=/ ? $_ : "$_=s") => \&diffopt_comboptstr) }
        qw/word-diff-regex word-diff ws-error-highlight/),
   (map { ($_ => \&diffopt_noval) }
        qw/w|ignore-all-space y|side-by-side/),
   "W|width=i" => sub{ $maxwidth = $_[1]; diffopt_comboptnum(@_); },

   # our options:
   "always-show-columns=s"   => sub{ push @{$opts{always_show_columns}}, $_[1]},
   "columns=s"               => sub{ push @{$opts{columns}}, $_[1] },
   "debug"                   => sub{ $opts{debug} = $_[1] },
   "encoding=s"              => sub{ $opts{encoding} = $_[1] },
   "first-data-row=i"        => sub{ $opts{first_data_row} = $_[1] },
   "hash-func=s"             => sub{ $opts{hash_func} = $_[1] },
   "hashid-func=s"           => sub{ $opts{hashid_func} = $_[1] },
   "h|help"                  => \$help,
   "id-columns=s"            => sub{ push @{$opts{id_columns}}, $_[1] },
   "keep-temps!"             => sub{ $opts{keep_temps} = $_[1] },
   "m|method=s"              => \$method,
   "output-encoding=s"       => sub{ $opts{output_encoding} = $_[1] },
   "quiet|silent"            => sub{ $opts{silent} = $_[1] },
   "quote-char=s"            => sub{ $opts{quote_char} = $_[1] },
   "sep-char=s"              => sub{ $opts{sep_char} = $_[1] },
   "setup-code=s"            => sub{ $opts{setup_code} = $_[1] },
   "sheets=s"                => sub{ push @{$opts{sheet_names}}, $_[1] },
   "show-empties"            => sub{ $opts{show_empties} = $_[1] },
   "sort-rows!"              => sub{ $opts{sort_rows} = $_[1] }, # allow --no-sort
   "suppress-common-lines"   => sub{ $opts{suppress_common_lines} = 1; push @diff_opts, "-$_[0]"; },
   "title-row=i"             => sub{ $opts{title_row} = $_[1] },
   "v|verbose"               => sub{ $opts{verbose} = $_[1] },
   "Z|ignore-trailing-space" => sub{ $opts{ign_trailing_spaces} = 1; push @diff_opts, "-$_[0]"; },
) or badargs_exit(-msg => "$Script -h for help");

call_pod2usage(-verbose => 2, -output => \*STDOUT) if $help;

foreach (@diff_opts) { s/^-(\w\w+)/--$1/ }  # change -longopt to --longopt

foreach my $key (qw/columns id_columns always_show_columns sheet_names/) {
  next unless $opts{$key};
  @{$opts{$key}} = map{ split/(?<!\\),/ } @{$opts{$key}}
}
$opts{verbose} //= $opts{debug};

if ($opts{output_encoding}) {
  my $crlf = grep(/crlf/, PerlIO::get_layers(*STDOUT)) ? ":crlf" : "";
  my $arg = ":raw${crlf}:encoding($opts{output_encoding})";
  warn ">binmode STDOUT/ERR '$arg'\n" if $opts{debug};
  binmode(\*STDOUT, $arg) or die "binmode $arg : $!";
  binmode(\*STDERR, $arg) or die "binmode $arg : $!";
}
($stdout_encoding) = map{ /encoding\((.+)\)/ ? ($1) : () }
                     PerlIO::get_layers(*STDOUT);

($visible_space, $RArrow) =
    ($stdout_encoding =~ /utf/i)
      ? ("\N{MIDDLE DOT}", "\N{RIGHTWARDS ARROW}\N{HAIR SPACE}")
      : (".",              "-->") ;

our ($hash_func_code, $hashid_func_code, $setup_code_code);
foreach my $argname (qw(hashid-func hash-func setup-code)) {
  (my $optskey = $argname) =~ s/-/_/g;
  next unless defined $opts{$optskey};
  my $source = "package Usercode;" . $opts{$optskey};
  no strict 'refs';
  ${"${optskey}_code"} = eval $source;
  die "Syntax error in Perl code for --$argname option:\n$@" if $@;
  die "--$argname did not produce a sub ref (got ",u(${"${optskey}_code"}),"\n"
    unless ref(${"${optskey}_code"}) eq "CODE";
}
$hashid_func_code //= sub{ Carp::cluck "bug" if grep{! defined} @{$_[0]}; join ",", @{$_[0]} };
$hash_func_code   //= sub{ Carp::cluck "bug" if grep{! defined} @{$_[0]}; join ",", @{$_[0]} };
$setup_code_code  //= sub{};

badargs_exit(-msg => "Two files must be specified") if @ARGV != 2;
$opts{origpath1} = $ARGV[0];
$opts{origpath2} = $ARGV[1];

if ($opts{keep_temps}) {
  my $dir = path( catfile(tmpdir(), "dstmp") );  # /tmp/dstmp
  $dir->remove_tree;
  mkdir $dir->canonpath or die "mkdir $dir : $!";
  warn "> Created ",qsh($dir),"\n";
  $opts{tempdir} = $dir;
} else {
  $opts{tempdir} = Path::Tiny->tempdir("diffspread_XXXXX", CLEANUP=>1);
}

# Extract the possibly-multiple "sheets" from each spreadsheet into
# separate .csv files and process the corresponding pairs.
# If a specific sheet was specified, then only that sheet will be extracted.
foreach my $N (1,2) {
  my $origpath = $opts{"origpath$N"};
  my $sheet_from_path = sheetname_from_spec($origpath);
  if (defined $sheet_from_path) {
    die "--sheets argument not allowed because filename specifies a sheet:\n",
        "  ", qsh($origpath), "\n"
      if $opts{sheet_names};
  }
  my $dir = $opts{tempdir}->child("--INFILE$N--")->mkdir;
  my $h = convert_spreadsheet($origpath, cvt_to=>"csv",
                                         allsheets => !$sheet_from_path,
                                         outpath => $dir->canonpath,
                                         silent  => $opts{silent},
                                         verbose => $opts{debug},
                                         debug   => $opts{debug},
                             );
  $opts{cvt_from} = $h->{cvt_from};
  if ($h->{cvt_from} =~ /csv/i && !openhandle($origpath)) {
    # Input was already a CSV (possibly detected by peeking at actual content).