SOAP::Message - Really simple SOAP

 use SOAP::Message;

 ## Procedural interface

 # Make SOAP

 my $message = SOAP::Message::create(

	version    => '1.1',
	body       => $xml_data,

 );

 # Receive SOAP

 my ( $header,$body ) = SOAP::Message::parse( $incoming );

 ## OO interface

 # Set some defaults up...

 my $object = SOAP::Message->new( version => '1.2', prefix => 'SOAP' );

 # Then just continue as normal...

 my $message = $object->create( body => $body, header => $header );

 # And for convenience...

 my ( $header, $body ) = $object->parse( $incoming );

 http://schemas.xmlsoap.org/soap/envelope/ - 1.1 
 http://www.w3.org/2003/05/soap-envelope - 1.2 

package SOAP::Message;

	require 5;
	use strict;

	use vars qw($VERSION);
	use XML::XPath;
	use XML::XPath::XMLParser;

	$VERSION = '0.01';

	sub create {
	
		my $self = shift;
		
		my %options;

	# Check here to see if we're being called as OO. If the first argument
	# is a ref, assume it's an object, and load up the defaults, then any
	# arguments to this function. If it's not, stick it back on the list
	# passed to the function, and use that list as our options.
		
		if ( ref( $self ) ) {
		
			%options = (%$self, @_);
		
		} else {
		
			%options = ($self, @_);
		
		}
	
	# Default the prefix (  <prefix:Envelope> )
	
		my $prefix = $options{'prefix'} || 'env';
		$options{'header'} = '' unless $options{'header'};
		$options{'body'} = '' unless $options{'body'};

	# Work out the correct namespace
		
		$options{'version'} = '1.1' unless $options{'version'};
		
		my $namespace = "http://schemas.xmlsoap.org/soap/envelope/";
		
		if ( $options{'version'} eq '1.2' ) {
		
			$namespace = "http://www.w3.org/2003/05/soap-envelope";
		
		}

	# That's all folks!

		return qq!<?xml version='1.0'?>
<$prefix:Envelope xmlns:$prefix = "$namespace">
		<$prefix:Header>! . $options{'header'} . qq!</$prefix:Header>
		<$prefix:Body>! . $options{'body'} . qq!</$prefix:Body>	
</$prefix:Envelope>
!;
	
	}

	sub parse {

		my $data = shift;
	
	# This method isn't enhanced by OO, so if the first argument was a ref,
	# silently drop it and grab the next.
	
		$data = shift if ref( $data ); # Handle OO calls
	
	# Open up our parser...
	
		my $xp = XML::XPath->new( xml => $data );
	
	# This means that when the namespace is set to X, we can assume the prefix
	# is going to be Y... This simplifies our XPath expressions a little.
	
		$xp->set_namespace( ver1 => 'http://schemas.xmlsoap.org/soap/envelope/');
		$xp->set_namespace( ver2 => 'http://www.w3.org/2003/05/soap-envelope' ) ;

	# Grab the Header and the Body

		my $header_nodes = 
			$xp->find('/ver1:Envelope/ver1:Header/* | /ver2:Envelope/ver2:Header/*');
		
		my $body_nodes 
			= $xp->find('/ver1:Envelope/ver1:Body/* | /ver2:Envelope/ver2:Body/*');

		my $header = '';
		my $body = '';
	
	# Serialize them
		
		for ($header_nodes->get_nodelist) { $header .= $_->toString }
		for ($body_nodes->get_nodelist) { $body .= $_->toString }

	# That's all done

		return( $body, $header );

	}

	sub xml_parse {

  # This method isn't enhanced by OO, so if the first argument was a ref,
  # silently drop it and grab the next.
 
 		my $data = shift;
    $data = shift if ref( $data ); # Handle OO calls
 
  # Open up our parser...
 
    my $xp = XML::XPath->new( xml => $data );
 
  # This means that when the namespace is set to X, we can assume the prefix
  # is going to be Y... This simplifies our XPath expressions a little.
 
    $xp->set_namespace( ver1 => 'http://schemas.xmlsoap.org/soap/envelope/');
    $xp->set_namespace( ver2 => 'http://www.w3.org/2003/05/soap-envelope' ) ;

  # Grab the Header and the Body

    my $header_nodes =
      $xp->find('/ver1:Envelope/ver1:Header/* | /ver2:Envelope/ver2:Header/*');
   
    my $body_nodes
      = $xp->find('/ver1:Envelope/ver1:Body/* | /ver2:Envelope/ver2:Body/*');

		return ($header_nodes, $body_nodes);

	}

	sub new {
	
		my $class = shift;
	
		my $self = { @_ };
	
		bless $self, $class;
		
		return $self;
	
	}

1;