File Coverage

blib/lib/Text/AutoLink.pm

Criterion	Covered	Total	%
statement	63	71	88.7
branch	18	22	81.8
condition	2	2	100.0
subroutine	11	13	84.6
pod	5	5	100.0
total	99	113	87.6

package Text::AutoLink;
use strict;
use warnings;
use 5.006;
use vars qw($VERSION);
use HTML::TreeBuilder;
use Module::Pluggable
    require => 0,
    search_path => 'Text::AutoLink::Plugin',
    sub_name => 'available_plugins',
;

BEGIN {
    $VERSION = '0.04000'
}

sub new
{
    my $class = shift;
    my %args  = @_;
    my $self  = bless {
        plugins => [],
    }, $class;

    $args{plugins} ||= [$class->available_plugins];
    foreach my $p (@{$args{plugins}}) {
        if (! ref $p) {
            eval "require $p";
            die if $@;
            $p = $p->new;
        }

        push @{$self->{plugins}}, $p;
    }

    return $self;
}

sub plugins
{
    my $self = shift;
    wantarray ? @{$self->{plugins}} : $self->{plugins};
}

sub _parse
{
    my $self = shift;
    my $x = shift;

    if ($x->attr('_tag') eq 'a') {
        return;
    }

    my @list = $x->content_list;
    for(my $i = 0; $i < @list; $i++) {
        my $c = $list[$i];
        if (ref $c) {
            $self->_parse($c);
        } else {
            foreach my $p ($self->plugins) {
                next unless $c;
                next unless $p->process(\$c);
                my $subtree = HTML::TreeBuilder->new_from_content($c);
                $self->_parse($subtree);
                $x->splice_content($i, 1, $subtree);
            }
        }
    }
}

sub parse_file
{
    my $self = shift;
    my $file = shift;
    open my $fh, "<", $file or die "Failed to open file $file: $!";
    $self->parse_fh($fh);
}

sub parse_fh
{
    my $self = shift;
    my $fh   = shift;
    my $text = join '', <$fh>;
    return $self->parse_string($text);
}

sub parse_string
{
    my $self = shift;
    my $string = shift;

    my $ret;
    my $tree = HTML::TreeBuilder->new_from_content($string);
    $self->_parse($tree);
    foreach my $i ($tree->look_down(_implicit => 1)) {
        $i->replace_with_content if $i->parent;
    }
    if ($tree->implicit) {
        $ret = join('',
            map { ref $_ ? $_->as_HTML : $_ } $tree->content_list );
    } else {
        $ret = $tree->as_HTML;
    }
    $tree->delete;
    return $ret;
}

1;

__END__