File Coverage

blib/lib/Test/XML.pm

Criterion	Covered	Total	%
statement	13	15	86.6
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	18	20	90.0

package Test::XML;
# @(#) $Id$

use strict;
use warnings;

use Carp;
use Test::Builder;
use XML::SemanticDiff;
use XML::Parser;

our $VERSION = '0.08';

#---------------------------------------------------------------------
# Import shenanigans.  Copied from Test::Pod...
#---------------------------------------------------------------------

sub import {
    my $self   = shift;
    my $caller = caller;

    no strict 'refs';
    *{ $caller . '::is_xml' }             = \&is_xml;
    *{ $caller . '::isnt_xml' }           = \&isnt_xml;
    *{ $caller . '::is_well_formed_xml' } = \&is_well_formed_xml;
    *{ $caller . '::is_good_xml' }        = \&is_well_formed_xml;

    my $Test = Test::Builder->new;
    $Test->exported_to( $caller );
    $Test->plan( @_ );
}

#---------------------------------------------------------------------
# Tool.
#---------------------------------------------------------------------

sub is_xml {
    my ($input, $expected, $test_name) = @_;
    croak "usage: is_xml(input,expected,test_name)"
        unless defined $input && defined $expected;

    my $Test = Test::Builder->new;
    my $differ = XML::SemanticDiff->new;
    my @diffs = eval { $differ->compare( $expected, $input ) };
    if ( @diffs ) {
        $Test->ok( 0, $test_name );
        $Test->diag( "Found " . scalar(@diffs) . " differences with expected:" );
        $Test->diag( "  $_->{message}" ) foreach @diffs;
        $Test->diag( "in processed XML:\n  $input" );
	return 0;
    } elsif ( $@ ) {
        $Test->ok( 0, $test_name );
        # Make the output a bit more testable.
        $@ =~ s/ at \/.*//;
        $Test->diag( "During compare:$@" );
        return 0;
    } else {
        $Test->ok( 1, $test_name );
	return 1;
    }
}

sub isnt_xml {
    my ($input, $mustnotbe, $test_name) = @_;
    croak "usage: isnt_xml(input,mustnotbe,test_name)"
        unless defined $input && defined $mustnotbe;

    my $Test = Test::Builder->new;
    my $differ = XML::SemanticDiff->new;
    my @diffs = eval { $differ->compare( $mustnotbe, $input ) };
    if ( $@ ) {
        $Test->ok( 0, $test_name );
        # Make the output a bit more testable.
        $@ =~ s/ at \/.*//;
        $Test->diag( "During compare:$@" );
        return 0;
    } elsif ( @diffs == 0 ) {
        $Test->ok( 0, $test_name );
        $Test->diag( "Found no differences in processed XML:\n  $input" );
	return 0;
    } else {
        $Test->ok( 1, $test_name );
	return 1;
    }
}

sub is_well_formed_xml {
    my ($input, $test_name) = @_;
    croak "usage: is_well_formed_xml(input,test_name)"
        unless defined $input;

    my $Test = Test::Builder->new;
    my $parser = XML::Parser->new;
    eval { $parser->parse($input) };
    if ( $@ ) {
        $Test->ok( 0, $test_name );
        # Make the output a bit more testable.
        $@ =~ s/ at \/.*//;
        $Test->diag( "During parse: $@" );
        return 0;
    } else {
        $Test->ok( 1, $test_name );
        return 1;
    }
}

1;
__END__