1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
|
#!/usr/bin/perl
use strict;
use warnings;
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: $_";
}
}
exit(1);
}
die "Content empty" unless length $response->{content};
my $json = $response->{content};
my $todos = decode_json($json);
# {
# ":shortname": "vcs_1d3d75dc0749b5f1cf615b273fb9a4f1",
# ":type": "vcs",
# ":source": "libbusiness-onlinepayment-perl",
# ":link": "https://salsa.debian.org/perl-team/modules/packages/libbusiness-onlinepayment-perl",
# ":description": "New version",
# ":details": " ready for upload",
# ":reason": "Maintained by pkg-perl-maintainers@lists.alioth.debian.org"
# },
my @readyforupload = sort { $a->{':source'} cmp $b->{':source'} }
grep { $_->{':shortname'} =~ /^vcs_/ } @{$todos};
my $header = "Packages in Git ready for upload";
say $header;
say "=" x length($header);
say "* $_->{':source'}" foreach @readyforupload;
exit;
__END__
=head1 NAME
dpt-ready-for-upload - list packages in Git which need an upload
=head1 SYNOPSIS
B<dpt ready-for-upload> I<[--help|-h]> I<[--man|-m]>
=head1 DESCRIPTION
B<dpt ready-for-upload> queries UDD's DMD for packages which are considered "ready for upload",
i.e. where the version in Git is newer than the latest version in the archive.
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 ready-for-upload> uses the C<DPT_PACKAGES> environment variable.
See L<dpt-config(5)> for details.
=head1 COPYRIGHT AND LICENSE
Copyright 2023, gregor herrmann E<lt>gregoa@debian.orgE<gt>
Released under the same terms as Perl itself, i.e. Artistic or GPL-1+.
|
