File Coverage

lib/MKDoc/XML/Stripper.pm

Criterion	Covered	Total	%
statement	79	92	85.8
branch	24	26	92.3
condition	14	17	82.3
subroutine	11	13	84.6
pod	6	7	85.7
total	134	155	86.4

# -------------------------------------------------------------------------------------
# MKDoc::XML::Stripper
# -------------------------------------------------------------------------------------
# Author : Jean-Michel Hiver.
# Copyright : (c) MKDoc Holdings Ltd, 2003
#
# This module removes user-defined markup from an existing XML file / variable.
#
# This module is distributed under the same license as Perl itself.
# -------------------------------------------------------------------------------------
package MKDoc::XML::Stripper;
use MKDoc::XML::Tokenizer;
use File::Spec;
use strict;
use warnings;


##
# $class->new();
# --------------
# Returns a new MKDoc::XML::Stripper object.
##
sub new
{
    my $class = shift;
    my $self  = bless { @_ }, $class;
    return $self;
}


sub load_def
{
    my $self = shift;
    my $file = shift;

    $file =~ /\// and return $self->_load_def ($file);
    $file =~ /\./ and return $self->_load_def ($file);

    $file .= '.txt';
    for (@INC)
    {
	my $path = File::Spec->catfile ($_, qw /MKDoc XML Stripper/, $file);
	-e $path and -f $path and return $self->_load_def ($path);
    }

    warn "Cannot read-open $file. Reason: Doesn't seem to be anywhere in \@INC";
}


sub _load_def
{
    my $self = shift;
    my $file = shift;

    open FP, "<$file" || do {
	warn "Cannot read-open $file. Reason: $!";
	return;
    };

    # clean $self
    for (keys %{$self}) { delete $self->{$_} }
    while () {
	chomp();
	s/\#.*$//;
	s/^\s*//;
	s/\s*$//;
	next unless ($_ ne '');

	my @l = split /\s+/, $_;
	$self->allow (@l);
    }

    close FP;
}


##
# $self->allow ($tag, @attributes);
# ---------------------------------
# Allows the tag $tag to be present along with a list of attributes,
# i.e.
#
# $self->allow (qw /p class id/);
##
sub allow
{
    my $self = shift;
    my $tag  = shift;
    $self->{$tag} ||= {};
    for (@_) { $self->{$tag}->{$_} = 1 };
}


##
# $self->disallow ($tag, @attributes);
# ------------------------------------
# Disallows the tag $tag to be present.
##
sub disallow
{
    my $self = shift;
    my $tag  = shift;
    delete $self->{$tag};
}


##
# $self->process_data ($data);
# ----------------------------
# Strips tags on $data and returns the stripped result.
##
sub process_data
{
    my $self   = shift;
    my $data   = shift;
    my $tokens = MKDoc::XML::Tokenizer->process_data ($data);
    my @result = map { $self->strip ($_) } @{$tokens};
    return join '', map { $$_ } @result;
}


##
# $self->process_file ($file);
# ----------------------------
# Strips tags on $file and returns the stripped result.
##
sub process_file
{
    my $self   = shift;
    my $file   = shift;
    my $tokens = MKDoc::XML::Tokenizer->process_file ($file);
    my @result = map { $self->strip ($_) } @{$tokens};
    return join '', map { $$_ } @result;
}


##
# $self->strip ($token);
# ----------------------
# Returns this token stripped out of the stuff which we don't want.
# Returns an empty list if the token is not allowed.
##
sub strip
{
    my $self  = shift;
    my $token = shift;
    my $node  = $token->tag();
    defined $node || return $token;

    my $tag = $node->{_tag};
    return unless ( $self->{$tag} );

    for (keys %{$node})
    {
	/^_/ and next;
	delete $node->{$_} unless $self->{$tag}->{$_};
    }

    return new MKDoc::XML::Token ( _node_to_tag ($node) );
}


sub _node_to_tag
{
    my $node  = shift;
    my $tag   = $node->{_tag};
    my $open  = $node->{_open};
    my $close = $node->{_close};
    my %attr  = map { /^_/ ? () : ($_ => $node->{$_}) } keys %{$node};
    my $attr  = join ' ', map {
	my $key = $_;
	my $val = $attr{$key};
	($val =~ /\"/) ? "$key='$val'" : "$key=\"$val\""
    } keys %attr;

    my $res = '<';
    $res .= '/'  if ($close and not $open);
    $res .= $tag;
    $res .= " $attr" if ($attr and $open);
    $res .= ' /' if ($open and $close);
    $res .= '>';
    return $res;
}


1;


__END__