wrt/lib/App/WRT/Filters.pm

package App::WRT::Filters;

use strict;
use warnings;
use 5.10.0;

use open ':std', ':encoding(UTF-8)';

use Carp;
use Encode qw(decode encode);
use IPC::Cmd qw(can_run run_forked);

=pod

=head1 NAME

App::WRT::Filters - Apply filters to markup

An experimental feature.

=head1 SYNOPSIS

  # Where $entry is the path to an entry and $markup is its content:
  my $filters = App::WRT::Filters->new($filter_dir);
  my @filter_list = qw(toc);
  $filters->dispatch($entry, $markup, @filter_list);

=cut

sub new {
  my $class = shift;
  my ($filter_dir) = @_;
  my %params = ( filter_dir => $filter_dir );
  my $self = \%params;
  bless $self, $class;
  return $self;
}

sub dispatch {
  my $self = shift;
  my ($entry, $markup, @filters) = @_;

  for my $filter (@filters)
  {
    my $new_markup = '';
    my $stderr = '';

    my $command = $self->resolve_filter($filter);

    local $ENV{'WRT_ENTRY'} = $entry;

    my $result = run_forked($command, {
      # The encode() here seems necessary to avoid "Wide character in print"
      # errors from IPC::Cmd:
      child_stdin    => encode('UTF-8', $markup),
      timeout        => 300,
      stdout_handler => sub { $new_markup .= decode('UTF-8', $_[0]); },
      stderr_handler => sub { $stderr .= decode('UTF-8', $_[0]); }
    });

    if (length $stderr) {
      carp($stderr);
    }

    $markup = $new_markup;
  }

  return $markup;
}

sub resolve_filter {
  my ($self, $filter) = @_;
  return $self->{filter_dir} . '/' . $filter;
}

1;