File Coverage

blib/lib/XML/FXN.pm

Criterion	Covered	Total	%
statement	135	136	99.2
branch	32	32	100.0
condition	3	3	100.0
subroutine	7	7	100.0
pod	2	4	50.0
total	179	182	98.3

package XML::FXN;
# Copyright Jerzy Wachowiak 2005
# Fast XML Notation

use strict;
use warnings;

require Exporter;
        use vars qw( @ISA @EXPORT $VERSION );
        @ISA =qw( Exporter );
        @EXPORT =qw( xml2fxn fxn2xml );
        $VERSION = '0.01';

sub xml2fxn {

    my $line = shift;

    # Some definitions from the XML standard...
    my $S = "[ \\n\\t\\r]+";
    my $NameStrt = "[A-Za-z_:]|[^\\x00-\\x7F]";
    my $NameChar = "[A-Za-z0-9_:.-]|[^\\x00-\\x7F]";
    my $Name = "(?:$NameStrt)(?:$NameChar)*";
    my $EndTagCE = "$Name(?:$S)?";
    my $AttValSE = "\"[^<\"]*\"|'[^<']*'";
    my $TextSE = "(?:[^<]+)*";

    my @string = split( //, $line );

    my( $char1 , $char2, $buffer, $output );
    $output = $buffer = $char1 = $char2 = '';
    my $IsSetDoctypedecl = 0;
    my $IsSetComment = 0;

    foreach $char2 ( @string ){

        $buffer .= $char1;


        if(  "$char1$char2" =~ m/[?%]>/ ){
            $buffer .= $char2;
            $output .= $buffer;
            $char1 = '';
            $buffer = '';
            next
        }

        if( "$buffer$char2" =~ m/-->$/ ){
            $buffer .= $char2;
            $output .= $buffer;
            $char1 = '';
            $buffer = '';
            $IsSetComment = 0;
            next
        }

        if( $IsSetComment ){
            $char1 = $char2;
            next
        }

        if( $IsSetDoctypedecl and $char2 =~ m/>/ ){
            $buffer .= $char2;
            $output .= $buffer;
            $char1 = '';
            $buffer = '';
            $IsSetDoctypedecl = 0;
            next
        }

        if( "$buffer$char2" =~ m/
            $char1 = $char2;
            $IsSetDoctypedecl = 1;
            next
        }

        if( "$buffer$char2" =~ m// ) {
            $output .= $buffer.$char2;
            $char1 = '';
            $buffer = '';
            next
        }

        if( "$buffer$char1$char2" =~ m/<[?!]/ ) {
            $char1 = $char2;
            next
        }

        if(  "$char1$char2" eq '<>'){
            $buffer =~
             s/(($Name)(?:$S$Name(?:$S)?=(?:$S)?(?:$AttValSE))*(?:$S)?)/g;
            $buffer =~
              s/($TextSE) (<$Name(?:$S$Name(?:$S)?=(?:$S)?(?:$AttValSE))*(?:$S)?\/>)/trim_back( $1, $2 )/ge;
            $output .= $buffer;
            $char1 = '';
            $buffer = '';
            next
        }

        if( $char1 eq '>' ){
            $last_name_on_stack = pop( @name_stack );
            $buffer =~ s/>//g;
            $buffer = "$buffer<\/$last_name_on_stack>";
            $output .= $buffer;
            $buffer = ''
        }

        if( $char1 eq '<' ){
            $buffer =~
             s/(($Name)(?:$S$Name(?:$S)?=(?:$S)?(?:$AttValSE))*(?:$S)?)/g;
            push( @name_stack, $2 );
            $buffer =~
              s/($TextSE) (<$Name(?:$S$Name(?:$S)?=(?:$S)?(?:$AttValSE))*(?:$S)?>)/trim_back( $1, $2 )/ge;
            $output .= $buffer;
            $buffer = ''
        }

       $char1 = $char2;
    }
    $output .= $buffer.$char1;
    return $output
}



sub trim_back {

    my $string1 = shift;
    my $string2 = shift;

    if ( $string1 =~ m/\w+/ ){ return "$string1$string2" }
    else { return "$string1 $string2" }
}

1;
__END__