#!/usr/bin/perl

=encoding UTF-8

=cut

=head1 DESCRIPTION

Релизный робот - парсит команды в релизных тикетах и собирает/выкладывает билды на ТС и Прод

=head1 PARAMS

 st_ticket                    - номер тикета релиза
 release_st_ticket_on_preprod - номер релизного тикета, который находится на препроде (актуально для hotfix)
 stage                        - название стэйджа (preprod|prod)
 checkout_to                  - ветка, tag, commit из которых нужно собрать релиз
 java_docker                  - java docker образы перечисленные через ; (добавляются к релизной задаче в SANDBOX)
 build                        - номер сборки
 update_preprod               - после сборки образа обновить препрод
 update_testing               - после сборки образа обновить тест
 debug                        - флаг дебага
 debug_slack_channel          - Slack канал при дебаге
 skip_not_merged              - Игнорировать несмерженный PR



=head1 USAGE

./opt/partner2_release_robot/bin/script
  --debug_slack_channel='@zurom'
  --debug


=begin comment

=cut

# common modules
use strict;
use warnings FATAL => 'all';
use feature 'say';
use utf8;
use open qw(:std :utf8);

use lib::abs-soft => qw'../lib ../partner2/lib';

use Carp;
use Data::Dumper;
use File::Slurp;
use Getopt::Long;
use HTTP::Request::Common qw( GET POST PUT );
use HTTP::Request;
use HTTP::Tiny;
use IO::Socket::SSL qw(SSL_VERIFY_NONE);
use JSON::PP;
use LWP::UserAgent;
use List::Util qw(first);
use Moment;
use Net::INET6Glue;
use Pod::Usage;
use Term::ANSIColor qw(colored);
use XML::Simple;
use Yandex::StarTrek;
use Yandex::ArcanumAPI;

# global vars
our $PI_SECRETS;

our $DEBUG               = 0;
our $DEBUG_REPO          = '';
our $DEBUG_SLACK_CHANNEL = '';

our $ROOT_PATH    = '/opt/partner2_release_robot/';
our $WORKING_PATH = $ROOT_PATH . 'partner2/';
our $LOGS_PATH    = '/var/log/partner2_release_robot/';

my $StOK   = '!!(green)**✓**!!';
my $StFAIL = '!!(red)**x**!!';

# local vars

my $VERSION_PREFIX = '2.18';

our $CURR_RELEASE_TICKET = '';
my $CURR_RELEASE_SUMMARY   = '';
my $CURR_RELEASE_NO        = 'Undef';
my $IS_DEBUG_ROBOT_RELEASE = 0;

my $ST_TICKET;
my $STAGE;
my $ACTION;
my $CHECKOUT_TO;
my $FRONTEND_TAG;
my $BUILD_NUMBER;
my $RELEASE_BRANCH;
my $YAV_TOKEN;
my $JAVA_DOCKER;
my $RELEASE_ST_TICKET_ON_PREPROD = 'UNKNOWN';
my $UPDATE_PREPROD;
my $UPDATE_TESTING;

my $CURR_JOB_DESCR = '';
my $CURR_JOB_NUM   = '';
my $FATAL_ERROR;
my $SKIP_NOT_MERGED;

my $RELEASE_KEEP = 10;    # сколько релизов оставляем

sub INFO ($) {_log('INFO', shift)}
sub INFOF ($@) {_logf('INFO', @_)}
sub WARN ($) {_log('WARN', shift)}
sub WARNF ($@) {_logf('WARN', @_)}
sub ERROR ($) {_log('ERROR', shift)}
sub ERRORF ($@) {_logf('ERROR', @_)}

my @HTTP_REQUEST_TIMEOUTS = (3, 10, 30, 90);

########
main();
########

# subs

sub main {

    get_args();

    write_log('START');

    eval {process_release_tickets()};
    if ($@) {
        _handle_error($@, $CURR_RELEASE_TICKET);
    }
    write_log('END');

    if ($@) {
        ERROR $@;
        $FATAL_ERROR = 1;
    }
    if ($FATAL_ERROR) {
        die colored('FAIL', 'red');
    }
}

sub get_secret {
    my ($name) = @_;

    unless ($PI_SECRETS) {
        $PI_SECRETS = decode_json scalar read_file '/etc/pi-secrets.json';
    }

    if (exists $PI_SECRETS->{$name}) {
        return $PI_SECRETS->{$name};
    } else {
        $name //= 'undef';

        die colored("Can't find secret '$name'", 'red');
    }
}

sub write_log {
    my ($message) = @_;

    my $file_name = _get_log_file_name('logs', 1);

    my $msg = sprintf('[%s] %s %-8s %s', Moment->now->get_dt(), $$, ($CURR_RELEASE_TICKET || "-"), $message,);

    write_file(
        $file_name,
        {
            binmode => ':utf8',
            append  => 1,
        },
        $msg . "\n"
    ) unless $DEBUG;

    say $msg;

}

=head2 get_open_startrek_release_tickets

    my @tickets = get_open_startrek_release_tickets();

Возвращает список типа ('PI-123', 'PI-456').

В список попадают только тикеты, которые попадают под следующие
условия:

 * очередь PI
 * тип release
 * статус не Closed
 * subject - 'Релиз NNN' (где NNN - это число)

=cut

sub get_open_startrek_release_tickets {

    my @tickets;

    my $tickets = _get_yandex_startrek()->search(query => 'Queue: PI and Status: !Closed and Type: "Release"',);

    foreach my $ticket (sort {$a->{createdAt} cmp $b->{createdAt}} @{$tickets}) {
        push @tickets, $ticket->{key};
    }

    return @tickets;
}

=head2 get_last_comment_and_author_from_startrek_ticket

    my $data = get_last_comment_and_author_from_startrek_ticket('PI-123');

Возвращает HASHREF или undef. В том случае если у тикете нет ни одного коментария, то
возвращается undef. Если же у тикета есть какие-то комментария, но возвращается структура вида:

    {
        text => 'last comment test',
        login => 'author_login',
    }

У комментария отрезаются пробельные символы в начале и конце.

=cut

sub get_last_comment_and_author_from_startrek_ticket {
    my ($ticket_id) = @_;

    my $ys = _get_yandex_startrek();

    my $comments = $ys->get_comments($ticket_id);

    if (@{$comments} == 0) {
        return undef;
    } else {

        my $text = $comments->[-1]->{text};

        $text =~ s/^\s+//;
        $text =~ s/\s+\z//;

        return {text => $text, login => $comments->[-1]->{createdBy}{id}};
    }
}

=head2 add_comment

    add_comment(
        ticket => 'INFRASTRUCTUREPI-639',
        text => 'Test message'
        summonees => ['summonee1', 'summonee2']
    );

=cut

sub add_comment {
    my (%opts) = @_;

    if ($DEBUG) {
        INFO colored('Add comment to tiket: ', 'cyan');

        local $Data::Dumper::Pad = '    ';
        ldump(\%opts);
    } else {
        write_log $opts{text};
        _get_yandex_startrek()->add_comment($opts{ticket}, $opts{text}, $opts{summonees});
    }
}

sub ldump {
    local $Data::Dumper::Indent   = 1;
    local $Data::Dumper::Sortkeys = 1;
    local $Data::Dumper::Useqq    = 1;
    local $Data::Dumper::Terse    = 1;

    no warnings 'redefine';
    local *Data::Dumper::qquote = sub {local $_ = shift; s/\'/\\'/g; "'$_'"};

    print STDERR Dumper(@_);
}

=head2 move_ticket

    move_ticket(
        ticket => 'INFRASTRUCTUREPI-639',
        transition_id => 'ready_for_test',
    );

=cut

sub move_ticket {
    my (%opts) = @_;

    _get_yandex_startrek()->make_transition($opts{ticket}, $opts{transition_id}, 1);

    return 1;
}

=head2 assignee_ticket

    assignee_ticket(
        ticket => 'INFRASTRUCTUREPI-639',
        login => 'alapaev',
    );

=cut

sub assignee_ticket {
    my (%opts) = @_;

    _get_yandex_startrek()->edit_ticket($opts{ticket}, {assignee => $opts{login}});

    return 1;
}

=head2 close_ticket

    close_ticket(
        ticket => 'INFRASTRUCTUREPI-639',
        comment => 'ticket closed',
    );

=cut

sub close_ticket {
    my (%opts) = @_;

    eval {_get_yandex_startrek()->make_transition($opts{ticket}, 'close', 1, $opts{comment});};
    if ($@ && $@ !~ /Переход не существует/) {
        ERROR $@;
        die colored('FAIL', 'red');
    }

    return 1;
}

sub get_release_summary {
    my ($startrek_release_ticket) = @_;

    my $summary = _get_yandex_startrek()->get_issue($startrek_release_ticket)->{summary};
    my ($release_no, $release_descr) = ($summary =~ /Релиз\s+(\d+)(.*)/);

    $release_no    //= '';
    $release_descr //= '';

    $release_descr =~ s|^\s*\.\*||;

    return ($summary, $release_no, $release_descr);
}

=head2 get_tickets_from_description

    get_tickets_from_description(
        ticket => 'PI-7701'
    );

=cut

sub get_tickets_from_description {
    my (%opts) = @_;
    my @tickets;

    my $ticket = _get_yandex_startrek()->get_issue($opts{ticket});
    my $description = $ticket->{description} // '';

    @tickets = $description =~ m/([A-Z]*PI-[0-9]+)/ga;

    return @tickets;
}

sub get_arc_prs {
    my ($st_ticket) = @_;
    my @result;
    my $links = _get_yandex_startrek()->get_issue_remotelinks($st_ticket);
    for (@$links) {
        next unless $_->{object}{application}{type} eq 'ru.yandex.arcanum';
        push @result, $_->{object}{key};
    }
    return @result;
}

=head2 build_and_upload_to_dist

    my ($build_number) = build_and_upload_to_dist(); # $build_number будет, например, 202

Саба клонирует код ПИ2, запускает там `make release`, парсит вывод, понимает
какой билд был собран и возвращает его.

Сабе можно передать опциональный параметр 'branch', если он указан, то сборка
будет проходить из указанной ветки.

=cut

sub build_and_upload_to_dist {
    my (%opts) = @_;

    my $branch = delete($opts{branch}) // $CHECKOUT_TO // 'trunk';

    my $run_tests = delete($opts{run_tests}) // 1;

    my $file_name = _get_log_file_name('make_release_log', 1);

    _run_cmd_with_log(
        cmd      => "rm -rf ${ROOT_PATH}yandex-partners*",
        log_file => $file_name
    );

    chdir($WORKING_PATH);

    $RELEASE_BRANCH = _get_release_branch_name();

    _run_cmd_with_log(
        cmd      => "arc checkout -f $branch && arc pull && arc clean -d && arc checkout -b $RELEASE_BRANCH",
        log_file => $file_name
    );

    if ($run_tests) {
        # Чистим readonly базы
        my $user = $ENV{USER} // 'unknown';
        foreach my $db_name (qw/ partner_db  partner_logs_db  kladr /) {
            _run_cmd(
                sprintf(
                    q[mysql -uroot -A -e 'drop database if exists `mocked_%s_READONLY_%s`'     &> /dev/null],
                    $db_name, $user
                ),
                'dont_die_on_fail'
            );
            _run_cmd(
                sprintf(
                    q[mysql -uroot -A -e 'drop database if exists `mocked_%s_READONLY_API_%s`' &> /dev/null],
                    $db_name, $user
                ),
                'dont_die_on_fail'
            );
        }
    }

    my $build_number = '';

    my $log_lines = _run_cmd_with_log(
        cmd      => "make release",
        log_file => $file_name
    );

    foreach my $line (@$log_lines) {
        if ($line =~ m{\[Arc::Tag\] Tagged \Q$VERSION_PREFIX\E\.([0-9\.]+)}) {
            $build_number = $1;
            last;
        }
    }

    unless ($build_number) {
        die "Can't find out build number";
    }

    _run_cmd_with_log(
        cmd      => "arc push $RELEASE_BRANCH -u $RELEASE_BRANCH",
        log_file => $file_name
    );

    add_comment(
        text   => "Создал ветку %%$RELEASE_BRANCH%% из %%$branch%%",
        ticket => $CURR_RELEASE_TICKET
    );

    return $build_number;
}

sub fix_tickets_in_description {
    my (%opts) = @_;

    my $allready_merged_tickets = _get_merged_tickets(@_);

    if (scalar @$allready_merged_tickets) {
        my $ys          = _get_yandex_startrek();
        my $ticket      = $ys->get_issue($opts{ticket});
        my $description = $ticket->{description} // '';
        $description =~ s/\s+$//;
        $description .= join '', map {"\n1. $_"} @$allready_merged_tickets;
        $ys->edit_ticket($opts{ticket}, {description => $description,},);
    }

    return $allready_merged_tickets;
}

sub _get_merged_tickets {
    my (%opts) = @_;

    my %tickets = map {$_ => 1} @{$opts{list} // []}, $opts{ticket};
    my ($last_release) = _get_partner2_production_versions();
    my $base_branch = $opts{branch} // $CHECKOUT_TO // 'trunk';
    my $already_merged_commit_messages = _run_cmd_with_log(
        cmd      => qq(arc log --pretty="{title}" ${last_release}...${base_branch} --grep="PI-[0-9]" .),
        log_file => _get_log_file_name('fix_tickets_in_description', 1),
    );
    my %allready_merged_tickets;
    my %release_tickets;
    foreach (@$already_merged_commit_messages) {

        if (/(release-)?(PI-\d+)/) {
            if ($1) {
                delete $allready_merged_tickets{$2};
                $release_tickets{$2} = 1;
            } elsif (!$release_tickets{$2} && !$tickets{$2}) {
                $allready_merged_tickets{$2} = 1;
            }
        }
    }
    return [sort keys %allready_merged_tickets];
}

sub _get_release_branch_name {
    my (%opts) = @_;

    my $last_branch = delete($opts{'last_branch'});

    my $template = "releases/partner/release-%s-build-%d";

    my $i = 1;
    my $release_branch;

    while (_try_checkout_release_branch($release_branch = sprintf($template, $CURR_RELEASE_TICKET, $i))) {
        $i++;
    }
    if ($last_branch) {
        die 'Can not get release branche' unless $i > 1;
        return sprintf($template, $CURR_RELEASE_TICKET, $i - 1);
    }
    return $release_branch;
}

sub _try_checkout_release_branch {
    my ($branch) = @_;
    return _run_cmd("arc checkout $branch .", 'iddqd');
}

sub _get_branches {
    my ($command) = @_;

    my $release_branches = `$command`;
    die 'Can not get release branches' if $?;

    chomp($release_branches);

    my @branches = ();
    while ($release_branches =~ m/refs\/heads\/(.+)/mig) {
        push(@branches, $1);
    }

    return \@branches;
}

sub http_request {
    my ($request, $process) = @_;

    my $browser = LWP::UserAgent->new(
        ssl_opts => {
            verify_hostname => 0,
            SSL_verify_mode => SSL_VERIFY_NONE
        }
    );

    foreach my $timeout (@HTTP_REQUEST_TIMEOUTS) {
        my $response = eval {$browser->request($request)};

        WARN $@ if $@;

        if ($response->is_success()) {
            return $process->($response);
        }

        write_log(sprintf("HTTP request fails. Retry in %s seconds.", $timeout));

        sleep($timeout);
    }
    return undef;
}

=head2 build_release

=cut

sub build_release {
    my (%opts) = @_;

    my $startrek_release_ticket = delete $opts{startrek_release_ticket};
    my $releaser                = delete $opts{releaser};
    my $description             = delete $opts{description};

    my @tickets        = get_tickets_from_description(ticket => $startrek_release_ticket);
    my $tg_ticket_list = '';
    my $sl_ticket_list = '';
    for my $i (0 .. $#tickets) {
        $tg_ticket_list .= sprintf "%d. <a href=\"https://st.yandex-team.ru/%s\">%s</a>\n", $i + 1, $tickets[$i],
          $tickets[$i];
        $sl_ticket_list .= sprintf "%d. <https://st.yandex-team.ru/%s|%s>\n", $i + 1, $tickets[$i], $tickets[$i];
    }

    my @steps = ();

    push @steps, {
        descr => 'Notify start',
        'job' => sub {
            return {
                is_ok  => 1,
                st_msg => "Начал собирать.",
                tg_msg =>
"Начал собирать server side по просьбе <b>$releaser</b>.\n<a href=\"https://st.yandex-team.ru/$startrek_release_ticket\">Релиз $startrek_release_ticket</a> $description\nТикеты:\n$tg_ticket_list",
                slak_msg =>
"Начал собирать server side по просьбе \@$releaser.\n<https://st.yandex-team.ru/$startrek_release_ticket|Релиз $startrek_release_ticket> $description\nТикеты:\n$sl_ticket_list",
            };
          }
    };

    my $ticket_prs = [];

    push @steps, {
        descr => 'Collect merged tickets',
        'job' => sub {

            (my $is_ok, $ticket_prs) = find_merged_pull_requests($startrek_release_ticket);

            my $headers = {
                not_merged     => 'Не смердженные',
                already_merged => 'Ранее смерженые',
            };

            my @st_msgs = ();
            foreach my $key (qw( not_merged  already_merged )) {
                next unless @{$ticket_prs->{$key}};

                push @st_msgs, sprintf "%s PRs:\n* %s", $headers->{$key}, join "\n* ",
                  map {sprintf '((%s %s))', @$_{qw( url summary )}} @{$ticket_prs->{$key}};

                if (!$SKIP_NOT_MERGED && $key eq 'not_merged' && @st_msgs) {
                    die
'Найдены несмерженные PR! Необходимо смержить PR перед сборкой: '
                      . join "\n\n", @st_msgs;
                }
            }

            return {
                is_ok  => $is_ok,
                st_msg => @st_msgs
                ? join "\n\n",
                @st_msgs
                : '!!Ни одного PR не найдено!!'
            };
          }
    };

    my $build_number = '';
    push @steps, {
        descr => 'Build and upload to dist',
        'job' => sub {
            $build_number = build_and_upload_to_dist();
            print "BUILD_NUMBER_PERL:$VERSION_PREFIX.$build_number\n";
            return {
                is_ok  => 1,
                st_msg => "Собрал билд $build_number, закоммитил в arc."
            };
          }
    };

    push @steps, {
        descr => 'Check tickets',
        'job' => sub {
            my $new_tickets = fix_tickets_in_description(
                list   => \@tickets,
                ticket => $startrek_release_ticket,
            );
            for my $i (0 .. $#$new_tickets) {
                $tg_ticket_list .= sprintf "%d. <a href=\"https://st.yandex-team.ru/%s\">%s</a>\n",
                  $i + scalar(@tickets), $new_tickets->[$i], $new_tickets->[$i];
                $sl_ticket_list .= sprintf "%d. <https://st.yandex-team.ru/%s|%s>\n", $i + scalar(@tickets),
                  $new_tickets->[$i], $new_tickets->[$i];
            }

            return {
                is_ok  => 1,
                st_msg => (
                    scalar @$new_tickets
                    ? "Автоматически добавил в описание тикеты:\n\n"
                      . join("\n", map {"* $_"} @$new_tickets)
                    : 'Проверил список тикетов'
                ),
            };
          }
    };

    push @steps, {
        descr         => 'Check migration sql',
        skip_on_fault => 1,
        'job'         => sub {
            my $migrations = _check_migrations('all');
            if (@$migrations) {
                return {
                    is_ok    => 1,
                    slak_msg => 'Необходимо выполнить миграции',
                    st_msg   => join("\n", "Не забыть бы про миграции:", @$migrations),
                    tg_msg   => 'Необходимо выполнить миграции',
                };
            } else {
                return {
                    is_ok  => 1,
                    st_msg => 'Миграций не обнаружено',
                };
            }
          }
    };

    push @steps, {
        descr => 'Check deploy specs change',
        'job' => sub {
            my ($last_release) = _get_partner2_production_versions();
            my $base_branch = $CHECKOUT_TO // 'trunk';
            my $diff_with_previous_release = _run_cmd_with_log(
                cmd =>
qq(arc diff ${last_release}:configs/production/deploy-stage.json ${base_branch}:configs/production/deploy-stage.json),
                log_file => _get_log_file_name('specs_diff', 1),
            );
            if (ref $diff_with_previous_release eq 'ARRAY' && @$diff_with_previous_release) {
                return {
                    is_ok => 1,
                    slak_msg =>
'Необходимо обновить продовый стейдж! Обнаружено изменение в json спецификации deploy.',
                    st_msg =>
'Необходимо обновить продовый стейдж! Обнаружено изменение в json спецификации deploy.',
                    tg_msg =>
'Необходимо обновить продовый стейдж! Обнаружено изменение в json спецификации deploy.',
                };
            } else {
                return {
                    is_ok  => 1,
                    st_msg => 'Изменений в спеках deploy на обнаружено.',
                };
            }
          }
    };

    _run_steps(\@steps, $startrek_release_ticket);
}

sub find_merged_pull_requests {
    my ($startrek_release_ticket) = @_;

    chdir($WORKING_PATH);

    my @tickets = get_tickets_from_description(ticket => $startrek_release_ticket);
    my @prs = map {get_arc_prs($_)} @tickets;
    my $is_ok = @prs ? 1 : 0;
    my $arc_api = Yandex::ArcanumAPI->new(oauth_token => $ENV{ARC_TOKEN});
    my $ticket_prs = {already_merged => [], not_merged => []};
    for (@prs) {
        my $pr = $arc_api->get_pr($_, [qw/url summary status/]);
        my $key = $pr->{status} eq 'merged' ? 'already_merged' : 'not_merged';
        push @{$ticket_prs->{$key}}, $pr;
    }
    return ($is_ok, $ticket_prs);
}

sub _run_steps {
    my ($steps, $startrek_release_ticket) = @_;

    for (my $i = 0; $i <= $#$steps; $i++) {
        my ($job, $CURR_JOB_DESCR, $skip_on_fault) = @{$steps->[$i]}{qw(job descr skip_on_fault)};

        $CURR_JOB_NUM = sprintf '%d/%d', $i + 1, scalar(@$steps);

        write_log("$i. start step $CURR_JOB_NUM - $CURR_JOB_DESCR");

        my $res = eval {$job->($CURR_JOB_NUM)};
        if (my $error = $@) {
            write_log($error);
            my $emsg = "$CURR_JOB_NUM $CURR_JOB_DESCR";
            add_comment(
                text   => "$StFAIL $emsg",
                ticket => $startrek_release_ticket
            );

            $emsg = "FAIL $emsg";
            _send_message_to_slack($emsg);
            _send_message_to_telegram($emsg);

            if ($skip_on_fault) {
                _handle_error($error, $startrek_release_ticket);
                ERROR $error;
                $res = {};
            } else {
                die $error;
            }
        }

        my ($st_msg, $slak_msg, $is_ok, $tg_msg) = @$res{qw/ st_msg  slak_msg is_ok tg_msg/};

        my $comment_id = '';
        if ($st_msg) {
            $comment_id = add_comment(
                text => ($is_ok ? $StOK : $StFAIL) . ' ' . $CURR_JOB_NUM . ' ' . $st_msg,
                ticket => $startrek_release_ticket
            );
        }

        if ($slak_msg) {
            $slak_msg =~ s/<ST_COMMENT_ID>/$comment_id/g;
            _send_message_to_slack($slak_msg);
        }

        if ($tg_msg) {
            $tg_msg =~ s/<ST_COMMENT_ID>/$comment_id/g;
            _send_message_to_telegram($tg_msg);
        }
    }

    return 1;
}

sub create_startrek_hotfix_ticket {
    my (%opts) = @_;

    my $issue_key = _get_yandex_startrek()->create_issue(
        queue   => 'PI',
        type    => 'release',
        summary => sprintf('Хотфикс. Сборка %s.', $opts{build_number}),
        parent  => $opts{startrek_release_ticket},
    );

    return 1;
}

=head2 check_before_migretions

=cut

sub check_before_migrations {
    my (%opts) = @_;

    my $startrek_release_ticket = delete $opts{startrek_release_ticket};
    my $build_number            = delete $opts{build_number};
    if ($build_number eq '') {
        die('empty build_number');
    }

    my @steps;

    push @steps, {
        descr => 'Check before migrations',
        job   => sub {
            my ($st_msg, $tg_msg, $slak_msg);

            chdir($WORKING_PATH);

            my $release_branch = _get_release_branch_name(last_branch => 1);

            _run_cmd("arc checkout $release_branch", 'iddqd');

            my $migrations = _check_migrations('before');

            if (@$migrations) {
                die join "\n",
                  "Не накачены before миграции:%%",
                  @$migrations,
                  "%%Выкладывать сборку в прод нельзя!";
            }
            $st_msg =
              "Проверил before миграции перед выкладкой в прод - !!(green)OK!!";

            return {
                is_ok    => 1,
                st_msg   => $st_msg,
                tg_msg   => $tg_msg,
                slak_msg => $slak_msg,
            };
          }
    };
    _run_steps(\@steps, $startrek_release_ticket);
}

=head2 finalize_release

=cut

sub finalize_release {
    my (%opts) = @_;

    my $build_number            = delete $opts{build_number};
    my $startrek_release_ticket = delete $opts{startrek_release_ticket};
    my $releaser                = delete $opts{releaser};
    if ($build_number eq '') {
        die('empty build_number');
    }

    my @steps;

    push @steps, {
        descr         => 'Move released migrations',
        skip_on_fault => 1,
        job           => sub {
            _move_released_migrations(
                startrek_release_ticket => $startrek_release_ticket,
                build_number            => $build_number,
            );
            return {};
          }
    };

    push @steps, {
        descr         => 'Close tickets',
        skip_on_fault => 1,
        job           => sub {
            _close_release_task_tickets(
                startrek_release_ticket => $startrek_release_ticket,
                build_number            => $build_number,
            );
            return {};
          }
    };

    push @steps, {
        descr         => 'Create ticket for translators',
        skip_on_fault => 1,
        job           => sub {
            create_startrek_ticket_for_translators($startrek_release_ticket, $releaser);
            return {};
          }
    };

    push @steps, {
        descr => 'Done notify',
        job   => sub {
            my ($st_msg, $tg_msg, $slak_msg);

            $st_msg = "Билд $build_number выложен в продакшн.";

            $tg_msg =
"Выложил билд $build_number <a href=\"https://partner2.yandex.ru\">в Продакшн</a> по просьбе \@$releaser";
            $slak_msg =
"Выложил билд $build_number <https://partner2.yandex.ru|в Продакшн> по просьбе \@$releaser";

            return {
                is_ok    => 1,
                st_msg   => $st_msg,
                tg_msg   => $tg_msg,
                slak_msg => $slak_msg,
            };
          }
    };

    _run_steps(\@steps, $startrek_release_ticket);
}

sub _get_yandex_startrek {

    my $ys = Yandex::StarTrek->new(
        oauth_token => get_secret('startrek-token'),
        retry       => 3,
        delay       => 3,
    );

    return $ys;
}

sub _get_log_file_name {
    my ($file_name, $with_porc_and_date) = @_;

    my $prefix =
      $with_porc_and_date
      ? _get_date_prefix() . '_' . $$
      : '';

    if (`uname -a` =~ /Darwin/) {
        return $prefix . $file_name . '.log';
    } else {
        return $LOGS_PATH . $prefix . '_' . $file_name . '.log';
    }
}

sub _get_date_prefix {
    my $now = Moment->now();

    my $date = Moment->now->get_d();

    $date =~ s|-||g;    # 2014-12-07 -> 20141207

    return $date;
}

sub _run_cmd {
    my ($cmd, $dont_die_on_fail) = @_;

    my $prefix = $CURR_JOB_NUM ? $CURR_JOB_NUM . '. ' : '';

    write_log($prefix . "running '$cmd'");

    my $exit_status = system($cmd);
    my $is_ok = $exit_status == 0 ? 1 : 0;

    if (!$dont_die_on_fail && !$is_ok) {
        die "Command '$cmd' exited with non zero exit status";
    }

    return $is_ok;
}

sub _run_cmd_with_log {
    my (%opts) = @_;

    my ($cmd, $log_file, $dont_die_on_fail) = @opts{qw(cmd log_file dont_die_on_fail)};

    chomp($cmd);

    $cmd .= " >> $log_file 2>&1";

    my $is_ok = _run_cmd($cmd, 'dont_die_on_fail');

    my @lines =
      (defined wantarray || !$is_ok)
      ? read_file($log_file, {binmode => ':utf8', err_mode => 'quiet'})
      : ();

    unless ($is_ok || $dont_die_on_fail) {

        my $last_100_lines = join "", @lines[($#lines < 100 ? 0 : $#lines - 100) .. $#lines];

        my $obj = bless {
            shortmsg => "Command '$cmd' exited with non zero exit status",
            stmsg =>
"Command exited with non zero exit status --- %%$cmd%% --- <{Несколько последних строк лога\n%%\n$last_100_lines\n%%}>",
        } => 'Robot::Exception';

        die $obj;
    }

    return \@lines;
}

sub _close_release_task_tickets {
    my (%opts) = @_;

    my $build_number            = delete $opts{build_number};
    my $startrek_release_ticket = delete $opts{startrek_release_ticket};

    my @tickets = get_tickets_from_description(ticket => $startrek_release_ticket);
    my @tickets_to_close = grep {$_ =~ /(INFRASTRUCTURE)?PI/} @tickets;

    foreach my $ticket (@tickets_to_close) {
        close_ticket(
            ticket => $ticket,
            comment =>
"Задача выложена в продакшн с билдом $build_number. Релизный тикет: $startrek_release_ticket",
        );
    }
}

sub _move_file_released_migrations {
    my ($build_number) = @_;

    my $arch_path = "migrations/archived";
    for my $stage (qw(before_release after_release)) {
        my $dst_root = "migrations/$stage/released";
        _run_cmd("mkdir -p $dst_root", 'iddqd') unless -d $dst_root;
        for my $build (read_dir($dst_root)) {
            next unless -d "$dst_root/$build";
            next if $build_number - $build <= $RELEASE_KEEP;
            my $asrc = "$dst_root/$build";
            my $adst = "$arch_path/$stage";
            _run_cmd("mkdir -p $adst", 'iddqd') unless -d $adst;
            _run_cmd("arc mv $asrc $adst", 'iddqd');
        }

        for my $type ('', 'clickhouse/', 'mysql/') {
            my $src = "migrations/$stage/$type";
            next unless -d $src;
            my $dst = "$dst_root/$build_number/$type";
            _run_cmd("mkdir -p $dst", 'iddqd') unless -d $dst;
            _run_cmd("arc mv $src*.* $dst", 'iddqd');
        }
    }
}

sub _move_released_migrations {
    my (%opts) = @_;

    my $startrek_release_ticket = delete $opts{startrek_release_ticket};
    my $build_number = $CURR_RELEASE_NO || delete $opts{build_number};

    chdir($WORKING_PATH);

    my $release_branch = _get_release_branch_name(last_branch => 1);

    _run_cmd("arc checkout -f $release_branch", 'iddqd');

    _move_file_released_migrations($build_number);

    my $is_ok = _run_cmd(<<"SH", 'iddqd');
        arc checkout -b ${startrek_release_ticket}_move_released_migrations
        arc add -u
        arc commit -m "$startrek_release_ticket - move released migrations"
        arc pr create --auto -m "$startrek_release_ticket - move released migrations"
SH

    if ($is_ok) {
        add_comment(
            ticket => $startrek_release_ticket,
            text =>
"$StOK Создал PullRequest на перенос миграционных скриптов в /released",
        );
    } else {
        add_comment(
            ticket => $startrek_release_ticket,
            text   => "$StFAIL Ошибка переноса миграционных скриптов в /released",
        );
    }
}

=begin comment _get_status_code_from_url

Возвращает 200, 404, ... или строку 'undef'.

=end comment

=cut

sub _get_status_code_from_url {
    my ($url) = @_;

    my $response = HTTP::Tiny->new()->get($url);

    my $status_code = $response->{status} // 'undef';

    return $status_code;
}

sub _send_message_to_telegram {
    return 1;
    my ($message) = @_;

    my $browser = LWP::UserAgent->new(
        ssl_opts => {
            verify_hostname => 0,
            SSL_verify_mode => SSL_VERIFY_NONE
        }
    );

    my $secret = get_secret('telegram_release');

    my $request = POST(
        "https://api.telegram.org/bot$secret->{token}/sendMessage",
        [
            text                     => $message,
            chat_id                  => $secret->{chat_id},
            parse_mode               => 'HTML',
            disable_web_page_preview => 1,
        ]
    );

    eval {$browser->request($request)};
    WARN $@ if $@;

    return 1;
}

sub _send_message_to_slack {
    return 1;
    my ($message) = @_;

    local $DEBUG = 1;

    my $browser = LWP::UserAgent->new(
        ssl_opts => {
            verify_hostname => 0,
            SSL_verify_mode => SSL_VERIFY_NONE
        }
    );

    my $request = POST(
        'https://partner.yandex-team.ru/slack_release_channel_message',
        Content => encode_json(
            {
                text => $message,
                $DEBUG
                ? (channel => $DEBUG_SLACK_CHANNEL)
                : ()
            }
        ),
    );

    eval {$browser->request($request)};
    WARN $@ if $@;

    return 1;
}

sub _run_teamcity_build {
    my $build_id;
    my $teamcity_token = get_secret('teamcity-token');

    write_log("Starting TC build with token: $teamcity_token");

    my $tc_response = eval {
        HTTP::Tiny->new->request(
            'POST',
            'https://teamcity.yandex-team.ru/httpAuth/app/rest/buildQueue',
            {
                content =>
"<build><buildType id=\"Pi_Autotests_AutotestsBetaCreator\"/><properties><property name=\"env.BACKEND_BRANCH\" value=\"master\" own=\"true\"/><property name=\"env.FRONTEND_BRANCH\" value=\"master\" own=\"true\"/></properties></build>",
                headers => {
                    'Content-Type'  => 'application/xml',
                    'Authorization' => "Basic $teamcity_token",
                },
            }
        );
    };
    WARN $@ if $@;

    my $tc_response_data = eval {XML::Simple->new()->XMLin($tc_response->{content})} // {};
    WARN $@ if $@;

    $build_id = $tc_response_data->{id};

    write_log($build_id) if $build_id;

    return $build_id ? $build_id : 0;
}

sub create_startrek_ticket_for_translators {
    my ($startrek_release_ticket, $last_comment_author) = @_;

    my $all_tickets = join(' ', keys %{_get_all_tickets($startrek_release_ticket)});

    return unless $all_tickets;

    my $file_name = _get_log_file_name("create_startrek_ticket_for_translators", 1);

    my $log_lines;

    for my $repo (qw(pi-frontend)) {
        $log_lines = _run_cmd_with_log(
            cmd =>
"cd $WORKING_PATH; ./bin/create_startrek_ticket_for_translators.pl --tanker-project=$repo --tickets '$all_tickets' --initiator='$last_comment_author'",
            log_file => $file_name
        );
    }

    add_comment(
        ticket => $startrek_release_ticket,
        text   => join("\n", "**Переводы**\n", @$log_lines),
    );
}

sub _get_all_tickets {
    my $startrek_release_ticket = shift;

    my @tickets_from_description = get_tickets_from_description(ticket => $startrek_release_ticket);

    my $all_tickets = {};

    foreach my $ticket (@tickets_from_description) {
        get_all_ticket_subtickets(
            ys                  => _get_yandex_startrek(),
            key                 => $ticket,
            ticket_storage_hash => $all_tickets,
            depth               => 1,
        );
    }

    return $all_tickets;
}

sub get_all_ticket_subtickets {
    my (%params) = @_;

    my ($ys, $ticket_storage_hash, $key, $depth) = @params{qw( ys  ticket_storage_hash  key  depth)};
    $depth //= 0;

    return if exists $ticket_storage_hash->{$key};

    my $ticket = $ys->get_issue($key);
    return if !$ticket;

    $ticket_storage_hash->{$ticket->{key}} =
      (exists($ticket->{testScope}) && $ticket->{testScope} ne "Не заполнено") ? 1 : 0;

    my $links = $ys->get_issue_links($key);
    foreach my $element (@{$links}) {
        next if $element->{type}->{id} ne 'subtask';
        next if $element->{type}->{id} eq 'subtask' and $element->{direction} eq 'inward';

        get_all_ticket_subtickets(
            ys                  => $ys,
            key                 => $element->{object}->{key},
            ticket_storage_hash => $ticket_storage_hash,
            depth               => $depth + 1
        );
    }
}

sub process_release_tickets {

    my @startrek_release_tickets = defined($ST_TICKET) ? ($ST_TICKET) : get_open_startrek_release_tickets();
    write_log 'Found st tickets: ' . join ', ', @startrek_release_tickets if @startrek_release_tickets;

    foreach my $startrek_release_ticket (@startrek_release_tickets) {

        $CURR_RELEASE_TICKET = $startrek_release_ticket;

        ($CURR_RELEASE_SUMMARY, $CURR_RELEASE_NO, my $release_descr) = get_release_summary($CURR_RELEASE_TICKET);
        $IS_DEBUG_ROBOT_RELEASE = ($release_descr =~ /Debug robot/) ? 1 : 0;

        my $last_comment      = '';
        my $last_comment_text = '';
        my $last_comment_author;

        if (defined($ST_TICKET)) {
            $last_comment_author = _get_yandex_startrek()->get_issue($ST_TICKET)->{'createdBy'}{'id'};
        } else {
            $last_comment        = get_last_comment_and_author_from_startrek_ticket($CURR_RELEASE_TICKET);
            $last_comment_text   = $last_comment->{text} // '';
            $last_comment_author = $last_comment->{login} // '';
        }

        next if not defined $last_comment;

        my $job = undef;

        if (defined($ACTION) && $ACTION eq 'build') {
            $job = sub {
                write_log("Got command by $last_comment_author to build release");

                build_release(
                    startrek_release_ticket => $CURR_RELEASE_TICKET,
                    releaser                => $last_comment_author,
                    description             => $release_descr,
                );
            };
        } elsif (defined($ACTION) && $ACTION eq 'check-before-migrations') {
            $job = sub {
                write_log("Got command by $last_comment_author to build release");

                # TODO: remove when SB task fixed
                my @number = split(/\./, $BUILD_NUMBER);
                check_before_migrations(
                    startrek_release_ticket => $CURR_RELEASE_TICKET,
                    build_number            => $number[-1],
                );
            };
        } elsif (defined($ACTION) && $ACTION eq 'finalize-release') {
            $job = sub {
                write_log("Got command by $last_comment_author to build release");

                # TODO: remove when SB task fixed
                my @number = split(/\./, $BUILD_NUMBER);
                finalize_release(
                    startrek_release_ticket => $CURR_RELEASE_TICKET,
                    build_number            => $number[@number - 1],
                    releaser                => $last_comment_author,
                );
            };
        } else {
            die "There is no suitable action found for parametr --action";
        }

        eval {$job->()} if $job;
        if ($@) {
            WARN $@;
            $FATAL_ERROR = 1;
            _handle_error($@, $CURR_RELEASE_TICKET);
        }

    }
}

sub _handle_error {
    my ($error, $startrek_release_ticket) = @_;

    if ($error) {

        my $st_err_msg = '';
        if (ref($error) eq 'Robot::Exception') {
            ($error, $st_err_msg) = @$error{qw( shortmsg  stmsg )};
        } else {
            $st_err_msg = "%%\n$error\n%%";
        }

        if ($startrek_release_ticket) {

            my $st_comment_id = add_comment(
                ticket => $startrek_release_ticket,
                text   => sprintf(qq[%s пошло не так: %s\n], ($CURR_JOB_DESCR || 'Что-то'), $st_err_msg)
            );
            _send_message_to_telegram(
"<a href=\"https://st.yandex-team.ru/$startrek_release_ticket#$st_comment_id\">Ошибка при сборке/выкладке server side!</a>"
            );
            _send_message_to_slack(
"<https://st.yandex-team.ru/$startrek_release_ticket#$st_comment_id|Ошибка при сборке/выкладке server side!>"
            );
        } else {
            _send_message_to_telegram("Ошибка при сборке/выкладке server side!");
            _send_message_to_slack("Ошибка при сборке/выкладке server side!");
        }

        write_log colored('ERROR: ', 'red') . colored($error, 'yellow');
    }
}

sub _get_creator_hosts {
    my $url = 'https://partner.yandex-team.ru/api/0/creator_hosts.json';

    my $request = GET($url);

    my @hosts = http_request(
        $request,
        sub {
            my ($response) = @_;
            return @{decode_json $response->decoded_content};
        }
    );

    unless (@hosts) {
        ERRORF "Can't find creator hosts from url %s", $url;
        die colored('FAIL', 'red');
    }

    return @hosts;
}

sub _get_partner2_production_versions {
    my (%opts) = @_;

    my $last_comment_author = $opts{last_comment_author};

    my $browser = LWP::UserAgent->new(
        ssl_opts => {
            verify_hostname => 0,
            SSL_verify_mode => SSL_VERIFY_NONE
        }
    );

    my $backend_version;
    my $frontend_version;

    my $url = 'https://partner.yandex-team.ru/partner2_production_version.json';
    my $data;

    my $time = time + 15 * 60;
  RETRY: foreach my $try_num (1 .. 3) {

        my $request = GET($url);
        my $response = eval {$browser->request($request)};
        WARN $@ if $@;

        if ($response->is_success()) {
            $data = eval {decode_json $response->decoded_content};
            WARN $@ if $@;
            if ($data) {
                $backend_version  = $data->{s};
                $frontend_version = $data->{f};
            }
        }

        last if $backend_version;
        sleep 2;
    }

    if ($CURR_RELEASE_TICKET && $opts{check_versions_and_report}) {
        my $text = "Версии пакетов в проде:\n";

        my ($sv, $fv) = delete @{$data}{qw(s f)};

        my $need_retry;
        for my $h (keys %$data) {
            if ($data->{$h} and ref $data->{$h}) {
                my $s = $data->{$h}{s} // '<undef>';
                my $f = $data->{$h}{f} // '<undef>';
                $text .= sprintf "**%s**\n* back: %s\n* front: %s\n", $h, $s, $f;

                if ($sv ne $s || $fv ne $f) {
                    $need_retry = 1;
                    WARNF
'Code versions dont match: on host=[%s] versions: front=[%s] back=[%s]. Expected versions: front=[%s], back=[%s]',
                      $h, $f, $s, $fv, $sv;
                }
            } else {
                $text .= sprintf "**%s**\n* FAIL\n", $h;
                $need_retry = 1;
                WARNF "**%s**\n* FAIL while getting code version\n", $h;
            }
        }

        if ($need_retry && time < $time) {
            sleep(3 * 60);

            _send_message_to_telegram(
"\@$last_comment_author Проверьте версию бокса PerlApp в <a href='https://deploy.yandex-team.ru/project/partner-production-stage/config'>Deploy</a>"
            );
            _send_message_to_slack(
"\@$last_comment_author Проверьте версию бокса PerlApp в <https://deploy.yandex-team.ru/project/partner-production-stage/config|Deploy>"
            );

            goto RETRY;
        }

        add_comment(
            ticket => $CURR_RELEASE_TICKET,
            text   => $text,
        );
    }

    if (!$backend_version || !$frontend_version) {
        ERRORF "Can't find partner2 production versions from url %s", $url;
        _handle_error("Can't find partner2 production versions");
        die colored('FAIL', 'red');
    }

    INFOF 'backend_version=%s, frontend_version=%s', $backend_version, $frontend_version;

    return ("tags/releases/partner/perl/$backend_version", "tags/releases/partner/yharnam/$frontend_version");
}

sub _get_latest_docker_db_image {
    my ($creator_host) = @_;

    my $url = sprintf 'https://%s/api/3/cached_docker_db_images', $creator_host;

    my $request = HTTP::Request->new(GET => $url);

    my $image = http_request(
        $request,
        sub {
            my ($response) = @_;
            my $data = decode_json $response->decoded_content;
            return $data->[-1];
        }
    );

    unless ($image) {
        ERRORF "Can't find latest docker image from url %s", $url;
        #        _handle_error("Can't find latest docker image");
        #        die colored('FAIL', 'red');
    }

    return $image;
}

sub get_args {

    my $help = 0;
    GetOptions(
        'debug!'                         => \$DEBUG,
        'debug_slack_channel:s'          => \$DEBUG_SLACK_CHANNEL,
        'st_ticket:s'                    => \$ST_TICKET,
        'action:s'                       => \$ACTION,
        'stage:s'                        => \$STAGE,
        'checkout_to:s'                  => \$CHECKOUT_TO,
        'frontend_tag=s'                 => \$FRONTEND_TAG,
        'build_number:s'                 => \$BUILD_NUMBER,
        'java_docker:s'                  => \$JAVA_DOCKER,
        'yav_token:s'                    => \$YAV_TOKEN,
        'release_st_ticket_on_preprod:s' => \$RELEASE_ST_TICKET_ON_PREPROD,
        'update_preprod!'                => \$UPDATE_PREPROD,
        'update_testing!'                => \$UPDATE_TESTING,
        #---
        'help|?|h'         => \$help,
        'skip_not_merged!' => \$SKIP_NOT_MERGED,
    ) or pod2usage(1);

    pod2usage(-verbose => 2, -noperldoc => 1) if $help;

}

sub _check_migrations {
    my ($order) = @_;

    my $filename = _get_log_file_name("check_migrations");

    _run_cmd('mkdir ./local');
    _run_cmd('BASE_PORT=8066 make create_and_copy_configs', 'iddqd');
    _run_cmd('perl -Ilib -Ilocal/lib/perl5 -MUtils::MakeFile ' .
            '-e "Utils::MakeFile::set_db_on_prod()"');

    local $ENV{FORCE_LOGGER_TO_SCREEN} = 1;
    my $migrations = _run_cmd_with_log(cmd => <<"RUN", log_file => $filename);
        echo yes |
        perl -Ilib -Ilocal/lib/perl5 bin/run_migrations.pl \\
            --type=all --order=$order --dry_run
RUN
    _run_cmd('cp configs/dev/DatabaseConfig.json lib/');

    my ($started, $errors, $skipped);
    for (@$migrations) {
        s/\e\[\d+m//g;
        $started = 1 if /START WITH OPTS:/;
        $errors  = 1 if / ERROR /;
        $skipped = 1 if /\bSKIP\b/;
    }
    if (!$started || $errors || $skipped) {
        my $lines = join "", @$migrations > 100 ? @$migrations[-100 .. -1] : @$migrations;
        die bless {
            shortmsg => 'Migration check failed',
            stmsg =>
              "Migration check failed -- <{Несколько последних строк лога\n%%\n$lines\n%%}>",
        } => 'Robot::Exception';
    }
    @$migrations = grep {s!^Try to execute.*(/migrations/.*)!* %%$1%%!} @$migrations;

    return $migrations;
}

sub _logf {
    my ($severity, $pattern, @params) = @_;
    _log($severity, sprintf($pattern, @params), 1);
}

sub _log {
    my ($severity, $message, $logf) = @_;

    my $severity_colors = {
        'INFO'  => 'green',
        'WARN'  => 'yellow',
        'ERROR' => 'red'
    };

    my $now  = Moment->now();
    my $date = Moment->now->get_dt();

    my ($package, $filename, $line) = caller(1 + ($logf ? 1 : 0));

    $severity = colored($severity, $severity_colors->{$severity});

    my $pattern = '%s %s [%s:%s] %s %s';
    warn sprintf($pattern, $date, $$, $package, $line, $severity, $message), "\n";
}

__END__
