#!/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
