package DhMakeRaku;

# ABSTRACT: Manage Debian package files of Raku modules

use strict;
use warnings;
use autodie qw(:all);

use Exporter qw/import/;

use Path::Tiny;
use Pod::POM;
use v5.32;
use Text::Wrap;
use Config::Model 2.150 qw/cme/;
use Pod::POM::View::Text;
use JSON;
use Git;

$Text::Wrap::columns = 72;

use feature qw/signatures/;
no warnings qw/experimental::signatures/;

our @EXPORT_OK = qw/setup_debian_files setup_git commit set_remote/;

sub add_missing_tag {
    my $version = get_version_from_meta6();
    my $blame_line =  Git::command_oneline('blame', '-L', '/"version"/,+1', 'META6.json');
    my $commit_nb = (split / /, $blame_line)[0];
    # Raku custom has tags with a leading 'v'
    my $tag = 'v'.$version;
    Git::command_oneline(tag => $tag => $commit_nb);
    return $tag;
}

sub setup_git ($arg) {
    my $init = 0;
    my $cwd = path('.')->absolute;

    my ($pkg_dir, $git, $package, $tag);
    if ($cwd->child('.git')->is_dir) {
        $package = $cwd->basename;
        $git = `git remote get-url upstream`;
        chomp $git;
        $pkg_dir = $cwd;
        $tag = $arg->{tag};
    }
    else {
        say "setup git";
        $package = $arg->{pkg} ||  die "missing 'pkg' arg\n";
        $git = $arg->{git};
        $tag = $arg->{tag} ||  die "missing 'tag' arg\n";

        if ($cwd->basename ne $package) {
            die "missing 'git' arg\n" unless $git;
            $pkg_dir = $cwd->child($package);
            if (not $pkg_dir->exists) {
                Git::command_oneline(qw/clone --origin upstream/, $git, $package);
                chdir $pkg_dir;
                my @refs = split m!/!, Git::command_oneline(qw(symbolic-ref refs/remotes/upstream/HEAD));
                my $branch = pop @refs;
                Git::command_oneline('branch', '--move', $branch, 'upstream');
                if ($tag !~ /\d/) {
                    # need to get actual version and tag
                    Git::command_oneline(checkout => $tag);
                    $tag = add_missing_tag();
                }
                system("git checkout -b debian/sid $tag");
                $init = 1;
            }
            else {
                chdir $pkg_dir;
            }
        }
    }
    return ($pkg_dir, $git, $package, $tag, $init);
}

sub set_remote ($name, $url) {
    my @remotes = Git::command_oneline(qw/remote show/);
    if (grep {$_ eq 'origin'} @remotes) {
        my $current = Git::command_oneline(qw/remote get-url origin/);
        if ($current ne $url) {
            say "Setting remote origin to $url...";
            Git::command_oneline(qw/remote set-url origin/, $url);
        }
    }
    else {
        say "Creating remote origin to $url...";
        Git::command_oneline(qw/remote add origin/, $url);
        Git::command_oneline(qw/remote set-url origin --push/, $url);
    }
}

my %dispatch = (
    "README.rakudoc" => \&get_description_from_pod,
);

sub get_description ($dir) {
    my $desc;
    while ( my ($file, $func) = each %dispatch) {
        if ($dir->child($file)->exists) {
            $desc = $func->($dir->child($file));
        }
    }
    warn "Could not find description\n" unless $desc;
    return $desc;
}

sub get_description_from_pod ($file) {
    my $parser = Pod::POM->new();
    my $pom = $parser->parse_file($file->stringify)
        || die $parser->error();

    my $txt;
    foreach my $s ($pom->head1->@*) {
        next unless $s->title() =~ /description/i;
        my $pod_desc = $s->text;
        my $desc = $pod_desc->present('Pod::POM::View::Text');
        $desc =~ s/L<([^|]+)\|.*?>/$1/;
        $desc =~ s/(.)\n(.)/$1 $2/g;
        $txt = wrap('', '', $desc);
        chomp($txt);
        last;
    }

    return $txt;
}

sub setup_control ($root, $pkg_dir, $git, $package) {
    say "setup control";

    # control file
    $root->load(<<"EOL");
control source
 Maintainer="Debian Rakudo Maintainers <pkg-rakudo-devel\@lists.alioth.debian.org>"
 Uploaders:.ensure("$ENV{DEBFULLNAME} <$ENV{DEBEMAIL}>")
 Section=interpreters
 Build-Depends:="debhelper-compat (= 13)",dh-sequence-raku
 Vcs-Browser="https://salsa.debian.org/perl6-team/modules/$package"
 Vcs-Git="https://salsa.debian.org/perl6-team/modules/$package.git"
 Homepage="$git"
 Rules-Requires-Root="no"

- binary:$package
 Synopsis=.json($package/META6.json/description)
 Synopsis=~s/^(an?|the)\\s+//i
 Architecture=all
 Depends="\${misc:Depends}","\${raku:Depends}"
EOL

    my $desc = get_description($pkg_dir);
    my $desc_obj = $root->grab("control binary:$package Description");
    if ($desc or not $desc_obj->fetch(check => 'no')) {
        $desc //= 'Please fill description manually';
        $desc_obj->store($desc);
    }
    return;
}

sub get_version_from_meta6 {
    my $file = path('META6.json');
    # utf8 decode is done by JSON module, so slurp_raw must be used
    my $data =  decode_json($file->slurp_raw);
    my $version = ( $data->{version} =~ s/^v//r );
    if ($version) {
        return $version;
    }
    else {
        die "Could not find version from META6.json";
    }
}

sub setup_changelog ($root) {
    my $version = get_version_from_meta6;
    my $log = $root->fetch_element_value('changelog');
    # this changes the default value provided by cme
    $log =~ s/\([0.-]+\)/"($version-1)"/e;
    $log =~ s/\.\.\./Initial release/;
    $root->store_element_value(changelog => $log);
}

sub update_debian_copyright($in) {
    my $email = $ENV{DEBEMAIL};
    my $name = $ENV{DEBFULLNAME};
    my @l = localtime;
    my $year = $l[5]+1900;
    my $oldyear = $year - 1;

    my @cop_lines = defined $in ? split /\n/, $in : () ;
    my $done = 0;
    foreach my $cop (@cop_lines) {
        next unless ($cop =~ /$name/);
        $done = 1;

        # append current year
        $cop =~ s/(\d+),?\s+$name/$1, $year, $name/;

        # suppress duplicate current year (for idempotency)
        $cop =~ s/$year, $year/$year/;

        # create ranges with new year when needed
        $cop =~ s/-$oldyear,\s*$year,?\s+$name/-$year, $name/g;
        $cop =~ s/$oldyear,\s*$year,?\s+$name/$oldyear-$year, $name/g;
    }
    if (not $done) {
        push @cop_lines, "$year, $name <$email>";
    }
    return join("\n", @cop_lines);
}

sub setup_copyright($root, $git, $package) {
    # copyright file
    say "setup copyright";
    $root->load(<<"EOL");
copyright
 Upstream-Name=.json($package/META6.json/name)
 Source="$git"
EOL

    my $cop_obj = $root->grab(
        step => q!copyright Files:"debian/*" Copyright!,
        check => 'no'
    );
    my $new_cop = update_debian_copyright($cop_obj->fetch(check => 'no'));
    $cop_obj->store($new_cop);

    my $license = $root->grab_value(q!copyright Files:"*" License short_name!);
    $root->load(qq!copyright Files:"debian/*" License short_name="$license"!);
}

sub get_watch_content ($git, $package) {
    my $watch;
    if ($git =~ /github/) {
        $git =~ s/\.git$//;
        $watch = <<"EOW";
version=4
opts="filenamemangle=s%(?:.*?)?v?(\\d[\\d.]*\@ARCHIVE_EXT@)%\@PACKAGE@-\$1%" \\
   $git/tags \\
   (?:.*?/)?v?\@ANY_VERSION@\@ARCHIVE_EXT@
EOW
    }
    else {
        # watch file for cgit sites
        $watch = <<"EOW";
version=4
opts=filenamemangle=s/.+\\/v?(\\d\\S+)\\.tar\\.gz/$package-\$1\\.tar\\.gz/ \\
  $git .*?-?(\\d\\S+)\\.tar\\.gz
EOW
    }

    return $watch;
}

sub setup_watch_file ($root, $git, $package) {
    say "setup watch file";
    my $watch = get_watch_content($git, $package);
    $root->store_element_value(name => "watch", value => $watch);
    return;
}

sub commit () {
    system("git add debian/");
    system('git commit -m "Initial version created with dh-make-raku"');
}

sub setup_debian_files ($pkg_dir, $git, $package, $tag, $init) {
    my $instance = cme(application => 'dpkg', name => $package);
    my $root = $instance->config_root;

    setup_control ($root, $pkg_dir, $git, $package);

    setup_changelog ($root) if $init;

    $root->instance->update;

    setup_copyright ($root, $git, $package);

    if ($pkg_dir->child('examples')->is_dir) {
        $root->load(qq(examples:$package content:="examples/*"));
    }

    setup_watch_file ($root, $git, $package);

    # upstream/metadata not yet supported by cme-dpkg

    if ($init) {
        say "setup source format";
        $root->load(q!source format="3.0 (quilt)"!);
    }

    $instance->write_back;

    $pkg_dir->child('debian/gbp.conf')->spew(qq!
[DEFAULT]
pristine-tar = False
pristine-tar-commit = False
upstream-tag = v%(version)s
debian-branch = debian/sid
!);

    return $root;
}


1;
