1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
|
package CGI::XML;
use strict;
use CGI;
use vars qw($VERSION @ISA $self $parser);
use XML::Parser;
@ISA = qw(CGI);
$VERSION = '0.1';
sub toXML {
my ($self,$root) = @_;
my $xml = join "\n", (map { "<$_>" . &QuoteXMLChars($self->param($_)) . "</$_>" } $self->param), "";
return $root
? "<$root>\n$xml</$root>\n"
: $xml;
}
sub toCGI {
my ($self, $xml) = @_;
my $root;
my $parser = new XML::Parser(Handlers => {Char => $self->handle_char});
$parser->parse($xml);
}
sub handle_char {
my $self = shift;
return sub {
my ($parser,$cdata) = @_;
return if $parser->depth == 1;
my $element = $parser->current_element;
$self->delete($element);
unshift @{$self->param_fetch(-name=>$element)},$cdata;
}
}
sub QuoteXMLChars {
$_[0] =~ s/&/&/g;
$_[0] =~ s/</</g;
$_[0] =~ s/>/>/g;
$_[0] =~ s/'/'/g;
$_[0] =~ s/"/"/g;
$_[0] =~ s/([\x80-\xFF])/&XmlUtf8Encode(ord($1))/ge;
return($_[0]);
}
sub XmlUtf8Encode {
# borrowed from XML::DOM
my $n = shift;
if ($n < 0x80) {
return chr ($n);
} elsif ($n < 0x800) {
return pack ("CC", (($n >> 6) | 0xc0), (($n & 0x3f) | 0x80));
} elsif ($n < 0x10000) {
return pack ("CCC", (($n >> 12) | 0xe0), ((($n >> 6) & 0x3f) | 0x80),
(($n & 0x3f) | 0x80));
} elsif ($n < 0x110000) {
return pack ("CCCC", (($n >> 18) | 0xf0), ((($n >> 12) & 0x3f) | 0x80),
((($n >> 6) & 0x3f) | 0x80), (($n & 0x3f) | 0x80));
}
return $n;
}
1;
__END__
=head1 NAME
CGI::XML - Perl extension for converting CGI.pm variables to/from XML
=head1 SYNOPSIS
use CGI::XML;
$q = new CGI::XML;
# convert CGI.pm variables to XML
$xml = $q->toXML;
$xml = $q->toXML($root);
# convert XML to CGI.pm variables
$q->toCGI($xml);
=head1 DESCRIPTION
The CGI::XML module converts CGI.pm variables
to XML and vice versa.
B<CGI::XML> is a subclass of B<CGI.pm>, so it reads the CGI
variables just as CGI.pm would.
=head1 METHODS
=item $q = new CGI::XML
=over 4
creates a new instance of CGI::XML. You also have access
to all of the methods in CGI.pm.
=back
=item $q->toXML([$root])
=over 4
where B<$root> is an optional parameter that specifies
the root element. By default, B<toXML> will not return a root
element.
=back
=item $q->toCGI($xml)
=over 4
where B<$xml> is the XML you would like to convert
to CGI.pm parameters. Values in the XML will overwrite any
existing values if they exist.
=back
=head1 NOTE
B<CGI::XML> does not currently handle multiple selections
passed from HTML forms. This will be added in a future release.
=head1 AUTHOR
Jonathan Eisenzopf <eisen@pobox.com>
=head1 CONTRIBUTORS
David Black <dblack@candle.superlink.net>
=head1 SEE ALSO
perl(1), XML::Parser(3).
=cut
|
