#
# Copyright 2005 Yuki Fujimura <fujimura@wakhok.ac.jp>
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
#     http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
#
# v1.0.0: First release.
# v1.0.1: Rewrite.
# v1.1.0 2005-11-24: Supports unless v5.8.0 by IO::String or IO::Scalar.
# v1.1.1 2005-11-28: Workaround multibytes =head[1-4].
#
package MT::Plugin::PodTextFilter;

use strict;
use warnings;


use MT;
use MT::Plugin;


our $VERSION = v1.1.1;


eval('use PerlIO::scalar');
my $HAS_PERLIO_SCALAR = 1 unless $@;

eval('use IO::String');
my $HAS_IO_STRING = 1 unless $@;

eval('use IO::Scalar');
my $HAS_IO_SCALAR = 1 unless $@;


MT->add_plugin(
    MT::Plugin->new(
        'name' => 'POD Text Filter',
        'version' => sprintf('%vd', $VERSION),
        'author_name' => 'Yuki Fujimura',
        'author_link' => 'http://www.wakhok.ac.jp/~fujimura/',
        'doc_link' => 'http://www.wakhok.ac.jp/~fujimura/2005/11/22/142632',
    )
);


MT->add_text_filter(
    'pod_text_filter' => {
        'label' => 'POD format',
        'on_format' => \&on_format,
    },
);


sub on_format
{
    my ($text, $context) = @_;

    return '' unless $text;

    eval('use Pod::Xhtml');
    die $@ if $@;

    $text = "=pod\n\n"
          . $text . "\n\n"
          . "=end\n";

    my $in = undef;

    if ($HAS_PERLIO_SCALAR) {
        open($in, '<:scalar', \$text)
            or die($!);
    } elsif ($HAS_IO_STRING) {
        $in = IO::String->new($text);
    } elsif ($HAS_IO_SCALAR) {
        $in = IO::Scalar->new(\$text);
    }

    die('POD Text Filter requires PerlIO::scalar or IO::String or IO::Scalar')
        unless ($in);

    my $parser = Pod::Xhtml->new(
        'StringMode' => 1,
        'FragmentOnly' => 1,
        'MakeIndex' => 0,
    );

    $parser->errorsub(\&on_error);
    $parser->parse_from_filehandle($in);

    # workaround for multibytes only =head[1-4].
    (my $retval = $parser->asString) =~ s/\s*id="(?:-+\d+)?">/>/gm;
    return $retval;
}


sub on_error
{
    (my $message = join('', grep { defined } @_, ':')) =~ s/^\s*\*+/__FILE__/e;

    return $message;
}


1;