#!/usr/bin/perl


=head1 NAME
    
    migrator -- применение миграций на различных конфигурациях

=head1 SYNOPSIS

    migrator --conf <cofiguration> <FILE> ...

=head1 DESCRIPTION

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

        -c, --conf, -configuration <conf>
            конфигурация, к которой надо применить миграции
            Поддерживаются: (dt|devtest|ts|tl|test-load|sbtest|sandboxtest|dev|sandboxdevtest|sbdevtest)

        -t, --to-text
            вывести текстовые описания миграций

        --syntax-help
            вывести справку по формату миграций
            почти никогда не требуется; миграции лучше генерировать скриптом migr-create

    $Id$

=head1 METHODS

=cut

package Migrator;

use strict;
use warnings;

use Safe;
use File::Slurp;
use Getopt::Long;
use List::MoreUtils qw/before/;

# нестандартный use из-за того, что Module::Info (и debosh) имеют какую-то проблему с обработкой этого модуля (сборка зависает)
eval "use MigratorB::Parse";

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

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

run() unless caller();

sub run
{
    my $opt = parse_options();


    my $files = read_migrations($opt);

    my $migrations = parse_migrations($files);
    if ( $opt->{strict} ){
        my @errors = extract_errors($migrations);
        die "errors:\n".join("\n", @errors)."\n" if @errors;
    }

    compile_texts($migrations);
    compile_actions($migrations, $opt);

    execute_migrations($migrations, $opt);

    exit;
}


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

# возвращает хеш %O с опциями из командной строки
sub parse_options
{
    my %O = (
        strict => 0,
        scripts_wc => '.',
    );

    GetOptions (
        "help"                   => sub {
            system("podselect -section NAME -section SYNOPSIS -section DESCRIPTION $0 | pod2text-utf8");
            exit(0);
        },
        "syntax-help"            => sub{
            system("podselect -section MIGRATION_SYNTAX $INC{'MigratorB/Parse.pm'} | pod2text-utf8");
            exit(0);
        },
        "c|conf|configuration=s" => \$O{conf},
        "wc|scripts-wc=s"        => \$O{scripts_wc},
        "s|strict!"              => \$O{strict},
        "t|text"                 => \$O{print_text_only},
        "n|dry-run"              => \$O{dry_run},
        "d|debug"                => \$O{debug},
        "task-count"             => \$O{print_task_count_only},
    );

    if ( $O{debug} ) {
        $O{dry_run} = 1; 
        $O{conf} ||= 'empty';
    }

    $O{conf} = 'empty' if $O{print_text_only} || $O{print_task_count_only};

    return \%O;
}


=head2 execute_migrations

    Выполняет миграции (запускает соответсвующие команды)

    На входе -- скомпилированные миграции, 
    возвращаемого значения нет. 

=cut
sub execute_migrations
{
    my ($migrations, $opt) = @_;

    if ($opt->{print_task_count_only}){
        print join" ", map {scalar @{$_->{tasks}}} @$migrations;
        return;
    }

    print "### configuration: $opt->{conf}\n";

    my $fc = 0;
    for my $m (@$migrations){
        $fc++;
        print "#### $fc. $m->{filename}\n";
        print "errors: ".join( "\n", @{$m->{errors}})."\n" if @{$m->{errors}||[]};
        print "text:\n$m->{text}\n" if $opt->{print_text_only};
        
        next if $opt->{print_text_only};

        if ( $m->{format} eq 'plaintext' ){
            message("skipping old-format file...");
            next;
        }

        my $tc = 0;
        for my $t ( @{$m->{tasks}} ){
            $tc++;
            print "#### $fc.$tc. comment: $t->{comment}\n" if $t->{comment};

            print("skipping manual task...\n"), next if $t->{type} eq 'manual';

            my $ac = 0;
            for my $action ( @{$t->{execute}} ){
                $ac++;
                print "#### $fc.$tc.$ac. to execute:\n$action\n"; 
                my $t1 = time;
                qx/$action/ unless $opt->{dry_run};
                my $t2 = time;
                print "done in ".($t2 - $t1)." seconds\n\n";
            }
        }
    }

    return;
}


=head2 get_cmd_for_sql

    Составляет shell-команду для применения заданного sql-запроса в заданной базе (и заданной конфигурации)

    Параметры именованные
        conf -- конфигурация (devtest, ts, tl, sbtest, dev, ...). TODO: production
        db   -- название базы, в которой должен выполняться запрос
        sql  -- запрос

=cut
sub get_cmd_for_sql
{
    my %O = @_;

    die "configuration expected" unless $O{conf};

    my $cmd;

    if ( $O{conf} eq 'empty' ) {
        $cmd = "sql: $O{db}\n$O{sql}";
    } else {
        die "suspicious configuration '$O{conf}'" if $O{conf} =~ /^pr/;
        $cmd = "direct-sql $O{conf}:$O{db} -q - <<'EOQ'\n$O{sql}\nEOQ";
    } 

    return $cmd;
}


=head2 get_cmd_for_script

    Составляет shell-команду для применения заданного скрипта к заданной конфигурации

    Параметры именованные: 
        conf -- конфигурация (devtest, ts, tl). TODO: production и sandbox
        scripts_wc -- (для конфигурации devtest) рабочая копия, из которой надо брать скрипты
        script -- имя скрипта (относительно корня рабочей копии Директа)

=cut
sub get_cmd_for_script
{
    my %O = @_;

    die "configuration expected" unless $O{conf};

    my $cmd;

    if ( $O{dry_run} ||  $O{conf} eq 'empty' ){
        $cmd = "script: $O{script}";
    } elsif ( $O{conf} =~ /^(devtest|dt|sandboxtest|sbtest|sandboxdevtest|dev7|testload|loadtest)$/ ) {
        $cmd = "$O{scripts_wc}/$O{script}";
    } elsif ( $O{conf} =~ /^(ts)$/ ) {
        $cmd = "test-update test1 /var/www/ppc.yandex.ru/$O{script}";
    } elsif ( $O{conf} =~ /^(ts2)$/ ) {
        $cmd = "test-update test2 /var/www/ppc.yandex.ru/$O{script}";
    } elsif ( $O{conf} =~ /^(tl)$/ ) {
        $cmd = "test-update test-load /var/www/ppc.yandex.ru/$O{script}";
    } else {
        die "unknown configuration $O{conf}";
    }

    return $cmd;
}


=head2 compile_actions

    Добавляет к миграциям shell-команды, необходимые для применения миграции

    В каждом задании появляется массив execute

=cut
sub compile_actions
{
    my ($migrations, $opt) = @_;

    for my $m (@$migrations){
        next if $m->{format} eq 'plaintext';
        for my $task ( @{$m->{tasks}} ){
            if ( $task->{type} eq 'sql' ){ 
                for my $sql ( @{$task->{sql}} ){
                    push @{$task->{execute}}, get_cmd_for_sql(conf => $opt->{conf}, db => $task->{db}, sql => $sql);
                }
            } elsif ( $task->{type} eq 'script' ){
                for my $script ( @{$task->{script}} ){
                    push @{$task->{execute}}, get_cmd_for_script(conf => $opt->{conf}, db => $task->{db}, script => $script, scripts_wc => $opt->{scripts_wc});
                }
            } elsif ( $task->{type} eq 'manual' ) {

            } else {
                message("$m->{filename}: unknown migration type $task->{type}");
            }
        }
    }

    return; 
}

sub message
{
    my ($message, $opt) = @_;

    print "$message\n";
}

