File Coverage

blib/lib/XML/LibXML/Fixup.pm

Criterion	Covered	Total	%
statement	10	12	83.3
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	14	16	87.5

package XML::LibXML::Fixup;
use strict;
use warnings;
use Carp;
use XML::LibXML;
use vars qw ( $VERSION @ISA );

$VERSION = '0.03';
@ISA = qw ( XML::LibXML );


#################################################################
# CONSTRUCTOR - calls parent constructor                        #
#################################################################
sub new
{
    my $self = XML::LibXML::new(@_);
    $self->{_throw_ex} = 1;
    $self->{_errors} = [];
    $self->{_error_cursor} = 0;
    $self->{_is_valid} = 0;
    $self->{_fixup} = [];
    $self->{_fixup_description} = [];
    $self->{_fixups_applied} = [];
    $self->{_fixup_cursor} = 0;
    return $self;
}

#################################################################
# VALIDATION AND FIXUPS                                         #
#################################################################
sub valid
{
    return $_[0]->{_is_valid};
}

sub fixed_up
{
    my $self = shift;
    if (wantarray){
	return @{$self->{_fixup_description}}[@{$self->{_fixups_applied}}];
    } else {
	return $#{$self->{_fixups_applied}} + 1;
    }
}


sub add_fixup
{
    my ($self, $fixup, $desc) = @_;
    my $filter;
    if (ref($fixup) eq 'CODE'){
	$filter = $fixup;
    } else {
	eval('$filter = sub { my $xml = shift;'."\n".
	     '$xml =~ '.$fixup.";\n".
	     'return $xml;'."\n}")
	    || croak("not a regex or subroutine reference");
    }
    push @{$self->{_fixup}}, $filter;
    push @{$self->{_fixup_description}}, $desc;
}

sub clear_fixups
{
    my $self = $_[0];
    $self->{_fixup} = [];
    $self->{_fixup_description} = [];
    $self->{_fixups_applied} = [];
    $self->{_fixup_cursor} = 0;
}

sub _do_fixup
{
    my ($self,$xml) = @_;
    my $fixup = $self->{_fixup}->[$self->{_fixup_cursor}];
    my $fixed_xml = $fixup->($xml);
    if ($fixed_xml ne $xml)
    {
	push @{$self->{_fixups_applied}}, $self->{_fixup_cursor};
    }
    $self->{_fixup_cursor}++;
    return $fixed_xml;
}

#################################################################
# PARSING - overridden methods of XML::LibXML                   #
#################################################################
sub parse_string
{
    my ($self, $string) = @_;
    $self->_clear_status();

    my $doc;

    # first attempt sans fixups
    $doc = $self->_safe_parse_string($string);

    # apply fixups one-by-one
    while(
	  (!$self->valid()) &&
	  ($self->{_fixup_cursor} <= $#{$self->{_fixup}})
	  )
    {
	$string = $self->_do_fixup($string);
	$doc = $self->_safe_parse_string($string);
    }

    if($self->throw_exceptions() && !$self->valid()){
	croak($self->get_last_error());
    }
    return $doc;
}

sub _safe_parse_string
{
    my ($self, $string) = @_;
    my $doc;
    eval {$doc = $self->SUPER::parse_string($string)};
    if ( $@ ) {
	$self->_add_error( $@ );
    } else {
	$self->{_is_valid} = 1;
    }
    return $doc;
}

sub parse_file
{
    die("not yet implimented");
}

sub parse_fh
{
    die("not yet implemented");
}

#################################################################
# ERROR HANDLING                                                #
#################################################################
sub throw_exceptions
{
    my ($self, $bool) = @_;
    if (defined $bool){
	$self->{_throw_ex} = $bool;
    }
    return $self->{_throw_ex};
}


sub get_errors
{
    return @{$_[0]->{_errors}};
}

sub _add_error
{
    my ($self, @err) = @_;
    push @{$self->{_errors}}, @err;
}

sub first_error
{
    my $self = shift;
    $self->{_error_cursor} = 0;
}

sub next_error
{
    my $self = shift;
    my $last_error_index = $#{$self->{_errors}};
    my $err;
    if ($self->{_error_cursor} <= $last_error_index)
    {
	$err = $self->{_errors}->[$self->{_error_cursor}];
	$self->{_error_cursor}++;
    }
    return $err;
}

sub _clear_status
{
    my $self = shift;
    $self->{_errors} = [];
    $self->{_is_valid} = 0;
    $self->{_fixups_applied} = [];
    $self->{_fixup_cursor} = 0;
    $self->first_error();
}

# slightly happier about this, rather than global variable
# used in XML::LibXML
sub get_last_error
{
    my $self = shift;
    my $last_error_index = $#{$self->{_errors}};
    my $err;
    if ($last_error_index >= 0){
	$err = $self->{_errors}->[$last_error_index];
    }
    return $err;
}

1;

__END__