package Froody::API::XML;
use strict;
use warnings;
use XML::LibXML;
use Froody::Method;
use Froody::ErrorType;
use Froody::Response::String;
use Froody::Logger;
my $logger = get_logger("froody.api.xml");
use base qw(Froody::API);
use Scalar::Util qw(weaken);
=head1 NAME
Froody::API::XML - Define a Froody API with xml
=head1 SYNOPSIS
package MyAPI;
use base qw{Froody::API::XML};
sub xml {
return q{
<spec>
<methods>
<method name="foo">....</method>
</methods>
</spec>
};
}
1;
=head1 DESCRIPTION
This class is a helper base class for Froody::API. It can parse a standard
format of XML and turn it into a bunch of Froody::Method objects.
=head1 METHODS
=over
=item xml
Subclasses must override this method to provide an XML specification.
=cut
sub xml {
Froody::Error->throw("perl.use", "Please override the abstract method Froody::API::XML::xml()");
}
=item load( xml )
Calls C<load_spec()> with the return value of the C<xml> method.
=cut
sub load {
my $class = shift;
return $class->load_spec($class->xml);
}
=item load_spec($xml_string)
Turns a method spec xml string into an array of
C<Froody::Method> objects.
=cut
sub load_spec {
my ($class, $xml) = @_;
unless ($xml)
{ Froody::Error->throw("perl.methodcall.param", "No xml passed to load_spec!") }
my $parser = $class->parser;
my $doc = UNIVERSAL::isa($xml, 'XML::LibXML::Node') ? $xml
: eval { $parser->parse_string($xml) };
Froody::Error->throw("froody.xml.invalid", "Invalid xml passed: $@")
if $@;
$doc->indexElements;
my $method_node_path = '/spec/methods/method';
my $error_node_path = '/spec/errortypes/errortype';
if ($doc->documentElement->nodeName eq 'rsp') {
$method_node_path = '/rsp'.$method_node_path;
$error_node_path = '/rsp'.$error_node_path;
}
my @methods = map { $class->load_method($_) }
$doc->findnodes($method_node_path)
or Froody::Error->throw('froody.xml.nomethods', "no methods found in spec!");
my @errortypes = map { $class->load_errortype($_) }
$doc->findnodes($error_node_path);
return (@methods, @errortypes);
}
=item load_method($element)
Passed an XML::LibXML::Element that represents a <method>...</method>,
this returns an instance of Froody::Method that represents that method.
=cut
sub load_method {
my ($class, $method_element) = @_;
unless (UNIVERSAL::isa($method_element, 'XML::LibXML::Element')) {
Froody::Error->throw("perl.methodcall.param",
"we were expected to be passed a XML::LibXML::Element!");
}
# work out the name of the element
my $full_name = $method_element->findvalue('./@name')
or Froody::Error->throw("froody.xml",
"Can't find the attribute 'name' for the method definition within "
.$method_element->toString);
# create a new method
my $method = Froody::Method->new()
->full_name($full_name)
->arguments($class->_arguments($method_element))
->errors($class->_errors($method_element))
->needslogin($class->_needslogin($method_element));
my ($response_element) = $class->_extract_response($method_element, $full_name);
if ($response_element) {
my ($structure, $example_data) = $class->_extract_structure($response_element);
$method->structure($structure);
my $example = Froody::Response::String->new;
$example->set_string("<rsp status='ok'>".$response_element->toString(1)."</rsp>");
$example->structure($method);
$method->example_response($example);
weaken($example->{structure});
} else {
$method->structure({})
}
my $desc = $method_element->findvalue("./description");
$desc =~ s/^\s+//;
$desc =~ s/\s+$//;
$method->description($desc);
return $method;
}
# okay, we're parsing this
# <arguments>
# <argument name="sex">male or female</argument>
# <argument name="hair" optional="1">optionally list hair color</argument>
# <argument name="hair" optional="1">optionally list hair color</argument>
# </arguments>
sub _arguments {
my ($class, $method_element) = @_;
# get all of the argument elements
my @argument_elements = $method_element->findnodes('./arguments/argument');
# convert them into a big old hash
my %arguments;
foreach my $argument_element (@argument_elements)
{
# pull our the attributes
my $name = $argument_element->findvalue('./@name');
my $optional = $argument_element->findvalue('./@optional') || 0;
my $type = $argument_element->findvalue('./@type') || 'text';
# Ugh. Track this down.
$type = 'text' if $type eq 'scalar';
my @types = split /,/, $type;
# extract the contents of <argument>...</argument> as the description
my $description = $argument_element->findvalue('./text()');
$arguments{$name}{multiple} = 1 unless $type eq 'text';
$arguments{$name}{optional} = $optional;
$arguments{$name}{doc} = $description;
$arguments{$name}{type} = \@types;
# XXX: compose the list in Froody::Argument
require Froody::Argument;
my @TYPES = keys %{ Froody::Argument->_types() };
push @TYPES, 'remaining'; # a special case.
for my $_type (@types) {
Froody::Error->throw("froody.api.unsupportedtype", "The type '$_type' is unsupported")
unless grep { $_type eq $_ } @TYPES;
if ($_type eq 'remaining') {
$arguments{$name}{optional} = 1;
}
}
}
return \%arguments;
}
# get the response element from the XML
sub _extract_response {
my ($class, $dom, $full_name) = @_;
my ($structure) = $dom->findnodes("./response");
return unless $structure; # we don't *have* to have a structure
return $class->_extract_children($structure, $full_name);
}
sub _extract_children {
my ($class, $structure, $full_name) = @_;
my @child_nodes = grep { $_->isa('XML::LibXML::Element') } $structure->childNodes;
unless (@child_nodes) {
my $structure_xml = '<rsp>' . $structure->textContent . '</rsp>';
my $structure_doc = $class->parser->parse_string($structure_xml);
@child_nodes = grep { $_->isa('XML::LibXML::Element') } $structure_doc->documentElement->childNodes();
}
Froody::Error->throw("froody.xml", "Too many top level elements in the structure for $full_name")
unless @child_nodes <= 1;
return @child_nodes;
}
sub _extract_structure {
my ($class, $dom) = @_;
return unless $dom;
return _xml_to_structure_hash($dom);
}
sub _text_only {
my $entry = shift;
return if exists $entry->{attr};
return if exists $entry->{elts};
return if exists $entry->{multi};
return 1 if $entry->{text};
}
sub _xml_to_structure_hash {
my $node = shift;
# Each element is explained in the top level results hash.
my $spec = {};
my $name = $node->nodeName;
$spec->{''}{elts}{ $name }++;
# Create the specification using a breadth-first iteration
my @list = ( $node, $name );
my %visited;
for(my $i = 0; $i < @list; $i += 2 ) {
my ($node, $path) = @list[$i..$i+1];
# Add all non text child nodes to the end of the list.
my $name = $node->nodeName;
my @elements;
my $has_non_text_nodes = 0;
my $child_spec = $spec->{$path}{elts} ||= {};
my $prefix = $path ? "$path/" : "";
for my $child ($node->childNodes) {
# Check if there's any text in the element we're looking at
if ($child->isa('XML::LibXML::Text')) {
next;
} else {
$has_non_text_nodes = 1;
}
my $nn = $child->nodeName;
# Mark each child element seen as being a child element of our spec list
$child_spec->{$nn}++ unless $visited{$path};
push @list, ($child, $prefix.$nn);
}
# We've been here. Move along.
if ($visited{$path}++) {
$spec->{$path}{multi}++;
next;
}
# Gather all attributes
foreach ($node->attributes) {
my $aname = $_->nodeName;
$spec->{$path}{attr}{$aname}++;
}
my $is_nonempty_root = !length($prefix) && $spec->{$path};
$spec->{$path}{text} = 1
unless $has_non_text_nodes || $is_nonempty_root;
}
_flatten_specification($spec);
# TODO: Flatten the text nodes.
return $spec;
# TODO: Handling types is a Service level detail.
}
sub _flatten_specification {
my $spec = shift;
# Flatten element and attribute names, and make
# sure that the multiplicity flag is correctly set.
foreach my $key (keys %$spec) {
# Flatten the list of names
my $prefix = $key;
$prefix .= $prefix ? '/' : '';
foreach my $name (qw{attr elts}) {
my @names = sort keys %{ $spec->{$key}{$name} };
if ($name eq 'elts') {
for my $cpath (@names) {
$spec->{$prefix.$cpath}{multi} = ($spec->{$key}{$name}{$cpath} > 1)
? 1
: 0
;
}
}
$spec->{$key}{$name} = \@names;
}
$spec->{$key}{multi} ||= 0;
$spec->{$key}{text} ||= 0;
}
}
sub _errors {
my ($class, $method_element) = @_;
# extract out the error methods
my @error_elements = $method_element->findnodes('./errors/error');
# build them into a hash
my %errors;
foreach my $error_element (@error_elements) {
# extract the attributes
my $code = $error_element->findvalue('./@code') || '';
my $message = $error_element->findvalue('./@message');
# convert them into a a hash that has the error number as the
# key, and contains a hashref with a message and description in it
my $description = $error_element->textContent;
$description =~ s/^\s+//;
$description =~ s/\s+$//;
$errors{ $code } = {
message => $message || '',
description => $description
};
}
return \%errors;
}
# returns true if the method element passed needs a login, i.e. has
# an attribute <method needslogin="1">. Returns false in all other cases
sub _needslogin {
my ($class, $method_element) = @_;
return $method_element->findvalue('./@needslogin') || 0;
}
=item load_errortype
Passed an XML::LibXML::Element that represents an <errortype>...</errortype>,
this returns an instance of Froody::ErrorType that represents that error type.
=cut
sub load_errortype {
my ($class, $et_element) = @_;
unless (UNIVERSAL::isa($et_element, 'XML::LibXML::Element')) {
Froody::Error->throw("perl.methodcall.param",
"we were expected to be passed a XML::LibXML::Element!");
}
# work out the name of the element
my $code = $et_element->findvalue('./@code') || '';
Carp::cluck "no code in ".$et_element->toString(1) unless defined $code;
my $et = Froody::ErrorType->new;
$et->name($code);
unless (grep { !UNIVERSAL::isa($_, "XML::LibXML::Text") } $et_element->childNodes) {
my $et_str = $et_element->textContent;
local $@;
eval {
my $new_et = $class->parser()->parse_string(qq{<errortype code="$code">$et_str</errortype>});
$et_element = $new_et->documentElement();
};
if ($@) {
$logger->warn($@);
}
}
my ($spec, $example_data) = $class->_extract_structure($et_element);
foreach (keys %$spec) {
my $val = delete $spec->{$_};
s{^errortype}{err}; # 'errortype's are really 'err's
$spec->{$_} = $val;
}
$spec->{''}{elts} = [ 'err' ];
# enforce msg (code is already in here!)
push @{ $spec->{err}{attr} }, "msg";
$et->structure($spec);
my $example = Froody::Response::String->new;
$et_element->setNodeName("err");
my $text = "<rsp status='fail'>".$et_element->toString(1)."</rsp>";
$example->set_bytes($text);
$example->structure($et);
weaken($example->{structure});
$et->example_response($example);
return $et;
}
=item parser
This method returns the parser we're using. It's an instance of XML::LibXML.
=cut
{
my $parser = XML::LibXML->new;
$parser->expand_entities(1);
$parser->keep_blanks(0);
sub parser { $parser }
}
=back
=head1 SPEC OVERVIEW
The specs handed to C<register_spec()> should be on this form:
<spec>
<methods>
<method ...> </method>
...
</methods>
<errortypes>
<errortype code="error.subtype">...</errortype>
...
</errortypes>
</spec>
=head2 <method>
Each method take this form:
<method name="foo.bar.quux" needslogin="1">
<description>Very short description of method's basic behaviour</description>
<keywords>...</keywords>
<arguments>...</arguments>
<response>...</response>
<errors>...</errors>
</method>
=over
=item <keywords>
A space-separated list of keywords of the concepts touched upon
by this method. As an example, clockthat.events.addTags would
have "events tags" as its keywords. This way we can easily list
all methods that deals with tags, no matter where in the
namespace they live.
=item <arguments>
Each argument has two mandatory attributes: "name" and
"optional". The name is the name of the argument, and optional is
"1" if the argument is optional, or "0" otherwise.
<argument name="api_key" optional="0">A non-optional argument</argument>
<argument name="quux_id" optional="1">An optional argument</argument>
You can specify that your argument should accept a comma-separated list of values:
<argument name="array_val" type="csv" optional="1">Don't
worry about description for argument type deduction now.</argument>
=item <response>
A well-formed XML fragment (excluding the <rsp> tag) describing
by example how this method will respond. This section can be
empty if the method does not return. When a list of elements are
expected, your example response B<must contain at least two>
elements of the same name.
<photoset page="1" per_page="10" pages="9" total="83">
<name>beyond repair</name>
<photo photo_id="1123" />
<photo photo_id="2345" />
</photos>
Currently we accept both a well-formed XML fragment and an
entity-encoded string that can be decoded to an XML fragment.
=item <errors>
A list of errors of this form:
<error code="1" message="Short message">Longer error message</error>
=back
=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>
=cut
1;