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__
# Below is stub documentation for your module. You'd better edit it!
=head1 NAME
XML::XMetaL::Utilities - Utility functions
=head1 SYNOPSIS
# Use the module
use XML::XMetaL::Utilities;
# Use the module and import constants
use XML::XMetaL::Utilities qw(:dom_node_types :attribute_types);
# Use the module and import all constants
use XML::XMetaL::Utilities qw(:all);
# The constructor
my $utilities = XML::XMetaL::Utilities->new(-application => $xmetal);
# Utility Methods
my $id_attribute_name = $utilities->get_id_attribute_name('Para');
my $id = $utilities->generate_id();
$utilities->populate_element_with_id($element_node);
$utilities->populate_id_attributes('Article');
my $inserted_node = $utilities->insert_element_with_id('VariableList');
my $word_count = $utilities->word_count($string);
my $word_count = $utilities->word_count($element_node);
# Miscellaneous Methods
my $xmetal_application = $utilities->get_application();
my $active_document = $utilities->get_active_document();
my $selection = $utilities->get_selection();
=head1 DESCRIPTION
The C<XML::XMetaL::Utilities> class contains utility methods:
=over 4
=item Id utilities
=item Word counting
=item Miscellaneous utility methods
=back
=head2 EXPORT
On request, the C<XML::XMetaL::Utilities> package can export a number of
constants used by XMetaL. The following export tags are available:
=over 4
=item C<:dom_node_types>
The C<:dom_node_types> tag exports constants representing the DOM node
types used by XMetaL. The following constants are exported:
DOMELEMENT DOMATTR DOMTEXT
DOMCDATASECTION DOMENTITYREFERENCE DOMENTITY
DOMPROCESSINGINSTRUCTION DOMCOMMENT DOMDOCUMENT
DOMDOCUMENTTYPE DOMDOCUMENTFRAGMENT DOMNOTATION
DOMCHARACTERREFERENCE
The integer values represented by these constants are the same as those
returned by the C<nodeType> property of the C<DOMNode> class in the
XMetaL API.
=item C<:attribute_types>
The C<:attribute_types> tag exports constants representing attribute
node types used by XMetaL. The following constants are exported:
UNKNOWN CDATA ID
IDREF IDREFS ENTITY
ENTITIES NMTOKEN NMTOKENS
NOTATION NAMETOKENGROUP
The integer values represented by these constants are the same as those
returned by the C<attributeType> property of the C<DOMDocumentType>
class in the XMetaL API.
=item C<:all>
The C<:all> tag exports all of the constants listed above.
=back
=head2 Constructor and initialization
use XML::XMetaL::Utilities qw(:all);
my $utilities = XML::XMetaL::Utilities->new(-application => $xmetal_application);
The C<use> statement takes optional export tags as arguments as described
in the L<EXPORT> section.
The constructor requires one named parameter: an XMetaL application object.
=head2 Class Methods
None.
=head2 Public Methods
=over 4
=item C<get_id_attribute_name>
my $id_attribute_name = $utilities->get_id_attribute_name('Para');
The C<get_id_attribute_name> method takes the name of an element
(a generic identifier) as an argument, and returns the name of the ID
type attribute of that element, if there is an ID type attribute
declared.
If there is no ID attribute declared for the element, C<undef> will be
returned.
=item C<generate_id>
my $id = $utilities->generate_id();
The C<generate_id> method generates an id value of the following format:
<user_name><time_stamp><count>
=over 4
=item C<user_name>
The C<user_name> is the user name of the XMetaL user
=item C<time_stamp>
The C<time_stamp> is obtained using the Perl C<time> function when the
utilities object is created. Thus, in most cases, the time stamp will
remain constant for an entire XMetaL session.
=item C<count>
The C<count> is incremented by one each time the C<generate_id> method
is called.
=back
The id generated by C<generate_id> will always be unique within the scope
of a particular XMetaL session.
It is conceivable that two users on different networks, with the same
user name, could start XMetaL at the exact same second, and thus generate
identical ids. However, this risk is so small as to be deemed negligible.
=item C<populate_element_with_id>
$utilities->populate_element_with_id($element_node);
The C<populate_element_with_id> method takes an element node as an
argument and adds an ID attribute with an id value to it.
If the element does not have an ID attribute, or if the ID attribute
already has a value, nothing happens. Existing id values are I<not>
changed.
=item C<populate_id_attributes>
$utilities->populate_id_attributes('Article');
The C<populate_id_attributes> method takes an element name as an argument
and populates all element nodes with the same name with ID attributes.
Existing ID attribute values are I<not> changed.
=item C<insert_element_with_id>
my $inserted_node = $utilities->insert_element_with_id('VariableList');
The C<insert_element_with_id> method inserts an element, with a
populated ID attribute, at the insertion point of the currently active
document.
If successful, the method returns the inserted element node.
If the element could not be inserted, the method returns C<undef>.
=item C<word_count>
my $word_count = $utilities->word_count($string);
my $word_count = $utilities->word_count($element_node);
The word count takes either a text string or an element node as an
argument. It returns a word count.
If the argument is a string, markup in the string will be counted as
words.
If the argument is an element node, only words in text nodes and CDATA
sections will be counted.
=item C<get_application>
my $xmetal_application = $utilities->get_application();
This accessor method returns the XMetaL application object.
=item C<get_active_document>
my $active_document = $utilities->get_active_document();
This accessor method returns the currently active document.
=item C<get_selection>
my $selection = $utilities->get_selection();
This accessor method returns a selection object representing the
current selection in the active document.
=back
=head1 ENVIRONMENT
The Corel XMetaL XML editor must be installed.
=head1 BUGS
The C<generate_id> method will generate illegal id values if the user
name contains characters that are illegal in an id, or if the user
name begins with a character that is not a letter.
This problem will be fixed in a future version.
There are almost certainly plenty of other bugs too.
Please send bug reports to E<lt>henrik.martensson@bostream.nuE<gt>.
=head1 SEE ALSO
See L<XML::XMetaL>.
=head1 AUTHOR
Henrik Martensson, E<lt>henrik.martensson@bostream.nuE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright 2003 by Henrik Martensson
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut