From Code to Community: Sponsoring The Perl and Raku Conference 2025 Learn more

FOTANGO / Froody-42.034 / lib / Froody / Response / XML.pm 

            

              
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
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158

              
package Froody::Response::XML;
use base qw(Froody::Response);
use warnings;
use strict;
use Encode;
use Scalar::Util qw(blessed);
use XML::LibXML;
=head1 NAME
Froody::Response::XML - create a response from a XML::LibXML document
=head1 SYNOPSIS
  my $response = Froody::Response::XML->new()
                                      ->structure($froody_method)
                                      ->xml($xml_doc);
  print $response->render;
=head1 DESCRIPTION
This is a concrete implementation of Froody::Response.  It takes its input
from an XML::LibXML::Document.
  use XML::LibXML;
  my $xml_doc = XML::LibXML::Document->new( "1.0", "utf-8" );
   
  # create the rsp
  my $rsp = $xml_doc->createElement("rsp");
  $rsp->setAttribute("stat", "ok");
  $xml_doc->setDocumentElement($rsp);
   
  # add the child node foo
  my $foo = $xml_doc->createElement("foo");
  $foo->appendText("bar");  # note, must pass bytes in the above encoding
  $rsp->appendChild($foo);
   
  my $rsp = Froody::Response::XML->new()
                                 ->structure($froody_method)
                                 ->xml($xml_doc);
You can get and set the current XML document by usinc C<xml>.  We only hold
a reference to the data so you can modify the XML after you've assigned it
to the response and it'll still effect that response.  This means the
above could be re-ordered as:
  use XML::LibXML;
  my $xml_doc = XML::LibXML::Document->new( "1.0", "utf-8" );
   
  my $rsp = Froody::Response::XML->new()
                                 ->structure($froody_method)
                                 ->xml($xml_doc);
   
  # create the rsp
  my $rsp = $xml_doc->createElement("rsp");
  $rsp->setAttribute("stat", "ok");
  $xml_doc->setDocumentElement($rsp);
   
  # add the child node foo
  my $foo = $xml_doc->createElement("foo");
  $foo->appendText("bar");  # note, must pass bytes in the above encoding
  $rsp->appendChild($foo);
And it'll work just as fine.  This does however mean you should be careful
about re-using XML::LibXML objects between responses.
=cut
# simple get/set accessor, returns self on set and checks what you're setting
# xml is documented
sub xml
{
   my $self = shift;
   return $self->{xml} unless @_;
   unless (blessed($_[0]) && $_[0]->isa("XML::LibXML::Document"))
    { Froody::Error->throw("perl.methodcall.param", 
                           "xml only accepts XML::LibXML::Document instances") }
   $self->{xml} = shift;
   return $self;
}
sub render
{
  my $self = shift;
  my $string = $self->xml->toString(@_);
  my $encoded = Encode::encode("utf-8", $string);
  return $encoded;
}
# status is documented
sub status
{
  my $self = shift;
  $self->xml->findvalue('/rsp/@stat');
}
=head2 Converting other Responses to Froody::Response::XML objects
Once you've loaded this class you can automatically convert other
Froody::Response class instances to Froody::Response::XML objects with
the C<as_xml> method.
  use Froody::Response::String;
  use Froody::Response::XML;
  my $string = Froody::Response::String
      ->new()
      ->structure($froody_method)
      ->set_bytes($bytes);
      ->as_xml;
  print ref($string);  # prints "Froody::Response::XML"
=cut
# rendering this class
# as_xml is documented
sub as_xml { return $_[0] }
sub Froody::Response::as_xml
{
  my $self = shift;
   
  my $parser = XML::LibXML->new();
  my $rendered = $self->render
    or Froody::Error->throw('froody.invoke.badresponse', "No XML returned from call");
  my $doc = eval { $parser->parse_string($rendered) } or die "$rendered";
   
  my $xml = Froody::Response::XML->new();
  $xml->xml($doc);
  $xml->structure($self->structure) if $self->structure;
  return $xml;
}
=head1 BUGS
None known.
Please report any bugs you find via the CPAN RT system.
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Froody>
=head1 AUTHOR
Copyright Fotango 2005.  All rights reserved.
Please see the main L<Froody> documentation for details of who has worked
on this project.
This module is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.
=head1 SEE ALSO
L<Froody>, L<Froody::Response>
=cut
1;