package Froody::Reflection;
use base qw(Froody::Implementation);
use strict;
use warnings;
use Froody::Response::XML;
use Froody::Response::Terse;
use Params::Validate qw( :all );
our $IMPLEMENTATION_SUPERCLASS = 1;
sub implements { "Froody::API::Reflection" => 'froody.reflection.*' }
use Froody::Logger;
our $logger = get_logger("froody.reflection");
=head1 NAME
Froody::Reflection
=head1 DESCRIPTION
=head2 Functions
=over
=item getMethodInfo
Returns information for a given froody API method.
=cut
sub getMethodInfo
{
my ($self, $args, $metadata) = @_;
my $method_name = $args->{method_name};
my $method = $metadata->{dispatcher}->get_method($method_name);
return $self->_methodInfo($metadata, $method);
}
sub _methodInfo {
my ($self, $metadata, $method) = @_;
my $calling_method = $metadata->{dispatcher}->get_method('froody.reflection.getMethodInfo');
my $response = {
name => $method->full_name,
};
$response->{description} = $method->description
if $method->description;
$response->{needslogin} = $method->needslogin || 0;
my $arg_info;
{
my $arguments = $method->arguments;
for my $k (keys %$arguments) {
my $v = $arguments->{$k};
my $argdata = {
name => $k,
-text => $v->{doc},
optional => $v->{optional},
type => join(',',@{$v->{type}}),
};
push @$arg_info, $argdata;
}
}
$response->{arguments} = { argument => $arg_info } if $arg_info && @$arg_info;
my $method_errors = $method->errors;
my $errors = [ map {
+{
code => $_,
message => $method_errors->{$_}{message},
-text => $method_errors->{$_}{description}
} } keys %$method_errors ];
$response->{errors} = { error => $errors } if @$errors;
$response->{response} = {} if $method->example_response;
my $rsp = Froody::Response::Terse->new();
$rsp->content($response);
$rsp->structure( $calling_method );
$rsp = $rsp->as_xml;
# find the empty ... and shove in our
# child nodes. This *must* be encoded in what we are (which is utf-8)
if ($method->example_response) {
my ($example_element) = $rsp->xml->findnodes("//response");
$example_element->appendText( _response_to_xml($method)->toString );
}
return $rsp->as_terse;
}
sub _response_to_xml {
my $structure = shift;
# convert whatever we have to XML -- example
# responses are always stored in terse form (for now)
my $example = $structure->example_response->as_xml;
# grab the thingy inside the rsp and return it
my ($response) = $example->xml->findnodes("/rsp/*");
return $response->cloneNode(1);
}
=item getMethods
Returns a list of methods.
=cut
sub getMethods
{
my ($self, $args, $metadata) = @_;
my $client = $metadata->{dispatcher};
my $repo = $metadata->{dispatcher}->repository;
my %methods = map { $_ => 1 }
map { $_->full_name }
$repo->get_methods;
return {
method => [ sort map { $_ } keys %methods],
};
}
=item getErrorTypes
Returns a list of error types.
=cut
sub getErrorTypes
{
my ($self, $args, $metadata) = @_;
return {
errortype => [ sort
grep { $_ }
map { $_->full_name }
$metadata->{dispatcher}->repository->get_errortypes ],
};
}
=item getErrorTypeInfo
Returns the error type information
=cut
sub getErrorTypeInfo
{
my ($self, $args, $metadata) = @_;
my $repo = $metadata->{dispatcher}->repository;
my $et = $repo->get_errortype($args->{code});
return _errortype_hash($et->example_response);
}
=item getSpecification($args, $metadata)
Returns a terse representation of all public registered methods and error types
within the repository indicated in $metadata
=cut
sub getSpecification {
my ($self, $args, $metadata) = @_;
my $repo = $metadata->{dispatcher}->repository;
my $methods = [ map { $self->_methodInfo($metadata, $_->[0])->as_terse->content }
sort { $a->[1] cmp $b->[1] }
map { [$_, $_->full_name ] }
$repo->get_methods ];
my $errortypes = [
map { _errortype_hash($_->[0]->example_response) }
sort { $a->[1] cmp $b->[1] }
grep { $_->[1] } # Skip the default structure
map { [ $_, $_->full_name ] }
$repo->get_errortypes
];
my $ret = {
methods => { method => $methods },
errortypes => { errortype => $errortypes },
};
return $ret;
}
sub _errortype_hash {
my $example = shift;
my $xml = $example->as_xml->xml;
my $ret = {
code => $xml->findvalue('/rsp/err/@code'),
-text => join('', map { $_->toString } ($xml->findnodes('/rsp/err/*')))
};
return $ret;
}
=back
=head1 BUGS
None known.
Please report any bugs you find via the CPAN RT system.
L
=head1 AUTHOR
Copyright Fotango 2005. All rights reserved.
Please see the main L 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
=cut
1;