File Coverage

blib/lib/XML/Tidy/Tiny.pm

Criterion	Covered	Total	%
statement	56	63	88.8
branch	21	26	80.7
condition			n/a
subroutine	4	4	100.0
pod	0	1	0.0
total	81	94	86.1

package XML::Tidy::Tiny;
use 5.008001;
use strict;
use Exporter 'import';
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use XML::Tidy::Tiny ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(
    xml_tidy
) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(
    xml_tidy
);
our $VERSION = '0.02';

sub xml_tidy{
    my $data = shift;
    my $header ='';
    $header  = $1 if $data=~s/^(<\?.*?\?>)\s*//s;
    $header .= "\n" if $header;

    my @data = grep length, split qr{(]+/?>)}, $data, -1;
    my @pre_push ;
    my @pre_number;
    my @pre_level;
    my $buff = '';
    my $level = 0;

    my $accum;

    while (@data) {
        my $item = shift @data;
        next unless length $item;

        my $type;
        if ( $item =~ m/^
            if ( $item =~ m/^<\// ) {    # TAG CLOSE
                $type = -1;
                my $indent;
                --$level;
                push @pre_push, $item;
                $pre_push[0]=~s/^\s+//;
                $buff .= $_ for "\n", '  ' x $level, @pre_push;
                @pre_push = ();
            }
            elsif ( $item =~ m/\/>\z/ ) { # TAG ALONE
                $type = 0;
                if (@pre_push) {
                    push @pre_push, $item;
                }
                else {
                    $pre_push[0]=~s/^\s+//;
                    $buff .= $_ for "\n", '  ' x $level, @pre_push, $item;
                    @pre_push = ();
                }
            }
            else {
                $type = 1;
                if (@pre_push) { # TAG OPEN
                    $pre_push[0]=~s/^\s+//;
                    $buff .= $_ for  "\n", '  ' x ( $level - 1 ), shift @pre_push;
                    ++$level;
                    if ( @pre_push ){
                        $pre_push[0]=~s/^\s+//;
                        $buff .= $_ for "\n", '  ' x ( $level - 1), @pre_push;
                    }
                    @pre_push = $item;
                }
                else {
                    ++$level;
                    push @pre_push, $item;
                }
            }
        }
        else {
            next if $item=~m/^\s+\z/;
            if (@pre_push) {
                push @pre_push, $item;
            }
            else {
                push @pre_push, $item;
                $pre_push[0]=~s/^\s+//;
                $buff .= $_ for "\n", '  ' x $level, @pre_push;
                @pre_push = ( );
            }
        }
    }
    if (@pre_push) {
        $buff .= "\n" if length $buff;
        $pre_push[0]=~s/^\s+//;
        $buff .= $_   for '  ' x ( $level ), @pre_push;
    }
    $buff=~s/^\s+//;
    $buff=~s/\s+\z//;
    return $header .  $buff;
}



# Preloaded methods go here.

1;
__END__