File Coverage

blib/lib/App/JsonLogUtils.pm

Criterion	Covered	Total	%
statement	68	109	62.3
branch	12	28	42.8
condition	2	6	33.3
subroutine	20	25	80.0
pod	3	8	37.5
total	105	176	59.6

package App::JsonLogUtils;
# ABSTRACT: Command line utilities for dealing with JSON-formatted log files
$App::JsonLogUtils::VERSION = '0.03';


use strict;
use warnings;

use Fcntl             qw(:seek);
use Iterator::Simple  qw(iterator iter igrep imap ichain);
use JSON::XS          qw(decode_json encode_json);
use Time::HiRes       qw(sleep);
use Term::SimpleColor;

use parent 'Exporter';

our @EXPORT_OK = qw(
  lines
  tail
  json_log
  json_cols
  json_cut
  json_grep
);


#-------------------------------------------------------------------------------
# Internal utilities
#-------------------------------------------------------------------------------
sub log_warn { warn red,    @_, default, "\n" }
sub log_info { warn yellow, @_, default, "\n" }

sub _open {
  my $path = shift || return;
  return $path if ref $path;

  open(my $fh, '<', $path) || return do{
    log_warn $!;
    return;
  };

  return $fh;
}



sub lines ($) {
  my $path = shift;
  my $fh   = _open($path) || return iter([]);
  imap{ chomp $_; $_ } iter $fh;
}



sub tail ($) {
  my $path = shift;
  my $fh   = _open($path) || return iter([]);
  my $pos  = 0;
  my $stop = 0;

  seek $fh, 0, SEEK_END;
  $pos = tell $fh;

  $SIG{INT} = sub{
    log_info 'Stopped';
    $stop = 1;
  };

  iterator{
    LINE:do{
      # Check for control-c
      if ($stop) {
        undef $SIG{INT};
        return;
      }

      # Check for file truncation
      my $eof = eof $fh;
      my $cur = tell $fh;

      seek $fh, 0, SEEK_END;
      my $end = tell $fh;

      if ($end < $cur) {
        log_info 'File truncated';
        $pos = $end;
      }
      else {
        $pos = $cur;
      }

      seek $fh, $pos, SEEK_SET;
      <$fh> if $eof;

      # Return next line
      if (defined(my $line = <$fh>)) {
        chomp $line;
        return $line;
      }

      # Reset position
      seek $fh, $pos, SEEK_SET;

      # Reset EOF condition on handle and wait for new input
      seek $fh, 0, SEEK_CUR;
      sleep 0.2;

      # Try again
      goto LINE;
    };
  };
}



sub json_log ($) {
  my $lines = shift;

  iterator{
    while (defined(my $line = <$lines>)) {
      if (!$line) {
        log_info 'empty line';
        next;
      }

      my $obj = eval{ decode_json $line };

      if ($@) {
        log_warn "invalid JSON: $line";
        next;
      }

      return [$obj, $line];
    }

    return;
  };
}



sub json_cols ($$$) {
  my ($cols, $sep, $lines) = @_;
  my @cols = ref $cols ? @$cols : split /\s+/, $cols;
  my $head = iter [ join($sep, @cols) ];
  my $rows = imap{
    my $obj = $_->[0];
    return join($sep, map{ $obj->{$_} || '' } @cols);
  } json_log $lines;
  ichain $head, $rows;
}



sub json_cut ($$$) {
  my ($fields, $inverse, $lines) = @_;
  my @fields = ref $fields ? @$fields : split /\s+/, $fields;

  if ($inverse) {
    imap{
      foreach my $field (@fields) {
        delete $_->[0]{$field};
      }

      $_->[0];
    } json_log $lines;
  }
  else {
    imap{
      my %filtered;
      foreach my $field (@fields) {
        $filtered{$field} = $_->[0]{$field};
      }

      \%filtered;
    } json_log $lines;
  }
}



sub json_grep ($$$) {
  my ($patterns, $inverse, $lines) = @_;
  return igrep{
    my $obj = $_->[0];

    foreach my $field (keys %$patterns) {
      foreach my $pattern (@{$patterns->{$field}}) {
        return unless $inverse
          ? $obj->{$field} !~ $pattern
          : $obj->{$field} =~ $pattern;
      }
    }

    return 1;
  }
  json_log $lines;
}



1;

__END__