Changeset 5094 for LMDZ6/branches/Amaury_dev/tools/fcm/bin/fcm_graphic_diff

Timestamp:

Jul 21, 2024, 1:47:00 PM (4 months ago)

Author:

abarral

Message:

Fix r5093: ship new fcm source

File:

• LMDZ6/branches/Amaury_dev/tools/fcm/bin/fcm_graphic_diff (modified) (1 diff)

LMDZ6/branches/Amaury_dev/tools/fcm/bin/fcm_graphic_diff

@@ -1 @@
-#!/usr/bin/perl
-# ------------------------------------------------------------------------------
-# NAME
-#   fcm_graphic_diff
+#!/usr/bin/env perl
+#-------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
 #
-# SYNOPSIS
-#   fcm_graphic_diff [-u] [-L OLD_DESC] [-L NEW_DESC] OLD NEW
+# This file is part of FCM, tools for managing and building source code.
 #
-# DESCRIPTION
-#   Wrapper script which invokes a graphical diff tool. Its interface is
-#   compatible with the "svn diff" command and can be used in combination with
-#   its "--diff-cmd" option. The command prints the OLD_DESC and NEW_DESC if
-#   they are both set. The two arguments OLD and NEW must be set and are the
-#   files to compare. The graphical diff tool invoked depends on the value of
-#   the FCM_GRAPHIC_DIFF environment variable. The command exits if the
-#   environment variable is not set.
+# 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.
 #
-# COPYRIGHT
-#   This program is part of the FCM system.
-#   (C) Crown copyright Met Office. All rights reserved.
-#   For further details please refer to the file COPYRIGHT.txt
-#   which you should have received as part of this distribution.
-# ------------------------------------------------------------------------------
+# 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 <http://www.gnu.org/licenses/>.
+#-------------------------------------------------------------------------------
 
-# Standard pragmas:
+use strict;
 use warnings;
-use strict;
 
-use Getopt::Long;
+use Getopt::Long qw{GetOptions};
+use Pod::Usage qw{pod2usage};
 
-# ------------------------------------------------------------------------------
+my $RE_SVN_EMPTY_FILE = qr{\.svn/empty-file}msx;
 
-my ($u, @label);
-GetOptions ('u' => \$u, 'L=s' => \@label);
+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', $_)} @_},
+);
 
-# Check existence of files
-for my $i (0 .. 1) {
-  die $ARGV[$i], ': not found, abort' unless $ARGV[$i] and -f $ARGV[$i];
+if (!caller()) {
+    # svn diff expects:
+    # 0 - no diff
+    # 1 - diff
+    # other return code - fatal
+    exit main(@ARGV);
 }
 
-my ($old, $new) = @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)
+    );
+}
 
-if ($old =~ m#.svn/empty-file$#) {
-  print 'Skipping new file', "\n\n";
+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);
+}
 
-} elsif ($new =~ m#.svn/empty-file$#) {
-  print 'Skipping deleted file', "\n\n";
-
-} elsif (-z $old) {
-  print 'Skipping as old file is empty (or does not exist)', "\n\n";
-
-} elsif (-z $new) {
-  print 'Skipping as new file is empty (or deleted)', "\n\n";
-
-} elsif (-B $new) {
-  print 'Skipping binary file', "\n\n";
-
-} else {
-  # Print descriptions of files
-  if (@label >= 2) {
-    print '--- ', $label[0], "\n", '+++ ', $label[1], "\n\n";
-  }
-
-  # FCM_GRAPHIC_DIFF is the graphical diff tool command
-  my $cmd = (exists $ENV{FCM_GRAPHIC_DIFF} ? $ENV{FCM_GRAPHIC_DIFF} : 'xxdiff');
-
-  if ($cmd) {
-    my @options = ();
-
-    # Set options for labels if appropriate
-    if (@label >= 2) {
-      if ($cmd eq 'tkdiff') {
-        # Use tkdiff
-        @options = ('-L', $label[0], '-L', $label[1]);
-
-      } elsif ($cmd eq 'xxdiff') {
-        # Use xxdiff
-        @options = ('--title1', $label[0], '--title2', $label[1]);
-      }
-    }
-
-    # Execute the command
-    my @command = ($cmd, @options, $old, $new);
-    exec (@command) or die 'Cannot execute: ', join (' ', @command);
-  }
-
-  exit;
+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<xxdiff|xxdiff> (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<svn diff|svn>
+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<xxdiff|xxdiff>, L<tkdiff|tkdiff>, or L<meld|meld>:
+
+    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