#!/usr/bin/perl

use strict;
use warnings;

use utf8;
use open ':std', ':encoding(UTF-8)';

=head1 NAME
      
    direct-sql 
    скрипт для удобного (интерактивного) выполнения запросов к БД из командной строки 
    понимает конфиги и шардинг в стиле Директа, алиасы конфигураций

=head1 DESCRIPTION

    direct-sql [<db>] [<query>]
    direct-sql [<query>] [<db>]

    alias m='direct-sql' # полезный алиас

    Основные параметры: база и запрос (в любом порядке)
        Если не указан запрос -- открывается mysql-shell

    База задается в виде conf:db (pr:ppc, dev7:ppclog, dt:catalog...)
    Список конфигураций с алиасами доступен по --list-conf
    Если база шардирована -- надо указать либо :<номер шарда>, либо :all

    И конфигурацию, и базу, и запрос можно указать через именованные опции.

=head1 OPTIONS

    -h, --help 
        показать справку
    --list-conf
        показать список известных конфигураций и их алиасами
    -n, --dry-run
        ничего не делать, только показать, какие команды были бы выполнены
        полезно перед применением пишущих запросов на продакшене или если хочется посмотреть параметры mysql-ного соединения
    --db <имя базы>
        с какой базой работать, имя листовой вершины из конфига
        Особый случай -- шардированная база.  Если вместо номера шарда указать :all, то запрос будет выполнен по очереди на всех шардах.
        Можно указывать не именованной опцией, а простым параметром.
    -c, --conf <имя конфигурации>
        имя конфигурации
        Можно не указывать через именованный параметр, а приклеить к имени базы: prod:ppcdict
        см. также --list-conf
    -q, --query <запрос>
        sql-запрос для выполнения
        можно указывать простым параметром, не именованным
        если сделать -q -, то запрос будет чиаться с STDIN
    --sh, --shell
        запустить mysql-шелл к указанной БД в указанной конфигурации
        атоматически срабатывает, если не задан запрос
        несовместим с :all
    -u <user>
        пользователь, которым надо коннектиться к mysql вместо такового из конфига
    -p <pass>
        пароль для mysql вместо такового из конфига
    -B, --batch
        выводить результаты в batch-режиме в виде tab-separated файла с именами полей первой строкой
    -N, --skip-column-names
        не выводить названия столбцов
    -q, --quick
        не кешировать резульаты, выводить строки по мере получения. Позволяет выгружать большие объёмы данных, но может замедлять сервер.

=head1 EXAMPLES

direct-sql --list-conf

direct-sql prod:ppc:all 'desc users' -n

direct-sql pr:ppc:all 'desc users'

cat alter_products | direct-sql -c production ppc:all -q -

direct-sql dt:ppc:all 'select count(*) from campaigns'

direct-sql -B -q dt:ppc:all 'select cid, bid, pid, 0 from banners' > resync.tsv

=head1 TODO

  --multiple-db + несколько --db (для продакшен + песочница)

  + таймер на время исполнения запроса

  работа с локальными конфигами

  + приписывать к каждому действию осмысленный комментарий, показывать

=cut

use Getopt::Long;
use YAML;
#use Pod::Usage;

use ProjectSpecific qw/get_db_conf_aliases/;
use Direct::Sql;


run() unless caller();


sub run
{
    $ProjectSpecific::PROJECT ||= 'Direct';
    my %O = %{parse_options()};
    my $query = get_query($O{query});

    my $conf = init_conf($O{conf_name});

    if ($O{shell}) {
        $conf->run_shell(db => $O{db});
        exit;
    }

    my $actions = $conf->compile_actions(
        query => $query, 
        db => $O{db}, 
        batch => $O{batch},
        skip_column_names => $O{skip_column_names},
        quick => $O{quick},
        mysql_user => $O{mysql_user},
        mysql_password => $O{mysql_password},
    );
    my $status = 0;
    if($O{dry_run}){
        $conf->print_actions($actions);
    } else {
        $status = $conf->perform_actions($actions, verbose => $O{verbose}, batch => $O{batch});
    }
    exit $status;
}


sub get_query
{
    my ($O_query) = @_;
    return $O_query;
}


sub init_conf
{
    my ($conf) = @_;
    $conf = _normalize_name($conf);
    return Direct::Sql->new(name => $conf);
}


sub parse_options
{
    utf8::decode($_) for @ARGV;
    my %O = (
        query => '',
        db => '',
        conf_name => '',
    );

    GetOptions(
        "help" => sub {
            #pod2usage(1);
            system("podselect -section NAME -section DESCRIPTION -section OPTIONS -section EXAMPLES $0 | pod2text-utf8 | LESSCHARSET=utf-8 less"); 
            exit 0;
        },
        "list-conf" => sub { print YAML::Dump(get_db_conf_aliases()); exit 0;},
        "n|dry-run" => \$O{dry_run},
        "db=s" => \$O{db},
        "c|conf=s" => \$O{conf_name},
        "query=s" => \$O{query},
        "sh|shell" => \$O{shell},
        "v|verbose" => \$O{verbose},
        "u|user=s" => \$O{mysql_user},
        "p|password=s" => \$O{mysql_password},
        'B|batch' => \$O{batch},
        'N|skip-column-names' => \$O{skip_column_names},
        'q|quick' => \$O{quick},
    ) || die "can't parse options, stop";

    if ( @ARGV > 2 ){
        die "too many arguments: @ARGV, stop";
    } elsif ( @ARGV == 2 ) {
        my ($new_db, $new_query);
        # Эвристика: если один из параметров состоит только из букв и двоеточий -- это имя базы
        if( !looks_like_db($ARGV[0]) && looks_like_db($ARGV[1]) ){
            ($new_db, $new_query) = ($ARGV[1], $ARGV[0]);
        } else{
            ($new_db, $new_query) = ($ARGV[0], $ARGV[1]);
        }
        die "can't process both --db and an argument $new_db, stop" if $O{db};
        die "can't process both --query and an argument $new_query, stop" if $O{query};
        ($O{db}, $O{query}) = ($new_db, $new_query);
    } elsif ( @ARGV == 1 ){
        if( looks_like_db($ARGV[0]) ){
            die "can't process both --db and an argument $ARGV[0], stop" if $O{db};
            $O{db} = $ARGV[0];
        } else {
            die "can't process both --query and an argument $ARGV[0], stop" if $O{query};
            $O{query} = $ARGV[0];
        }
    } else {
    }

    if ($O{query} eq '-'){
        $O{query} = join '\n', <STDIN>;
    }

    if (!$O{query}){
        $O{shell} = 1;
    }

    my $conf_re = _conf_re();
    if ( $O{db} =~ /^($conf_re):(.*)$/ ){
        my ($new_conf, $new_db) = ($1, $2);
        die "can't process both --conf and db '$O{db}', stop" if $O{conf_name};
        $O{conf_name} = $new_conf;
        $O{db} = $new_db;
    }

    die "empty db, stop (try $0 --help)" unless $O{db};
    die "empty conf, stop (try $0 --help)" unless $O{conf_name};

    return \%O;
}

sub looks_like_db
{
    my ($str) = @_;
    return (length($str) > 1 && $str =~ /^[a-zA-Z0-9:]+$/) ? 1 : 0;
}

{
my %norm;

sub _init_norm
{
    return if keys %norm > 0;
    my $aliases = get_db_conf_aliases();
    for my $norm_name (keys %$aliases){
        $norm{$norm_name} = $norm_name;
        for my $name (@{$aliases->{$norm_name} || []}){
            $norm{$name} = $norm_name;
        }
    }
}

sub _normalize_name 
{
    my ($conf_name) = @_;
    _init_norm();

    return $norm{$conf_name} || die "can't normalize conf name '$conf_name', stop";
}

sub _conf_re
{
    _init_norm();
    my $variants = join "|", map {quotemeta($_)} keys %norm;
    return qr/(?:$variants)/;
}

}
