mirror of
https://github.com/xcat2/xcat-core.git
synced 2026-09-04 20:17:55 +00:00
refactor(build): read and write files through File::Slurper
The two builders read and wrote files three different ways. buildrpms.pl used File::Slurper, builddebs.pl opened and closed handles inline, and BuildUtils.pm carried its own read_file/write_file pair to avoid the dependency. The result was that the same operation was spelled differently in each place, and the Version stamp was read by hand in both builders: buildrpms.pl chomped it ten lines after reading it, which is how a stamp keeps a trailing newline nobody notices until it reaches a package name. Drop the hand-rolled pair and use File::Slurper throughout, and add BuildUtils::read_line for the one-line Version and Release stamps -- it strips the newline at the point of reading and reports an absent file as undef, which is what builddebs.pl's fallback to snap_release needs. File::Slurper is already required by buildrpms.pl and is already in the CI package list, so this adds no new build-host prerequisite. The lock file still uses a raw open: flock needs a real handle. Behaviour note: Version is now read as its first line rather than the whole file with the final newline removed. For the one-line file it is, these are the same; a malformed multi-line Version now yields its first line instead of an embedded newline. Signed-off-by: Daniel Hilst <392820+dhilst@users.noreply.github.com>
This commit is contained in:
Daniel Hilst
+20
-31
@@ -17,6 +17,7 @@ use Exporter 'import';
|
||||
use File::Copy qw(copy move);
|
||||
use File::Basename qw(basename);
|
||||
use File::Path qw(make_path remove_tree);
|
||||
use File::Slurper qw(read_text write_text);
|
||||
use POSIX qw(strftime);
|
||||
use Pod::Usage qw(pod2usage);
|
||||
use feature 'say';
|
||||
@@ -32,7 +33,7 @@ our @EXPORT_OK = qw(
|
||||
sh_quote clean_debian_residue git_revision
|
||||
backup_file restore_file
|
||||
sh usage
|
||||
read_file write_file rewrite_file write_script
|
||||
rewrite_file write_script read_line
|
||||
buildinfo_text
|
||||
);
|
||||
|
||||
@@ -64,26 +65,6 @@ sub buildinfo_text {
|
||||
"COMMIT_ID_LONG=$commit");
|
||||
}
|
||||
|
||||
# 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;
|
||||
}
|
||||
|
||||
# Write a helper script and make it executable. Both builders ship a
|
||||
# mklocalrepo.sh beside the packages they publish, and builddebs.pl installs the
|
||||
# genesis postscripts the same way; a script written without the executable bit
|
||||
@@ -93,17 +74,31 @@ sub write_file {
|
||||
sub write_script {
|
||||
my ($path, $content, $mode) = @_;
|
||||
$mode = 0775 unless defined $mode;
|
||||
write_file($path, $content);
|
||||
write_text($path, $content);
|
||||
chmod $mode, $path or die "Cannot chmod $path: $!\n";
|
||||
return;
|
||||
}
|
||||
|
||||
# The first line of a file, without its newline. Version and Release are
|
||||
# one-line stamps that both builders read, and each spelled the open, the read
|
||||
# and the chomp differently -- buildrpms.pl chomped ten lines away from its
|
||||
# read, which is how a stamp keeps a trailing newline nobody notices until it
|
||||
# lands in a package name. Returns undef when the file is absent, which is
|
||||
# what a caller with a fallback wants.
|
||||
sub read_line {
|
||||
my ($path) = @_;
|
||||
return undef unless -f $path;
|
||||
my ($line) = split /\n/, read_text($path), 2;
|
||||
return undef unless defined $line && length $line;
|
||||
return $line;
|
||||
}
|
||||
|
||||
# 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)));
|
||||
write_text($path, $transform->(read_text($path)));
|
||||
return 1;
|
||||
}
|
||||
|
||||
@@ -188,10 +183,7 @@ sub git_revision {
|
||||
my $run = $args{git} || sub { `git rev-parse HEAD 2>/dev/null` };
|
||||
my $read_file = $args{read_file} || sub {
|
||||
return unless -f 'Gitinfo';
|
||||
open my $fh, '<', 'Gitinfo' or return;
|
||||
my $line = <$fh>;
|
||||
close $fh;
|
||||
return $line;
|
||||
return scalar read_text('Gitinfo');
|
||||
};
|
||||
|
||||
for my $source ($run, $read_file) {
|
||||
@@ -270,10 +262,7 @@ sub source_date_epoch {
|
||||
my $read = $args{read_file} || sub {
|
||||
my ($p) = @_;
|
||||
return unless -f $p;
|
||||
open my $fh, '<', $p or return;
|
||||
my $v = <$fh>;
|
||||
close $fh;
|
||||
return $v;
|
||||
return scalar read_text($p);
|
||||
};
|
||||
my $git = $args{git_epoch} || sub { return scalar `git log -1 --format=%ct HEAD 2>/dev/null`; };
|
||||
|
||||
|
||||
+9
-18
@@ -20,6 +20,7 @@ use File::Basename qw(basename);
|
||||
use File::Copy qw(copy move);
|
||||
use File::Path qw(make_path remove_tree);
|
||||
use File::Spec;
|
||||
use File::Slurper qw(read_text write_text);
|
||||
use File::Temp qw(tempdir);
|
||||
use Getopt::Long qw(GetOptions);
|
||||
use POSIX qw(strftime);
|
||||
@@ -36,7 +37,7 @@ use BuildUtils qw(
|
||||
pin_control_version rewrite_changelog_header
|
||||
reprepro_distributions reprepro_options
|
||||
lock_id_for take_build_lock sh_quote
|
||||
sh usage read_file write_file rewrite_file write_script buildinfo_text
|
||||
sh usage rewrite_file write_script read_line buildinfo_text
|
||||
);
|
||||
|
||||
# The xcat-core packages that ship as debs. xCAT-openbmc-py, xCAT-rmc and xCAT-release
|
||||
@@ -88,18 +89,12 @@ for my $pkg ($opts{packages}->@*) {
|
||||
}
|
||||
|
||||
my $ROOT = abs_path($FindBin::Bin);
|
||||
my $VERSION = do { open my $fh, '<', "$ROOT/Version" or die "Cannot read Version: $!\n";
|
||||
my $v = <$fh>; chomp $v; $v };
|
||||
my $VERSION = read_line("$ROOT/Version") // die "Cannot read $ROOT/Version\n";
|
||||
my $EPOCH = source_date_epoch();
|
||||
# A Release file, when present, is authoritative: buildrpms.pl writes one, and a
|
||||
# pipeline that builds both must stamp the rpms and the debs with the same release.
|
||||
my $FILE_RELEASE = do {
|
||||
my $r;
|
||||
if (-f "$ROOT/Release") {
|
||||
open my $fh, '<', "$ROOT/Release" or die "Cannot read Release: $!\n";
|
||||
$r = <$fh>;
|
||||
chomp $r if defined $r;
|
||||
}
|
||||
my $r = read_line("$ROOT/Release");
|
||||
($r && $r =~ /\S/) ? $r : undef;
|
||||
};
|
||||
my $RELEASE = $opts{release} || $FILE_RELEASE || snap_release($EPOCH);
|
||||
@@ -122,11 +117,7 @@ if ($GITINFO eq 'unknown') {
|
||||
. " If $ROOT is a git checkout, check `git -C $ROOT rev-parse HEAD` "
|
||||
. "as the build user (HOME=$ENV{HOME}).\n";
|
||||
}
|
||||
{
|
||||
open my $g, '>', "$ROOT/Gitinfo" or die "Cannot write Gitinfo: $!\n";
|
||||
print {$g} "$GITINFO\n";
|
||||
close $g;
|
||||
}
|
||||
write_text("$ROOT/Gitinfo", "$GITINFO\n");
|
||||
|
||||
# dpkg reads these for the changelog trailer. Fixed, so the packages do not carry
|
||||
# whoever happened to run the build.
|
||||
@@ -197,7 +188,7 @@ 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 = read_file($src);
|
||||
my $text = read_text($src);
|
||||
$text =~ s/xcat\.genesis\.\Q$f\E/$f/g;
|
||||
write_script($dst, $text, 0755);
|
||||
}
|
||||
@@ -206,7 +197,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;
|
||||
write_file($control, pin_control_version(read_file($per_arch), $PKGVER));
|
||||
write_text($control, pin_control_version(read_text($per_arch), $PKGVER));
|
||||
}
|
||||
|
||||
my $rc = eval { $body->($dir); 1 } ? 0 : 1;
|
||||
@@ -228,7 +219,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 = read_file($format);
|
||||
my $text = read_text($format);
|
||||
if ($text =~ /3\.0 \(quilt\)/) {
|
||||
my $tar = "$ROOT/" . orig_tarball_name($pkg, $PKGVER);
|
||||
unless (-f $tar) {
|
||||
@@ -334,7 +325,7 @@ fi
|
||||
echo deb [arch=$host_arch] file://"`pwd`" $DISTRIB_CODENAME main > /etc/apt/sources.list.d/xcat-core.list
|
||||
SCRIPT
|
||||
|
||||
write_file("$repodir/buildinfo", buildinfo_text(
|
||||
write_text("$repodir/buildinfo", buildinfo_text(
|
||||
version => $VERSION, release => $RELEASE, epoch => $EPOCH,
|
||||
commit => $GITINFO, time_format => '%a %b %d %H:%M:%S %Y'));
|
||||
return;
|
||||
|
||||
+3
-3
@@ -43,7 +43,8 @@ use File::Slurper qw(read_text write_text);
|
||||
use File::Temp qw(tempdir tempfile);
|
||||
use FindBin qw($Bin);
|
||||
use lib $Bin;
|
||||
use BuildUtils qw(git_revision source_date_epoch sh usage buildinfo_text write_script);
|
||||
use BuildUtils qw(git_revision source_date_epoch sh usage buildinfo_text write_script
|
||||
read_line);
|
||||
use Fcntl qw(:flock); # per-target build lock (concurrency guard; see main())
|
||||
use Getopt::Long qw(GetOptions);
|
||||
use POSIX qw(strftime);
|
||||
@@ -62,7 +63,7 @@ my $SOURCES = "$ENV{HOME}/rpmbuild/SOURCES";
|
||||
# no srpms/rpms are produced, and the run still exits 0. Create the tree up front so a build never
|
||||
# depends on prior manual setup.
|
||||
system('mkdir', '-p', map { "$ENV{HOME}/rpmbuild/$_" } qw(SOURCES SPECS BUILD BUILDROOT RPMS SRPMS));
|
||||
my $VERSION = read_text("Version");
|
||||
my $VERSION = read_line("Version") // die "Cannot read Version\n";
|
||||
my $PWD = Cwd::cwd();
|
||||
my @XCAT_PROBE_HELPERS = qw(
|
||||
GlobalDef.pm
|
||||
@@ -70,7 +71,6 @@ my @XCAT_PROBE_HELPERS = qw(
|
||||
ServiceNodeUtils.pm
|
||||
);
|
||||
|
||||
chomp($VERSION);
|
||||
|
||||
# Gitinfo is regenerated at each run with the current git revision.
|
||||
my $GITINFO = git_revision();
|
||||
|
||||
@@ -333,29 +333,51 @@ isnt( git_revision( git => sub { '' }, read_file => sub { '' } ), '',
|
||||
'each builder keeps the format its own consumers parse' );
|
||||
}
|
||||
|
||||
# -------------------------------------------------- whole-file helpers --
|
||||
# ---------------------------------------------------------- rewrite_file --
|
||||
# The two builders each rewrote debian/control and debian/changelog with the
|
||||
# same read, transform, write-back sequence spelled out by hand.
|
||||
{
|
||||
my $dir = tempdir(CLEANUP => 1);
|
||||
my $path = File::Spec->catfile($dir, 'thing.txt');
|
||||
write_text($path, "one\ntwo\n");
|
||||
|
||||
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' );
|
||||
is( read_text($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' );
|
||||
# ------------------------------------------------------- one-line stamps --
|
||||
# Version and Release are one-line files both builders read. The newline must
|
||||
# come off at the point of reading: buildrpms.pl used to chomp ten lines later,
|
||||
# and a Release that keeps its newline goes straight into a package name.
|
||||
{
|
||||
my $dir = tempdir(CLEANUP => 1);
|
||||
my $path = File::Spec->catfile($dir, 'Version');
|
||||
|
||||
write_text($path, "2.18.1\n");
|
||||
is( BuildUtils::read_line($path), '2.18.1',
|
||||
'a one-line stamp comes back without its newline' );
|
||||
|
||||
write_text($path, "2.18.1\nignored\n");
|
||||
is( BuildUtils::read_line($path), '2.18.1',
|
||||
'and only the first line is taken' );
|
||||
|
||||
write_text($path, "2.18.1");
|
||||
is( BuildUtils::read_line($path), '2.18.1',
|
||||
'a file with no trailing newline reads the same' );
|
||||
|
||||
# builddebs.pl falls back to snap_release() when there is no Release file,
|
||||
# so absence has to be reported rather than raised.
|
||||
is( BuildUtils::read_line(File::Spec->catfile($dir, 'nope')), undef,
|
||||
'a file that is not there reads as undef, not an error' );
|
||||
|
||||
write_text($path, "");
|
||||
is( BuildUtils::read_line($path), undef, 'and so does an empty file' );
|
||||
}
|
||||
|
||||
# ------------------------------------------------- the published helper script --
|
||||
@@ -368,7 +390,7 @@ isnt( git_revision( git => sub { '' }, read_file => sub { '' } ), '',
|
||||
my $path = File::Spec->catfile($dir, 'mklocalrepo.sh');
|
||||
|
||||
BuildUtils::write_script($path, "#!/bin/sh\necho hello\n");
|
||||
is( BuildUtils::read_file($path), "#!/bin/sh\necho hello\n",
|
||||
is( read_text($path), "#!/bin/sh\necho hello\n",
|
||||
'a helper script keeps the exact text it was given' );
|
||||
ok( -x $path, 'and is executable, which is the point of writing it this way' );
|
||||
is( (stat $path)[2] & 07777, 0775,
|
||||
|
||||
Reference in New Issue
Block a user