view release on metacpan or  search on metacpan

lib/XML/MinWriter.pm  view on Meta::CPAN

package XML::MinWriter;
$XML::MinWriter::VERSION = '0.08';
use strict;
use warnings;

use Carp;

require Exporter;
use XML::Writer;

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

our @EXPORT_OK = qw();

our @EXPORT = qw();

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()";