view release on metacpan or  search on metacpan

lib/SOAP/Packager.pm  view on Meta::CPAN

}

sub new {
    my($class)  = shift;
    my(%params) = @_;
    bless {
        "_parts"         => [ ],
        "_parser"        => undef,
        "_persist_parts" => 0,
    }, $class;
}

sub is_supported_part {
  my $self = shift;
  return $SUPPORTED_TYPES->{ref $_[0]};
}

sub parts {
  my $self = shift;
  if (@_) {
    $self->{'_parts'} = shift;
  }
  return $self->{'_parts'};
}

# This is a static method that helps find the right Packager
sub find_packager {
   # TODO - Input:
   #        * the mimetype of the data to be decoded raw data that needs
   #        * the data to be decoded
   #        Returns:
   #        * the proper SOAP::Packager instance
}

sub push_part {
   my $self = shift;
   my ($part) = @_;
   push @{$self->{'_parts'}}, $part;
}

sub package {
    # do nothing
    die "SOAP::Packager::package() must be implemented";
}

sub unpackage {
   my $self = shift;
   $self->{'_parts'} = [] if !$self->persist_parts; # experimental
}

# ======================================================================

package SOAP::Packager::MIME;

use strict;
use vars qw(@ISA);
@ISA = qw(SOAP::Packager);

sub BEGIN {
  no strict 'refs';
  for my $method ( qw(transfer_encoding env_id env_location) ) {
    my $field = '_' . $method;
    *$method = sub {
      my $self = shift;
      if (@_) { $self->{$field} = shift; return $self }
      return $self->{$field};
    }
  }
}

sub new {
    my ($classname) = @_;
    my $self = SOAP::Packager::new(@_);
    $self->{'_content_encoding'} = '8bit';
    $self->{'_env_id'}           = '<main_envelope>';
    $self->{'_env_location'}     = '/main_envelope';
    bless $self, $classname;
    $SOAP::Packager::SUPPORTED_TYPES->{"MIME::Entity"} = 1;
    return $self;
}

sub initialize_parser {
  my $self = shift;
  eval "require MIME::Parser;";
  die "Could not find MIME::Parser - is MIME::Tools installed? Aborting." if $@;
  $self->{'_parser'} = MIME::Parser->new;
  $self->{'_parser'}->output_to_core('ALL');
  $self->{'_parser'}->tmp_to_core(1);
  $self->{'_parser'}->ignore_errors(1);
  $self->{'_parser'}->extract_nested_messages(0);
}

sub generate_random_string {
  my ($self,$len) = @_;
  my @chars=('a'..'z','A'..'Z','0'..'9','_');
  my $random_string;
  foreach (1..$len) {
    $random_string .= $chars[rand @chars];
  }
  return $random_string;
}

sub get_multipart_id {
  my ($id) = shift;
  ($id || '') =~ /^<?([^>]+)>?$/; $1 || '';
}

sub package {
   my $self = shift;
   my ($envelope,$context) = @_;
   return $envelope if (!$self->parts); # if there are no parts,
                                        # then there is nothing to do
   require MIME::Entity;
   local $MIME::Entity::BOUNDARY_DELIMITER = "\r\n";
   my $top = MIME::Entity->build('Type'     => "Multipart/Related");
   my $soapversion = defined($context) ? $context->soapversion : '1.1';
   $top->attach('Type'                      => $soapversion == 1.1 ? "text/xml" : "application/soap+xml",
                'Content-Transfer-Encoding' => $self->transfer_encoding(),
                'Content-Location'          => $self->env_location(),
                'Content-ID'                => $self->env_id(),
                'Data'                      => $envelope );
   # consume the attachments that come in as input by 'shift'ing
   no strict 'refs';
   while (my $part = shift(@{$self->parts})) {
      $top->add_part($part);
   }
   # determine MIME boundary
   my $boundary = $top->head->multipart_boundary;
   $self->headers_http({ 'Content-Type' => 'Multipart/Related; type="text/xml"; start="<main_envelope>"; boundary="'.$boundary.'"'});
   return $top->stringify_body;
}

sub unpackage {
  my $self = shift;
  my ($raw_input,$context) = @_;
  $self->SUPER::unpackage();

  # Parse the raw input into a MIME::Entity structure.
  #   - fail if the raw_input is not MIME formatted
  $self->initialize_parser() if !defined($self->parser);
  my $entity = eval { $self->parser->parse_data($raw_input) }
    or die "Something wrong with MIME message: @{[$@ || $self->parser->last_error]}\n";

  my $env = undef;
  # major memory bloat below! TODO - fix!
  if (lc($entity->head->mime_type) eq 'multipart/form-data') {
    $env = $self->process_form_data($entity);
  } elsif (lc($entity->head->mime_type) eq 'multipart/related') {
    $env = $self->process_related($entity);
  } elsif (lc($entity->head->mime_type) eq 'text/xml') {
    # I don't think this ever gets called.
    # warn "I am somewhere in the SOAP::Packager::MIME code I didn't know I would be in!";
    $env = $entity->bodyhandle->as_string;
  } else {
    die "Can't handle MIME messsage with specified type (@{[$entity->head->mime_type]})\n";
  }

  # return the envelope
  if ($env) {
    return $env;
  } elsif ($entity->bodyhandle->as_string) {
    return $entity->bodyhandle->as_string;
  } else {
    die "No content in MIME message\n";
  }
}

sub process_form_data {
  my ($self, $entity) = @_;
  my $env = undef;
  foreach my $part ($entity->parts) {
    my $name = $part->head->mime_attr('content-disposition.name');
    $name eq 'payload' ?
      $env = $part->bodyhandle->as_string
      : $self->push_part($part);
  }
  return $env;
}

lib/SOAP/Packager.pm  view on Meta::CPAN

=item parts

Contains an array of parts. The contents of this array and their types are completely
dependent upon the Packager being used. For example, when using MIME, the content
of this array is MIME::Entity's.

=item push_part

Adds a part to set of parts managed by the current instance of SOAP::Packager.

=item parser

Returns the parser used to parse attachments out of a data stream.

=item headers_http

This is a hook into the HTTP layer. It provides a way for a packager to add and/or modify
HTTP headers in a request/response. For example, most packaging layers will need to
override the Content-Type (e.g. multipart/related, or application/dime).

=back

=head1 ABSTRACT METHODS

If you wish to implement your own SOAP::Packager, then the methods below must be
implemented by you according to the prescribed input and output requirements.

=over

=item package()

The C<package> subroutine takes as input the SOAP envelope in string/SCALAR form.
This will serve as the content of the root part. The packager then encapsulates the
envelope with the parts contained within C<parts> and returns the properly
encapsulated envelope in string/SCALAR form.

=item unpackage()

The C<unpackage> subroutines takes as input raw data that needs to be parsed into
a set of parts. It is responsible for extracting the envelope from the input, and
populating C<parts> with an ARRAY of parts extracted from the input. It then returns
the SOAP Envelope in string/SCALAR form so that SOAP::Lite can parse it.

=back

=head1 SUPPORTED PACKAGING FORMATS

=head2 SOAP::Packager::MIME

C<SOAP::Packager::MIME> utilizes L<MIME::Tools> to provides the ability to send
and receive Multipart/Related and Multipart/Form-Data formatted requests and
responses.

=head3 MIME METHODS

The following methods are used when composing a MIME formatted message.

=over

=item transfer_encoding

The value of the root part's Content-Transfer-Encoding MIME Header. Default is: 8bit.

=item env_id

The value of the root part's Content-Id MIME Header. Default is: <main_envelope>.

=item env_location

The value of the root part's Content-Location MIME Header. Default is: /main_envelope.

=item env_type

The value of the root part's Content-Type MIME Header. Default is: text/xml.

=back

=head3 OPTIMIZING THE MIME PARSER

The use of attachments can often result in a heavy drain on system resources depending
upon how your MIME parser is configured. For example, you can instruct the parser to
store attachments in memory, or to use temp files. Using one of the other can affect
performance, disk utilization, and/or reliability. Therefore you should consult the
following URL for optimization techniques and trade-offs:

http://search.cpan.org/dist/MIME-tools/lib/MIME/Parser.pm#OPTIMIZING_YOUR_PARSER

To modify the parser's configuration options consult the following code sample,
which incidentally shows how to minimize memory utilization:

  my $packager = SOAP::Packager::MIME->new;
  # $packager->parser->decode_headers(1); # no difference
  # $packager->parser->extract_nested_messages(1); # no difference
  $packager->parser->output_to_core(0); # much less memory
  $packager->parser->tmp_to_core(0); # much less memory
  $packager->parser->tmp_recycling(0); # promotes faster garbage collection
  $packager->parser->use_inner_files(1); # no difference
  my $client = SOAP::Lite->uri($NS)->proxy($URL)->packager($packager);
  $client->someMethod();

=head3 CLIENT SIDE EXAMPLE

The following code sample shows how to use attachments within the context of a
SOAP::Lite client.

  #!/usr/bin/perl
  use SOAP::Lite;
  use MIME::Entity;
  my $ent = build MIME::Entity
    Type        => "text/plain",
    Path        => "attachment.txt",
    Filename    => "attachment.txt",
    Disposition => "attachment";
  my $NS = "urn:Majordojo:TemperatureService";
  my $HOST = "http://localhost/cgi-bin/soaplite.cgi";
  my $client = SOAP::Lite
    ->packager(SOAP::Packager::MIME->new)
    ->parts([ $ent ])
    ->uri($NS)
    ->proxy($HOST);