File Coverage

blib/lib/Test/XML/Order.pm

Criterion	Covered	Total	%
statement	43	43	100.0
branch	6	6	100.0
condition	6	6	100.0
subroutine	9	9	100.0
pod	2	2	100.0
total	66	66	100.0

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

use strict;
use warnings;

use Carp;
use Test::Builder;

our $VERSION = '1.01';

our $Test = Test::Builder->new;

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

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

    no strict 'refs';
    *{ $caller . '::is_xml_in_order' }    = \&is_xml_in_order;
    *{ $caller . '::isnt_xml_in_order' }  = \&isnt_xml_in_order;

    $Test->exported_to( $caller );
    $Test->plan( @_ );
}

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

sub _transform
{
    my $data = shift;

    $data =~ s|[^<]*(<[/a-z]+)[^a-z][^<]*|$1|gs;
    $data =~ s|<([a-z]+)

    return $data;
}

sub is_xml_in_order($$@)
{
    my ($input, $expected, $test_name) = @_;

    croak "usage: is_xml_in_order(input,expected,test_name)"
        unless defined $input && defined $expected;

    my $input_1 = _transform($input);
    my $expected_1 = _transform($expected);

    $Test->ok( 1, $test_name );
    return 1;
}

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

    my $input_1 = _transform($input);
    my $expected_1 = _transform($expected);

    my $ret = 1;

    if ($input_1 eq $expected_1) {
        $Test->diag( $input_1, $expected_1 );
        $ret = 0;
    }

    $Test->ok( $ret, $test_name );
    return $ret;
}

1;
__END__