need to recursively chown TOPDIR
[opensuse:build.git] / spec2changelog
1 #!/usr/bin/perl
2 #
3 # Tiny perl script that parses a .spec file (STDIN), extracts
4 # its %changelog entries and prints (STDOUT) them in the
5 # format of a .changes file, ordered.
6 #
7 # Usage: cat foo.spec | spec2changes.pl > foo.changes
8 #
9 # Copyright 2009 by Pascal Bleser <pascal.bleser@opensuse.org>
10 # This script is licensed under the GNU General Public License version 2
11 # http://www.gnu.org/licenses/gpl-2.0.html
12 #
13
14 use warnings;
15 use strict;
16 use Date::Language;
17 use POSIX qw(strftime setlocale LC_ALL);
18
19 # make sure date printed in correct locale
20 $ENV{'TZ'} = 'UTC';
21 setlocale(LC_ALL, 'C');
22
23 my $sep = "-" x 67;
24 my @days   = qw{Mon Tue Wed Thu Fri Sat Sun};
25 my @months = qw{Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec};
26
27 #----------------------------------------------------------------------
28 #
29 my %dh = map { $_ => 1 } @days;
30 my %mh = map { $_ => 1 } @months;
31
32 my $date_parser = Date::Language->new('English');
33
34 my %items = ();
35 my $current_block = undef;
36 my $time = undef;
37 while (<>) {
38     if (/^%changelog/ .. eof()) {
39         next if /^%/;
40         next if /^\s*#/;
41
42         chomp;
43         s/\s+$//;
44
45         if (/^\*\s+(([A-Z][a-z]{2})\s+([A-Z][a-z]{2})\s+\d{1,2}\s+\d{4})(\s+(.*)\s*)$/ and exists $dh{$2} and exists $mh{$3}) {
46             $items{$time} = $current_block if defined $current_block and defined $time;
47             $time = $date_parser->str2time($1);
48             $current_block = [];
49             $_ = $4;
50         } elsif (/^\*/) {
51             warn("not matching a headline: \"$_\"\n");
52         }
53         push(@$current_block, $_);
54     }
55 }
56 $items{$time} = $current_block if defined $current_block and defined $time;
57
58 foreach my $time (sort { $b <=> $a } (keys(%items))) {
59     print $sep, "\n";
60     my $item = $items{$time};
61     my $head = shift(@$item);
62     $head =~ s/^\s+//;
63     $head =~ s/^\-\s+//;
64     if ($head =~ m/^(.+?)\s*<(.+?\@.+?\..+?)>(\s*.*)$/) {
65         $head = $2;
66     } elsif ($head =~ m/^<(.+?\@.+?\..+?)>(\s*.*)$/) {
67         $head = $1;
68     }
69     if ($head =~ m/^\s*-\s*(.+)$/) {
70         $head = $1;
71     }
72
73     print strftime("%a %b %e %H:%M:%S %Z %Y", localtime($time)), " - ", $head, "\n";
74     my $first = shift(@$item);
75     print "\n" unless defined($first) && ($first eq '');
76     print $first, "\n";
77     print join("\n", @$item), "\n" if @$item;
78     print "\n";
79 }