#!/usr/bin/perl ############################################################################# ## ## Copyright (C) 2013 Intel Corporation. ## Contact: http://www.qt-project.org/legal ## ## $QT_BEGIN_LICENSE:BSD$ ## You may use this file under the terms of the BSD license as follows: ## ## "Redistribution and use in source and binary forms, with or without ## modification, are permitted provided that the following conditions are ## met: ## * Redistributions of source code must retain the above copyright ## notice, this list of conditions and the following disclaimer. ## * Redistributions in binary form must reproduce the above copyright ## notice, this list of conditions and the following disclaimer in ## the documentation and/or other materials provided with the ## distribution. ## * Neither the name of Digia Plc and its Subsidiary(-ies) nor the names ## of its contributors may be used to endorse or promote products derived ## from this software without specific prior written permission. ## ## ## THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ## "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT ## LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR ## A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT ## OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, ## SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT ## LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, ## DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY ## THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT ## (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE ## OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE." ## ## $QT_END_LICENSE$ ## ############################################################################# use strict; use warnings; use Text::Wrap; my %log; sub help { print "Usage: create-changelog \n" . "\n" . "srcdir the qt source directory\n" . "revision-range arguments to git log, like v5.0.0..v5.1.0-rc1\n"; exit 0; } sub collect_entries { # Run git submodule foreach chdir(shift @ARGV) if (scalar @ARGV); open FOREACH, "-|", "git", "submodule", "foreach", "--quiet", "git rev-list --reverse --grep '^\\[ChangeLog\\]' " . $ARGV[0] . " 2> /dev/null | git cat-file --batch || true"; # Collect all entries while () { /(^[0-9a-f]{40}) commit (\d+)/ or die("Could not parse header line: $_"); my %entry; $entry{commit} = $1; my $msg; die("Could not read log message") unless read(FOREACH, $msg, $2 + 1) == $2 + 1; # is there a task number? # Extract each argument after Task-number: to an array my @tasks = ( $msg =~ /^Task-number:\s*(.*)\s*$/mixg ); $entry{tasks} = \@tasks; # Extract the changelogs from $msg my @texts = ( $msg =~ /\[ChangeLog\](.*?)\n(?=\n)/sixg ); foreach (@texts) { /\[((?:[^]]|\]\[)+)\]\s*(.*)\z/si; my @groups = split(/\]\[/, $1); $entry{text} = $2 =~ s/\s+/ /gr; $entry{text} =~ s/\s+$//; # Store this entry # Each entry in %log is a hash my $topgroup = shift @groups; my $logentry = \$log{$topgroup}; $$logentry = {} unless defined($$logentry); my $subentry; if (scalar @groups) { # Two-level entry $subentry = join(' / ', @groups); } else { # One-level entry $subentry = 0; } my $array = \$$$logentry{$subentry}; $$array = [] unless defined($$array); push $$array, { %entry }; } } close FOREACH or die("git submodule foreach died: $!"); } sub print_entry($%) { my $level = $_[0]; my %entry = %{$_[1]}; die if $level > 1; my $line; #$line = $entry{commit}; $line .= join('', map { "[$_]" } @{$entry{tasks}}); $line .= ' ' if scalar @{$entry{tasks}}; $line .= $entry{text}; if ($level == 0) { print wrap(" - ", " ", $line); } else { print wrap(" * ", " ", $line); } print "\n"; } help() unless scalar @ARGV; # Now print the output collect_entries(); for my $toplevel (sort keys %log) { print "\n$toplevel\n"; print '-' x (length $toplevel) . "\n"; my $value = \$log{$toplevel}; # Print one-level entries first my $entry = \$$$value{0}; if (defined($$entry)) { print "\n"; foreach my $subentry (@$$entry) { print_entry(0, $subentry); } } # Print two-level entries now foreach my $sublevel (sort keys $$value) { next if $sublevel eq "0"; print "\n - $sublevel:\n"; $entry = \$$$value{$sublevel}; foreach my $subentry (@$$entry) { print_entry(1, $subentry); } } }