mirror of https://gitee.com/openkylin/lintian.git
152 lines
3.6 KiB
Perl
Executable File
152 lines
3.6 KiB
Perl
Executable File
#!/usr/bin/perl
|
|
|
|
# Copyright (C) 2017, 2019 Chris Lamb <lamby@debian.org>
|
|
|
|
use v5.20;
|
|
use warnings;
|
|
use utf8;
|
|
|
|
use Cwd qw(realpath);
|
|
use File::Basename qw(dirname);
|
|
use Unicode::UTF8 qw(decode_utf8 encode_utf8);
|
|
|
|
# neither Path::This nor lib::relative are in Debian
|
|
use constant THISFILE => realpath __FILE__;
|
|
use constant THISDIR => dirname realpath __FILE__;
|
|
|
|
# use Lintian modules that belong to this program
|
|
use lib THISDIR . '/../lib';
|
|
|
|
use Const::Fast;
|
|
use Getopt::Long;
|
|
use IPC::Run3;
|
|
|
|
use Lintian::IPC::Run3 qw(safe_qx);
|
|
|
|
const my $PLUS => q{+};
|
|
const my $WAIT_STATUS_SHIFT => 8;
|
|
|
|
my (%added, %removed, %opt);
|
|
|
|
my %opthash = ('in-place|i' => \$opt{'in-place'},);
|
|
|
|
# init commandline parser
|
|
Getopt::Long::config('bundling', 'no_getopt_compat', 'no_auto_abbrev',
|
|
'permute');
|
|
|
|
# process commandline options
|
|
Getopt::Long::GetOptions(%opthash)
|
|
or die encode_utf8("error parsing options\n");
|
|
|
|
my ($commit_range) = @ARGV;
|
|
if (not $commit_range) {
|
|
my $bytes = safe_qx(qw(git describe --abbrev=0));
|
|
my $status = $? >> $WAIT_STATUS_SHIFT;
|
|
|
|
die encode_utf8("git describe failed with code $status\n")
|
|
if $status;
|
|
|
|
my $describe = $bytes;
|
|
chomp($describe);
|
|
|
|
if (not $describe) {
|
|
die encode_utf8("git describe did not return anything.\n");
|
|
}
|
|
$commit_range = "${describe}..HEAD";
|
|
print encode_utf8("Assuming commit range to be: ${commit_range}\n");
|
|
}
|
|
|
|
my $output;
|
|
my @command =(qw{git diff}, $commit_range, qw{-- tags/*/*.tag});
|
|
run3(\@command, \undef, \$output);
|
|
|
|
my @lines = split(/\n/, $output);
|
|
while (defined(my $line = shift @lines)) {
|
|
|
|
next
|
|
unless $line =~ m{ \A ([\+-]) Tag: \s*+ ([^ ]++) \s*+ \Z}xsm;
|
|
|
|
my ($change, $tag) = ($1, $2);
|
|
if ($change eq $PLUS) {
|
|
$added{$tag} = 1;
|
|
} else {
|
|
$removed{$tag} = 1;
|
|
}
|
|
}
|
|
|
|
for my $tag (keys(%added)) {
|
|
if (exists($removed{$tag})) {
|
|
# Added and removed? More likely, the tag was moved between
|
|
# two files.
|
|
delete($added{$tag});
|
|
delete($removed{$tag});
|
|
}
|
|
}
|
|
|
|
if (not %added and not %removed) {
|
|
print {*STDERR} encode_utf8("No tags were added or removed\n");
|
|
}
|
|
|
|
if ($opt{'in-place'}) {
|
|
my $matched = 0;
|
|
|
|
my $infile = 'debian/changelog';
|
|
open(my $in_fd, '<:encoding(UTF-8)', $infile)
|
|
or die encode_utf8("Cannot open $infile");
|
|
|
|
my $outfile = 'debian/changelog.tmp';
|
|
open(my $out_fd, '>', $outfile)
|
|
or die encode_utf8("Cannot open $outfile");
|
|
|
|
while (my $line = <$in_fd>) {
|
|
chomp $line;
|
|
if ($line =~ m/^ \* WIP\b/) {
|
|
emit_tag_summary($out_fd);
|
|
$matched++;
|
|
} else {
|
|
print {$out_fd} encode_utf8($line . "\n");
|
|
}
|
|
}
|
|
close($out_fd);
|
|
close($in_fd);
|
|
if ($matched != 1) {
|
|
die encode_utf8(
|
|
"changelog did not match WIP placeholder exactly once\n");
|
|
}
|
|
|
|
rename($outfile, $infile)
|
|
or die encode_utf8("Cannot rename $outfile to $infile");
|
|
|
|
print encode_utf8("Updated $infile\n");
|
|
|
|
} else {
|
|
emit_tag_summary(\*STDOUT);
|
|
}
|
|
|
|
sub emit_tag_summary {
|
|
my ($fd) = @_;
|
|
|
|
if (%added or %removed) {
|
|
print {$fd} encode_utf8(" * Summary of tag changes:\n");
|
|
}
|
|
if (%added) {
|
|
print {$fd} encode_utf8(" + Added:\n");
|
|
for my $tag (sort(keys(%added))) {
|
|
print {$fd} encode_utf8(" - $tag\n");
|
|
}
|
|
}
|
|
if (%removed) {
|
|
print {$fd} encode_utf8(" + Removed:\n");
|
|
for my $tag (sort(keys(%removed))) {
|
|
print {$fd} encode_utf8(" - $tag\n");
|
|
}
|
|
}
|
|
return;
|
|
}
|
|
|
|
# Local Variables:
|
|
# indent-tabs-mode: nil
|
|
# cperl-indent-level: 4
|
|
# End:
|
|
# vim: syntax=perl sw=4 sts=4 sr et
|