1package Font::TTF::XMLparse;
2
3=head1 NAME
4
5Font::TTF::XMLparse - provides support for XML parsing. Requires Expat module XML::Parser::Expat
6
7=head1 SYNOPSIS
8
9    use Font::TTF::Font;
10    use Font::TTF::XMLparse;
11
12    $f = Font::TTF::Font->new;
13    read_xml($f, $ARGV[0]);
14    $f->out($ARGV[1]);
15
16=head1 DESCRIPTION
17
18This module contains the support routines for parsing XML and generating the
19Truetype font structures as a result. The module has been separated from the rest
20of the package in order to reduce the dependency that this would bring, of the
21whole package on XML::Parser. This way, people without the XML::Parser can still
22use the rest of the package.
23
24The package interacts with another package through the use of a context containing
25and element 'receiver' which is an object which can possibly receive one of the
26following messages:
27
28=over 4
29
30=item XML_start
31
32This message is called when an open tag occurs. It is called with the context,
33tag name and the attributes. The return value has no meaning.
34
35=item XML_end
36
37This messages is called when a close tag occurs. It is called with the context,
38tag name and attributes (held over from when the tag was opened). There are 3
39possible return values from such a message:
40
41=over 8
42
43=item undef
44
45This is the default return value indicating that default processing should
46occur in which either the current element on the tree, or the text of this element
47should be stored in the parent object.
48
49=item $context
50
51This magic value marks that the element should be deleted from the parent.
52Nothing is stored in the parent. (This rather than '' is used to allow 0 returns.)
53
54=item anything
55
56Anything else is taken as the element content to be stored in the parent.
57
58=back
59
60In addition, the context hash passed to these messages contains the following
61keys:
62
63=over 4
64
65=item xml
66
67This is the expat xml object. The context is also available as
68$context->{'xml'}{' mycontext'}. But that is a long winded way of not saying much!
69
70=item font
71
72This is the base object that was passed in for XML parsing.
73
74=item receiver
75
76This holds the current receiver of parsing events. It may be set in associated
77application to adjust which objects should receive messages when. It is also stored
78in the parsing stack to ensure that where an object changes it during XML_start, that
79that same object that received XML_start will receive the corresponding XML_end
80
81=item stack
82
83This is the parsing stack, used internally to hold the current receiver and attributes
84for each element open, as a complete hierarchy back to the root element.
85
86=item tree
87
88This element contains the storage tree corresponding to the parent of each element
89in the stack. The default action is to push undef onto this stack during XML_start
90and then to resolve this, either in the associated application (by changing
91$context->{'tree'}[-1]) or during XML_end of a child element, by which time we know
92whether we are dealing with an array or a hash or what.
93
94=item text
95
96Character processing is to insert all the characters into the text element of the
97context for available use later.
98
99=back
100
101=back
102
103=head1 METHODS
104
105=cut
106
107use XML::Parser::Expat;
108require Exporter;
109
110use strict;
111use vars qw(@ISA @EXPORT);
112
113@ISA = qw(Exporter);
114@EXPORT = qw(read_xml);
115
116sub read_xml
117{
118    my ($font, $fname) = @_;
119
120    my ($xml) = XML::Parser::Expat->new;
121    my ($context) = {'xml' => $xml, 'font' => $font};
122
123    $xml->setHandlers('Start' => sub {
124            my ($x, $tag, %attrs) = @_;
125            my ($context) = $x->{' mycontext'};
126            my ($fn) = $context->{'receiver'}->can('XML_start');
127
128            push(@{$context->{'tree'}}, undef);
129            push(@{$context->{'stack'}}, [$context->{'receiver'}, {%attrs}]);
130            &{$fn}($context->{'receiver'}, $context, $tag, %attrs) if defined $fn;
131        },
132        'End' => sub {
133            my ($x, $tag) = @_;
134            my ($context) = $x->{' mycontext'};
135            my ($fn) = $context->{'receiver'}->can('XML_end');
136            my ($stackinfo) = pop(@{$context->{'stack'}});
137            my ($current, $res);
138
139            $context->{'receiver'} = $stackinfo->[0];
140            $context->{'text'} =~ s/^\s*(.*?)\s*$/$1/o;
141            $res = &{$fn}($context->{'receiver'}, $context, $tag, %{$stackinfo->[1]}) if defined $fn;
142            $current = pop(@{$context->{'tree'}});
143            $current = $context->{'text'} unless (defined $current);
144            $context->{'text'} = '';
145
146            if (defined $res)
147            {
148                return if ($res eq $context);
149                $current = $res;
150            }
151            return unless $#{$context->{'tree'}} >= 0;
152            if ($tag eq 'elem')
153            {
154                $context->{'tree'}[-1] = [] unless defined $context->{'tree'}[-1];
155                push (@{$context->{'tree'}[-1]}, $current);
156            } else
157            {
158                $context->{'tree'}[-1] = {} unless defined $context->{'tree'}[-1];
159                $context->{'tree'}[-1]{$tag} = $current;
160            }
161        },
162        'Char' => sub {
163            my ($x, $str) = @_;
164            $x->{' mycontext'}{'text'} .= $str;
165        });
166
167    $xml->{' mycontext'} = $context;
168
169    $context->{'receiver'} = $font;
170    if (ref $fname)
171    { return $xml->parse($fname); }
172    else
173    { return $xml->parsefile($fname); }
174}
175
1761;
177
178=head1 AUTHOR
179
180Martin Hosken L<http://scripts.sil.org/FontUtils>.
181
182
183=head1 LICENSING
184
185Copyright (c) 1998-2016, SIL International (http://www.sil.org)
186
187This module is released under the terms of the Artistic License 2.0.
188For details, see the full text of the license in the file LICENSE.
189
190
191
192=cut