File: missing-upstream

package info (click to toggle)
pkg-perl-tools 0.82
  • links: PTS, VCS
  • area: main
  • in suites: trixie
  • size: 796 kB
  • sloc: sh: 3,255; perl: 3,239; makefile: 142; python: 18
file content (224 lines) | stat: -rwxr-xr-x 6,402 bytes parent folder | download | duplicates (2)
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
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
#!/usr/bin/perl
#
# Copyright, licensing and codumentation below

use strict;
use warnings;

use feature 'say';

use autodie;
use Dpkg::Changelog::Debian;
use File::Basename qw(basename);
use File::Temp qw(tempdir);
use Getopt::Long;
use Git;
use IPC::Run qw(run);
use WWW::Mechanize;

our $opt_check_only;
our $opt_skip_missing_snapshots;

GetOptions(
    'check-only!' => \$opt_check_only,
    'skip-missing-snapshots!' => \$opt_skip_missing_snapshots,
) or exit 1;

my $me = basename($0);

my $has_non_native_releases = 0;

my $cl = Dpkg::Changelog::Debian->new( range => { "all" => 1 } );
$cl->load('debian/changelog') or die "Parse error\n";
my $git = Git->repository();
my %tags = map ( ( $_ => 1 ), $git->command('tag') );
my @releases;
my %versions;
my @entries = @{$cl};
my $pkg;
for my $r ( @entries ) {
    $pkg = $r->get_source();

    my $ver = $r->get_version();
    $ver =~ s/^\d+://;
    if ( not $ver =~ s/-[^-]+$// ) {
        say "Skipping native version $ver";
        next;
    }
    $has_non_native_releases = 1;
    my $tag = "upstream/$ver";
    last if $tags{$tag};
    ( my $tmp_tag = $tag ) =~ s/~/_/;
    last if $tags{$tmp_tag};
    ( $tmp_tag = $tag ) =~ s/~/-/;
    last if $tags{$tmp_tag};
    ( $tmp_tag = $tag ) =~ s/~/./;
    last if $tags{$tmp_tag};

    push @releases, $r unless $versions{$ver};
    $versions{$ver} = 1;
}

unless ( @releases ) {
    say "$pkg: All releases have upstream tags";
    my @branches = $git->command('branch');
    if ( grep { /^[* ] upstream$/ } @branches ) {
        my @upstream_in_branches = $git->command('branch', '--contains', 'upstream');
        unless ( grep { /^[* ] master$/ } @upstream_in_branches ) {
            warn "$pkg: branch upstream not merged into master\n";
            my @last_tag = $git->command( 'tag', '--contains', 'upstream' );
            if ( @last_tag ) {
                warn "$pkg: the last upstream tag seems to be @last_tag\n";
                $git->command( 'merge', @last_tag );
            }
            else {
                warn "Unable to find the latest upstream tag. Merging 'upstream'\n";
                $git->command( merge => 'upstream' );
            }
            $git->command('push');
        }
        exit 0;
    }
    else {
        die "Package $pkg has no local upstream branch.\n"
            if $has_non_native_releases;
    }

    exit 0;
}

warn "$me: Missing upstream tags: ", join( ' ', map( $_->get_version(), @releases ) ),
    "\n";

exit 1 if $opt_check_only;

my $tmp = tempdir( CLEANUP => 1 );
my $web = WWW::Mechanize->new( autocheck => 0 );
while ( my $r = pop @releases ) {
    my $source = $r->get_source();
    my $version = $r->get_version();
    $version =~ s/-[^-]+$//;
    $version =~ s/^\d+://;
    $web->get("https://snapshot.debian.org/package/$source/");
    my @ver_links = $web->find_all_links( text_regex => qr/^\Q$version\E/ );

    unless ( @ver_links ) {
        if ($opt_skip_missing_snapshots) {
            warn
                "Version $version not found on https://snapshot.debian.org/package/$source/ Skipping.\n";
            next;
        }
    }

    my $filename;
    foreach my $ver_link (@ver_links) {
        $web->get( $ver_link->url_abs ) or die "Can't GET " . $ver_link->url;

        my $orig = $web->follow_link( text_regex => qr/\.orig\.tar\./ )
            or warn "Unable to find a link to the original source tarball on "
            . $web->uri . "\n", next;


        $filename = "$tmp/$source\_$version.orig.tar.gz";
        open( my $fh, '>', $filename );
        print $fh $orig->content;
        close $fh;

        say $web->uri . " downloaded.";
        last;
    }

    unless($filename) {
        my $wanted = "../$source\_$version.orig.tar.gz";
        if ( -f $wanted ) {
            warn "Using $wanted as upstream source.\n";
            $filename = $wanted;
        }
    }

    die "Unable to find orig.tar for version $version and nothing appropriate found in ../.\n" unless $filename;

    unless (`git branch | grep 'upstream'`) {
        say "Missing branch 'upstream'";
        if (`git branch -a | grep origin/upstream`) {
            say "Creating it from origin/upstream";
            run( [qw( git branch upstream origin/upstream )] );
        }
        else {
            say "Creating it from scratch";
            $git->command( checkout => '--orphan', 'upstream' );
            $git->command( rm => '-qrf', '.' );
            $git->command(
                commit => '--allow-empty',
                "-mCreated empty upstream branch"
            );
            $git->command( checkout => 'master' );
        }
    }

    my @gbp_import_orig_cmd =
        -x '/usr/bin/gbp' ? qw(gbp import-orig) : qw(git-import-orig);
    run([   @gbp_import_orig_cmd,
            '--no-merge', '--pristine-tar',  "--upstream-version=$version",
            $filename
        ]
    ) or die join(' ', @gbp_import_orig_cmd).' failed';

    say "$me: $source\_$version.orig.tar.gz imported.";
}

say "$me: merging upstream branch into master";
say scalar $git->command( merge => '--allow-unrelated-histories', 'upstream' );

say "$me: \\o/ Done!";
say "$me: Don't forget to 'git push --all' and 'git push --tags' :)";

__END__
=head1 NAME

dpt-missing-upstream - fix missing C<upstream> branch and/or tags

=head1 SYNOPSIS

B<dpt missing-upstream> [I<--skip-missing-snapshots>] [I<--check-only>]

=head1 DESCRIPTION

B<dpt missing-upstream> tries to find releases present in F<debian/changelog>
that have no corresponding tags like C<upstream/x.y.z>.

For each missing tag, an attempt is made to download the upstream sources from
L<https://snapshot.debian.org/> and then put them in version control using
L<gbp-import-orig(1)>.

If the C<upstream> branch is also not present, it is either created from the
remote repository, or, if it is not present on the remote repository, created
from scratch.

When all is done, the C<upstream> branch is merged into C<master>. Nothing is
pushed.

=head1 OPTIONS

=over

=item I<--check-only>

Only report missing tags, do not try to download sources.

=item I<--skip-missing-snapshots>

If a given upstream source is not found even on L<https://snapshot.debian.org>,
just move on and do not abort execution.

=back

=head1 COPYRIGHT & LICENSE

Copyright 2011 Damyan Ivanov L<dmn@debian.org>

Copyright 2019 intrigeri L<intrigeri@boum.org>

License: Artistic | GPL-1+

=cut