Commit c2ed6be3 authored by gregor herrmann's avatar gregor herrmann

New dpt subcommand: dpt-new-upstream.

Script to list packages with newer upstream version.
parent a29e63af
......@@ -144,6 +144,10 @@ See L<dpt-missing-pristine-tar(1)>.
See L<dpt-missing-upstream(1)>.
=item B<new-upstream> - list packages with newer upstream versions
See L<dpt-new-upstream(1)>.
=item B<packagecheck> - various package consistency checks
See L<dpt-packagecheck(1)>.
......
......@@ -176,6 +176,10 @@ Copyright: 2017-2018, Niko Tyni <ntyni@debian.org>
2017-2018, gregor herrmann <gregoa@debian.org>
License: Artistic or GPL-1+
Files: scripts/new-upstream
Copyright: 2018, gregor herrmann <gregoa@debian.org>
License: Artistic or GPL-1+
Files: lib/*
Copyright: 2016, Alex Muntada <alexm@alexm.org>
License: Artistic or GPL-1+
......
#!/usr/bin/perl
use strict;
use warnings;
use Dpkg::Changelog::Debian;
use Dpkg::Control::Info;
use File::Spec;
use Getopt::Long;
use HTTP::Tiny;
use JSON::XS;
use Pod::Usage qw( pod2usage );
use 5.010;
my %opt;
GetOptions( \%opt, 'help|h', 'man|m' ) || pod2usage(2);
pod2usage(1) if $opt{help};
pod2usage( -exitval => 0, -verbose => 2 ) if $opt{man};
my $dpt_packages = $ENV{'DPT_PACKAGES'};
die "Required configuration variable DPT_PACKAGES is not set
in ~/.dpt.conf or ~/.config/dpt.conf or in your environment.\n" unless $dpt_packages;
$dpt_packages =~ s/~/$ENV{'HOME'}/;
die "No directory called '$dpt_packages' found: $!" unless -d $dpt_packages;
my $todojsonurl
= 'https://udd.debian.org/dmd/?email1=pkg-perl-maintainers%40lists.alioth.debian.org&format=json';
my $response = HTTP::Tiny->new->get($todojsonurl);
if ( !$response->{success} ) {
say "$response->{status} $response->{reason}";
while ( my ( $k, $v ) = each %{ $response->{headers} } ) {
for ( ref $v eq 'ARRAY' ? @$v : $v ) {
say "$k: $_\n";
}
}
exit(1);
}
die "Content empty" unless length $response->{content};
my $json = $response->{content};
my $todos = decode_json($json);
my @newupstream = sort { $a->{':source'} cmp $b->{':source'} }
grep { $_->{':shortname'} =~ /^newupstream_/ } @{$todos};
my $new_categorized = {};
foreach (@newupstream) {
my $source = $_->{':source'};
my $uversion = $_->{':details'};
my $changelogfile
= File::Spec->catfile( $dpt_packages, $source, 'debian', 'changelog' );
warn("Can't find changelog '$changelogfile' for package '$source'.\n"), next
unless -f $changelogfile;
my $changelog = Dpkg::Changelog::Debian->new( range => { "count" => 1 } );
$changelog->load($changelogfile);
my $entry = @{$changelog}[0]; # Dpkg::Changelog::Entry::Debian object
my $dversion = $entry->get_version();
my $dist = $entry->get_distributions();
my @items = $entry->get_change_items();
my $ignore_version = grep /^\s+IGNORE-VERSION:/, @items;
my $waits_for = grep /^\s+WAITS-FOR:/, @items;
my $issue = grep /^\s+(PROBLEM|TODO|NOTE|WARNING|FIXME):/, @items;
my $controlfile
= File::Spec->catfile( $dpt_packages, $source, 'debian', 'control' );
warn("Can't find control '$controlfile' for package '$source'.\n"), next
unless -f $controlfile;
my $control = Dpkg::Control::Info->new($controlfile); # Dpkg::Control object
my $build_depends = $control->get_source()->{'Build-Depends'}; # string!
my $cdbs = $build_depends =~ /cdbs/m;
# categorize new upstream releases
my $pkg = {
source => $source,
dist => $dist,
dversion => "$dversion", # stringify Dpkg::Version
uversion => $uversion,
};
push @{ $new_categorized->{'ignore-version'} }, $pkg if $ignore_version;
push @{ $new_categorized->{'waits-for'} }, $pkg if $waits_for;
push @{ $new_categorized->{'problem'} }, $pkg if $issue;
push @{ $new_categorized->{'cdbs'} }, $pkg if $cdbs;
push @{ $new_categorized->{'default'} }, $pkg
unless ( $ignore_version or $waits_for or $issue or $cdbs );
}
my @categories = (qw/default cdbs problem ignore-version waits-for/);
foreach (@categories) {
my $category = $_;
next unless defined( $new_categorized->{$category} );
my @categoryentries = @{ $new_categorized->{$category} };
my $title
= "New upstream releases ($category): " . scalar(@categoryentries);
say "\n$title";
say '=' x 96;
my $format = "%-50s %-25s %-15s\n";
printf $format, 'Source package', 'Status git', 'Upstream (DMD)';
say '-' x 96;
foreach (@categoryentries) {
printf $format, $_->{'source'},
$_->{'dist'} . '/' . $_->{'dversion'},
$_->{'uversion'};
}
}
exit;
__END__
=head1 NAME
dpt-new-upstream - list packages with newer upstream versions
=head1 SYNOPSIS
B<dpt new-upstream> I<[--help|-h]> I<[--man|-m]>
=head1 DESCRIPTION
B<dpt new-upstream> queries UDD's DMD for newer upstream version, compares
the results to the local git clones, categorizes the found packages, and
outputs tables by category. If this reminds you of PET -- you're not wrong
to assume that there was some inspiration taken from there.
/*
=over
=item UDD: Ultimate Debian Database
=item DMD: Debian Maintainer Dashboard
=item PET: Package Entropy Tracker
=back
*/
=head1 OPTIONS
=over
=item B<--help|-h>
Show this help.
=item B<--man|-m>
Show full manpage.
=back
=head1 CONFIGURATION
B<dpt new-upstream> uses the C<DPT_PACKAGES> environment variable.
See L<dpt-config(5)> for details.
=head1 COPYRIGHT AND LICENSE
Copyright 2018, gregor herrmann E<lt>gregoa@debian.orgE<gt>
Released under the same terms as Perl itself, i.e. Artistic or GPL-1+.
......@@ -26,6 +26,7 @@ Cf
DEBEMAIL
DEBFULLNAME
DEP
DMD
Damyan
GPL
Ghedini
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment