#!/bin/env perl use strict; use Test; BEGIN { unless(grep /blib/, @INC) { chdir 't' if -d 't'; unshift @INC, '../lib' if -d '../lib'; } plan tests => 10; } my ($mp, $env, $part, @part_data); use SOAP::Packager; $mp = SOAP::MIME::Packager->new; ok(ref $mp); # check attachment deserialization print "Attachment deserialization (Content-ID) test(s)...\n"; $env = $mp->unpackage(<<'EOX'); Content-Type: Multipart/Related; boundary=MIME_boundary; type="text/xml"; start="" SOAPAction: http://schemas.risky-stuff.com/Auto-Claim Content-Description: This is the optional message description. --MIME_boundary Content-Type: text/xml; charset=UTF-8 Content-Transfer-Encoding: 8bit Content-ID: --MIME_boundary Content-Type: image/tiff Content-Transfer-Encoding: base64 Content-ID: AAECAyAgIAQFBg== --MIME_boundary Content-Type: image/jpeg Content-Transfer-Encoding: binary Content-ID: ...Raw JPEG image.. --MIME_boundary Content-Type: text/plain Content-Transfer-Encoding: binary Content-ID: c --MIME_boundary Content-Type: text/xml Content-Transfer-Encoding: binary Content-ID: c --MIME_boundary-- EOX # test to see how how many parts were found: ok(@{$mp->parts} == 4); ok(UNIVERSAL::isa(ref($mp->parts->[0]) => "MIME::Entity")); # Tests to see if data extraction works - TIFF not checked @part_data = $mp->find_part( id => '' ); ok($part_data[0] eq '...Raw JPEG image..'); @part_data = $mp->find_part( id => '' ); ok($part_data[0] eq 'c'); @part_data = $mp->find_part( id => '' ); ok($part_data[0] eq 'c'); # Test: no start parameter specified $env = $mp->unpackage(<<'EOX'); Content-Type: Multipart/Related; boundary=MIME_boundary; type="text/xml" SOAPAction: http://schemas.risky-stuff.com/Auto-Claim Content-Description: This is the optional message description. --MIME_boundary Content-Type: text/xml; charset=UTF-8 Content-Transfer-Encoding: 8bit Content-ID: --MIME_boundary Content-Type: text/plain Content-Transfer-Encoding: binary Content-ID: c --MIME_boundary-- EOX # test to see how how many parts were found: ok(@{$mp->parts} == 1); # Tests to see if data extraction worked @part_data = $mp->find_part( id => '' ); ok($part_data[0] eq 'c'); # test to see if start parameter works if it doesn't point to root $env = $mp->unpackage(<<'EOX'); Content-Type: Multipart/Related; boundary=MIME_boundary; type="text/xml"; start="" SOAPAction: http://schemas.risky-stuff.com/Auto-Claim Content-Description: This is the optional message description. --MIME_boundary Content-Type: text/plain Content-Transfer-Encoding: binary Content-ID: c --MIME_boundary Content-Type: text/xml; charset=UTF-8 Content-Transfer-Encoding: 8bit Content-ID: --MIME_boundary-- EOX # test to see how how many parts were found: ok(@{$mp->parts} == 1); # Tests to see if data extraction worked @part_data = $mp->find_part( id => '' ); ok($part_data[0] eq 'c'); 1;