view release on metacpan or  search on metacpan

lib/Apache/Voodoo/Soap.pm  view on Meta::CPAN

package Apache::Voodoo::Soap;

$VERSION = "3.0200";

use strict;
use warnings;

use SOAP::Transport::HTTP;
use Data::Structure::Util qw(unbless);


# FIXME: Hack to prefer my extended version of Pod::WSDL over the
# one on CPAN.  This will need to stay in place until either the
# author of Pod::WSDL replys or I release my own version.
my $PWSDL;
BEGIN {
	eval {
		require Pod::WSDL2;
		$PWSDL = 'Pod::WSDL2';
	};
	if ($@) {
		require Pod::WSDL;
		$PWSDL = 'Pod::WSDL';
	}
}

use MIME::Entity;

use Apache::Voodoo::MP;
use Apache::Voodoo::Engine;
use Apache::Voodoo::Exception;
use Exception::Class::DBI;

use Data::Dumper;

sub new {
	my $class = shift;

	my $self = {};
	bless $self,$class;

	$self->{'mp'}     = Apache::Voodoo::MP->new();
	$self->{'engine'} = Apache::Voodoo::Engine->new('mp' => $self->{'mp'});

	$self->{'soap'} = SOAP::Transport::HTTP::Apache->new();
	$self->{'soap'}->on_dispatch(
		sub {
			$self->{'run'}->{'method'} = $_[0]->dataof->name;
			return ("Apache/Voodoo/Soap","handle_request");
		}
	);

	$self->{'soap'}->dispatch_to($self,"handle_request");

	return $self;
}

sub handler {
	my $self = shift;
	my $r    = shift;

	$self->{'mp'}->set_request($r);
	$self->{'engine'}->set_request($r);

	eval {
		$self->{'engine'}->init_app();
	};
	if ($@) {
		warn "$@";
		return $self->{'mp'}->server_error();
	}

	my $return;
	if ($self->{'mp'}->is_get() && $r->unparsed_uri =~ /\?wsdl$/) {
		my $uri = $self->{'mp'}->uri();

		$uri =~ s/^\///;
		$uri =~ s/\/$//;

		# FIXME hack.  Shouldn't be looking in there to get this
		unless ($self->{'engine'}->_app->{'controllers'}->{$uri}) {
			return $self->{'mp'}->not_found();
		}

		my $m = ref($self->{'engine'}->_app->{'controllers'}->{$uri});
		if ($m eq "Apache::Voodoo::Loader::Dynamic") {
			$m = ref($self->{'engine'}->_app->{'controllers'}->{$uri}->{'object'});
		}
		# FIXME here ends the hackery

		my $wsdl;
		eval {
			# FIXME the other part of the Pod::WSDL version hack
			$wsdl = $PWSDL->new(