ci-bot

#!/usr/bin/perl

use strict;
use warnings;

{
  package MyWebServer;

  use HTTP::Server::Simple::CGI;
  use base qw(HTTP::Server::Simple::CGI);
  use JSON;
  use threads;
  use File::Basename;
  #use Data::Dumper;

  my %config = do (dirname (__FILE__) . "/config");

  sub handle_request {
    my $self = shift;
    my $cgi  = shift;

    unless ($cgi->request_method() eq 'POST' && $cgi->path_info() eq '/' && (my $hook = JSON->new->utf8->decode(scalar $cgi->param('POSTDATA')))) {
      print "HTTP/1.1 400 Bad Request\r\n", $cgi->header, "400 Bad Request\n";
    } else {
      print "HTTP/1.1 200 OK\r\n", $cgi->header, "200 OK\n";
      if ($hook->{'object_kind'} eq 'merge_request') {
        process_mr($hook->{'object_attributes'}->{'target_project_id'}, $hook->{'object_attributes'}->{'iid'});
      } elsif ($hook->{'object_kind'} eq 'note' && defined $hook->{'merge_request'}) {
        process_mr($hook->{'object_attributes'}->{'project_id'}, $hook->{'merge_request'}->{'iid'})
      } # else { warn Dumper($hook), "\n"; }
    }
  }

  sub query {
    my $res = shift;
    open(Q, "-|", 'psql', '-Atd', 'gitlab', '-c', $res);
    chomp($res) if (defined($res = <Q>));
    close Q;
    return $res;
  }

  sub process_mr {
    $SIG{CHLD} = sub { wait(); };
    threads->create(\&real_process_mr, @_)->detach();
  }

  sub real_process_mr {
    my $project_id = 0 + shift;
    my $iid = 0 + shift;
    warn "Processing !$iid in project $project_id.\n";

    # is it neither closed nor merged? get the real id
    my $id = query("SELECT m.id FROM merge_requests AS m WHERE m.target_project_id = $project_id AND m.iid = $iid AND m.state != 'closed' AND m.state != 'merged'");
    return unless defined($id);

    # trigger merge_status checking with @michalrus' mod to GitLab
    system('curl', '-s', '-o', '/dev/null', '--header', 'PRIVATE-TOKEN: '.$config{private_token}, $config{gitlab_url}.'/api/v3/projects/'.$project_id.'/merge_request/'.$id);

    # notes.id of the last push to this MR:
    my $last_push_note_id = query("SELECT n.id FROM notes AS n WHERE n.noteable_id = $id AND n.noteable_type = 'MergeRequest' AND n.system = 't' AND n.note LIKE 'Added % commit%' ORDER BY n.id DESC LIMIT 1");
    $last_push_note_id = 0 unless defined($last_push_note_id);

    # number of distinct users doing LGTMs after the last push:
    my $num_lgtms = 0 + query("SELECT COUNT(DISTINCT u.username) FROM notes AS n, users AS u WHERE n.noteable_id = $id AND u.id = n.author_id AND n.noteable_type = 'MergeRequest' AND u.username != '".$config{my_handle}."' AND n.id > $last_push_note_id AND n.system = 'f' AND note LIKE '%LGTM%'");

    # is it [WIP]
    my $wip = (query("SELECT m.title FROM merge_requests AS m WHERE m.id = $id") =~ /^\s*(wip\W|\[wip\])/i);

    # can it be merged automatically? The third state is 'unchecked' which means 'being checked now'
    my $merge_status = query("SELECT m.merge_status FROM merge_requests AS m WHERE m.id = $id");
    my $can_be_merged    = 'can_be_merged'    eq $merge_status;
    my $cannot_be_merged = 'cannot_be_merged' eq $merge_status;

    # last message of @ci-bot
    my $my_last_msg = query("SELECT n.note FROM notes AS n, users AS u WHERE n.noteable_id = $id AND u.id = n.author_id AND n.noteable_type = 'MergeRequest' AND u.username = '".$config{my_handle}."' AND n.system = 'f' ORDER BY n.id DESC LIMIT 1");
    $my_last_msg = '' unless defined($my_last_msg);

    # current-state message
    my $current_msg = "**${num_lgtms}** LGTM(s) down";
    my $should_merge = 0;
    if ($wip) {
      $current_msg .= '. However, a **work-in-progress** branch will not be merged.';
    } elsif ($cannot_be_merged) {
      my $author = query("SELECT u.username FROM users AS u, merge_requests AS m WHERE u.id = m.author_id AND m.id = $id");
      $current_msg .= '. However, this **cannot be merged** automatically. @' . $author . ', merge the upstream first.';
    } elsif ($num_lgtms < $config{required_lgtms}) {
      $current_msg .= ", **" . ($config{required_lgtms}-$num_lgtms) . "** more to go.";
    } else {
      $current_msg .= ". Merging.";
      $should_merge = 1;
    }

    # if current != last, post it
    unless ($current_msg eq $my_last_msg) {
      system('curl', '-s', '-o', '/dev/null', '--form', 'body='.$current_msg, '--header', 'PRIVATE-TOKEN: '.$config{private_token}, $config{gitlab_url}.'/api/v3/projects/'.$project_id.'/merge_requests/'.$id.'/notes');
    }

    # if № LGTMs satisfied, merge
    if ($should_merge) {
      system('curl', '-s', '-o', '/dev/null', '-X', 'PUT', '--header', 'PRIVATE-TOKEN: '.$config{private_token}, $config{gitlab_url}.'/api/v3/projects/'.$project_id.'/merge_request/'.$id.'/merge');
    }
  }
}

my $pid = MyWebServer->new(8089)->background();
print "Daemonizing; pid = $pid.\n";