File Coverage

blib/lib/App/Tailor.pm

Criterion	Covered	Total	%
statement	61	73	83.5
branch	15	24	62.5
condition	2	14	14.2
subroutine	15	17	88.2
pod	6	8	75.0
total	99	136	72.7

package App::Tailor;
# ABSTRACT: easily tailor terminal output to meet your needs
$App::Tailor::VERSION = '0.01';


use strict;
use warnings;

use Term::ANSIColor qw(color RESET);

use parent 'Exporter';

our @EXPORT = qw(
  ignore
  modify
  colorize
  tail
  itail
  reset_rules
);

use constant IGNORE   => 1;
use constant MODIFY   => 2;
use constant COLORIZE => 3;

our @RULES;
our $RESET = RESET;
our $DEBUG;

sub debug (&) {
  if ($DEBUG || $ENV{APP_TAILOR_DEBUG}) {
    my $msg = $_[0]->() || return;
    warn __PACKAGE__.": $msg\n";
  }
}

sub reset_rules () {
  undef @RULES;
}

sub itail (;$) {
  my $fh = shift || *STDIN;
  my $closed;

  return sub{
    return if $closed;

    LINE: until ($closed) {
      my $line = <$fh>;

      unless (defined $line) {
        $closed = 1;
        return;
      }

      chomp $line;

      debug{ "Input=[[$line]]" };

      for (@RULES) {
        $line = apply_rule($line, $_);

        unless (defined $line) {
          next LINE;
        }
      }

      return $line."\n";
    }

    debug{ 'end of input' };
  };
}

sub tail (;$$) {
  my $in   = shift || *STDIN;
  my $out  = shift || *STDOUT;
  my $iter = itail $in;
  while ( defined( my $line = $iter->() ) ) {
    print $out $line;
  }
}

sub apply_rule {
  my ($line, $rule) = @_;
  my ($type, @rule) = @$rule;

  debug{
    my $label = $type == IGNORE   ? 'ignore'
              : $type == MODIFY   ? 'modify'
              : $type == COLORIZE ? 'colorize'
                                  : $type;

    "applying rule <$label>: [@rule]";
  };

  if ($type == IGNORE) {
    my ($regex) = @rule;
    return if $line =~ /$regex/;
  }
  elsif ($type == MODIFY) {
    my ($regex, $replace) = @rule;

    if (ref $replace eq 'CODE') {
      $line =~ s/$regex/
        local $_ = $line;
        $replace->($line);
      /xe;
    }
    else {
      $line =~ s/$regex/$replace/;
    }
  }
  elsif ($type == COLORIZE) {
    my ($regex, $color) = @rule;
    $line =~ s/($regex)/$color$1$RESET/;
  }

  return $line;
}

sub ignore ($) {
  my ($regex) = @_;
  push @RULES, [IGNORE, $regex];
}

sub modify ($$) {
  my ($regex, $replacement) = @_;
  push @RULES, [MODIFY, $regex, $replacement];
}

sub colorize ($@) {
  my ($regex, @colors) = @_;
  my $color = color @colors;
  push @RULES, [COLORIZE, $regex, $color];
}

1;

__END__