generate-change-log 1.9 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667
  1. #!/usr/bin/env perl
  2. #
  3. # Copyright (c) 2013 Nagios Plugins Development Team
  4. #
  5. # Originally written by Holger Weiss <holger@zedat.fu-berlin.de>.
  6. #
  7. # This file is free software; the Nagios Plugins Development Team gives
  8. # unlimited permission to copy and/or distribute it, with or without
  9. # modifications, as long as this notice is preserved.
  10. #
  11. # This program is distributed in the hope that it will be useful, but WITHOUT
  12. # ANY WARRANTY, to the extent permitted by law; without even the implied
  13. # warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  14. #
  15. use warnings;
  16. use strict;
  17. use Text::Wrap;
  18. # The lines will have a length of no more than $columns - 1.
  19. $Text::Wrap::columns = 81;
  20. if (system('git rev-parse --git-dir >/dev/null 2>&1') != 0) {
  21. print "Not a Git repository, so I won't update the ChangeLog.\n";
  22. exit 0;
  23. }
  24. my $regex =
  25. '^commit [0-9a-f]+\n' .
  26. '^Author: (?<name>.+) <(?<email>.*)>\n' .
  27. '^Date: (?<date>\d{4}-\d{2}-\d{2})\n' .
  28. '^\n' .
  29. '(?<message>(^ .*\n)+)' .
  30. '^\n' .
  31. '(?<files>(^.+\n)+)';
  32. my $git_log = qx'git log -M -C --stat --name-only --date=short';
  33. die "Cannot get `git log' output\n" if $? != 0;
  34. my ($prev_date, $prev_name, $prev_email);
  35. while ($git_log =~ /$regex/gm) {
  36. my %commit = %+;
  37. if (not defined $prev_date
  38. or $commit{date} ne $prev_date
  39. or $commit{name} ne $prev_name
  40. or $commit{email} ne $prev_email) {
  41. print "$commit{date} $commit{name} <$commit{email}>\n\n";
  42. }
  43. $prev_date = $commit{date};
  44. $prev_name = $commit{name};
  45. $prev_email = $commit{email};
  46. my @files = split(/\n/, $commit{files});
  47. my @message = map { s/^ {4}//; $_ } split(/\n/, $commit{message});
  48. my $first_line = shift(@message);
  49. $first_line =~ s/^$files[-1]: //;
  50. my $intro = sprintf('* %s: %s', join(', ', @files), $first_line);
  51. print fill("\t", "\t", $intro), "\n";
  52. foreach my $line (@message) {
  53. print "\t$line" if length($line) > 0;
  54. print "\n";
  55. }
  56. print "\n";
  57. }