File: MAILTO.pm

package info (click to toggle)
movabletype-opensource 4.2.3-1%2Blenny3
  • links: PTS
  • area: main
  • in suites: lenny
  • size: 21,268 kB
  • ctags: 15,862
  • sloc: perl: 178,892; php: 26,178; sh: 161; makefile: 82
file content (122 lines) | stat: -rw-r--r-- 3,632 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
# ======================================================================
#
# Copyright (C) 2000-2001 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: MAILTO.pm,v 1.3 2001/08/11 19:09:57 paulk Exp $
#
# ======================================================================

package SOAP::Transport::MAILTO;

use strict;
use vars qw($VERSION);
$VERSION = eval sprintf("%d.%s", q$Name: release-0_52-public $ =~ /-(\d+)_([\d_]+)/);

use MIME::Lite; 
use URI;

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

package SOAP::Transport::MAILTO::Client;

use vars qw(@ISA);
@ISA = qw(SOAP::Client);

sub DESTROY { SOAP::Trace::objects('()') }

sub new { 
  my $self = shift;

  unless (ref $self) {
    my $class = ref($self) || $self;
    my(@params, @methods);
    while (@_) { $class->can($_[0]) ? push(@methods, shift() => shift) : push(@params, shift) }
    $self = bless {@params} => $class;
    while (@methods) { my($method, $params) = splice(@methods,0,2);
      $self->$method(ref $params eq 'ARRAY' ? @$params : $params) 
    }
    SOAP::Trace::objects('()');
  }
  return $self;
}

sub send_receive {
  my($self, %parameters) = @_;
  my($envelope, $endpoint, $action) = 
    @parameters{qw(envelope endpoint action)};

  $endpoint ||= $self->endpoint;
  my $uri = URI->new($endpoint);
  %parameters = (%$self, map {URI::Escape::uri_unescape($_)} map {split/=/,$_,2} split /[&;]/, $uri->query || '');

  my $msg = MIME::Lite->new(
    To         => $uri->to,
    Type       => 'text/xml',
    Encoding   => $parameters{Encoding} || 'base64',
    Data       => $envelope,
    $parameters{From}       ? (From       => $parameters{From}) : (),
    $parameters{'Reply-To'} ? ('Reply-To' => $parameters{'Reply-To'}) : (),
    $parameters{Subject}    ? (Subject    => $parameters{Subject}) : (),
  );
  $msg->replace('X-Mailer' => join '/', 'SOAP::Lite', 'Perl', SOAP::Transport::MAILTO->VERSION);
  $msg->add(SOAPAction => $action);

  SOAP::Trace::transport($msg);
  SOAP::Trace::debug($msg->as_string);
    
  MIME::Lite->send(map {exists $parameters{$_} ? ($_ => $parameters{$_}) : ()} 'smtp', 'sendmail');
  eval { local $SIG{__DIE__}; $MIME::Lite::AUTO_CC = 0; $msg->send };
  (my $code = $@) =~ s/ at .*\n//;

  $self->code($code);
  $self->message($code);
  $self->is_success(!defined $code || $code eq '');
  $self->status($code);

  return;
}

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

1;

=head1 NAME

SOAP::Transport::MAILTO - Client side SMTP/sendmail support for SOAP::Lite

=head1 SYNOPSIS

  use SOAP::Lite;

  SOAP::Lite
    -> uri('http://soaplite.com/My/Examples')                
    -> proxy('mailto:destination.email@address', smtp => 'smtp.server', From => 'your.email', Subject => 'SOAP message')

    # or 
    # -> proxy('mailto:destination.email@address?From=your.email&Subject=SOAP%20message', smtp => 'smtp.server')

    # or if you want to send with sendmail
    # -> proxy('mailto:destination.email@address?From=your.email&Subject=SOAP%20message')

    # or if your sendmail is in undiscoverable place
    # -> proxy('mailto:destination.email@address?From=your.email&Subject=SOAP%20message', sendmail => 'command to run your sendmail')

    -> getStateName(12)
  ;

=head1 DESCRIPTION

=head1 COPYRIGHT

Copyright (C) 2000-2001 Paul Kulchenko. All rights reserved.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=head1 AUTHOR

Paul Kulchenko (paulclinger@yahoo.com)

=cut