#!/usr/bin/perl -w

=head1 NAME

    format-direct-log - скрипт для удобного форматирования direct-style логов

=head1 SYNOPSIS

    format-direct-log logfile1 logfile2

    grep cid=123 logfile | format-direct-log

    grep cid=123 logfile | format-direct-log --format=perl

    grep cid=123 logfile | format-direct-log --colored | less -R -F

=head1 DESCRIPTION

    В каждой строке лога пытаемся найти однострочные сериализованные в json структуры.
    Найденные структуры форматируем новым форматером на месте и выводим в стандартный вывод.
    Если в строке встречается что-то, похожее на дату - подсвечиваем её.

    Дополнительные опции:

      --help - справка

      --colored / --no-colored - нужно ли раскрашевать вывод, по умолчанию не нужно

      --date-color=red - цвет, для подсветки дат

      --format=data-printer
        выбор форматера, встроенные форматы такие:
          - data-printer - из модуля Data::Printer, поддерживает раскраску вывода
          - perl - формат Data::Dumper
          - json - отформатированный json
          - yaml - YAML

    Переменные окружения:

      FORMAT_DIRECT_LOG_FORMAT - умолчательное значение для опции --format

      FORMAT_DIRECT_LOG_COLORED - умолчательное значение для опции --colored, нужно ли подсвечивать вывод

      FORMAT_DIRECT_LOG_DATE_COLOR - умолчательный цвет для дат

=cut

use strict;
use warnings;

use JSON;
use Term::ANSIColor;
use Getopt::Long;

my $COLORED = defined $ENV{FORMAT_DIRECT_LOG_COLORED} ? $ENV{FORMAT_DIRECT_LOG_COLORED} : 0;
my $DATE_COLOR = defined $ENV{FORMAT_DIRECT_LOG_DATE_COLOR} ? $ENV{FORMAT_DIRECT_LOG_DATE_COLORE} : 'red';
my $DEFAULT = eval {require Data::Printer; } ? 'data-printer' : 'json';
my $FORMAT = defined $ENV{FORMAT_DIRECT_LOG_FORMAT} ? $ENV{FORMAT_DIRECT_LOG_FORMAT} : $DEFAULT;

$|++;
my %FORMATING_SUB = (
    'data-printer' => sub {
        require Data::Printer;
        return sub {
            Data::Printer::np(@_, colored => $COLORED);
        };
    },
    'perl' => sub {
        require Data::Dumper;
        return sub {
            no warnings 'once';
            local $Data::Dumper::Indent = 1;
            local $Data::Dumper::Terse = 1;
            local $Data::Dumper::Sortkeys = 1;
            local $Data::Dumper::Quotekeys = 0;
            my $ret = Data::Dumper::Dumper(@_);
            $ret =~ s/\\x\{([\da-f]{2,3})\}/chr hex $1/ige;
            return $ret;
        };
    },
    'json' => sub {
        require JSON;
        my $json = JSON->new->pretty(1)->canonical(1);
        return sub {
            (my $ret = $json->encode(@_)) =~ s/\n$//;
            return $ret;
        };
    },
    'yaml' => sub {
        require YAML;
        return sub {
            (my $ret = YAML::Dump(@_)) =~ s/\n$//;
            return $ret;
        };
    },
    );

GetOptions(
    'help' => \&usage_full,
    'format=s' => \$FORMAT,
    'colored!' => \$COLORED,
    'date-color=s' => \$DATE_COLOR,
    ) || die $!;

if ($COLORED && $DATE_COLOR && !Term::ANSIColor::colorvalid($DATE_COLOR)) {
    die "Invalid date color: '$DATE_COLOR'";
}

die "Unknown format: '$FORMAT'" if !$FORMATING_SUB{$FORMAT};
my $fsub = $FORMATING_SUB{$FORMAT}->();

my $json_parser = JSON->new->relaxed(1);

while(<>) {
    chomp;
    print format_str($_), "\n";
}

sub format_str {
    my $str = shift;
    if ($str =~ /(.*?)(([\{\[]).*)/) {
        my ($prefix, $possible_json, $first_char) = ($1, $2, $3);

        if ($COLORED && $DATE_COLOR) {
            $prefix =~ s/(\d{4}-\d{2}-\d{2}(?:\s+\d{2}:\d{2}:\d{2})?)/colored([$DATE_COLOR], $1)/ge;
        }

        my ($res, $charnum);
        if (eval {($res, $charnum) = $json_parser->decode_prefix($possible_json); 1;}) {
            my $pretty = $fsub->($res);
            return $prefix.$pretty.format_str(substr($possible_json, $charnum));
        } else {
            return $prefix.$first_char.format_str(substr($possible_json, 1));
        }
    }
    return $str;
}

sub usage_full {
    system("pod2text-utf8 <$0 | less -F");
    exit(0);
}
