#!/usr/bin/perl -w

# $Id$

=head1 NAME

    svn-hotfix - Создание релизов в svn, мердж изменений

=head1 SYNOPSYS

    svn-hotfix PROJECT_SVN_URL RELEASE_REV MERGE_REV1,-MERGE_REV2,MERGE_REV3-MERGE_REV4

    svn mkdir https://svn.yandex.ru/direct/releases
    
    svn-hotfix https://svn.yandex.ru/direct 32768

    svn-hotfix https://svn.yandex.ru/direct 32768 65536,65539-65540

=head1 DESCRIPTION
    
    Скрипт позволяет создавать в SVN, в дирректории PROJECT_SVN_URL/releases создавать бранчи, соотвествующие тестируемым или выкладываемым
    релизам, а так же накладывать на релизы патчи из транка.

    Опции
        
        -h, --help
            показать справку и завершиться

        --ignore-externals
            при чекауте рабочей копии не раскрывать externals (==> работает быстрее)

        --non-interactive
            ничего не спрашивать у пользователя: 
            изменения сразу же коммитить с умолчальными сообщениями, 
            в случае конфликта -- сохранять рабочую копию и выходить.

        --pre-interactive 
            (интерактивность -- только предварительная)
            сначала по возможности быстро собирается информация о требуемых действиях и предъявляется пользователю
            Затем, если пользователь согласился со списком -- чекауты, мержи и коммиты делаются как в неинтерактивном режиме.
            Есть возможность выбрать продолжение в интерактивном режиме
        
        -w, --use-working-copy <путь>
            использовать уже существующую рабочую копию
            Если в рабочей копии есть локальные изменения или неверсионируемые файлы, svn-hotfix выдаст ошибку, если не был запущен с --reset-working-copy

        --reset-working-copy
            сделать svn-reset на рабочей копии перед svn switch

    Параметры 

    1-ый параметр - SVN урл репозитория проекта. Предполагается, что у проекта стандартный конфиг - транк называется транком.

    2-ой параметр - базовая ревизия для создания релиза. Если бранча PROJECT_SVN_URL/releases/release-RELEASE_REV не существует - он создаётся.

    3-ий параметр - списки коммитов и диапазонов коммитов для накладывания на релиз патчей.

    svn-hotfix --pre-interactive $DRT 22690 22768,-22685

    -22685 означает откат правок по ревизии 22685 в релизе.

=cut

use warnings;
use strict;

use SVN::Client;
use Data::Dumper;
use File::Path qw/rmtree/;
use File::Temp;
use Date::Parse;
use Time::Local;
use POSIX qw/strftime/;
use Encode;
use Getopt::Long;

use Yandex::Interactive qw/prompt prompt_yn/;
use Yandex::Shell;

use utf8;
use open ':std' => ':utf8';

$ENV{'SVN_SSH'} = "ssh -S $ENV{'SSH_MASTER_CONN_SVN'}" if $ENV{'SSH_MASTER_CONN_SVN'};

my ($IGNORE_EXTERNALS, $NON_INTERACTIVE, $PRE_INTERACTIVE);

my ($WC_PATH, $RESET_WC, $TMP_DIR);

GetOptions (
    "ignore-externals" => \$IGNORE_EXTERNALS,
    "non-interactive"  => \$NON_INTERACTIVE,
    "pre-interactive"  => \$PRE_INTERACTIVE,
    "w|use-working-copy=s" => \$WC_PATH,
    "reset-working-copy" => \$RESET_WC,
    "tmp-dir=s" => \$TMP_DIR,
    "h|help" => \&usage,
);

# разбираемся с аргументами командной строки
if (@ARGV < 2 || @ARGV > 3){
    die "expected 2 or 3 parameters, ".(scalar @ARGV)." found. Stop";
}elsif($ARGV[0] !~ /^(https?|svn\+ssh|file):\/\//){
    die "bad svn url: $ARGV[0]. Stop";
} elsif ($ARGV[1] !~ /^\d+$/){
    die "bad base revision: $ARGV[1]. Stop";
} elsif (@ARGV>2 && $ARGV[2] !~ /^(-?\d+|\d+-\d+)?(,-?\d+|\d+-\d+)*$/){
    die "bad revisions for hotfix: $ARGV[2]. Stop";
    #die "Usage: $0 SVN_URL RELEASE_REV MERGE_REV1,-MERGE_REV2,MERGE_REV3-MERGE_REV4";
}

my ($REPOSITORY_URL, $REV, $patches) = @ARGV;

my $svn = SVN::Client->new();

### выясняем ситуацию
# проверить, надо ли создавать бранч
my $release_branch_to_create = ''; # короткое, человекопонятное имя релизного бранча, который надо создать (пустая строка, если бранч уже есть)
my $RELEASE_URL = "$REPOSITORY_URL/branches/direct/release/perl/release-$REV";
my $BASE_URL = "$REPOSITORY_URL/trunk/arcadia/direct/perl";
if (!exists $svn->ls("$REPOSITORY_URL/branches/direct/release/perl", 'HEAD', 0)->{"release-$REV"}) {
   $release_branch_to_create = "release-$REV";
}

# составить исполняемый список патчей
# {
#     r1 => ..., # 
#     r2 => ..., # ревизии для мержа: svn merge -r r1:r2
#     text => ...,  # текст из параметра скрипта, номер ревизии либо диапазон
#     rollback 0|1, # флаг -- является ли патч откатыванием коммита(ов)
#     messages => [...], # массив текстовых фрагментов для коммит-сообщения, по одному на каждую смерженную ревизию
# }
my @to_patch;
for my $patch (split ',', $patches) {
    my ($r1, $r2);
    if ($patch =~ /^\d+$/) {
        ($r1, $r2) = ($patch-1, $patch);
    } elsif ($patch =~ /^-(\d+)$/) {
        ($r1, $r2) = ($1, $1-1);
    } elsif ($patch =~ /^(\d+)-(\d+)$/) {
        ($r1, $r2) = $1 <= $2 ? ($1-1, $2) : ($1, $2-1);
    } else {
        die "Incorrect patch definition: $patch";
    }
    my @log_rev = $r1 <= $r2 ? ($r1+1, $r2) : ($r1, $r2+1);
    
    my $p = {
        text => $patch,
        r1 => $r1,
        r2 => $r2, 
        rollback => $r1 > $r2 ? 1 : 0, 
    };

    $svn->log($BASE_URL, @log_rev, 0, 0,
              sub {
                  my (undef, $rev, $author, $date, $msg) = map {Encode::decode_utf8($_)} @_;
                  push @{$p->{messages}}, "r$rev: ".format_date($date).", $author\n$msg";
              }
        );

    if (!defined $p->{messages} || (scalar @{$p->{messages}} != abs($log_rev[1] - $log_rev[0]) + 1)) {
        die "Missing log entries for $patch, check if the revision numbers are right";
    }
    push @to_patch, $p;
}

# коммит-сообщение
# составить лог изменений (по 2 группам "добавлено", "откачено")
my @message_parts_add      = map { @{$_->{messages}} } grep { !$_->{rollback} } @to_patch;
my @message_parts_rollback = map { @{$_->{messages}} } grep {  $_->{rollback} } @to_patch;
my @messages = ( @message_parts_add, ( @message_parts_rollback ? "ROLLBACK:" : () ), @message_parts_rollback );
my $commit_message = join "\n\n", "RELEASE: Merged $patches", @messages;
$commit_message =~ s/\s+$//;
$commit_message =~ s/(\s*\n\s*){3,}/\n\n/g;
# REVIEW в коммит-месседжах обрабатывается нежелательным для хотфиксов образом (коммиты с мержами не проходят). Маскируем. Копия из arcadia-hotfix.pl. 
$commit_message =~ s/REVIEW: ([0-9]+)/<rvw $1>/g;

if( $PRE_INTERACTIVE ){
    # вывести лог, спросить
    while(1) {
        print "Log message:\n";
        print "$commit_message\n\n";
        my @opts = ('y', 'i', 'e', 'q');
        my %names = ('y' => 'yes', 'e' => 'edit message', 'i' => 'return to interactive mode', 'q' => 'quit');
        my $query = "proceed with non-interactive mode? (".join(" | ", map {"$_=$names{$_}"} @opts).")?";
        my $res = lc prompt("$query ", {"$query (Please enter ".join('|', @opts)."): " => \@opts});
        if ($res eq 'q') {
            # выйти...
            exit 1;
        } elsif ($res eq 'e') {
            $commit_message = Yandex::Interactive::edit($commit_message);
        } elsif ($res eq 'y') {
            # ...либо продолжить с $NON_INTERACTIVE=1...
            $NON_INTERACTIVE = 1;
            last;
        } elsif ($res eq 'i') {
            # ...либо продолжить в интерактивном режиме
            last;
        } else {
            print "Incorrect answer: '$res'\n";
        }
    }
}

# если релизного бранча еще нет - создаём
if ($release_branch_to_create) {
    $svn->log_msg(sub {svn_ask("Create branch", "RELEASE: Created release-$REV", undef, @_);});
    $svn->copy($BASE_URL, $REV, $RELEASE_URL);
    print "Branch created: $RELEASE_URL\n";
}

# если патчи накладывать не нужно - выходим
if (!@to_patch) {
    exit;
}

my $want_checkout = !$WC_PATH;
if ($want_checkout) {
    $WC_PATH = File::Temp::tempdir("svn-hotfix_XXXXXXX", CLEANUP => 0, ($TMP_DIR ? (DIR => $TMP_DIR) : ()));
    print "Start checkout to empty $WC_PATH ...\n";
    #$svn->checkout($RELEASE_URL, $WC_PATH, 'HEAD', 1);
    # непонятно, как через SVN::Client отказаться от чекаута externals, поэтому так: 
    system("svn co ".($IGNORE_EXTERNALS ? "--ignore-externals" : "")." $RELEASE_URL $WC_PATH > /dev/null") == 0 or die;
} else {
    my $dirty = 0;
    $svn->status($WC_PATH, 'HEAD', sub {$dirty=1 if $_[1]->text_status() != $SVN::Wc::Status::external;}, 1, 0, 0, 0);
    if ($dirty && !$RESET_WC) {
        die "Working copy $WC_PATH has local modifications and/or unversioned files.\nRun $0 with --reset-working-copy option if you're ok with losing these changes";
    } elsif ($RESET_WC) {
        `svn-reset $WC_PATH`;
    }
    print "Start switch $WC_PATH...\n";
    $svn->switch($WC_PATH, $RELEASE_URL, 'HEAD', 1);
}

# мерджим изменения, собираем commit-message
for my $p (@to_patch) {
    print "Start merge $p->{text}\n";
    $svn->merge($BASE_URL, $p->{r1}, $BASE_URL, $p->{r2}, $WC_PATH, 1, 0, 0, 0);
}

# проверяем, всё ли удачно смерджилось
my $want_commit = 0;
my @conflicts;
print "Changes:\n";
$svn->status($WC_PATH, 'HEAD',
             sub {
                 my $st = $_[1]->text_status();
                 print "  ".format_status($st)."\t$_[0]\n";
                 push @conflicts, $_[0] if $_[1]->text_status() == $SVN::Wc::Status::conflicted;
                 $want_commit = 1 if $_[1]->text_status() != $SVN::Wc::Status::external;
             }, 
             1, 0, 0, 0);

my $ready_rev = '';
# если нужно - коммитим изменения
if ($want_commit) {
    if (@conflicts) {
        print "Conflict occured during merge, resolve and commit manually.\n";
        if ($NON_INTERACTIVE || prompt_yn("Keep directory $WC_PATH? ")) {
            $File::Temp::KEEP_ALL = 1;
            print STDERR "\nCommit message:\n";
            print STDERR $commit_message, "\n\n";
            print STDERR "Please, don't forget to remove directory after commit.\n";
        }
        exit(1);
    }
    if ($want_commit) {
        $svn->log_msg(
            sub {
                svn_ask("Commit changes?", $commit_message, yash_qx("svn", "diff", $WC_PATH), @_);
            }
            );
        my $commit = $svn->commit($WC_PATH, 0);
        print "Changes commited (revision ".$commit->revision().").\n";
        $ready_rev = $commit->revision();
    }
} else {
    my $receiver = sub {
        my( undef, $info ) = @_;
        $ready_rev = $info->rev;
    };
    $svn->info($WC_PATH, undef, 'COMMITTED', $receiver, 0);
}

print "Release url: $RELEASE_URL\n";
print "ready branch\@rev: $RELEASE_URL\@$ready_rev";

# формат времени из gmt в human-readable
sub format_date {

    # надо для случая когда из SVN::_Client::svn_client_log придёт время вида "2013-10-09T14:35:59.890845Z"
    # тогда вызов strptime( $_[0] ) вернёт 59.89084535140991130 и мы упадем с сообщением "Second '59.890845' out of range 0..59"
    ( my $time = $_[0] ) =~ s/\.\d+Z/Z/;

    my @localtime = strptime( $time );
    $localtime[0] = int($localtime[0]);
    return strftime "%Y-%m-%d %H:%M", localtime(timegm(@localtime));
}

# текстовые обозначения статусов
sub format_status {
    my %STATES = (
        $SVN::Wc::Status::none => '?',
        $SVN::Wc::Status::unversioned => '?',
        $SVN::Wc::Status::normal => '',
        $SVN::Wc::Status::added => 'A',
        $SVN::Wc::Status::missing => '_',
        $SVN::Wc::Status::deleted => 'D',
        $SVN::Wc::Status::replaced => 'R',
        $SVN::Wc::Status::modified => 'M',
        $SVN::Wc::Status::merged => 'M',
        $SVN::Wc::Status::conflicted => 'C',
        $SVN::Wc::Status::ignored => 'I',
        $SVN::Wc::Status::obstructed => '?',
        $SVN::Wc::Status::external => 'X',
        $SVN::Wc::Status::incomplete => '?',
        );
    return exists $STATES{$_[0]} ? $STATES{$_[0]} : "?($_[0])";
}

# показываем пользователю умолчательное сообщение для коммита,
# предлагаем отредактировать
sub svn_ask {
    my ($question, $msg, $diff, $ret_ref) = @_;
    while(1) {
        print "Log message:\n";
        print "  $_\n" for split /\n/, $msg;
        last if $NON_INTERACTIVE;
        my @opts = defined $diff ? ('y', 'e', 'd', 'q') : ('y', 'e', 'q');
        my %names = ('y' => 'yes', 'e' => 'edit message', 'd' => 'show diff', 'q' => 'quit');
        my $query = "$question (".join(" | ", map {"$_=$names{$_}"} @opts).")?";
        my $res = lc prompt("$query ", {"$query (Please enter ".join('|', @opts)."): " => \@opts});
        if ($res eq 'q') {
            exit 1;
        } elsif ($res eq 'd') {
            Yandex::Interactive::view($diff);
        } elsif ($res eq 'e') {
            $msg = Yandex::Interactive::edit($msg);
        } elsif ($res eq 'y') {
            last;
        } else {
            print "Incorrect answer: '$res'\n";
        }
    }
    $$ret_ref = $msg;
}

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

