1# ====================================================================== 2# 3# Copyright (C) 2000-2001 Paul Kulchenko (paulclinger@yahoo.com) 4# SOAP::Lite is free software; you can redistribute it 5# and/or modify it under the same terms as Perl itself. 6# 7# ====================================================================== 8 9package SOAP::Transport::MAILTO; 10 11use strict; 12 13 14our $VERSION = 1.11; 15 16use MIME::Lite; 17use URI; 18 19# ====================================================================== 20 21package SOAP::Transport::MAILTO::Client; 22use SOAP::Lite; 23use vars qw(@ISA); 24@ISA = qw(SOAP::Client); 25 26sub DESTROY { SOAP::Trace::objects('()') } 27 28sub new { 29 my $class = shift; 30 return $class if ref $class; 31 32 my(@params, @methods); 33 while (@_) { $class->can($_[0]) ? push(@methods, shift() => shift) : push(@params, shift) } 34 my $self = bless {@params} => $class; 35 while (@methods) { my($method, $params) = splice(@methods,0,2); 36 $self->$method(ref $params eq 'ARRAY' ? @$params : $params) 37 } 38 SOAP::Trace::objects('()'); 39 40 return $self; 41} 42 43sub send_receive { 44 my($self, %parameters) = @_; 45 my($envelope, $endpoint, $action) = 46 @parameters{qw(envelope endpoint action)}; 47 48 $endpoint ||= $self->endpoint; 49 my $uri = URI->new($endpoint); 50 %parameters = (%$self, 51 map {URI::Escape::uri_unescape($_)} 52 map {split/=/,$_,2} 53 split /[&;]/, $uri->query || ''); 54 55 my $msg = MIME::Lite->new( 56 To => $uri->to, 57 Type => 'text/xml', 58 Encoding => $parameters{Encoding} || 'base64', 59 Data => $envelope, 60 $parameters{From} 61 ? (From => $parameters{From}) 62 : (), 63 $parameters{'Reply-To'} 64 ? ('Reply-To' => $parameters{'Reply-To'}) 65 : (), 66 $parameters{Subject} 67 ? (Subject => $parameters{Subject}) 68 : (), 69 ); 70 $msg->replace('X-Mailer' => join '/', 'SOAP::Lite', 'Perl', SOAP::Transport::MAILTO->VERSION); 71 $msg->add(SOAPAction => $action); 72 73 SOAP::Trace::transport($msg); 74 SOAP::Trace::debug($msg->as_string); 75 76 MIME::Lite->send(map {exists $parameters{$_} 77 ? ($_ => $parameters{$_}) 78 : ()} 'smtp', 'sendmail'); 79 eval { local $SIG{__DIE__}; $MIME::Lite::AUTO_CC = 0; $msg->send }; 80 (my $code = $@) =~ s/ at .*\n//; 81 82 $self->code($code); 83 $self->message($code); 84 $self->is_success(!defined $code || $code eq ''); 85 $self->status($code); 86 87 return; 88} 89 90# ====================================================================== 91 921; 93 94__END__ 95