#!/usr/bin/env perl
#-------------------------------------------------------------------------------
# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
#
# This file is part of FCM, tools for managing and building source code.
#
# FCM is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# FCM is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with FCM. If not, see .
#-------------------------------------------------------------------------------
use strict;
use warnings;
use Getopt::Long qw{GetOptions};
use Pod::Usage qw{pod2usage};
my $RE_SVN_EMPTY_FILE = qr{\.svn/empty-file}msx;
my %S = (
'LABEL' => "--- %s\n+++ %s",
'SKIP_ADD' => "Skipping since file has been added (or old file is empty)",
'SKIP_DEL' => "Skipping since file has been deleted (or new file is empty)",
'SKIP_BIN' => "Skipping binary file",
);
my %LABELS_HANDLER_FOR = (
'tkdiff' => sub {map {('-L', $_)} @_},
'xxdiff' => sub {('--title1', $_[0], '--title2', $_[1])},
'meld' => sub {map {('-L', $_)} @_},
);
if (!caller()) {
# svn diff expects:
# 0 - no diff
# 1 - diff
# other return code - fatal
exit main(@ARGV);
}
sub main {
local(@ARGV) = @_;
my %option;
my $rc = GetOptions(\%option, 'u', 'L=s@');
if (!$rc || @ARGV != 2 || grep {!-f $_} @ARGV) {
pod2usage(1);
}
my ($old, $new) = @ARGV;
( $old =~ $RE_SVN_EMPTY_FILE || -z $old ? message('SKIP_ADD')
: $new =~ $RE_SVN_EMPTY_FILE || -z $new ? message('SKIP_DEL')
: -B $new ? message('SKIP_BIN')
: command(\%option, @ARGV)
);
}
sub command {
my ($option_hash_ref, $old, $new) = @_;
my @labels;
if ($option_hash_ref->{'L'} && @{$option_hash_ref->{'L'}} >= 2) {
@labels = @{$option_hash_ref->{'L'}};
message('LABEL', @labels);
}
my $diff_command
= exists($ENV{FCM_GRAPHIC_DIFF}) ? $ENV{FCM_GRAPHIC_DIFF} : 'xxdiff';
if (!$diff_command) {
return;
}
my @command = (
$diff_command,
( @labels && exists($LABELS_HANDLER_FOR{$diff_command})
? $LABELS_HANDLER_FOR{$diff_command}->(@labels) : ()
),
$old, $new,
);
system(@command);
}
sub message {
my $format = shift();
printf($S{$format} . "\n\n", @_);
1;
}
__END__
=head1 NAME
fcm_graphic_diff
=head1 SYNOPSIS
fcm_graphic_diff [-u] [-L OLD_LABEL] [-L NEW_LABEL] OLD NEW
=head1 DESCRIPTION
Invokes L (or the command specified in the FCM_GRAPHIC_DIFF
environment variable) to compare the OLD and NEW files, where possible.
If either file does not exist or is empty, or if the NEW file is a binary, the
command will only print a diagnostic message.
The -u option is not used, and is for compatibility with the L
command only.
If OLD_LABEL and NEW_LABEL are set, they are printed in the format:
---- OLD_LABEL
++++ NEW_LABEL
The command makes use of the labels when the diff command is either
L, L, or L:
xxdiff --title1 OLD_LABEL --title2 NEW_LABEL OLD NEW
tkdiff -L OLD_LABEL -L NEW_LABEL OLD NEW
meld -L OLD_LABEL -L NEW_LABEL OLD NEW
The command returns 0 if the files are the same or 1 if the files differ. All
other return codes should be regarded as fatal errors.
=head1 COPYRIGHT
Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
=cut