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;