File Coverage

lib/XML/XMetaL.pm

Criterion	Covered	Total	%
statement	15	62	24.1
branch	0	18	0.0
condition	0	25	0.0
subroutine	5	12	41.6
pod	2	3	66.6
total	22	120	18.3

package XML::XMetaL;

use strict;
use warnings;

use Carp;
use Hash::Util qw(lock_keys);


our $VERSION = '0.52';

our $singleton;
our $application;
our %custom_handlers;

sub new {
    my ($class, %args) = @_;
    my $self;
    eval {
        lock_keys(%args,qw(-application));
        if ($singleton) {
            $self = $singleton;
        } else {
            $application = $args{-application} ||
                croak "-application argument missing or undefined";
            $self = bless {}, ref($class) || $class;
            lock_keys(%$self, keys %$self);
            $singleton = $self;
        }
    };
    croak $@ if $@;
    return $self;
}

sub _get_application {
    return $application ||
        croak "Application object does not exist";
}

sub get_handler {
    my ($self, $key) = @_;
    return $custom_handlers{$key} || croak "Handler ".($key || "UNDEF")." does not exist";
}


sub add_handler {
    my ($self, %args) = @_;
    my $handler_exists_exception = "Handler is registered already";
    eval {
        lock_keys(%args, qw(-system_identifier -handler));
        my $dtd_name = $self->_base_path($args{-system_identifier});
        die $handler_exists_exception if exists $custom_handlers{$dtd_name};
        $custom_handlers{$args{-system_identifier}} = $args{-handler};
    };
    if ($@ eq $handler_exists_exception) {
        return;
    } elsif ($@) {
        croak $@;
    }
}

sub _base_path {
    my ($self, $system_identifier) = @_;
    my ($base_name) = $system_identifier =~ /([^\\\/]+)$/;
    return $base_name;
}

# ======================================================================
# Dispatcher
#
# The AUTOLOAD method generates dispatch methods automatically,
# and installs them in the symbol table
# ======================================================================

our $AUTOLOAD;
sub AUTOLOAD {
    my ($self, @args) = @_;
    my ($class, $method) = $AUTOLOAD =~ /^(.*)::(.*)$/;
    return if $method eq 'DESTROY';
    no strict 'refs';
    *{$AUTOLOAD} = sub {
        my ($self, @args) = @_;
        my $application;
        my @return_values;
        eval {
            $application = $self->_get_application() ||
                die "Dispatch method $method called, but there is no application object";
            my $active_document = $application->{ActiveDocument} ||
                die "Dispatch method $method called, but there is no active document";
            my $doctype = $active_document->{doctype} ||
                die "The active document had no doctype";
            my $system_identifier = $doctype->{systemId} ||
                die "The doctype declaration of the active document had no system identifier";
            my $handler = $self->get_handler($system_identifier) ||
                die "Handler for system identifier $system_identifier could not be found";
            @return_values = $handler->$method(@args);
        };
        if ($@ && $application) {
            $application->Alert("$@");
        } elsif ($@) {
            croak $@;
        }
        return wantarray ? @return_values : $return_values[0];
    };
    $self->$method(@args);
}




1;
__END__