refactor(build): share whole-file read, write and rewrite helpers

builddebs.pl spelled out the same slurp five times, and twice wrapped it in the
identical read, transform, write-back sequence -- once to pin the dependency
versions in debian/control and once to rewrite the changelog header. The two
blocks differed only in the file and the function applied to its contents.

BuildUtils.pm now provides read_file, write_file and rewrite_file. The last
leaves a file that is not there alone rather than creating it, which is what
both call sites guarded for with -f.

These use plain open and close rather than File::Slurper. buildrpms.pl already
depends on that module, but builddebs.pl does not, and putting it in the shared
module would oblige a deb build to install something it otherwise has no need
of.

Reading a missing file now names the file it could not read; one of the call
sites died with no message at all.

Covered by tests: a round trip, that rewrite_file applies its transform and
reports whether it acted, that it neither runs the transform nor creates the
file when there is nothing there, and that a failed read names the path.

Signed-off-by: Daniel Hilst <392820+dhilst@users.noreply.github.com>

BuildUtils.pm

@@ -32,6 +32,7 @@ our @EXPORT_OK = qw(
     sh_quote clean_debian_residue git_revision
     backup_file restore_file
     sh usage
+    read_file write_file rewrite_file
 );
 
 # Both builders echo the commands they run under --verbose.  Set once, after
@@ -41,6 +42,35 @@ our $VERBOSE = 0;
 # The xCAT-probe helpers. xcat-probe reuses functions shipped by xCAT; they are COPIED
 # rather than symlinked because a symlink does not survive packaging, and rather than
 # maintained twice because they would drift. Both builders stage them the same way.
+# Whole-file read and write.  Deliberately plain open/close rather than
+# File::Slurper, so that loading this module does not oblige a deb build to
+# install a module it otherwise does not need.
+sub read_file {
+    my ($path) = @_;
+    open my $fh, '<', $path or die "Cannot read $path: $!\n";
+    local $/;
+    my $text = <$fh>;
+    close $fh;
+    return $text;
+}
+
+sub write_file {
+    my ($path, $text) = @_;
+    open my $fh, '>', $path or die "Cannot write $path: $!\n";
+    print {$fh} $text;
+    close $fh or die "Cannot write $path: $!\n";
+    return;
+}
+
+# Read a file, pass its contents through $transform, write the result back.
+# A file that is not there is left alone, which is what every caller wanted.
+sub rewrite_file {
+    my ($path, $transform) = @_;
+    return 0 unless -f $path;
+    write_file($path, $transform->(read_file($path)));
+    return 1;
+}
+
 # Run a shell command, returning its EXIT STATUS.  system() yields the raw wait
 # status, which is the exit code times 256, so it is shifted here: a caller
 # comparing the result against a specific code gets the code it expects, not a

builddebs.pl

@@ -36,7 +36,7 @@ use BuildUtils qw(
     pin_control_version rewrite_changelog_header
     reprepro_distributions reprepro_options
     lock_id_for take_build_lock sh_quote
-    sh usage
+    sh usage read_file write_file rewrite_file
 );
 
 # The xcat-core packages that ship as debs. xCAT-openbmc-py, xCAT-rmc and xCAT-release
@@ -174,20 +174,11 @@ sub with_prepared_tree {
     # Pin the intra-xCAT dependencies to this exact build, so a partial upgrade cannot
     # mix versions.
     my $control = "$dir/debian/control";
-    if (-f $control) {
-        my $text = do { open my $fh, '<', $control or die; local $/; <$fh> };
-        open my $out, '>', $control or die "Cannot write $control: $!\n";
-        print {$out} pin_control_version($text, $PKGVER);
-        close $out;
-    }
+    rewrite_file($control, sub { pin_control_version($_[0], $PKGVER) });
 
     my $changelog = "$dir/debian/changelog";
-    if (-f $changelog) {
-        my $text = do { open my $fh, '<', $changelog or die; local $/; <$fh> };
-        open my $out, '>', $changelog or die "Cannot write $changelog: $!\n";
-        print {$out} rewrite_changelog_header($text, $PKGVER, $DEB_DATE, $MAINTAINER);
-        close $out;
-    }
+    rewrite_file($changelog,
+        sub { rewrite_changelog_header($_[0], $PKGVER, $DEB_DATE, $MAINTAINER) });
     unlink glob("$dir/debian/*.dch");
 
     my @added;
@@ -206,11 +197,9 @@ sub with_prepared_tree {
             # them back; treating them as created would delete them from the
             # checkout, which is what happened before.
             $claim->("postscripts/$f");
-            my $text = do { open my $fh, '<', $src or die; local $/; <$fh> };
+            my $text = read_file($src);
             $text =~ s/xcat\.genesis\.\Q$f\E/$f/g;
-            open my $out, '>', $dst or die "Cannot write $dst: $!\n";
-            print {$out} $text;
-            close $out;
+            write_file($dst, $text);
             chmod 0755, $dst;
         }
     }
@@ -218,10 +207,7 @@ sub with_prepared_tree {
     if ($pkg eq 'xCAT-genesis-scripts' && $arch ne 'all') {
         my $per_arch = "$dir/debian/control-$arch";
         die "FATAL: $per_arch is missing\n" unless -f $per_arch;
-        my $text = do { open my $fh, '<', $per_arch or die; local $/; <$fh> };
-        open my $out, '>', $control or die "Cannot write $control: $!\n";
-        print {$out} pin_control_version($text, $PKGVER);
-        close $out;
+        write_file($control, pin_control_version(read_file($per_arch), $PKGVER));
     }
 
     my $rc = eval { $body->($dir); 1 } ? 0 : 1;
@@ -243,7 +229,7 @@ sub build_package {
         # A 3.0 (quilt) source package needs its .orig tarball beside the tree.
         my $format = "$dir/debian/source/format";
         if (-f $format) {
-            my $text = do { open my $fh, '<', $format or die; local $/; <$fh> };
+            my $text = read_file($format);
             if ($text =~ /3\.0 \(quilt\)/) {
                 my $tar = "$ROOT/" . orig_tarball_name($pkg, $PKGVER);
                 unless (-f $tar) {

xCAT-test/unit/build_utils.t

@@ -308,6 +308,31 @@ is( git_revision( git => sub { "\n" }, read_file => sub { "  \n" } ),
 isnt( git_revision( git => sub { '' }, read_file => sub { '' } ), '',
     'the one thing it must never return is empty' );
 
+# -------------------------------------------------- whole-file helpers --
+{
+    my $dir = tempdir(CLEANUP => 1);
+    my $path = File::Spec->catfile($dir, 'thing.txt');
+
+    BuildUtils::write_file($path, "one\ntwo\n");
+    is( BuildUtils::read_file($path), "one\ntwo\n",
+        'a file reads back exactly as it was written' );
+
+    # The two builders each rewrote debian/control and debian/changelog with the
+    # same read, transform, write-back sequence spelled out by hand.
+    my $changed = BuildUtils::rewrite_file($path, sub { uc $_[0] });
+    is( $changed, 1, 'rewriting a file that exists reports that it did' );
+    is( BuildUtils::read_file($path), "ONE\nTWO\n", 'and applies the transform' );
+
+    my $absent = File::Spec->catfile($dir, 'not-there.txt');
+    is( BuildUtils::rewrite_file($absent, sub { die 'must not run' }), 0,
+        'a file that is not there is left alone, not created' );
+    ok( !-e $absent, 'and really is not created' );
+
+    my $err = eval { BuildUtils::read_file($absent); 1 } ? '' : $@;
+    like( $err, qr/Cannot read .*not-there/,
+        'reading a missing file names the file it could not read' );
+}
+
 # ---------------------------------------------------------------- sh() --
 # system() returns the raw wait status, which is the exit code times 256. The
 # two builders disagreed about shifting it, so a caller comparing sh() against