hydra/src/lib/Hydra/Plugin/MercurialInput.pm

package Hydra::Plugin::MercurialInput;

use strict;
use parent 'Hydra::Plugin';
use Digest::SHA qw(sha256_hex);
use File::Path;
use Hydra::Helper::Nix;
use Nix::Store;

sub supportedInputTypes {
    my ($self, $inputTypes) = @_;
    $inputTypes->{'hg'} = 'Mercurial checkout';
}

sub _parseValue {
    my ($value) = @_;
    (my $uri, my $id) = split ' ', $value;
    $id = defined $id ? $id : "default";
    return ($uri, $id);
}

sub _clonePath {
    my ($uri) = @_;
    my $cacheDir = getSCMCacheDir . "/hg";
    mkpath($cacheDir);
    return $cacheDir . "/" . sha256_hex($uri);
}

sub fetchInput {
    my ($self, $type, $name, $value) = @_;

    return undef if $type ne "hg";

    (my $uri, my $id) = _parseValue($value);
    $id = defined $id ? $id : "default";

    # init local hg clone

    my $stdout = ""; my $stderr = "";

    my $clonePath = _clonePath($uri);

    if (! -d $clonePath) {
        (my $res, $stdout, $stderr) = captureStdoutStderr(600,
            "hg", "clone", $uri, $clonePath);
        die "error cloning mercurial repo at `$uri':\n$stderr" if $res;
    }

    # hg pull + check rev
    chdir $clonePath or die $!;
    (my $res, $stdout, $stderr) = captureStdoutStderr(600, "hg", "pull");
    die "error pulling latest change mercurial repo at `$uri':\n$stderr" if $res;

    (my $res1, $stdout, $stderr) = captureStdoutStderr(600,
        "hg", "log", "-r", $id, "--template", "{node|short} {rev} {branch}");
    die "error getting branch and revision of $id from `$uri':\n$stderr" if $res1;

    my ($revision, $revCount, $branch) = split ' ', $stdout;

    my $storePath;
    my $sha256;
    (my $cachedInput) = $self->{db}->resultset('CachedHgInputs')->search(
        {uri => $uri, branch => $branch, revision => $revision});

    if (defined $cachedInput && isValidPath($cachedInput->storepath)) {
        $storePath = $cachedInput->storepath;
        $sha256 = $cachedInput->sha256hash;
    } else {
        print STDERR "checking out Mercurial input from $uri $branch revision $revision\n";
        $ENV{"NIX_HASH_ALGO"} = "sha256";
        $ENV{"PRINT_PATH"} = "1";

        (my $res, $stdout, $stderr) = captureStdoutStderr(600,
            "nix-prefetch-hg", $clonePath, $revision);
        die "cannot check out Mercurial repository `$uri':\n$stderr" if $res;

        ($sha256, $storePath) = split ' ', $stdout;

        txn_do($self->{db}, sub {
            $self->{db}->resultset('CachedHgInputs')->update_or_create(
                { uri => $uri
                , branch => $branch
                , revision => $revision
                , sha256hash => $sha256
                , storepath => $storePath
                });
            });
    }

    return
        { uri => $uri
        , branch => $branch
        , storePath => $storePath
        , sha256hash => $sha256
        , revision => $revision
        , revCount => int($revCount)
        };
}

sub getCommits {
    my ($self, $type, $value, $rev1, $rev2) = @_;
    return [] if $type ne "hg";

    return [] unless $rev1 =~ /^[0-9a-f]+$/;
    return [] unless $rev2 =~ /^[0-9a-f]+$/;

    my ($uri, $id) = _parseValue($value);

    my $clonePath = _clonePath($uri);
    chdir $clonePath or die $!;

    my $out;
    IPC::Run::run(["hg", "log", "--template", "{node|short}\t{author|person}\t{author|email}\n", "-r", "$rev1::$rev2", $clonePath], \undef, \$out)
        or die "cannot get mercurial logs: $?";

    my $res = [];
    foreach my $line (split /\n/, $out) {
        if ($line ne "") {
            my ($revision, $author, $email) = split "\t", $line;
            push @$res, { revision => $revision, author => $author, email => $email };
        }
    }

    return $res;
}


1;