#!/usr/bin/perl


=head1 DESCRIPTION

=encoding utf8

Скрипт для неинтерактивных обращений к zookeeper из командной строки

Общая справка: 

    direct-zkcli help

Справка по отдельной команде:

    direct-zkcli help ls

Команды: 
 
    cat get
    ls
    rm delete
    tee set
    touch create
    vim
    getAcl
    setAcl

Глобальные опции: 
 
    -H, --host <hostname>  хост с zookeeper'ом
    -p, --port <port>      порт zookeeper'а

=head1 EXAMPLES

    direct-zkcli -H directmod3.haze.yandex.net ls / -R
    direct-zkcli ls /playground
    direct-zkcli touch /playground/n1
    # в zookeeper храним только текстовые данные, поэтому на входе direct-zkcli tee должен быть валидный UTF-8
    echo "some data" | direct-zkcli tee /playground/n1
    direct-zkcli cat /playground/n1
    direct-zkcli rm /playground/n1

    direct-zkcli getAcl /some-node 
    direct-zkcli setAcl /some-node world:anyone:r ip:127.0.0.1:rwdca

    direct-zkcli help setAcl


=head1 subcommands

=encoding utf8

=cut

use warnings;
use strict;

use Getopt::Long;
use File::Temp;
use Net::ZooKeeper qw(:node_flags :acls :acl_perms);

use utf8;
use open ':std' => ':utf8';
use Encode qw(decode_utf8 encode_utf8);

our $VERBOSE;
our $HOST;
our $PORT;
our $zkh;

our %cmds = (
    help => {
        code => \&cmd_help,
    },
    cat => {
        code => \&cmd_cat,
        aliases => [ qw/get/ ],
    },
    ls => {
        code => \&cmd_ls,
    },
    rm => {
        code => \&cmd_rm,
        aliases => [ qw/delete/ ],
    },
    tee => {
        code => \&cmd_tee,
        aliases => [ qw/set/ ],
    },
    touch => {
        code => \&cmd_touch,
        aliases => [ qw/create/ ],
    },
    getAcl => {
        code => \&cmd_getAcl,
        aliases => [ qw// ],
    },
    setAcl => {
        code => \&cmd_setAcl,
        aliases => [ qw// ],
    },
    vim => {
        code => \&cmd_vim,
        aliases => [ qw// ],
    },
    stat => {
        code => \&cmd_stat,
    }
);

our %norm_cmd_for;

my %perm_flag = (
    r => ZOO_PERM_READ, 
    w => ZOO_PERM_WRITE, 
    c => ZOO_PERM_CREATE, 
    d => ZOO_PERM_DELETE, 
    a => ZOO_PERM_ADMIN,
);

run() unless caller();

sub run
{
    my $opt = parse_options();

    my $norm_cmd = normalize_cmd($opt->{cmd});
    die "usupported cmd '$norm_cmd', stop\n" unless exists $cmds{$norm_cmd};
    connect_zookeeper();
    $cmds{$norm_cmd}->{code}->($opt);

    exit 0;
}


sub parse_options
{
    my %O;

    utf8::decode($_) for @ARGV;
    Getopt::Long::Configure("no_ignore_case");
    GetOptions(
        'h|help' => sub {
            system("podselect -section NAME -section DESCRIPTION -section OPTIONS -section EXAMPLES $0 | pod2text");
            exit 0;
        },
        'H|host=s' => \$O{host},
        'p|port=s' => \$O{port},
        'R|recursive' => \$O{recursive},
#        'n|node=s' => \$O{node_name},
    ) or die "can't parse options, stop\n";

    die "command missing, stop\nsee direct-zkcli -h for help\n" unless @ARGV > 0;
    $O{cmd} = shift @ARGV;

    $O{argv} = [ @ARGV ];

    $HOST = delete $O{host} || '127.0.0.1';
    $PORT = delete $O{port} || 2181;

    $VERBOSE = delete $O{verbose};

    return \%O;
}


sub normalize_cmd
{
    my ($alias) = @_;

    return $alias if exists $cmds{$alias};

    if ( ! %norm_cmd_for) {
        for my $cmd (keys %cmds){
            next unless exists $cmds{$cmd}->{aliases};
            for my $alias ( @{$cmds{$cmd}->{aliases}} ){
                $norm_cmd_for{$alias} = $cmd;
            }
        }
    }

    return $norm_cmd_for{$alias} || die "can't get cmd for alias $alias\n";
}

=head2 connect_zookeeper

=cut
sub connect_zookeeper
{
    my $zk_host = "$HOST:$PORT";
    for (1..5) {
        $zkh = Net::ZooKeeper->new($zk_host) or die "Error creating zkh object (host $zk_host): $!";
        last if $zkh->exists("/");
    }
    $zkh->{data_read_len} = 10_000_000;
}


=head2 help

    справка по командам

=cut
sub cmd_help
{
    my ($opt) = @_;

    for my $topic (@{$opt->{argv}}){
        my $norm_topic = normalize_cmd($topic);
        system("podselect -section subcommands/!.+ -section '/$norm_topic' $0 | pod2text") == 0 or print "no help for '$topic'";
    }

    if ( @{$opt->{argv}} == 0 ){
        system("podselect -section NAME -section DESCRIPTION -section OPTIONS -section EXAMPLES $0 | pod2text");
    }
}


=head2 ls

    список нод

    -R -- рекурсивный листинг

    direct-zkcli ls /palyground
    direct-zkcli ls / -R

=cut
sub cmd_ls
{
    my ($opt) = @_;

    my @nodes = @{$opt->{argv}};
    @nodes = ("/") unless @nodes;

    my $depth = $opt->{recursive} ? 10_000 : 1;

    my @subnodes; 
    for my $node ( @nodes ){
        get_children_recursive($node, $depth, \@subnodes);
    }
    print join "", map { "$_\n" } @subnodes;
    return;
}


sub get_children_recursive
{
    my ($node, $depth, $res) = @_;
    return if $depth <= 0;
    $depth--;
    for my $subnode ($zkh->get_children($node)) {
        my $path = $node eq "/" ? "/$subnode" : "$node/$subnode";
        push @$res, $path;
        next if $depth <= 0;
        get_children_recursive( $path, $depth, $res );
    }
    die "can't get subnodes of $node: ".$zkh->str_error()."\n" if $zkh->get_error();
    return;
}


=head2 get | cat

    читает указанные ключи и пишет контент на stdout

=cut
sub cmd_cat
{
    my ($opt) = @_;

    for my $node ( @{ $opt->{argv} } ){
        my $data = decode_utf8($zkh->get($node));
        die "can't get content of $node: ".$zkh->str_error()."\n" if $zkh->get_error();
        print $data
    }

    return;
}


=head2 tee

    читает stdin и пишет в указанную ноду

    echo "some text" | direct-zkcli tee /playground 

=cut
sub cmd_tee
{
    my ($opt) = @_;
    
    my $param_count = @{$opt->{argv}};
    die "tee expects exactly 1 parameter, but $param_count given\n" unless $param_count == 1;
    my $node = $opt->{argv}->[0];

    my $data = join "", <STDIN>;

    mkpath($node);
    $zkh->set($node, encode_utf8($data)) or die "set failed:".$zkh->str_error()."\n";

    return;
}


=head2 touch

    Cоздает указанные ноды, в том числе и рекурсивно
    Если ноды не было -- записывает пустую строку, если была -- не трогает

    direct-zkcli touch /playground/my_subnode/my_node

=cut
sub cmd_touch
{
    my ($opt) = @_;
    
    for my $node ( @{$opt->{argv}} ){
        mkpath($node);
    }

    return;
}

=head2 rm 

=cut
sub cmd_rm
{
    my ($opt) = @_;
    for my $node ( @{$opt->{argv}} ){
        $zkh->delete($node);
        die "can't remove $node: ".$zkh->str_error()."\n" if $zkh->get_error();
    }
}


=head2 mkpath

Получает полный путь к ноде, создает ее и все недостающие промежуточные 
(как mkdir -p)

В создаваемые ноды пишет пустую строку, существующие не трогает.

=cut
sub mkpath
{
    my ($path) = @_;

    die "Path must start with / character" unless $path =~ m!^/!;

    my @path_items = split "/", $path;
    shift @path_items;

    my $subpath = "";

    for my $dir ( @path_items ){
        $subpath .= "/$dir";
        my $create_error;
        unless ($zkh->exists($subpath)){
            $zkh->create($subpath, '', 'acl' => ZOO_OPEN_ACL_UNSAFE);
            $create_error = $zkh->get_error();
        }
        unless ($zkh->exists($subpath)){
            die "unable to create node $subpath: ".$zkh->str_error()."\n";
        }
    }

    return;
}

=head2 getAcl 

Показывает acl-и на указанную ноду/ноды. В каждой строке: права, схема, id, нода.

Права: (r)ead, (w)rite, (c)reate, (d)elete, (a)dmin

    > direct-zkcli -H ppcback01f.yandex.ru getAcl /direct/db-config.json /direct 
    rwcda ip 127.0.0.1 /direct/db-config.json
    r---- world anyone /direct/db-config.json
    rwcda ip 127.0.0.1 /direct
    r---- world anyone /direct

=cut
sub cmd_getAcl
{
    my ($opt) = @_;

    for my $node ( @{ $opt->{argv} } ){
         for my $acl_entry ($zkh->get_acl($node)) {
           for my $p ( qw/r w c d a/ ){
               print $acl_entry->{perms} & $perm_flag{$p} ? $p : '-';
           }
           print " ";
           print "$acl_entry->{scheme} $acl_entry->{id} $node\n";
         }
    }

    return;
}

=head2 setAcl 

Устанавливает acl-и на указанную ноду. 
Указывать полный список прав (права заменяются, не добавляются).

direct-zkcli setAcl /some-node world:anyone:r ip:127.0.0.1:rwdca

ОСТОРОЖНО! Можно нечаянно отнять у себя все права. 

Права: (r)ead, (w)rite, (c)reate, (d)elete, (a)dmin

=cut
sub cmd_setAcl
{
    my ($opt) = @_;

    my $node = shift @{ $opt->{argv} };
    my @acls = ();

    my $someone_has_admin_permissions = 0;
    for my $acl_str ( @{ $opt->{argv} } ){
        $acl_str =~ /^(.+?):(.+):(.+?)$/ or die "can't parse acl '$acl_str', stop\n";
        my ($scheme, $id, $perms_str) = ($1, $2, $3);
        my $perms = 0;
        for my $p (split //, $perms_str){
            die "unknown permission '$p' in acl '$acl_str', stop\n" if !exists $perm_flag{$p};
            $someone_has_admin_permissions ||= ($p eq 'a');
            $perms |= $perm_flag{$p};
        }
        my $acl = {
            'perms' => $perms,
            'scheme' => $scheme,
            'id' => $id,
        };
        push @acls, $acl;
    }
    die "DANGEROUS: no admin permission set, stop\n" unless $someone_has_admin_permissions;
    my $success = $zkh->set_acl($node, \@acls);
    unless ($success){
        die "unable to set acl: ".$zkh->str_error()."\n";
    }

    return;
}


=head2 vim

    Очень простое интерактивное редактирование содержимого ноды. 

    Дифф НЕ показывает.

    Отменить редактирование можно командой :cq -- vim завершится не-нулем, и ничего не сохранится.
    
    ОСТОРОЖНО! С не-utf8 консолью и/или не-ascii контентом в ноде будет делать неизвестно что.

=cut
sub cmd_vim
{
    my ($opt) = @_;

    my $node = $opt->{argv}->[0];

    my $cont = decode_utf8($zkh->get($node));
    die "can't get content of $node: ".$zkh->str_error()."\n" if $zkh->get_error();

    my (undef, $old_file) = File::Temp::tempfile(UNLINK => 1);
    my (undef, $file) = File::Temp::tempfile(UNLINK => 1);

    for my $cur_file ($file, $old_file) {
        open(my $fh, ">:encoding(UTF-8)", $cur_file) or die "cannot open $cur_file: $!";
        print $fh $cont;
        undef $fh;
    }

    while (1) {
        my $res = system("vim", $file);
        die "not saving new content because of non-zero exit code\n" if $res !=0;

        print `diff -u $old_file $file`;
        print "\nCheck diff and choose action:\n(y) - save changes, (e) - continue editing, any other key - exit without saving changes\n> ";
        chomp(my $ans = <STDIN>);

        if ($ans eq "y") {
            last;
        } elsif ($ans eq "e") {
            print "\n##################################################\n\n";
            next;
        }
        return;
    }

    open(my $fh2, "<:encoding(UTF-8)", $file) or die "cannot open $file: $!";
    my $new_cont = join "", <$fh2>;
    undef $fh2;

    return if $new_cont eq $cont;

    $zkh->set($node, encode_utf8($new_cont)) or die "set failed:".$zkh->str_error()."\n";

    return;
}

=head2 stat

    выполняет командy stat на заданные ноды

=cut
sub cmd_stat
{
    my ($opt) = @_;

    for my $node ( @{ $opt->{argv} } ){
        my $stat = $zkh->stat();
        if ($zkh->exists($node, 'stat' => $stat)) {
            print "$node:\n";
            while (my($key,$value) = each(%{$stat})) {
                print "  $key: $value\n";
            }
        }
    }

    return;
}

