File Coverage

lib/MKDoc/XML/Decode.pm

Criterion	Covered	Total	%
statement	53	55	96.3
branch	7	12	58.3
condition			n/a
subroutine	14	14	100.0
pod	1	3	33.3
total	75	84	89.2

# -------------------------------------------------------------------------------------
# MKDoc::XML::Decode
# -------------------------------------------------------------------------------------
# Author : Jean-Michel Hiver
# Copyright : (c) MKDoc Holdings Ltd, 2003
#
# This modules expands XML entities & > < " and '.
#
# This module is distributed under the same license as Perl itself.
# -------------------------------------------------------------------------------------
package MKDoc::XML::Decode;
use warnings;
use strict;


our %Modules = ();

our $WARN    = 0;


# import all plugins once
foreach my $include_dir (@INC)
{
    my $dir = "$include_dir/MKDoc/XML/Decode";
    if (-e $dir and -d $dir)
    {
        opendir DD, $dir or do {
            warn "Cannot open directory $dir. Reason: $!";
            next;
        };

        my @modules = map { s/\.pm$//; $_ }
                      grep /\.pm$/,
                      grep !/^\./,
                      readdir (DD);

        closedir DD;

        foreach my $module (@modules)
        {
	    $module =~ /^(\w+)$/;
	    $module = $1;
	    eval "use MKDoc::XML::Decode::$module";
            $@ and warn "Cannot import module $module. Reason: $@";

	    my $name = "MKDoc::XML::Decode::$module"->can ('module_name') ?
	               "MKDoc::XML::Decode::$module"->module_name() :
		       lc ($module);

	    $Modules{$name} = "MKDoc::XML::Decode::$module";
        }
    }
}


sub new
{
    my $class = shift;
    @_ = sort keys %Modules unless (scalar @_);

    my $self  = bless [ map {
	$Modules{$_} ? $Modules{$_} : do {
	    warn "Module $_ not found - Ignoring";
	    ();
	} } @_ ], $class;

    return $self;
}


sub entity_to_char
{
    my $self = shift;
    my $char = shift;
    for (@{$self}) {
	my $res = $_->process ($char);
	return $res if (defined $res);
    };

    warn "Could not expand &$char;" if ($WARN);
    return "&$char;";
}


sub process
{
    (@_ == 2) or warn "MKDoc::XML::Encode::process() should be called with two arguments";

    my $self = shift;
    my $data = join '', map { defined $_ ? $_ : () } @_;
    $data    =~ s/&(#?[0-9A-Za-z]+);/$self->entity_to_char ($1)/eg;
    return $data;
}


1;


__END__