+++ /dev/null
-package Font::TTF::XMLparse;
-
-=head1 NAME
-
-Font::TTF::XMLparse - provides support for XML parsing. Requires Expat module XML::Parser::Expat
-
-=head1 SYNOPSIS
-
- use Font::TTF::Font;
- use Font::TTF::XMLparse;
-
- $f = Font::TTF::Font->new;
- read_xml($f, $ARGV[0]);
- $f->out($ARGV[1]);
-
-=head1 DESCRIPTION
-
-This module contains the support routines for parsing XML and generating the
-Truetype font structures as a result. The module has been separated from the rest
-of the package in order to reduce the dependency that this would bring, of the
-whole package on XML::Parser. This way, people without the XML::Parser can still
-use the rest of the package.
-
-The package interacts with another package through the use of a context containing
-and element 'receiver' which is an object which can possibly receive one of the
-following messages:
-
-=over 4
-
-=item XML_start
-
-This message is called when an open tag occurs. It is called with the context,
-tag name and the attributes. The return value has no meaning.
-
-=item XML_end
-
-This messages is called when a close tag occurs. It is called with the context,
-tag name and attributes (held over from when the tag was opened). There are 3
-possible return values from such a message:
-
-=over 8
-
-=item undef
-
-This is the default return value indicating that default processing should
-occur in which either the current element on the tree, or the text of this element
-should be stored in the parent object.
-
-=item $context
-
-This magic value marks that the element should be deleted from the parent.
-Nothing is stored in the parent. (This rather than '' is used to allow 0 returns.)
-
-=item anything
-
-Anything else is taken as the element content to be stored in the parent.
-
-=back 4
-
-=back 4
-
-In addition, the context hash passed to these messages contains the following
-keys:
-
-=over 4
-
-=item xml
-
-This is the expat xml object. The context is also available as
-$context->{'xml'}{' mycontext'}. But that is a long winded way of not saying much!
-
-=item font
-
-This is the base object that was passed in for XML parsing.
-
-=item receiver
-
-This holds the current receiver of parsing events. It may be set in associated
-application to adjust which objects should receive messages when. It is also stored
-in the parsing stack to ensure that where an object changes it during XML_start, that
-that same object that received XML_start will receive the corresponding XML_end
-
-=item stack
-
-This is the parsing stack, used internally to hold the current receiver and attributes
-for each element open, as a complete hierarchy back to the root element.
-
-=item tree
-
-This element contains the storage tree corresponding to the parent of each element
-in the stack. The default action is to push undef onto this stack during XML_start
-and then to resolve this, either in the associated application (by changing
-$context->{'tree'}[-1]) or during XML_end of a child element, by which time we know
-whether we are dealing with an array or a hash or what.
-
-=item text
-
-Character processing is to insert all the characters into the text element of the
-context for available use later.
-
-=back 4
-
-=head1 METHODS
-
-=cut
-
-use XML::Parser::Expat;
-require Exporter;
-
-use strict;
-use vars qw(@ISA @EXPORT);
-
-@ISA = qw(Exporter);
-@EXPORT = qw(read_xml);
-
-sub read_xml
-{
- my ($font, $fname) = @_;
-
- my ($xml) = XML::Parser::Expat->new;
- my ($context) = {'xml' => $xml, 'font' => $font};
-
- $xml->setHandlers('Start' => sub {
- my ($x, $tag, %attrs) = @_;
- my ($context) = $x->{' mycontext'};
- my ($fn) = $context->{'receiver'}->can('XML_start');
-
- push(@{$context->{'tree'}}, undef);
- push(@{$context->{'stack'}}, [$context->{'receiver'}, {%attrs}]);
- &{$fn}($context->{'receiver'}, $context, $tag, %attrs) if defined $fn;
- },
- 'End' => sub {
- my ($x, $tag) = @_;
- my ($context) = $x->{' mycontext'};
- my ($fn) = $context->{'receiver'}->can('XML_end');
- my ($stackinfo) = pop(@{$context->{'stack'}});
- my ($current, $res);
-
- $context->{'receiver'} = $stackinfo->[0];
- $context->{'text'} =~ s/^\s*(.*?)\s*$/$1/o;
- $res = &{$fn}($context->{'receiver'}, $context, $tag, %{$stackinfo->[1]}) if defined $fn;
- $current = pop(@{$context->{'tree'}});
- $current = $context->{'text'} unless (defined $current);
- $context->{'text'} = '';
-
- if (defined $res)
- {
- return if ($res eq $context);
- $current = $res;
- }
- return unless $#{$context->{'tree'}} >= 0;
- if ($tag eq 'elem')
- {
- $context->{'tree'}[-1] = [] unless defined $context->{'tree'}[-1];
- push (@{$context->{'tree'}[-1]}, $current);
- } else
- {
- $context->{'tree'}[-1] = {} unless defined $context->{'tree'}[-1];
- $context->{'tree'}[-1]{$tag} = $current;
- }
- },
- 'Char' => sub {
- my ($x, $str) = @_;
- $x->{' mycontext'}{'text'} .= $str;
- });
-
- $xml->{' mycontext'} = $context;
-
- $context->{'receiver'} = $font;
- if (ref $fname)
- { return $xml->parse($fname); }
- else
- { return $xml->parsefile($fname); }
-}
-
-
fnp / librarian.git / blobdiff