SOAP::Lite::Packager - this class is an abstract class which allows for multiple types of packaging agents such as MIME and DIME.

  my $packager = SOAP::Lite::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();

  #!/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";
  $NS = "urn:Majordojo:TemperatureService";
  $HOST = "http://localhost/cgi-bin/soaplite.cgi";
  my $client = SOAP::Lite
    ->packager(SOAP::Lite::Packager::MIME->new)
    ->parts([ $ent ])
    ->uri($NS)
    ->proxy($HOST);
  $response = $client->c2f(SOAP::Data->name("temperature" => '100'));
  print $response->valueof('//c2fResponse/foo');

  #!/usr/bin/perl -w
  use SOAP::Transport::HTTP;
  use MIME::Entity;
  SOAP::Transport::HTTP::CGI
    ->packager(SOAP::Lite::Packager::MIME->new)
    ->dispatch_with({'urn:Majordojo:TemperatureService' => 'TemperatureService'})
    ->handle;

  BEGIN {
    package TemperatureService;
    use vars qw(@ISA);
    @ISA = qw(Exporter SOAP::Server::Parameters);
    use SOAP::Lite;
    sub c2f {
      my $self = shift;
      my $envelope = pop;
      my $temp = $envelope->dataof("//c2f/temperature");
      use MIME::Entity;
      my $ent = build MIME::Entity
        Type        => "text/plain",
        Path        => "printenv",
        Filename    => "printenv",
        Disposition => "attachment";
      # read attachments
      foreach my $part (@{$envelope->parts}) {
        print STDERR "soaplite.cgi: attachment found! (".ref($part).")\n";
        print STDERR "soaplite.cgi: contents => ".$part->stringify."\n";
      }
      # send attachments
      return SOAP::Data->name('convertedTemp' => (((9/5)*($temp->value)) + 32)),
        $ent;
    }
  }

# ======================================================================
#
# Copyright (C) 2000-2004 Paul Kulchenko (paulclinger@yahoo.com)
# SOAP::Lite is free software; you can redistribute it
# and/or modify it under the same terms as Perl itself.
#
# $Id: Packager.pm 372 2010-04-29 18:32:31Z kutterma $
#
# ======================================================================

package SOAP::Lite::Packager;

use strict;
use vars;

use vars qw($SUPPORTED_TYPES);
$SUPPORTED_TYPES = { };

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

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::Lite::Packager instance
}

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

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

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

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

package SOAP::Lite::Packager::MIME;

use strict;
use vars qw(@ISA);
@ISA = qw(SOAP::Lite::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::Lite::Packager::new(@_);
    $self->{'_content_encoding'} = '8bit';
    $self->{'_env_id'}           = '<main_envelope>';
    $self->{'_env_location'}     = '/main_envelope';
    bless $self, $classname;
    $SOAP::Lite::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);
}

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::Lite::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;
}

sub process_related {
    my $self = shift;
    my ($entity) = @_;
    die "Multipart MIME messages MUST declare Multipart/Related content-type"
        if ($entity->head->mime_attr('content-type') !~ /^multipart\/related/i);
    # As it turns out, the Content-ID and start parameters are optional
    # according to the MIME and SOAP specs. In the event that the head cannot
    # be found, the head/root entity is used as a starting point.
    my $start = get_multipart_id($entity->head->mime_attr('content-type.start'));
    if (!defined($start) || $start eq "") {
        $start = $self->generate_random_string(10);
        $entity->parts(0)->head->add('content-id',$start);
    }
    my $location = $entity->head->mime_attr('content-location')
        || 'thismessage:/';
    my $env;
    foreach my $part ($entity->parts) {
        next if !UNIVERSAL::isa($part => "MIME::Entity");

        # Weird, the following use of head->get(SCALAR[,INDEX]) doesn't work as
        # expected. Work around is to eliminate the INDEX.
        my $pid = get_multipart_id($part->head->mime_attr('content-id'));

        # If Content-ID is not supplied, then generate a random one (HACK - because
        # MIME::Entity does not do this as it should... content-id is required
        # according to MIME specification)
        $pid = $self->generate_random_string(10) if $pid eq '';
        my $type = $part->head->mime_type;

        # If a Content-Location header cannot be found, this will look for an
        # alternative in the following MIME Header attributes
        my $plocation = $part->head->get('content-location')
            || $part->head->mime_attr('Content-Disposition.filename')
            || $part->head->mime_attr('Content-Type.name');
        if ($start && $pid eq $start) {
            $env = $part->bodyhandle->as_string;
        }
        else {
            $self->push_part($part) if (defined($part->bodyhandle));
        }
    }

    return $env;
}

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

package SOAP::Lite::Packager::DIME;

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

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

sub new {
    my ($classname) = @_;
    my $self = SOAP::Lite::Packager::new(@_);
    bless $self, $classname;
    $SOAP::Lite::Packager::SUPPORTED_TYPES->{"DIME::Payload"} = 1;
    return $self;
}

sub initialize_parser {
    my $self = shift;
    print STDERR "Initializing parser\n";
    eval "require DIME::Parser;";
    die "Could not find DIME::Parser - is DIME::Tools installed? Aborting." if $@;
    $self->{'_parser'} = DIME::Parser->new;
}

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 DIME::Message;
   require DIME::Payload;
   my $message = DIME::Message->new;
   my $top = DIME::Payload->new;
   my $soapversion = defined($context) ? $context->soapversion : '1.1';
   $top->attach('MIMEType' => $soapversion == 1.1 ?
                  "http://schemas.xmlsoap.org/soap/envelope/" : "application/soap+xml",
                'Data'     => $envelope );
   $message->add_payload($top);
   # consume the attachments that come in as input by 'shift'ing
   no strict 'refs';
   while (my $part = shift(@{$self->parts})) {
      die "You are only allowed to add parts of type DIME::Payload to a DIME::Message"
        if (!$part->isa('DIME::Payload'));
#      print STDERR "Adding payload to DIME message: ".ref($part)."\n";
      $message->add_payload($part);
#      print STDERR "Payload's payload is: ".${$part->print_content_data}."\n";
   }
   $self->headers_http({ 'Content-Type' => 'application/dime' });
   return $message->print_data;
}

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

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

    # The first payload is always the SOAP Message
    # TODO - Error check
    my @payloads = @{$message->{'_PAYLOADS'}};
    my $env = shift(@payloads);
    my $env_str = $env->print_content_data;
    print STDERR "Received this envelope: ".$env_str."\n";
    while (my $p = shift(@payloads)) {
        print STDERR "Adding part to Packager\n";
        $self->push_part($p);
    }
    return $env_str;
}

1;
__END__