#!/usr/bin/perl
#
# Transforms Lucene Java's CHANGES.txt into Changes.html
#
# Input is on STDIN, output is to STDOUT
#
#
# Licensed to the Apache Software Foundation (ASF) under one or more
# contributor license agreements. See the NOTICE file distributed with
# this work for additional information regarding copyright ownership.
# The ASF licenses this file to You under the Apache License, Version 2.0
# (the "License"); you may not use this file except in compliance with
# the License. You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
#
use strict;
use warnings;
my $jira_url_prefix = 'http://issues.apache.org/jira/browse/';
my $bugzilla_url_prefix = 'http://issues.apache.org/bugzilla/show_bug.cgi?id=';
my %release_dates = &setup_release_dates;
my $month_regex = &setup_month_regex;
my %month_nums = &setup_month_nums;
my %bugzilla_jira_map = &setup_bugzilla_jira_map;
my $title = undef;
my $release = undef;
my $reldate = undef;
my $relinfo = undef;
my $sections = undef;
my $items = undef;
my $first_relid = undef;
my $second_relid = undef;
my @releases = ();
my @lines = <>; # Get all input at once
#
# Parse input and build hierarchical release structure in @releases
#
for (my $line_num = 0 ; $line_num <= $#lines ; ++$line_num) {
$_ = $lines[$line_num];
next unless (/\S/); # Skip blank lines
next if (/^\s*\$Id(?::.*)?\$/); # Skip $Id$ lines
unless ($title) {
if (/\S/) {
s/^\s+//; # Trim leading whitespace
s/\s+$//; # Trim trailing whitespace
}
s/^[^Ll]*//; # Trim leading BOM characters if exists
$title = $_;
next;
}
if (/\s*===+\s*(.*?)\s*===+\s*/) { # New-style release headings
$release = $1;
$release =~ s/^release\s*//i; # Trim "Release " prefix
($release, $relinfo) = ($release =~ /^(\d+(?:\.\d+)*|Trunk)\s*(.*)/i);
$relinfo =~ s/\s*:\s*$//; # Trim trailing colon
$relinfo =~ s/^\s*,\s*//; # Trim leading comma
($reldate, $relinfo) = get_release_date($release, $relinfo);
$sections = [];
push @releases, [ $release, $reldate, $relinfo, $sections ];
($first_relid = lc($release)) =~ s/\s+/_/g if ($#releases == 0);
($second_relid = lc($release)) =~ s/\s+/_/g if ($#releases == 1);
$items = undef;
next;
}
if (/^\s*([01](?:\.[0-9]{1,2}){1,2}[a-z]?(?:\s*(?:RC\d+|final))?)\s*
((?:200[0-7]-.*|.*,.*200[0-7].*)?)$/x) { # Old-style release heading
$release = $1;
$relinfo = $2;
$relinfo =~ s/\s*:\s*$//; # Trim trailing colon
$relinfo =~ s/^\s*,\s*//; # Trim leading comma
($reldate, $relinfo) = get_release_date($release, $relinfo);
$sections = [];
push @releases, [ $release, $reldate, $relinfo, $sections ];
$items = undef;
next;
}
# Section heading: no leading whitespace, initial word capitalized,
# five words or less, and no trailing punctuation
if (/^([A-Z]\S*(?:\s+\S+){0,4})(?[0]; # 0th position of items array is list type
} else {
$type = get_list_type($_);
push @$items, $type;
}
if ($type eq 'numbered') { # The modern items list style
# List item boundary is another numbered item or an unindented line
my $line;
my $item = $_;
$item =~ s/^(\s{0,2}\d+\.\d?\s*)//; # Trim the leading item number
my $leading_ws_width = length($1);
$item =~ s/\s+$//; # Trim trailing whitespace
$item .= "\n";
while ($line_num < $#lines
and ($line = $lines[++$line_num]) !~ /^(?:\s{0,2}\d+\.\s*\S|\S)/) {
$line =~ s/^\s{$leading_ws_width}//; # Trim leading whitespace
$line =~ s/\s+$//; # Trim trailing whitespace
$item .= "$line\n";
}
$item =~ s/\n+\Z/\n/; # Trim trailing blank lines
push @$items, $item;
--$line_num unless ($line_num == $#lines);
} elsif ($type eq 'paragraph') { # List item boundary is a blank line
my $line;
my $item = $_;
$item =~ s/^(\s+)//;
my $leading_ws_width = defined($1) ? length($1) : 0;
$item =~ s/\s+$//; # Trim trailing whitespace
$item .= "\n";
while ($line_num < $#lines and ($line = $lines[++$line_num]) =~ /\S/) {
$line =~ s/^\s{$leading_ws_width}//; # Trim leading whitespace
$line =~ s/\s+$//; # Trim trailing whitespace
$item .= "$line\n";
}
push @$items, $item;
--$line_num unless ($line_num == $#lines);
} else { # $type is one of the bulleted types
# List item boundary is another bullet or a blank line
my $line;
my $item = $_;
$item =~ s/^(\s*\Q$type\E\s*)//; # Trim the leading bullet
my $leading_ws_width = length($1);
$item =~ s/\s+$//; # Trim trailing whitespace
$item .= "\n";
while ($line_num < $#lines
and ($line = $lines[++$line_num]) !~ /^(?:\S|\s*\Q$type\E)/) {
$line =~ s/^\s{$leading_ws_width}//; # Trim leading whitespace
$line =~ s/\s+$//; # Trim trailing whitespace
$item .= "$line\n";
}
push @$items, $item;
--$line_num unless ($line_num == $#lines);
}
}
#
# Print HTML-ified version to STDOUT
#
print<<"__HTML_HEADER__";
$title
$title
__HTML_HEADER__
my $heading;
my $relcnt = 0;
my $header = 'h2';
for my $rel (@releases) {
if (++$relcnt == 3) {
$header = 'h3';
print "
\n"
if ($has_release_sections);
for my $section (@$sections) {
($heading, $items) = @$section;
(my $sectid = lc($heading)) =~ s/\s+/_/g;
my $numItemsStr = $#{$items} > 0 ? "($#{$items})" : "(none)";
print "
",
($heading || ''), " $numItemsStr\n"
if ($has_release_sections and $heading);
my $list_type = $items->[0] || '';
my $list = ($has_release_sections || $list_type eq 'numbered' ? 'ol' : 'ul');
my $listid = $sectid ? "$relid.$sectid" : $relid;
print " <$list id=\"$listid.list\">\n"
unless ($has_release_sections and not $heading);
for my $itemnum (1..$#{$items}) {
my $item = $items->[$itemnum];
$item =~ s:&:&:g; # Escape HTML metachars,
$item =~ s:<(?!/?code>):<:gi; # but leave tags intact
$item =~ s:(?:>:gi; # and add
tags so that
$item =~ s::
:gi; # whitespace is preserved in the
$item =~ s:\s*
:
:gi; # output.
# Put attributions on their own lines.
# Check for trailing parenthesized attribution with no following period.
# Exclude things like "(see #3 above)" and "(use the bug number instead of xxxx)"
unless ($item =~ s:\s*(\((?!see #|use the bug number)[^)"]+?\))\s*$:\n $1:) {
# If attribution is not found, then look for attribution with a
# trailing period, but try not to include trailing parenthesized things
# that are not attributions.
#
# Rule of thumb: if a trailing parenthesized expression with a following
# period does not contain "LUCENE-XXX", and it either has three or
# fewer words or it includes the word "via" or the phrase "updates from",
# then it is considered to be an attribution.
$item =~ s{(\s*(\((?!see \#|use the bug number)[^)"]+?\)))
((?:\.|(?i:\.?\s*Issue\s+\d{3,}|LUCENE-\d+)\.?)\s*)$}
{
my $subst = $1; # default: no change
my $parenthetical = $2;
my $trailing_period_and_or_issue = $3;
if ($parenthetical !~ /LUCENE-\d+/) {
my ($no_parens) = $parenthetical =~ /^\((.*)\)$/s;
my @words = grep {/\S/} split /\s+/, $no_parens;
if ($no_parens =~ /\b(?:via|updates\s+from)\b/i || scalar(@words) <= 3) {
$subst = "\n $parenthetical";
}
}
$subst . $trailing_period_and_or_issue;
}ex;
}
$item =~ s{(.*?)(