Revert "Use SOCK_NOPIPE to fix testcase failures on NetBSD"
[xapian.git] / xapian-maintainer-tools / changelog-to-news
blobdcb03436e7553d3c464ee684a4bb33d9d94f73a9
1 #!/usr/bin/perl -w
2 # Copyright (c) Olly Betts 2010-2021
4 # Permission is hereby granted, free of charge, to any person obtaining a copy
5 # of this software and associated documentation files (the "Software"), to
6 # deal in the Software without restriction, including without limitation the
7 # rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
8 # sell copies of the Software, and to permit persons to whom the Software is
9 # furnished to do so, subject to the following conditions:
11 # The above copyright notice and this permission notice shall be included in
12 # all copies or substantial portions of the Software.
14 # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
15 # IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
16 # FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
17 # AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
18 # LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
19 # FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
20 # IN THE SOFTWARE.
21 use strict;
22 use POSIX;
24 my $vcs;
25 if (-d '.svn') {
26 $vcs = 'svn';
27 } else {
28 $vcs = 'gitlog';
29 if (open CL, '<', 'ChangeLog') {
30 my $cl_head = <CL>;
31 close CL;
32 $vcs = 'git' if $cl_head =~ /^(?:Mon|Tue|Wed|Thu|Fri|Sat|Sun) /;
35 my $new_version;
36 my $date = strftime("%Y-%m-%d", gmtime());
37 open NEWS, '<', 'NEWS' or die "Can't find 'NEWS' in current directory: $!\n";
38 my $news = <NEWS>;
39 my $rev1;
40 if ($news =~ /^(?:up *to:?) *([[:xdigit:]]{7,}|\d+)\b/i) {
41 # Partly updated already.
42 if ($vcs eq 'svn') {
43 $rev1 = $1 + 1;
44 } else {
45 $rev1 = $1;
47 # Discard that line...
48 $news = undef;
49 } elsif ($news =~ /^(?:Changes in|\S+) (\d[\d\.]*\.)(\d+) \(/) {
50 # No updates since the last release.
51 my $last_release = "$1$2";
52 $new_version = $1.($2+1);
53 print "Finding changes since release '$last_release'.\n";
54 if (-d '.svn') {
55 open SVNINFO, "svn info|" or die $!;
56 my $svnroot;
57 while (<SVNINFO>) {
58 if (s/^Repository Root: //) {
59 chomp;
60 $svnroot = $_;
61 last;
64 if (!defined $svnroot) {
65 die "svn info didn't tell us the repo root!\n";
67 close SVNINFO;
68 open SVNLOG, "svn log --limit=1 \Q$svnroot\E/tags/\Q$last_release\E|" or die $!;
69 my $line = <SVNLOG>;
70 if (!defined $line || $line !~ /^-+$/) {
71 $last_release =~ y/./_/;
72 open SVNLOG, "svn log --limit=1 \Q$svnroot\E/tags/v\Q$last_release\E|" or die $!;
73 $line = <SVNLOG>;
74 if (!defined $line || $line !~ /^-+$/) {
75 die "Unexpected output from svn log.\n";
78 $line = <SVNLOG>;
79 if ($line !~ /^r(\d+) \|/) {
80 die "Unexpected output from svn log.\n";
82 $rev1 = $1;
83 } else {
84 # git
85 $rev1 = "v$last_release";
86 if (`git tag -l \Q$rev1\E` eq '' && `git tag -l \Q$last_release\E` ne '') {
87 $rev1 = $last_release;
90 } else {
91 die "Can't find revision in NEWS\n";
94 if ($vcs eq 'svn') {
95 open BLAME, "svn blame -r$rev1:HEAD ChangeLog 2>/dev/null|" or die $!;
96 } elsif ($vcs eq 'git') {
97 open BLAME, "git blame $rev1.. ChangeLog 2>/dev/null|" or die $!;
98 } else {
99 open BLAME, "git log $rev1.. -- . 2>/dev/null|" or die $!;
102 open NEWSTMP, '>', 'NEWS~' or die $!;
104 my $lines = 0;
105 my $prefix = "";
106 while (<BLAME>) {
107 if ($lines == 0) {
108 if ($vcs eq 'svn') {
109 print NEWSTMP;
110 } elsif ($vcs eq 'git') {
111 print NEWSTMP;
112 } else {
113 if (/ ([0-9a-f]+)/) {
114 print NEWSTMP "up to: $1\n\n";
118 if ($vcs eq 'svn') {
119 if (!s/^( *(\d+) +(\S+) )//) {
120 last if (/^ *-/);
121 } else {
122 if ($1 ne $prefix) {
123 $prefix = $1;
124 $_ = $prefix . $_;
125 print NEWSTMP "\n";
126 } else {
127 next if $_ eq "\n";
130 } elsif ($vcs eq 'git') {
131 next if /^\^/;
132 if (s/^([[:xdigit:]]+.*?) +\d+\) //) {
133 my $p = $1 . ")\n";
134 if ($p ne $prefix) {
135 $prefix = $p;
136 $_ = $prefix . $_;
137 print NEWSTMP "\n";
138 } else {
139 next if $_ eq "\n";
142 } else {
143 # next if /^\^/;
144 # if (s/^([[:xdigit:]]+.*?) +\d+\) //) {
145 # my $p = $1 . ")\n";
146 # if ($p ne $prefix) {
147 # $prefix = $p;
148 # $_ = $prefix . $_;
149 # print NEWSTMP "\n";
150 # } else {
151 # next if $_ eq "\n";
155 print NEWSTMP;
156 ++$lines;
158 close BLAME;
159 if ($lines == 0) {
160 close NEWSTMP;
161 unlink 'NEWS~';
162 print "No ChangeLog entries since the last update to NEWS.\n";
163 exit 0;
166 print NEWSTMP "\n";
167 if (defined $new_version) {
168 if (open NEWSSKEL, '<', 'NEWS.SKELETON') {
169 while (<NEWSSKEL>) {
170 s/\@VERSION\@/$new_version/g;
171 s/\@DATE\@/$date/g;
172 print NEWSTMP;
174 close NEWSSKEL;
177 print NEWSTMP $news if defined $news;
178 while (<NEWS>) {
179 if (!defined $new_version) {
180 if (s/^([A-Za-z][-\w]* (\d+(?:\.\d+)+) \()\d{4}-\d\d-\d\d(\):)$/$1$date$3/) {
181 $new_version = $2;
184 print NEWSTMP;
186 close NEWS;
187 close NEWSTMP or die $!;
188 rename 'NEWS~', 'NEWS' or die $!;