[honey] Fix portability to systems without pread()
[xapian.git] / xapian-maintainer-tools / changelog-to-news
blob1b15e7e565c062659a4c0f8b1869c47531a260f8
1 #!/usr/bin/perl -w
2 # Copyright (c) Olly Betts 2010,2011,2012
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 = 'git';
29 open CL, '<', 'ChangeLog' or die "Can't find 'ChangeLog' in current directory: $!\n";
30 my $cl_head = <CL>;
31 $vcs = 'gitlog' if $cl_head !~ /^(?:Mon|Tue|Wed|Thu|Fri|Sat|Sun) /;
33 my $new_version;
34 my $date = strftime("%Y-%m-%d", gmtime());
35 open NEWS, '<', 'NEWS' or die "Can't find 'NEWS' in current directory: $!\n";
36 my $news = <NEWS>;
37 my $rev1;
38 if ($news =~ /^(?:up *to:?) *([[:xdigit:]]{7,}|\d+)\b/i) {
39 # Partly updated already.
40 if ($vcs eq 'svn') {
41 $rev1 = $1 + 1;
42 } else {
43 $rev1 = $1;
45 # Discard that line...
46 $news = undef;
47 } elsif ($news =~ /^(?:Changes in|\S+) (\d[\d\.]*\.)(\d+) \(/) {
48 # No updates since the last release.
49 my $last_release = "$1$2";
50 $new_version = $1.($2+1);
51 print "Finding changes since release '$last_release'.\n";
52 if (-d '.svn') {
53 open SVNINFO, "svn info|" or die $!;
54 my $svnroot;
55 while (<SVNINFO>) {
56 if (s/^Repository Root: //) {
57 chomp;
58 $svnroot = $_;
59 last;
62 if (!defined $svnroot) {
63 die "svn info didn't tell us the repo root!\n";
65 close SVNINFO;
66 open SVNLOG, "svn log --limit=1 \Q$svnroot\E/tags/\Q$last_release\E|" or die $!;
67 my $line = <SVNLOG>;
68 if (!defined $line || $line !~ /^-+$/) {
69 $last_release =~ y/./_/;
70 open SVNLOG, "svn log --limit=1 \Q$svnroot\E/tags/v\Q$last_release\E|" or die $!;
71 $line = <SVNLOG>;
72 if (!defined $line || $line !~ /^-+$/) {
73 die "Unexpected output from svn log.\n";
76 $line = <SVNLOG>;
77 if ($line !~ /^r(\d+) \|/) {
78 die "Unexpected output from svn log.\n";
80 $rev1 = $1;
81 } else {
82 # git
83 $rev1 = "v$last_release";
84 if (`git tag -l \Q$rev1\E` eq '' && `git tag -l \Q$last_release\E` ne '') {
85 $rev1 = $last_release;
88 } else {
89 die "Can't find revision in NEWS\n";
92 if ($vcs eq 'svn') {
93 open BLAME, "svn blame -r$rev1:HEAD ChangeLog 2>/dev/null|" or die $!;
94 } elsif ($vcs eq 'git') {
95 open BLAME, "git blame $rev1.. ChangeLog 2>/dev/null|" or die $!;
96 } else {
97 open BLAME, "git log $rev1.. -- . 2>/dev/null|" or die $!;
100 open NEWSTMP, '>', 'NEWS~' or die $!;
102 my $lines = 0;
103 my $prefix = "";
104 while (<BLAME>) {
105 if ($lines == 0) {
106 if ($vcs eq 'svn') {
107 print NEWSTMP;
108 } elsif ($vcs eq 'git') {
109 print NEWSTMP;
110 } else {
111 if (/ ([0-9a-f]+)/) {
112 print NEWSTMP "up to: $1\n\n";
116 if ($vcs eq 'svn') {
117 if (!s/^( *(\d+) +(\S+) )//) {
118 last if (/^ *-/);
119 } else {
120 if ($1 ne $prefix) {
121 $prefix = $1;
122 $_ = $prefix . $_;
123 print NEWSTMP "\n";
124 } else {
125 next if $_ eq "\n";
128 } elsif ($vcs eq 'git') {
129 next if /^\^/;
130 if (s/^([[:xdigit:]]+.*?) +\d+\) //) {
131 my $p = $1 . ")\n";
132 if ($p ne $prefix) {
133 $prefix = $p;
134 $_ = $prefix . $_;
135 print NEWSTMP "\n";
136 } else {
137 next if $_ eq "\n";
140 } else {
141 # next if /^\^/;
142 # if (s/^([[:xdigit:]]+.*?) +\d+\) //) {
143 # my $p = $1 . ")\n";
144 # if ($p ne $prefix) {
145 # $prefix = $p;
146 # $_ = $prefix . $_;
147 # print NEWSTMP "\n";
148 # } else {
149 # next if $_ eq "\n";
153 print NEWSTMP;
154 ++$lines;
156 close BLAME;
157 if ($lines == 0) {
158 close NEWSTMP;
159 unlink 'NEWS~';
160 print "No ChangeLog entries since the last update to NEWS.\n";
161 exit 0;
164 print NEWSTMP "\n";
165 if (defined $new_version) {
166 if (open NEWSSKEL, '<', 'NEWS.SKELETON') {
167 while (<NEWSSKEL>) {
168 s/\@VERSION\@/$new_version/g;
169 s/\@DATE\@/$date/g;
170 print NEWSTMP;
172 close NEWSSKEL;
175 print NEWSTMP $news if defined $news;
176 while (<NEWS>) {
177 if (!defined $new_version) {
178 if (s/^([A-Za-z][-\w]* (\d+(?:\.\d+)+) \()\d{4}-\d\d-\d\d(\):)$/$1$date$3/) {
179 $new_version = $2;
182 print NEWSTMP;
184 close NEWS;
185 close NEWSTMP or die $!;
186 rename 'NEWS~', 'NEWS' or die $!;