2c879b2bfdc79c7bb5cadfab6f7ec6f47a12531e
[pkg-perl/scripts.git] / sort_unreleased_packages.pl
1 #!/usr/bin/perl
2
3 # Copryright © 2014 by Axel Beckert <abe@debian.org>
4 #
5 # License:
6 #
7 #         DO WHAT THE FUCK YOU WANT TO PUBLIC LICENSE
8 #                    Version 2, December 2004
9 #
10 # Copyright (C) 2004 Sam Hocevar <sam@hocevar.net>
11 #
12 # Everyone is permitted to copy and distribute verbatim or modified
13 # copies of this license document, and changing it is allowed as long
14 # as the name is changed.
15 #
16 #            DO WHAT THE FUCK YOU WANT TO PUBLIC LICENSE
17 #   TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
18 #
19 #  0. You just DO WHAT THE FUCK YOU WANT TO.
20 #
21
22 use warnings;
23 use strict;
24
25 use FindBin qw($Bin);
26 use Parse::DebianChangelog;
27 use Getopt::Long qw(:config auto_help);
28
29 # Init
30 my @changelogs = <$Bin/../packages/*/debian/changelog>;
31 my %result = ();
32 my %date = ();
33 my %timestamp = ();
34 my %noupload = ();
35
36 # Defaults
37 my $bydate = 0;
38 my $bylength = 0;
39 my $never = -1;
40
41 # Getopt
42 GetOptions ('date' => \$bydate,
43             'time' => \$bydate,
44             'length' => \$bylength,
45             'unreleased' => \$bylength,
46             'never!' => \$never);
47 $bydate = 1 unless $bylength or $bydate;
48
49 foreach my $file (@changelogs) {
50     my $cl = Parse::DebianChangelog->init({infile => $file});
51     my $entries = $cl->data;
52
53     next unless $entries->[0]->Distribution eq 'UNRELEASED';
54     $result{$file} = scalar split(/\n/, $entries->[0]->Changes);
55
56     if ($entries->[1]) {
57         $date{$file}      = $entries->[1]->Date;
58         $timestamp{$file} = $entries->[1]->Timestamp;
59     } else {
60         $date{$file}      = $entries->[0]->Date;
61         $timestamp{$file} = $entries->[0]->Timestamp;
62         $noupload{$file}  = 1;
63     }
64 }
65
66 my @result;
67 if ($bydate) {
68     @result = sort { $timestamp{$b} <=> $timestamp{$a}  } keys %result;
69 } elsif ($bylength) {
70     @result = sort { $result{$a} <=> $result{$b} or $a cmp $b } keys %result;
71 } else {
72     die "Assertion: Should be never reached"
73 }
74
75 foreach my $file (@result) {
76     next if ($never == 1 and not $noupload{$file});
77     next if ($never == 0 and $noupload{$file});
78
79     my $pkg = $file;
80     $pkg =~ s:^.*/packages/(.*?)/debian/changelog$:$1:;
81
82     # Properly format dates with single digit day but only one blank before it
83     $date{$file} =~ s/^([A-Z][a-z]{2}), (\d) /$1,  $2 /;
84
85     printf "%3i (%s): %-50s%s\n",
86         $result{$file},
87         $date{$file},
88         $pkg,
89         $noupload{$file} ? ' (Never uploaded)' : '';
90 }
91
92 =head1 NAME
93
94 sort_unreleased_packages.pl - sort pkg-perl's unreleased packages
95
96 =head1 SYNOPSIS
97
98 =over 12
99
100 =item B<sort_unreleased_packages.pl>
101
102 [B<--help>]
103 [B<--date>|B<--time>|B<--length>|B<--unreleased>]
104 [B<--never>|B<--nonever>]
105
106 =back
107
108 =head1 DESCRIPTION
109
110 This script expects a locally checked out copy of all packages
111 maintained by the Debian Perl Group (use "mr up" for getting there)
112 and checks all their changelogs for "UNRELEASED" changes.
113
114 It then sorts and outputs the packages by different criterias. It can
115 also filter on never uploaded packages.
116
117 =head1 OPTIONS AND ARGUMENTS
118
119 =over 8
120
121 =item B<--help>
122
123 Print a brief help message and exit.
124
125 =item B<--date> or B<--date>
126
127 Order output by date and time of last upload (according to the
128 changelog entries).
129
130 =item B<--length> or B<--unreleased>
131
132 Order output by the number of lines in the current "UNRELEASED"
133 changelog entry.
134
135 =item B<--never>
136
137 Only show never uploaded packages.
138
139 =item B<--nonever>
140
141 Don't show packages which were never uploaded.
142
143 =back
144
145 =head1 AUTHOR
146
147 Axel Beckert E<lt>abe@debian.orgE<gt>
148
149 =head1 COPYRIGHT
150
151 Copryright (C) 2014 by Axel Beckert E<lt>abe@debian.orgE<gt>
152
153 =head1 LICENSE
154
155 DO WHAT THE FUCK YOU WANT TO PUBLIC LICENSE
156
157 Version 2, December 2004
158
159 Copyright (C) 2004 Sam Hocevar E<lt>sam@hocevar.netE<gt>
160
161 Everyone is permitted to copy and distribute verbatim or modified
162 copies of this license document, and changing it is allowed as long as
163 the name is changed.
164
165 DO WHAT THE FUCK YOU WANT TO PUBLIC LICENSE
166
167 TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
168
169 0. You just DO WHAT THE FUCK YOU WANT TO.