#!/usr/bin/perl

# $Id$

use strict; 
use warnings;

use IO::Prompt;
use File::Slurp;
use POSIX qw/strftime/;

use Data::Dumper;
use JSON;
use YAML;

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

my $DEPLOY_DIR = 'deploy';
my $EDITOR = [grep {$_} $ENV{EDITOR}, $ENV{VISUAL}]->[0] || 'editor';

my %keys_priority = (
    type => 4,
    db => 6,
    when => 8, 
    instructions => 10,
    time_estimate => 13,
    comment => 15,
    script => 30,
    sql => 31,
);

my %S = (
    deploy_script => 'запустить скрипт из deploy',
    script => 'запустить скрипт',
    sql => 'sql-запрос',
    manual => 'сложная последовательность действий',

    after => 'после выкладки пакетов',
    before => 'до выкладки пакетов',
    any => 'в любое время до или после пакетов',
    instructions => 'опишу словами',

    format_perl => "perl",
    format_json => "json",
    format_yaml => "yaml (рекомендуется)",
);

# проверяем, есть ли локально-модифицированные деплои, или деплой, отсутствующие в транке
if (-d $DEPLOY_DIR) {
    my @not_trunk_deploys = map {/^A\s+(\S+)/ ? $1 : ()} `svn st -q $DEPLOY_DIR`;
    
    my ($svn_url, $svn_start) = map {m!^URL: ((.*)/branches/.*/$DEPLOY_DIR)!} `svn info $DEPLOY_DIR`;
    if ($svn_url) {
        my %deploy_diff_summary = map { m!^ *([^ ]).*/$DEPLOY_DIR/(.*)\n!; $2 => $1; } `svn diff --summarize $svn_start/trunk/$DEPLOY_DIR $svn_url`; 
        my @branch_deploys = grep { ! /^archive\// } keys %deploy_diff_summary;
        my %archive_deploys = map { s!^archive/!!r => 1 } grep { /^archive/ } keys %deploy_diff_summary;
        @not_trunk_deploys = grep { !$archive_deploys{$_} && $deploy_diff_summary{$_} ne 'D'} @branch_deploys;
    }
    if (@not_trunk_deploys) {
        my $sel = prompt 'Редактировать один из обнаруженных нетранковых файлов? ',
            -menu => ['нет, создать новый', @not_trunk_deploys], '>';
        if (grep {$sel eq $_} @not_trunk_deploys) {
            edit_deploy($sel);
            exit 0;
        }
    }
}

my @tasks;
while (1){
    my $t = {};
    push @tasks, $t;
    my $sel = prompt 'Добавляем задание: ', 
        -menu => [ $S{deploy_script}, $S{script}, $S{sql}, $S{manual} ] , '>';
    print "$sel\n";

    if ($sel =~ /($S{script}|$S{deploy_script})/ ){
        $t->{type} = 'script';
        $t->{time_estimate} = '<примерное время выполнения>';
        $t->{comment} = '<комментарий>';
        $t->{script} = '<здесь впиши скрипт, который надо запустить>' if $sel eq $S{script};
    } elsif ($sel eq $S{manual}) {
        $t->{type} = 'manual';
        $t->{time_estimate} = '<примерное время выполнения>';
        $t->{text} = '<последовательность действий>';
    } else {
        $t->{db} = '<база данных>';
        $t->{type} = 'sql';
        $t->{sql} = '<здесь впиши sql-запрос>';
        $t->{time_estimate} = '<примерное время выполнения>';
    }

    my $when = prompt('Когда выполнять? ', -menu => [
        $S{after},
        $t->{type} eq 'script' ? () : ($S{before}, $S{any}),
        $S{instructions}
    ] , '>')->{value};
    print "$when\n";
    for (qw/after before any instructions/){
        $t->{when} = $_ if $when eq $S{$_};
    }
    $t->{instructions} = '<здесь опиши подробности про время и условия запуска>' if $t->{when} eq 'instructions' ;
        

    last if 'n' eq prompt 'Добавим еще что-нибудь? [yn]', -yesno, '> ';
}

my $migration = {
    tasks => \@tasks,
};

my $format;
if(is_deploy_script($migration)){
    $format = "format_perl";
} else {
    $format = prompt('Формат? ', -menu => [
        $S{format_yaml},
        $S{format_perl},
        $S{format_json},
    ] , '>')->{value};
    print "$format\n";
    for (qw/format_perl format_json format_yaml/){
        $format = $_ if $format eq $S{$_};
    }
}

$migration->{approved_by} = '';

my ($migration_text, $file_ext) = migration_text($migration, $format);

print "\nМиграция получится примерно такая:\n";
print $migration_text;

# пишем деплой в файл, открываем редактор
if (!-d $DEPLOY_DIR) {
    print "Файл создать нельзя, директория deploy отсутствует\n";
} elsif ('y' eq prompt 'Запишем в файл? [yn]', -yesno, '> ') {
    my $migr_name;
    while(1) {
        $migr_name = prompt 'Краткое название миграции? ';
        if ($migr_name && $migr_name =~ /^[\w-]+$/) {
            last;
        } else {
            print "Ошибка, некорректные символы. Допускаются латинские буквы, цифры, -, _\n";
        } 
    }
    my $ext = is_deploy_script($migration) ? 'pl' : $file_ext;
    my $filename = $DEPLOY_DIR . "/" . strftime("%Y%m%d", localtime) . "_" . $migr_name . ".$ext";
    if (!-f $filename || 'y' eq prompt 'Файл уже существует, перезаписать? ', -yesno, '>') {
        write_file($filename, {atomic => 1, binmode => ':utf8'}, $migration_text);
        system(svn => "add", $filename) && die "Ошибка добавления файла в svn: $!";
        if ('y' eq prompt "Отредактировать файл $filename? ", -yesno, '>') {
            edit_deploy($filename);
        }
    }
}

exit;

sub edit_deploy
{
    my $filename = shift;
    while(1) {
        system($EDITOR, $filename) && die $!;
        last if !system("migrator", "-s", "-t", $filename);
        last if 'n' eq prompt "Ошибка проверки миграции, продолжить редактирование? ", -yesno;
    }
}

sub migration_text
{
    my ($migration, $format) = @_;

    if ( $format eq 'format_perl'){
        return (migration_text_perl($migration), 'migr');
    } elsif ( $format eq 'format_json' ) {
        return (migration_text_json($migration), 'migr.json');
    } elsif ( $format eq 'format_yaml' ) {
        return (migration_text_yaml($migration), 'migr.yaml');
    } else {
        die "unknown format '$format'";
    }
}

sub migration_text_json
{
    my ($migration) = @_;
    return to_json($migration, { pretty => 1 });
}

sub migration_text_yaml
{
    my ($migration) = @_;
    return YAML::Dump($migration);
}

sub migration_text_perl
{
    my ($migration) = @_;

    local $Data::Dumper::Indent = 1;
    local $Data::Dumper::Terse = 1;
    local $Data::Dumper::Quotekeys = 0;
    local $Data::Dumper::Sortkeys = sub { 
        return [sort {($keys_priority{$a} || 100) <=> ($keys_priority{$b} || 100) } keys %{$_[0]}] 
    };

    my $text;
    if (is_deploy_script($migration)) {
        $text = q{#!/usr/bin/perl

=head1 DEPLOY

# .migr
}.Dumper_rus($migration).q{
=cut

use Direct::Modern;

use Yandex::DBTools;

use my_inc '..';

use ScriptHelper;
use Settings;

$log->out('START');

# <ВАШ КОД>

$log->out('FINISH');

};
    } else {
        $text = Dumper_rus($migration);
    }
    
    return $text;
}

sub create_task
{
    my (%O) = @_; 
    my $res;

    return $res;
}


sub Dumper_rus
{
    my $text = Dumper(@_);
    $text =~ s/\\x\{([\da-f]{2,3})\}/chr hex $1/ige;
    $text =~ s/\&/&amp;/g;
    return $text;
}

sub is_deploy_script {
    my $migration = shift;
    return scalar grep {$_->{type} eq 'script' && !$_->{script}} @{$migration->{tasks}};
}
