File Coverage

lib/XML/XMetaL/Utilities.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::Utilities;

use strict;
use warnings;
use Carp;
use Hash::Util qw(lock_keys);
use Win32;

# DOM node types
use constant DOMELEMENT               => 1;
use constant DOMATTR                  => 2;
use constant DOMTEXT                  => 3;
use constant DOMCDATASECTION          => 4;
use constant DOMENTITYREFERENCE       => 5;
use constant DOMENTITY                => 6;
use constant DOMPROCESSINGINSTRUCTION => 7;
use constant DOMCOMMENT               => 8;
use constant DOMDOCUMENT              => 9;
use constant DOMDOCUMENTTYPE          => 10;
use constant DOMDOCUMENTFRAGMENT      => 11;
use constant DOMNOTATION              => 12;
use constant DOMCHARACTERREFERENCE    => 505; # Extension to DOM

# Attribute types
use constant UNKNOWN        => -1;
use constant CDATA          =>  0;
use constant ID             =>  1;
use constant IDREF          =>  2;
use constant IDREFS         =>  3;
use constant ENTITY         =>  4;
use constant ENTITIES       =>  5;
use constant NMTOKEN        =>  6;
use constant NMTOKENS       =>  7;
use constant NOTATION       =>  8;
use constant NAMETOKENGROUP =>  9;



require Exporter;

our  @ISA = qw(Exporter);

our @dom_type_names = qw(
    DOMELEMENT                  DOMATTR                   DOMTEXT
    DOMCDATASECTION             DOMENTITYREFERENCE        DOMENTITY
    DOMPROCESSINGINSTRUCTION    DOMCOMMENT                DOMDOCUMENT
    DOMDOCUMENTTYPE             DOMDOCUMENTFRAGMENT       DOMNOTATION
    DOMCHARACTERREFERENCE
);

our @attribute_type_names = qw(
    UNKNOWN            CDATA            ID
    IDREF              IDREFS           ENTITY
    ENTITIES           NMTOKEN          NMTOKENS
    NOTATION           NAMETOKENGROUP
);

our %EXPORT_TAGS = (
    all             => [@dom_type_names, @attribute_type_names],
    dom_node_types  => [@dom_type_names],
    attribute_types => [@attribute_type_names],
);

our  @EXPORT_OK = (@{$EXPORT_TAGS{all}});

# Variables used by the generate_id() method
our $count = 0;
our $user = Win32::LoginName();
our $time = time();



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

sub get_application {
    my ($self) = @_;
    return $self->{_application};
}

sub get_active_document {
    my ($self) = @_;
    return $self->get_application()->{ActiveDocument};
}

sub get_selection {
    my ($self) = @_;
    my $application = $self->get_application();
    return $application->{Selection};
}

sub insert_element_with_id {
    my ($self, $generic_identifier) = @_;
    my $inserted_node = undef;
    eval {
        my $active_document = $self->get_active_document();
        my $initial_position_range = $active_document->{Range};
        my $final_position_range;
        my $selection = $self->get_selection();
        if ($selection->CanInsert($generic_identifier)) {
            $selection->InsertElementWithRequired($generic_identifier);
            $final_position_range = $active_document->{Range};
            $initial_position_range->Select();
            $selection->MoveRight(0);
            $inserted_node = $selection->{ContainerNode};
            $self->populate_element_with_id($inserted_node);
            $final_position_range->Select();
        }
    };
    croak $@ if $@;
	return $inserted_node;
}

sub generate_id {
    $count++;
    my $id = sprintf "%s%u%04u",$user,$time,$count;
    return $id;
}

sub get_id_attribute_name {
    my ($self, $generic_identifier) = @_;
    my $id_attribute_name;
    eval {
        my $active_document = $self->get_active_document();
        my $doctype = $active_document->{doctype};
        my $count = 0;
        while ($id_attribute_name = $doctype->elementAttribute($generic_identifier, $count)) {
            $count++;
            last if $doctype->attributeType($generic_identifier,$id_attribute_name) == ID;
        }
    };
    croak $@ if $@;
    return $id_attribute_name || undef;
}

sub populate_id_attributes {
    my ($self, $generic_identifier) = @_;
    eval {
        my $active_document = $self->get_active_document();
            my $element_node_list = $active_document->getElementsByTagName($generic_identifier);
            my $element;
            for (my $count = 0; $count < $element_node_list->{length}; $count++) {
                $element = $element_node_list->item($count);
                $self->populate_element_with_id($element);
            }
    };
    croak $@ if $@;
}

sub populate_element_with_id {
    my ($self, $element_node) = @_;
    eval {
        my $generic_identifier = $element_node->{tagName};
        my $attribute_name = $self->get_id_attribute_name($generic_identifier);
        if ($attribute_name) {
            unless ($element_node->hasAttribute($attribute_name)) {
                my $id_value = $self->generate_id();
                $element_node->setAttribute($attribute_name, $id_value);
            }
        }
    };
    croak $@ if $@;
}

sub word_count {
    my ($self, $argument) = @_;
    my $word_count;
    eval {
        $word_count = ref($argument) ?
            $self->_count_words_in_element($argument):
            $self->_count_words_in_string($argument);

    };
    croak($@) if $@;
    return $word_count;
}

sub _count_words_in_string {
    my ($self, $string) = @_;
    my $word_count;
    eval {
        my @words = split /[\s\:\-\;\,]+/, $string;
        @words = grep {$_} @words; # Filter out empty strings
        $word_count = @words;
    };
    croak $@ if $@;
    return $word_count;
}

sub _count_words_in_element {
    my ($self, $element) = @_;
    my $word_count = 0;
    eval {
        my $child_nodes = $element->{childNodes};
        my ($child, $node_type);
        for (my $count = 0; $count < $child_nodes->{length};$count++) {
            $child = $child_nodes->item($count);
            $node_type = $child->{nodeType};
            foreach ($node_type) {
                $node_type == DOMELEMENT && do {
                    $word_count += $self->_count_words_in_element($child);
                    last;
                };
                $node_type == DOMTEXT && do {
                    $word_count += $self->_count_words_in_string($child->{data});
                    last;
                };
                $node_type == DOMCDATASECTION && do {
                    $word_count += $self->_count_words_in_string($child->{data});
                    last;
                };
            }
        }
    };
    croak $@ if $@;
    return $word_count;
}

1;

__END__