log-defer-viz

#!/usr/bin/env perl

use common::sense;

use JSON::XS;
use Getopt::Long;
use Term::ANSIColor;
use Term::Size;
use Try::Tiny;

use Log::Defer::Viz;


## List of terminal colours in order of preference (not all terminals support bright_*)

my $colour_spec = {
    error => [qw/ bright_red red /],
    warn => [qw/ bright_yellow yellow /],
    info => [qw/ green /],
    debug => [qw/ bright_blue blue /],
};

my @opt_spec = (
  ## INPUT FORMAT
 
  'input-format=s',

  ## DATE

  'date!',
  'since-now',

  ## FILTERING

  'logs!',

  'verbosity=i',
  'error!',
  'warn!',
  'info!',
  'debug!',

  'quiet|q',
  'verbose|v',

  'colour!', 'color!',

  ## TIMERS

  'timers!',
  'timer-columns=i',

  ## DATA SECTION

  'data!',
  'data-format=s',
  'data-only',

  ## MISC

  'help|h|?',
  'grep|filter|g=s',
  'map|m=s',
);

my $opt = {
    'input-format' => 'json',

    'date' => 1,
    'since-now' => 0,

    'logs' => 1,
    'verbosity' => 30,
    'quiet' => 0,
    'verbose' => 0,

    'timers' => 1,
    'timer-columns' => 100,

    'data-format' => 'json-pretty',
    'data-only' => 0,
};

GetOptions($opt, @opt_spec) || die "GetOptions failed";



if ($opt->{help}) {
  require Pod::Perldoc;
  @ARGV = ('-F', $0);
  Pod::Perldoc->run();
}


die "Only json input-format is currently supported" unless $opt->{'input-format'} eq 'json';

$opt->{colour} = $opt->{color} if exists $opt->{color};
if (!exists $opt->{colour}) {
  $opt->{colour} = 1 if -t STDOUT;
}

if ($opt->{verbose} && $opt->{quiet}) {
  die "--verbose and --quiet are incompatible";
} elsif ($opt->{verbose}) {
  $opt->{verbosity} = 40;
  $opt->{data} = 1 unless (defined $opt->{data} && !$opt->{data});
} elsif ($opt->{quiet}) {
  $opt->{verbosity} = 20;
  $opt->{timers} = 0 unless !$opt->{timers};
}


if ($opt->{'data-only'}) {
  $opt->{date} = $opt->{timers} = $opt->{logs} = 0;
  $opt->{data} = 1;
}


my $columns = $opt->{'timer-columns'};

my ($term_cols, $term_rows) = Term::Size::chars(*STDOUT{IO});
$columns = $term_cols if $term_cols;


## The _ sub is a shortcut for --grep and --map expressions, ie --grep '_->{data}'
sub _ () { $_ }

if ($opt->{grep}) {
  $opt->{grep} = eval('sub { local $_ = $_[0]; ' . $opt->{grep} . '}');
  die "Error compiling --grep expression: $@" if $@;
}

if ($opt->{map}) {
  $opt->{map} = eval('sub { local $_ = $_[0]; ' . $opt->{map} . '}');
  die "Error compiling --map expression: $@" if $@;
}


unshift(@ARGV, '-') unless @ARGV;
while (my $file = shift) {
  my $fh;

  ## FIXME: do this with a perl module in case zcat/bzcat aren't available

  if ($file =~ /[.]gz$/) {
    open($fh, "zcat '$file' |") || die "couldn't open $file with zcat: $!";
  } elsif ($file =~ /[.]bz2$/) {
    open($fh, "bzcat '$file' |") || die "couldn't open $file with bzcat: $!";
  } elsif ($file eq '-') {
    $fh = \*STDIN;
  } else {
    open($fh, '<', $file) || die "couldn't open $file: $!";
  }

  while(<$fh>) {
    my $entry;

    try {
      $entry = decode_json($_);
    } catch {
      if ($opt->{verbose}) {
        print STDERR "Error parsing log line: $_";
      }
    };

    handle_entry($entry) if defined $entry;
  }

  close($fh);
}



sub handle_entry {
  my ($entry) = @_;

  if ($opt->{grep}) {
    my $result;

    eval {
      $result = $opt->{grep}->($entry);
    };

    if ($@) {
      print STDERR "Run-time error in --grep expression, skipping record: $@";
      return;
    }

    return unless $result;
  }

  if ($opt->{map}) {
    my $output;

    eval {
      $output = $opt->{map}->($entry);
    };

    if ($@) {
      print STDERR "Run-time error in --map expression, skipping record: $@";
      return;
    }

    $output = "$output\n" unless $output =~ /\n$/;;
    print $output;

    return;
  }

  my $millis = '';

  if ($entry->{start} =~ /[.](\d+)$/) {
    $millis = ".$1";
  }

  if ($opt->{date}) {
    my $datetime = '';

    if ($opt->{'since-now'}) {
      require Date::Calc;

      my $elapsed = int(time - $entry->{start});

      if ($elapsed <= 0) {
        $datetime = abs($elapsed) . " seconds in the future.. clock is wrong?";
      } else {
        my ($Dd,$Dh,$Dm,$Ds) = Date::Calc::Normalize_DHMS(0, 0, 0, int(time - $entry->{start}));
        $datetime .= "$Dd days " if $Dd;
        $datetime .= "$Dh hours " if $Dh;
        $datetime .= "$Dm minutes " if $Dm;
        $datetime .= "$Ds seconds " if $Ds;

        $datetime .= "ago";
      }
    } else {
      require Date::Format;

      $datetime = Date::Format::time2str("%Y-%m-%d %a %I:%M:%S$millis %Z", $entry->{start});
    }

    my $date_header = "------ " . $datetime . " ------";

    $date_header = colored($date_header, 'black on_white') if $opt->{colour};

    print "$date_header\n";
  }

  if ($opt->{logs}) {
    foreach my $log (@{ $entry->{logs} }) {
      next unless should_show_message($log->[1]);

      my @log_message = @$log[2..(@$log-1)];

      my $log_string = ' [' . sprintf("%5s", num_to_level($log->[1])) . ']';

      if (!ref $log_message[0] && $log_message[0] !~ /\n/) {
          $log_string .= " $log_message[0]";
          shift @log_message;
      }

      $log_string .= ' ' . encode_json(\@log_message) if @log_message;

      if ($opt->{colour}) {
          my $colour = num_to_colour($log->[1]);
          $log_string = colored($log_string, $colour) if defined $colour;
      }

      print '  | ' . format_time_offset($log->[0]) . $log_string . "\n";
    }

    print "  |_" . format_time_offset($entry->{end}) . " [END]\n\n";
  }
  
  if ($opt->{timers}) {
    print Log::Defer::Viz::render_timers(width => $columns-10, timers => $entry->{timers}) if $entry->{timers};
  }

  if ($entry->{data}) {
    if ($opt->{data}) {
      print "  Data:\n" unless $opt->{'data-only'};
      print output_data($entry->{data});
    } else {
      print "  ** This log has associated data. See it with --data\n"
        unless $opt->{quiet} || (defined $opt->{data} && !$opt->{data});
    }
  }

  print "\n";
}



sub num_to_level {
  my $level = shift;

  return "ERROR" if $level == 10;
  return "WARN" if $level == 20;
  return "INFO" if $level == 30;
  return "DEBUG" if $level == 40;

  return $level;
}

my $terminal_colour_name_cache = {};

sub get_colour_name {
  my $name = shift;

  return $terminal_colour_name_cache->{$name} if exists $terminal_colour_name_cache->{$name};

  foreach my $colour_under_test (@{ $colour_spec->{$name} }) {
    eval {
      colored('junk', $colour_under_test);
    };

    return ($terminal_colour_name_cache->{$name} = $colour_under_test)
      if !$@;
  }

  return ($terminal_colour_name_cache->{$name} = undef);
}

sub num_to_colour {
  my $level = shift;

  return get_colour_name("error") if $level <= 10;
  return get_colour_name("warn") if $level <= 20;
  return get_colour_name("info") if $level <= 30;
  return get_colour_name("debug") if $level <= 40;

  return;
}

sub format_time_offset {
  my $offset = shift;

  return sprintf("%.6f", $offset);
}

sub should_show_message {
  my $level = shift;

  return $opt->{error} if $level == 10 && defined $opt->{error};
  return $opt->{warn} if $level == 20 && defined $opt->{warn};
  return $opt->{info} if $level == 30 && defined $opt->{info};
  return $opt->{debug} if $level == 40 && defined $opt->{debug};

  return 1 if $level <= $opt->{verbosity};

  return 0;
}


my $pretty_json_context;

sub output_data {
  my $data = shift;

  if ($opt->{'data-format'} eq 'json-pretty') {
    $pretty_json_context ||= JSON::XS->new->ascii->pretty->allow_nonref;
    return $pretty_json_context->encode($data);
  } elsif ($opt->{'data-format'} eq 'json') {
    return encode_json($data);
  } elsif ($opt->{'data-format'} eq 'yaml') {
    require YAML;
    return YAML::Dump($data);
  } elsif ($opt->{'data-format'} eq 'dumper') {
    require Data::Dumper;
    return Data::Dumper::Dumper($data);
  }

  die "Unknown data format: $opt->{'data-format'}";
}



__END__

=pod

=head1 NAME

log-defer-viz - command-line utility for rendering log messages created by L<Log::Defer>

=head1 DESCRIPTION

L<Log::Defer> is a module that creates structured logs. Read its documentation which explains how structured logging can help you.

This module installs a command-line script that parses these logs and displays them in a readable manner.

=head1 INPUT METHODS

    $ cat file.log | log-defer-viz
    $ log-defer-viz < file.log
    $ log-defer-viz file.log
    $ log-defer-viz file.log file2.log
    $ log-defer-viz archived.log.gz more_logs.bz2

=head1 INPUT FORMAT

    $ log-defer-viz --input-format=json  ## default is newline separated JSON
    $ log-defer-viz --input-format=sereal  ## Sereal::Decoder (not impl)
    $ log-defer-viz --input-format=messagepack  ## Data::MessagePack (not impl)
    $ log-defer-viz --input-format=storable  ## Storable (not impl)

Note: The only input format currently implemented is newline-separated JSON.

=head1 LOG MESSAGES

    $ log-defer-viz  ## by default shows error, warn, and info logs
    $ log-defer-viz -v  ## verbose mode (adds debug logs and more)
    $ log-defer-viz --debug  ## show debug logs
    $ log-defer-viz --quiet  ## only errors and warnings
    $ log-defer-viz --verbosity 25  ## numeric verbosity threshold
    $ log-defer-viz --nowarn  ## muffle warn logs (so show error and info)
    $ log-defer-viz --nologs  ## don't show log section
    $ log-defer-viz --nocolour  ## turn off terminal colours

=head1 TIMERS

    $ log-defer-viz --timer-columns 80  ## width of timer chart
    $ log-defer-viz --since-now  ## show relative to now times
                                 ##   like "34 minutes ago"
    $ log-defer-viz --notimers  ## don't show timer chart

=head1 DATA SECTION

Data is extra embedded information in the log file. The available outputs are C<pretty-json>, C<json>, C<yaml>, and C<dumper>.

    $ log-defer-viz --data  ## show data section. default is pretty-json
    $ log-defer-viz --data-format=json  ## compact, not pretty
    $ log-defer-viz --data-format=dumper  ## Data::Dumper
    $ log-defer-viz --data-only  ## only show data

=head1 MISC

    $ log-defer-viz --help  ## the text you're reading now
    $ log-defer-viz --grep '$_->{data}'  ## grep for records that have a data section.
                                         ## $_ is the entire Log::Defer entry.
    $ log-defer-viz --map '$_->{data}->{username}'  ## Extract username from data


=head1 GREPING

As shown above, there is a C<--grep> command-line option. This lets you filter log messages using arbitrary perl code. If the expression returns true, the log message is processed and displayed as normal.

Being able to do this easily is an important advantage of structured logs. With unstructured logs it is often difficult to extract all of the information related to a request and nothing else.

For example, here is how to grep for all requests that took longer than 500 milliseconds:

    $ log-defer-viz --grep '$_->{end} > .5' server.log

Depending on your underlying storage format, it may be meaningful to grep B<before> passing to C<log-defer-viz>. Currently the only supported storage format is newline-separated JSON which I<is> designed to be pre-grepable. If your search string appears anywhere in the object, the entire log message will be displayed:

    $ grep 10.9.1.2 app.log | log-defer-viz

The final and most error-prone way to grep Log::Defer logs is to grep the unstructured output of C<log-defer-viz>:

    $ log-defer-viz app.log | grep 10.9.1.2



=head1 MAPPING

Similar to C<--grep>, there is also a C<--map> command-line option. If this option is passed in, the only thing that is output is whatever your C<--map> expression returns.

For example, if you are putting the PID into the data section with C< <$log->data->{pid} = $$ >>, then you can extract the PID like so:

    $ log-defer-viz --map '$_->{data}->{pid}' app.log
    9765
    9768
    9771

Since you have access to any perl functions you need, including L<JSON::XS>. Also, you can combine C<--map> and C<--grep>. For example, here is how to do a "pass-through" grep where the output is another valid JSON-encoded L<Log::Defer> file:

    $ log-defer-viz -g '_->{data}->{username} eq "jimmy"' \
                    -m 'encode_json _'                    \
                    app.log                               \
                    > jimmys-requests.log

Note that the above also takes advantage of the C<-g> and C<-m> option shortcuts for C<--map> and C<--grep> respectively. It also uses the special C<_> shortcut which is an abbreviation for C<$_>.



=head1 SEE ALSO

L<Log::Defer>

L<Log::Defer::Viz github repo|https://github.com/hoytech/Log-Defer-Viz>

=head1 AUTHOR

Doug Hoyte, C<< <doug@hcsw.org> >>

=head1 COPYRIGHT & LICENSE

Copyright 2013 Doug Hoyte.

This module is licensed under the same terms as perl itself.

=cut