177
|
1 |
# $Id: DocumentLocator.pm,v 1.3 2005/10/14 20:31:20 matt Exp $
|
|
2 |
|
|
3 |
package XML::SAX::DocumentLocator;
|
|
4 |
use strict;
|
|
5 |
|
|
6 |
sub new {
|
|
7 |
my $class = shift;
|
|
8 |
my %object;
|
|
9 |
tie %object, $class, @_;
|
|
10 |
|
|
11 |
return bless \%object, $class;
|
|
12 |
}
|
|
13 |
|
|
14 |
sub TIEHASH {
|
|
15 |
my $class = shift;
|
|
16 |
my ($pubmeth, $sysmeth, $linemeth, $colmeth, $encmeth, $xmlvmeth) = @_;
|
|
17 |
return bless {
|
|
18 |
pubmeth => $pubmeth,
|
|
19 |
sysmeth => $sysmeth,
|
|
20 |
linemeth => $linemeth,
|
|
21 |
colmeth => $colmeth,
|
|
22 |
encmeth => $encmeth,
|
|
23 |
xmlvmeth => $xmlvmeth,
|
|
24 |
}, $class;
|
|
25 |
}
|
|
26 |
|
|
27 |
sub FETCH {
|
|
28 |
my ($self, $key) = @_;
|
|
29 |
my $method;
|
|
30 |
if ($key eq 'PublicId') {
|
|
31 |
$method = $self->{pubmeth};
|
|
32 |
}
|
|
33 |
elsif ($key eq 'SystemId') {
|
|
34 |
$method = $self->{sysmeth};
|
|
35 |
}
|
|
36 |
elsif ($key eq 'LineNumber') {
|
|
37 |
$method = $self->{linemeth};
|
|
38 |
}
|
|
39 |
elsif ($key eq 'ColumnNumber') {
|
|
40 |
$method = $self->{colmeth};
|
|
41 |
}
|
|
42 |
elsif ($key eq 'Encoding') {
|
|
43 |
$method = $self->{encmeth};
|
|
44 |
}
|
|
45 |
elsif ($key eq 'XMLVersion') {
|
|
46 |
$method = $self->{xmlvmeth};
|
|
47 |
}
|
|
48 |
if ($method) {
|
|
49 |
my $value = $method->($key);
|
|
50 |
return $value;
|
|
51 |
}
|
|
52 |
return undef;
|
|
53 |
}
|
|
54 |
|
|
55 |
sub EXISTS {
|
|
56 |
my ($self, $key) = @_;
|
|
57 |
if ($key =~ /^(PublicId|SystemId|LineNumber|ColumnNumber|Encoding|XMLVersion)$/) {
|
|
58 |
return 1;
|
|
59 |
}
|
|
60 |
return 0;
|
|
61 |
}
|
|
62 |
|
|
63 |
sub STORE {
|
|
64 |
my ($self, $key, $value) = @_;
|
|
65 |
}
|
|
66 |
|
|
67 |
sub DELETE {
|
|
68 |
my ($self, $key) = @_;
|
|
69 |
}
|
|
70 |
|
|
71 |
sub CLEAR {
|
|
72 |
my ($self) = @_;
|
|
73 |
}
|
|
74 |
|
|
75 |
sub FIRSTKEY {
|
|
76 |
my ($self) = @_;
|
|
77 |
# assignment resets.
|
|
78 |
$self->{keys} = {
|
|
79 |
PublicId => 1,
|
|
80 |
SystemId => 1,
|
|
81 |
LineNumber => 1,
|
|
82 |
ColumnNumber => 1,
|
|
83 |
Encoding => 1,
|
|
84 |
XMLVersion => 1,
|
|
85 |
};
|
|
86 |
return each %{$self->{keys}};
|
|
87 |
}
|
|
88 |
|
|
89 |
sub NEXTKEY {
|
|
90 |
my ($self, $lastkey) = @_;
|
|
91 |
return each %{$self->{keys}};
|
|
92 |
}
|
|
93 |
|
|
94 |
1;
|
|
95 |
__END__
|
|
96 |
|
|
97 |
=head1 NAME
|
|
98 |
|
|
99 |
XML::SAX::DocumentLocator - Helper class for document locators
|
|
100 |
|
|
101 |
=head1 SYNOPSIS
|
|
102 |
|
|
103 |
my $locator = XML::SAX::DocumentLocator->new(
|
|
104 |
sub { $object->get_public_id },
|
|
105 |
sub { $object->get_system_id },
|
|
106 |
sub { $reader->current_line },
|
|
107 |
sub { $reader->current_column },
|
|
108 |
sub { $reader->get_encoding },
|
|
109 |
sub { $reader->get_xml_version },
|
|
110 |
);
|
|
111 |
|
|
112 |
=head1 DESCRIPTION
|
|
113 |
|
|
114 |
This module gives you a tied hash reference that calls the
|
|
115 |
specified closures when asked for PublicId, SystemId,
|
|
116 |
LineNumber and ColumnNumber.
|
|
117 |
|
|
118 |
It is useful for writing SAX Parsers so that you don't have
|
|
119 |
to constantly update the line numbers in a hash reference on
|
|
120 |
the object you pass to set_document_locator(). See the source
|
|
121 |
code for XML::SAX::PurePerl for a usage example.
|
|
122 |
|
|
123 |
=head1 API
|
|
124 |
|
|
125 |
There is only 1 method: C<new>. Simply pass it a list of
|
|
126 |
closures that when called will return the PublicId, the
|
|
127 |
SystemId, the LineNumber, the ColumnNumber, the Encoding
|
|
128 |
and the XMLVersion respectively.
|
|
129 |
|
|
130 |
The closures are passed a single parameter, the key being
|
|
131 |
requested. But you're free to ignore that.
|
|
132 |
|
|
133 |
=cut
|
|
134 |
|