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