File Coverage

lib/XML/XMetaL/Factory.pm

Criterion	Covered	Total	%
statement	13	15	86.6
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	18	20	90.0

package XML::XMetaL::Factory;

use strict;
use warnings;

use Carp;
use Hash::Util qw(lock_keys);
use Switch;
use Win32::OLE;

use constant XMETAL_NO_SAVE => 2;

sub new {
    my ($class) = @_;
    my $self;
    eval {
        $self = bless {
            _xmetal    => undef,
        }, ref($class) || $class;
        lock_keys(%$self, keys %$self);
        $self->_create_xmetal();
    };
    croak $@ if $@;
    return $self;
}

sub get_xmetal_path {
    my ($self) = @_;
    my $xmetal = $self->_get_xmetal();
    my $path = $xmetal->{Path};
    return $path;
}
sub _get_xmetal {$_[0]{_xmetal}}
sub _set_xmetal {$_[0]{_xmetal} = $_[1]}

sub _get_documents {
    my ($self) = @_;
    my $xmetal = $self->_get_xmetal();
    return $xmetal->{Documents};
}

sub create_xmetal {
    my ($self, @documents) = @_;
    eval {
        my $documents = $self->_get_documents();
        my $document;
        foreach my $document (@documents) {
            chomp $document;
            if ( $document =~ /^<\?xml/i) {
                $document = $self->_create_document_from_string($document);
            } elsif (-f $document) {
                $document = $self->_create_document_from_path($document);
            };
            die "Could not open document" unless ref($document);
        }
    };
    croak $@ if $@;
    return $self->_get_xmetal();
}

sub _create_document_from_string {
    my ($self, $document_string) = @_;
    my ($document);
    eval {
        my $documents = $self->_get_documents();
        $document = $documents->OpenString($document_string);
        $self->_die_on_ole_error();
    };
    croak $@ if $@;
    return $document;
}

sub _create_document_from_path {
    my ($self, $document_path) = @_;
    my ($document);
    eval {
        my $documents = $self->_get_documents();
        $document = $documents->Open($document_path, -1);
        $self->_die_on_ole_error();
    };
    croak $@ if $@;
    return $document;
}

sub tear_down {
    my ($self) = @_;
    croak "Tear down method is not implemented yet."
    #$self->_destroy_xmetal();
}

sub _create_xmetal {
    my ($self) = @_;
    eval {
        my $xmetal = Win32::OLE->new('XMetaL.Application', sub {$self->_destroy_xmetal()});
        $self->_die_on_ole_error();
        do {sleep 1} until $xmetal->InitComplete();
        $self->_set_xmetal($xmetal);
    };
    die $@ if $@;
}

sub _destroy_xmetal {
    my ($self) = @_;
    my $xmetal = $self->_get_xmetal();
    eval {
        undef $self->{_xmetal};
        $xmetal->Quit(&XMETAL_NO_SAVE);
        $self->_die_on_ole_error();
    };
    croak $@ if $@;
}

sub _die_on_ole_error {
    my ($self) = @_;
    my $error = "".Win32::OLE->LastError();
    die $error if $error;
}

1;
__END__