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;
|