File Coverage

blib/lib/Win32/MinXSLT.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

use strict;
use warnings;

package Win32::MinXSLT;

use Carp;
use Win32::OLE;

our $VERSION = '0.02';

our $Dom;
our $MsVer;
our $status;

BEGIN {
    $MsVer  = undef;
    $status = 'ok';
}

sub import {
    my $self = shift;

    $status = 'unknown';

    for my $v (@_) {
        unless ($v =~ m{\A : v ([\d.]+) \z}xmsi) {
            local $" = "', '";
            croak "Invalid parameter - use Win32::MinXSLT('@_') - not format /^:v9.9\$/ ==> '$v'";
        }

        if (defined $MsVer) {
            croak "Invalid duplicate of use Win32::MinXSLT (old version = '$MsVer', new version = '$1')";
        }

        $MsVer = $1;
    }

    $status = 'ok';
}

CHECK {
    unless ($status eq 'ok') { return; }

    unless (defined $MsVer) { $MsVer = '6.0'; }

    unless ($MsVer =~ m{\.}xms) {
        $MsVer .= '.0';
    }

    if ($MsVer eq '1.0') {
        $Dom = 'Microsoft.XMLDOM';
    }
    else {
        $Dom = 'Msxml2.DOMDocument';
        unless ($MsVer eq '2.0') {
            $Dom .= '.'.$MsVer;
        }
    }

    my $test_doc = Win32::OLE->new($Dom) or croak "Can not create Win32::OLE->new('$Dom') during initialisation";

    $test_doc->{async} = 'False';
    my $test = '';
    unless ($test_doc->LoadXML($test)) {
        croak "Can not do '$Dom' Win32::OLE->LoadXML('$test')";
    }
}

sub new { bless [], $_[0]; }

sub parse_stylesheet { $_[1]; }

# **************************************************************************
# Here is a new package "Win32::MinXML" that does the bulk of the workload:
# **************************************************************************

package Win32::MinXML;

use Carp;
use Win32::OLE;

sub new { bless [], $_[0]; }

sub parse_file {
    my $xml_doc = Win32::OLE->new($Dom)
      or croak "Can not create Win32::OLE->new('$Dom') during Win32::MinXML->parse_file";

    $xml_doc->{async}           = 'False';
    $xml_doc->{validateOnParse} = 'True';

    unless ($xml_doc->Load($_[1])) {
        my $Rs = $xml_doc->{parseError}->{reason}; $Rs =~ s{\r}''xmsg; chomp $Rs;
        my $Ln = $xml_doc->{parseError}->{line};
        my $Ps = $xml_doc->{parseError}->{linePos};
        my $Tx = $xml_doc->{parseError}->{srcText};
        croak "XML-file '$_[1]' did not load for $Dom at line $Ln, pos $Ps, reason: $Rs, text: '$Tx'";
    }

    bless \$xml_doc, ref($_[0]);
}

sub parse_string {
    my $xml_doc = Win32::OLE->new($Dom)
      or croak "Can not create Win32::OLE->new('$Dom') during Win32::MinXML->parse_string";

    $xml_doc->{async}           = 'False';
    $xml_doc->{validateOnParse} = 'True';

    unless ($xml_doc->LoadXML($_[1])) {
        my $Rs = $xml_doc->{parseError}->{reason}; $Rs =~ s{\r}''xmsg; chomp $Rs;
        my $Ln = $xml_doc->{parseError}->{line};
        my $Ps = $xml_doc->{parseError}->{linePos};
        my $Tx = $xml_doc->{parseError}->{srcText};
        croak "XML-text did not load for $Dom at line $Ln, pos $Ps, reason: $Rs, text: '$Tx'";
    }

    bless \$xml_doc, ref($_[0]);
}

sub transform {
    my ($xslt_doc, $xml_doc) = (${$_[0]}, ${$_[1]});

    my $html_doc = Win32::OLE->new($Dom) or croak "Can not create Win32::OLE->new('$Dom') during Win32::MinXML->transform";

    # Do the work, i.e. take the xml-input and transform it (using the xslt stylesheet)
    $xml_doc->transformNodeToObject($xslt_doc, $html_doc);
    if (Win32::OLE::LastError()) {
        my $Rs = Win32::OLE::LastError(); $Rs =~ s{\s+}' 'xmsg;
        croak "XSLT-file has syntax-errors for $Dom: $Rs";
    }

    bless \$html_doc;
}

sub output_file {
    my $self = shift;

    my ($html_doc, $filename) = (${$_[0]}, $_[1]);

    # Save the html to the output-file
    my $rc = $html_doc->save($filename);
    if (Win32::OLE::LastError()) {
        my $Rs = Win32::OLE::LastError(); $Rs =~ s{\s+}' 'xmsg;
        croak "Can't save to output-file '$filename' for $Dom, reason: $Rs";
    }
    elsif ($rc) {
        croak "Can't save to output-file '$filename' for $Dom, returncode = $rc";
    }
}

sub output_string { ${$_[1]}->xml; }

1;
__END__