File Coverage

blib/lib/Text/Markup.pm

Criterion	Covered	Total	%
statement	46	47	97.8
branch	15	20	75.0
condition	6	12	50.0
subroutine	15	15	100.0
pod	8	8	100.0
total	90	102	88.2

package Text::Markup;

use 5.8.1;
use strict;
use warnings;
use Text::Markup::None;
use Carp;

our $VERSION = '0.30';

my %_PARSER_FOR;
my %REGEX_FOR = (
    html          => qr{x?html?},
    markdown      => qr{m(?:d(?:own)?|kdn?|arkdown)},
    multimarkdown => qr{mm(?:d(?:own)?|kdn?|arkdown)},
    pod           => qr{p(?:od|m|l)},
    textile       => qr{textile},
    trac          => qr{tra?c},
    mediawiki     => qr{(?:m(?:edia)?)?wiki},
    rest          => qr{re?st},
    asciidoc      => qr{a(?:sc(?:iidoc)?|doc)?},
    bbcode        => qr{bb(?:code)?},
    creole        => qr{creole},
);

sub register {
    my ($class, $name, $regex) = @_;
    my $pkg = caller;
    $REGEX_FOR{$name}   = $regex;
    $_PARSER_FOR{$name} = $pkg->can('parser')
        or croak "No parser() function defind in $pkg";
}

sub _parser_for {
    my ($self, $format) = @_;
    return Text::Markup::None->can('parser') unless $format;
    return $_PARSER_FOR{$format} if $_PARSER_FOR{$format};
    my $pkg = __PACKAGE__ . '::' . ($format eq 'html' ? 'HTML' : ucfirst $format);
    eval "require $pkg; 1" or die $@;
    return $_PARSER_FOR{$format} = $pkg->can('parser')
        || croak "No parser() function defind in $pkg";
}

sub formats {
    sort keys %REGEX_FOR;
}

sub format_matchers { %REGEX_FOR }

sub new {
    my $class = shift;
    bless { default_encoding => 'UTF-8', @_ } => $class;
}

sub parse {
    my $self = shift;
    my %p = @_;
    my $file = $p{file} or croak "No file parameter passed to parse()";
    croak "$file does not exist" unless -e $file && !-d _;

    my $parser = $self->_get_parser(\%p);
    return $parser->(
        $file,
        $p{encoding} || $self->default_encoding,
        $p{options}
    );
}

sub default_format {
    my $self = shift;
    return $self->{default_format} unless @_;
    $self->{default_format} = shift;
}

sub default_encoding {
    my $self = shift;
    return $self->{default_encoding} unless @_;
    $self->{default_encoding} = shift;
}

sub _get_parser {
    my ($self, $p) = @_;
    my $format = $p->{format}
        || $self->guess_format($p->{file})
        || $self->default_format;

    return $self->_parser_for($format);
}

sub guess_format {
    my ($self, $file) = @_;
    for my $format (keys %REGEX_FOR) {
        return $format if $file =~ qr{[.]$REGEX_FOR{$format}$};
    }
    return;
}

1;
__END__