#!/usr/bin/perl -w

=head1 NAME


=head1 SYNOPSIS

    commit -j <issue_key> <files>
    commit -s <summary>   <files>

    commit -j 6793 protected/some_script.pl data/js/new_file_1 data/js/new_file_2
    commit -s 'поправить таймауты в some_script' -int protected/some_script.pl

=head1 DESCRIPTION

    Опции:
        -h, --help 
            показать справку и завершиться
        -j, --issue-key <issue>
            идентификатор тикета в трекере: SSB-1000, DIRECT-NNNN или просто MMMM (=тикет в $ProjectSpecific::PROJECT)
            можно указать несколько: -j 3435 -j 6775 -j 7899
        -m, --message <текст> 
            == svn commit -m <текст>
        -s, --summ, --summary <текст>
            если указано -- перед коммитом в трекере будет создан тикет с таким заголовком
        -d, --desc, --description <текст>
            описание для создаваемого тикета, необязательно
        -int, --internal
            создавать тикет как "Внутренний" (=будут выставлены нужные поля в Testing + комментарий словами + Resolve после коммита)
        -hf, --hotfix 
            во время тестирования релиза trunk-коммиты по умолчанию не проходят. 
            Для того, чтобы все-таки закоммитить код в trunk, надо указать опцию --hotfix
            Для того, чтобы всегда игнорировать флаг "осторожно, релиз", можно выставить переменную окружения $IGNORE_RELEASE_FLAG
        -rs, --resolve 
            после коммита сделать Resolve тикета/тикетов
        -rt, --ready-for-test 
            после коммита сделать Ready For Test тикета/тикетов
        -cl, --close
            после коммита сделать Close тикета/тикетов
        -c, --comm, --comment <текст>
            после коммита добавить к тикетам комментарий
        --queue <строка>
            очередь в трекере, в котором создавать тикет, если требуется. 
            Необязательно, если не указана -- то умолчальная очередь из Project::Specific
        --bug 
            если создается тикет -- создавать его как Bug (по умолчанию создается Task)
        --task
            (умолчальное поведение) если создается тикет -- создавать его как Task
        -cc <логин>[,<логин>,...] 
            добавить указанных людей в CC к тикету/тикетам

        --startrek-instance [test|prod|...]
            условное название инстанса Стартрека, с которым работать.
            По умолчанию prod

        --editor-cmd=<команда>
            == svn commit --editor-cmd=<команда>
            Если опция не указана, svn commit запускается с ключом --editor-cmd='svn-edit-log-message'



=head1 COMMENTS

=cut

# $Id$

use strict;
use Data::Dumper;
use File::Slurp;
use Getopt::Long;
use JSON;
use POSIX qw/strftime/;
use Encode;
use File::Temp qw/ tempfile /;

#use lib '/home/lena-san/usr/bin/project_specific';
use ProjectSpecific;

use Startrek::Client::Easy;

use Yandex::Svn;

use utf8;
use open ':locale';


my $INTERNAL_SUMMARY_PREFIX = "Internal";
my $EDIT_LOG_MESSAGE = "svn-edit-log-message";

my $SVN_BASE_URL = "svn+ssh://arcadia.yandex.ru/arc/trunk/arcadia/direct/perl";

my $ARCADIA_BASE_URL = "svn+ssh://arcadia.yandex.ru/arc";

$ENV{LC_ALL} = 'en_US.UTF-8';

#.......................................................................................

run() unless caller();

sub run
{
    my $opt = parse_options();
    $opt->{svn_info} = svn_info($opt->{target});
    if ($opt->{svn_info}->{url} =~ m!^svn\+ssh://arcadia\.yandex\.ru/arc/(trunk/arcadia/direct/(perl|infra/direct-utils)|branches/direct/perl)(/|$)!) {
        $opt->{skip_arcanum_check} = 1;
    }

    pre_commit_actions($opt);

    $ENV{MY_SVN_COMMIT_MESSAGE} = Encode::encode_utf8(make_svn_commit_message($opt));

#print STDERR "commit message:\n$ENV{MY_SVN_COMMIT_MESSAGE}\n";

    my $revision = svn_commit({skip_arcanum_check => $opt->{skip_arcanum_check}});
    die "nothing committed" unless $revision > 0; 

    my $post_commit_opt = {};
    if ($opt->{is_trunk} || $opt->{branch}) {
        $post_commit_opt->{revision} = $revision;
    }
    $post_commit_opt->{branch} = $opt->{branch} if $opt->{branch};
    post_commit_actions($opt, %$post_commit_opt);

    exit; 
}

#.......................................................................................

=head2 parse_options

    возвращает хеш %O с опциями из командной строки

=cut

sub parse_options
{
    my %O = (
        startrek_instance => 'prod',
    );
    GetOptions (
        'startrek-instance=s'   => \$O{startrek_instance},
        "j|issue-key=s@"        => \$O{issue_keys},
        "h|help"                => \&usage,
        "m|message=s"           => \$O{m_message},
        "s|summ|summary=s"      => \$O{summary},
        "d|desc|description=s"  => \$O{description},
        "queue=s"               => \$O{queue},
        "bug"                   => sub { $O{issue_type} = 'Bug'},
        "task"                  => sub { $O{issue_type} = 'Task'},
        "hf|hotfix"             => \$O{hotfix},
        "int|internal"          => \$O{internal},
        "rs|resolve"            => \$O{resolve},
        "rt|ready-for-test"     => \$O{ready_for_test},
        "cl|close"              => \$O{close},
        "c|comm|comment=s@"     => \$O{comment},
        "cc=s@"                 => \$O{cc},
        "editor-cmd=s"          => \$O{editor_cmd},
        "ignore-issue-status"   => \$O{ignore_status},
        "skip-arcanum-check"    => \$O{skip_arcanum_check},
    ) or die "cant't parse options, stop\n";
    # Getopt не понимает utf8
    for my $opt_name (keys %O){
        next unless $O{$opt_name};
        if (ref $O{$opt_name} eq 'ARRAY') {
            $O{$opt_name} = [ map { Encode::decode_utf8($_) } @{ $O{$opt_name} } ];
        } elsif (!ref $O{$opt_name}) {
            $O{$opt_name} = Encode::decode_utf8( $O{$opt_name} );
        }
    }

    $O{ignore_release_flag} = $ENV{IGNORE_RELEASE_FLAG} ? 1 : 0;
    $O{target} = $ARGV[0] || '.';

    if($O{m_message}){
        unshift @ARGV, '-m', $O{m_message};
    }

    $O{editor_cmd} //= $EDIT_LOG_MESSAGE;
    unshift @ARGV, '--editor-cmd=' . $O{editor_cmd};

    $O{cc} = join ',', @{$O{cc}} if ref($O{cc}) eq 'ARRAY';
    $O{comment} = join "\n", @{$O{comment}} if ref($O{comment}) eq 'ARRAY';

    $O{queue} ||= ProjectSpecific::get_project_data('default_tracker_queue');
    for my $key (@{ $O{issue_keys} }) {
        $key =~ s/^(\d+)$/$O{queue}-$1/;
    }

    return \%O;
}


=head2 usage

    Печатает usage-сообщение

=cut

sub usage {
    system("podselect -section SYNOPSIS -section DESCRIPTION $0 | pod2text-utf8 >&2");
    exit(1);
}


=head2 svn_commit

Вызывает svn commit со всеми опциями, перечисленными в @ARGV
Возвращает число -- номер закоммиченной ревизии. 

Если коммит по какой-то причине не состоялся -- возвращает 0

Внутри -- обычный svn commit, обернутый в script
Возможно, можно то же самое сделать через Svn::Client, но лень разбираться

=cut

sub svn_commit
{
    my ($opt) = @_;

    my $cmd = join " ", 'svn', 'commit', map {"'$_'"} @ARGV;
    if ($opt->{skip_arcanum_check}) {
        $cmd .= " --with-revprop arcanum:check-skip=yes";
    }

    my ($fh, $filename) = tempfile();
    my $commit_exit_code = system('script', '-e', '-c', $cmd, $filename);
    my @typescript = map {Encode::decode_utf8($_)} <$fh>;
    close $fh;
    unlink $filename;

    unless ( 0 == $commit_exit_code ){
        print STDERR "system failed: $?\ncmd: $cmd\n";
        return 0;
    }

    my $revision_committed = 0;
    # рассматриваем только последние строчки, чтобы уменьшить ложные срабатывания
    @typescript = @typescript[-4 .. -1];
    # строки, похожие на рапорт о закоммиченной ревизии (могут быть по-русски, по-английски)
    my $reqexp = qr/^(?:committed\s+revision|\w+\s+\w+)\s+([0-9]+)\.\s*$/;
    my @rev_str = grep { ($_ || '') =~ m/$reqexp/smi } @typescript;
    if ( @rev_str == 1 ) {
        $rev_str[0] =~ m/$reqexp/smi;
        $revision_committed = $1;
    } 

    return $revision_committed;
}

=head2 make_svn_commit_message

=cut

sub make_svn_commit_message
{
    my ($opt) = @_;

    my $res = '';

    # если бранч -- подставляем его имя
    my $svn_url = $opt->{svn_info}->{url};

    my ($branch) = $svn_url =~ m!branches/direct/perl/([\w\-]+)!;
    $res .= "$branch: " if $branch;

    if ($opt->{issue_keys}){
        $opt->{startrek} ||= Startrek::Client::Easy->new(startrek => $opt->{startrek_instance});
        my @issues = @{ $opt->{startrek}->get( key => $opt->{issue_keys}, array => 1 ) };

        my @lines;
        for my $i (@issues){
            $i->{summary} =~ s/^\Q$INTERNAL_SUMMARY_PREFIX\E: //;
            push @lines, "$i->{key}: $i->{summary}";
        }
        $res .= join "\n", @lines;
    }
    my ($du_project) = $svn_url =~ m!/direct-utils/((?:yandex-lib/)?[\w\-]+)!;
    $res .= "\n\n$du_project: " if $du_project;

    if (-e 'changes') {
        $res .= "\n";
        my @diff_lines = grep {/^\+/ && !/^\+{3}/} `svn diff changes`;
        for my $line (@diff_lines) {
            chomp $line;
            $res .= substr($line, 1)."\n";
        }
    }

    return $res;
}


=head2 pre_commit_actions


=cut

sub pre_commit_actions
{
    my ($opt) = @_;

    # Не даем коммитить в trunk во время релиза
    my $svn_url = $opt->{svn_info}->{url};
    my $arcadia_perl_trunk_url = 'arcadia.yandex.ru/arc/trunk/arcadia/direct/perl';
    my $direct_trunk = $svn_url =~ m!svn\.yandex\.ru/direct(?:\-moderate)?/trunk|\Q$arcadia_perl_trunk_url\E!;

    $opt->{is_trunk} = $svn_url =~ m!/trunk!;
    ($opt->{branch}) = $svn_url =~ m!/branches/direct/perl/([\w\-]+)!;

    if ( $direct_trunk && !$opt->{ignore_release_flag} && !$opt->{hotfix} && system('direct-release-flag -q') != 0 ){
        print "
Сейчас тестируется релиз, несрочные коммиты в trunk лучше сделать попозже.
Если твой коммит -- срочный, используй опцию -hf

После окончания моратория на транковые коммиты на почту будет разослано уведомление с напоминанием о коммитах.
Вопросы и предложения пиши lena-san@

Для просмотра состояния релизного флага есть скрипт direct-release-flag:

> direct-release-flag
".qx!direct-release-flag!;
        # пишем в лог параметры коммита, чтобы после окончания моратория напомнить закоммитить
        my $details = {
            format => 1,
            login => [getpwuid($<)]->[0],
            logtime => strftime("%Y-%m-%d %H:%M:%S", localtime),
            pwd => `pwd`,
            commit_params => $opt,
            argv => \@ARGV,
        };
        my $logfile = '/var/spool/direct-release-flag/failed-commits/log';
        write_file( $logfile, {append => 1 }, JSON::to_json($details, {utf8 => 1, canonical => 1})."\n" );
        chmod 0666, $logfile;
        exit 1;
    }   

    if ($opt->{is_trunk} && $opt->{issue_keys} && !$opt->{ignore_status} && !$opt->{resolve} && !$opt->{ready_for_test} && !$opt->{close}) {
        check_issue_status($opt);
    }

    # если надо -- создаем тикет
    create_issue_if_necessary($opt); 

    return;
}


=head2 create_issue_if_necessary

=cut

sub create_issue_if_necessary
{
    my ($opt) = @_;

    return unless $opt->{summary} || $opt->{description};

    $opt->{startrek} ||= Startrek::Client::Easy->new(startrek => $opt->{startrek_instance});

    $opt->{$_} ||= '' for qw/summary description queue/;

    if ( $opt->{description} && !$opt->{summary} ){
        my $MAX_AUTO_SUMMARY_LEN = 70;
        if (length $opt->{description} <= $MAX_AUTO_SUMMARY_LEN){
            $opt->{summary} = $opt->{description};
            $opt->{description} = '';
        } else {
            $opt->{summary} = substr($opt->{description}, 0, $MAX_AUTO_SUMMARY_LEN)."...";
        }
    }

    if( $opt->{internal} ){
        $opt->{summary} = "$INTERNAL_SUMMARY_PREFIX: $opt->{summary}" if $opt->{summary};
    }

    # Сложное, но нужное: смотрим последние несколько созданных тикетов, если уже есть в точности с таким описанием -- не создаем, а используем готовый
    # (на случай, если коммит не прошел и команда в точности повторяется из истории)
    # Для SSB -- 19023 TODO: хранить хеш (Джира-проект => Id фильтра с недавними тикетами) 
    # еще TODO: определять Джира-проект по svn-пути, где делается коммит
    my @duplicate_keys;
    my $issues = eval { $opt->{startrek}->get( query => qq!Queue: $opt->{queue} "Sort by": key desc!, limit => 10, array => 1 ) } || [];
    if ($@) {
        warn "warning: could not find duplicates: $@\n";
    }
    push @duplicate_keys, map {$_->{key}} grep { $_->{summary} eq $opt->{summary} && ($_->{description} || '') eq $opt->{description} } @$issues;
    if (@duplicate_keys){
        push @{$opt->{issue_keys}}, @duplicate_keys;
        return;
    }

    my %to_create = (
        queue       => $opt->{queue},
        create      => 1,
        summary     => $opt->{summary}, 
        description => $opt->{description},
        internal    => $opt->{internal} || 0, 
        type        => lc($opt->{issue_type} || 'Task'),
        followers   => $opt->{cc},
    );

    $opt->{close} = 1 if $to_create{internal}; 

    my $issue = $opt->{startrek}->do(%to_create) or die "can't create an issue";
    print STDERR "created $issue\n";

    push @{$opt->{issue_keys}}, $issue;

    return;
}



=head2 post_commit_actions


=cut

sub post_commit_actions
{
    my ($opt, %data) = @_;

    update_issue_if_necessary($opt, revision => $data{revision}, $data{branch} ? (branch => $data{branch}) : ());
    # TODO отправить запросы на хотфиксы в Версионику

    return;
}


=head2 update_issue_if_necessary

=cut

sub update_issue_if_necessary
{
    my ($opt, %data) = @_;

    return if ! @{$opt->{issue_keys}||[]};

    my $is_trunk = !$data{branch};

    # если есть -rs, -cl, -comm -- проделать нужные действия над тикетами
    my %to_update;

    for (qw/resolve ready_for_test close cc/){
        $to_update{$_} = $opt->{$_} if $opt->{$_};
    }

    my $revision_comment;
    if (my $revision = $data{revision}) {
        my $revision_url;
        my $svn_root = $opt->{svn_info}->{repository_root};
        if (is_project_repo($svn_root) && !is_arcadia($svn_root)) {
            $revision_url = get_svnlog_url($revision);
        } elsif (is_arcadia($svn_root)) {
            $revision_url = "https://a.yandex-team.ru/commit/$data{revision}";
        }

        if ($is_trunk) { 
            $revision_comment = "Committed revision $revision";
            $revision_comment .= "\n$revision_url" if $revision_url;
            $revision_comment .= "\nticket: https://st.yandex-team.ru/$_" for @{$opt->{issue_keys}};
        } else {
            # для веток прячем полные ссылки, чтобы визуально отличать от коммитов в транк.
            $revision_comment = sprintf qq/""%s"": Committed revision %s/, $data{branch}, ($revision_url ? "(($revision_url $revision))" : $revision);
        }
    }
    $to_update{comment} = join "\n", ($opt->{comment}||()), ($data{revision}? $revision_comment: ());

    delete $to_update{comment} unless $to_update{comment};
    $to_update{commited} = 'Да' if $data{revision} && $is_trunk;

    print "Comment for tracker: $to_update{comment}\n" if $to_update{comment};

    for my $key (@{$opt->{issue_keys}}){
        $opt->{startrek} ||= Startrek::Client::Easy->new(startrek => $opt->{startrek_instance});
        $to_update{followers} //= delete $to_update{cc};
        local $to_update{key} = $key;
        eval {
            $opt->{startrek}->do(%to_update);
        };
        print $@ if $@;
    }

    return;
}

=head2 check_issue_status

    Список статусов можно посмотреть так
    curl -H "Authorization: OAuth ****" "https://st-api.yandex-team.ru/v2/statuses" | jq .  | grep key

    Токен возможно лежит в $HOME/.startrek_client_token

=cut

sub check_issue_status {
    my ($opt) = @_;
    my @issue_keys = @{ $opt->{issue_keys} };
    return if ! @issue_keys;
    $opt->{startrek} ||= Startrek::Client::Easy->new(startrek => $opt->{startrek_instance});
    my $issues = $opt->{startrek}->get(key => \@issue_keys, array => 1);
    my @open_issues = grep { $_->{status} =~ /^(codeReview|inProgress|inReview|needInfo|new|open|readyForTest|testing)$/ } @$issues;
    if (@open_issues) {
        my @lines;
        push @lines, "Попытка коммита в транк по незакрытым тикетам:";
        push @lines, map { "($_->{status}) $_->{key}: $_->{summary}" } @open_issues;
        push @lines, "Проверь, правильно ли указаны ключи тикетов и не нужно ли перевести их в другой статус.";
        push @lines, "Подробнее о коммитах в транк: https://wiki.yandex-team.ru/direct/development/howto/procedure-trunk-commit/";
        push @lines, "Если по каким-то причинам нужно закоммитить тикету в статусе Open, Need Info, In Progress, Code Reiview, Ready for Test, Testing используй --ignore-issue-status и сообщи релиз-менеджеру.";
        my $message = join "\n", @lines;
        die "$message\n";
    }
}

sub get_svnlog_url {
    my ($revision) = @_;
    die "no revision given" unless $revision;
    # меняем протокол с http на https здесь, а не в ProjectSpecific, потому что есть код, который ходит в Табулу по HTTP без авторизации (например, релизный шелл и воркер автобет), и пока неизвестно, будет ли он работать по HTTPS
    (my $tabula_url = ProjectSpecific::get_project_data("tabula_url")) =~ s/^http\b/https/;
    return $tabula_url . "/svnreview/add/" . $revision;
}

# Проверить, является ли переданный URL адресом в репозитории проекта ($ProjectSpecific::PROJECT)
sub is_project_repo {
    my ($svn_url) = @_;
    my $project_svn_url = ProjectSpecific::get_project_data("svn_url");
    return (index($svn_url, $project_svn_url) == 0);
}

# Прроверить, является ли переданный URL адресом в Аркадии
sub is_arcadia {
    my ($svn_url) = @_;
    return (index($svn_url, $ARCADIA_BASE_URL) == 0);
}
