File Coverage

blib/lib/XML/MinWriter.pm

Criterion	Covered	Total	%
statement	113	127	88.9
branch	47	50	94.0
condition	10	15	66.6
subroutine	15	19	78.9
pod	13	15	86.6
total	198	226	87.6

package XML::MinWriter;

use strict;
use warnings;

use Carp;

require Exporter;
use XML::Writer;

our @ISA = qw(Exporter XML::Writer);

our @EXPORT_OK = qw();

our @EXPORT = qw();

our $VERSION = '0.06';

sub new {
    my $class = shift;
    my $self = $class->SUPER::new(@_);

    $self->{PYX_TYPE} = '';
    $self->{PYX_TAG}  = '';
    $self->{PYX_ATTR} = [];

    bless $self, $class; # reconsecrate
}

sub xmlDecl     { my $self = shift; $self->flush_pyx; $self->SUPER::xmlDecl(@_);     }
sub doctype     { my $self = shift; $self->flush_pyx; $self->SUPER::doctype(@_);     }
sub comment     { my $self = shift; $self->flush_pyx; $self->SUPER::comment(@_);     }
sub pi          { my $self = shift; $self->flush_pyx; $self->SUPER::pi(@_);          }
sub startTag    { my $self = shift; $self->flush_pyx; $self->SUPER::startTag(@_);    }
sub emptyTag    { my $self = shift; $self->flush_pyx; $self->SUPER::emptyTag(@_);    }
sub endTag      { my $self = shift; $self->flush_pyx; $self->SUPER::endTag(@_);      }
sub characters  { my $self = shift; $self->flush_pyx; $self->SUPER::characters(@_);  }
sub raw         { my $self = shift; $self->flush_pyx; $self->SUPER::raw(@_);         }
sub cdata       { my $self = shift; $self->flush_pyx; $self->SUPER::cdata(@_);       }
sub dataElement { my $self = shift; $self->flush_pyx; $self->SUPER::dataElement(@_); }
sub end         { my $self = shift; $self->flush_pyx; $self->SUPER::end(@_);         }

sub write_pyx {
    my $self = shift;

    my @inlist;
    for (@_) {
        push @inlist, split m{\n}xms;
    }

    LOOP1: for my $instr (@inlist) {
        if ($instr eq '') {
            next LOOP1;
        }

        my $code = substr($instr, 0, 1);
        my $text = substr($instr, 1);

        $text =~ s{\\(.)}{
          $1 eq '\\' ? "\\" :
          $1 eq 'n'  ? "\n" :
          $1 eq 't'  ? "\t" :
          "\\".$1}xmsge;

        if ($code eq '(') {
            $self->flush_pyx;
            $self->{PYX_TYPE} = '(';
            $self->{PYX_TAG}  = $text;
            $self->{PYX_ATTR} = [];
        }
        elsif ($code eq 'A') {
            my ($key, $val) = $text =~ m{\A (\S+) \s+ (.*) \z}xms;
            unless (defined($key) and defined($val)) {
                carp "Can't parse (key, val) [code = 'A'] in '$text' in write_pyx()";
                next LOOP1;
            }
            push @{$self->{PYX_ATTR}}, $key, $val;
        }
        elsif ($code eq '?') {
            my ($intro, $def) = $text =~ m{\A (\S+) \s+ (.*) \z}xms;
            unless (defined($intro) and defined($def)) {
                carp "Can't parse (intro, def) [code = '?'] in '$text' in write_pyx()";
                next LOOP1;
            }

            if ($intro =~ m{\A xml}xmsi and $intro !~ m{\A xml-stylesheet \z}xmsi) {
                my ($version, $encoding, $standalone);
                my $data = $def;
                while (my ($key, $val, $rest) = $data =~ m{\A (\S+) \s* = \s* ["']([^"']+)["'] \s* (.*) \z}xms) {
                    if    ($key =~ m{\A version    \z}xmsi) { $version    = $val; }
                    elsif ($key =~ m{\A encoding   \z}xmsi) { $encoding   = $val; }
                    elsif ($key =~ m{\A standalone \z}xmsi) { $standalone = $val; }
                    else {
                        carp "Found invalid XML-Declaration (key = '$key') in (intro = '$intro', def = '$def') in write_pyx()";
                        next LOOP1;
                    }
                    unless (defined $version) { $version = '1.0'; }
                    unless ($version eq '1.0') {
                        carp "Found version other than 1.0 ('$version') in (intro = '$intro', def = '$def') in write_pyx()";
                        next LOOP1;
                    }
                    $data = $rest;
                }
                $self->xmlDecl($encoding, $standalone);
            }
            else {
                $self->pi($intro, $def);
            }
        }
        elsif ($code eq '!') {
            my ($intro, $def) = $text =~ m{\A (\S+) \s+ (.*) \z}xms;
            unless (defined($intro) and defined($def)) {
                carp "Can't parse (intro, def) [code = '!'] in '$text' in write_pyx()";
                next LOOP1;
            }

            if ($def =~ m{\A PUBLIC}xmsi) {
                my ($public, $system) = $def =~ m{\A PUBLIC \s+ ["']([^"']+)["'] \s+ ["']([^"']+)["'] \s* \z}xmsi;
                unless (defined($public) and defined($system)) {
                    carp "Can't parse DOCTYPE PUBLIC in (intro = '$intro', def = '$def') in write_pyx()";
                    next LOOP1;
                }
                $self->doctype($intro, $public, $system);
            }
            elsif ($def =~ m{\A SYSTEM}xmsi) {
                my ($system) = $def =~ m{\A SYSTEM \s+ ["']([^"']+)["'] \s* \z}xmsi;
                unless (defined($system)) {
                    carp "Can't parse DOCTYPE SYSTEM in (intro = '$intro', def = '$def') in write_pyx()";
                    next LOOP1;
                }
                $self->doctype($intro, undef, $system);
            }
            else {
                carp "Can't find neither PUBLIC nor SYSTEM in DOCTYPE (intro = '$intro', def = '$def') in write_pyx()";
                next LOOP1;
            }
        }
        elsif ($code eq ')') { $self->endTag($text);     }
        elsif ($code eq '-') { $self->characters($text); }
        elsif ($code eq '#') { $self->comment($text);    }
        else {
            carp "Invalid code = '$code' in write_pyx()";
            next LOOP1;
        }
    }
}

sub flush_pyx {
    my $self = shift;

    if ($self->{PYX_TYPE} eq '(') {
        $self->SUPER::startTag($self->{PYX_TAG}, @{$self->{PYX_ATTR}});
    }

    $self->{PYX_TYPE}    = '';
    $self->{PYX_TAG}     = '';
    $self->{PYX_ATTR}    = [];
}

1;

__END__