home *** CD-ROM | disk | FTP | other *** search
/ Netrunner 2004 October / NETRUNNER0410.ISO / regular / ActivePerl-5.8.4.810-MSWin32-x86.msi / _f7e247a1b0a1666f83a0a5e02a489b64 < prev    next >
Encoding:
Text File  |  2004-06-01  |  3.7 KB  |  123 lines
  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. # $Id: MAILTO.pm,v 1.3 2001/08/11 19:09:57 paulk Exp $
  8. #
  9. # ======================================================================
  10.  
  11. package SOAP::Transport::MAILTO;
  12.  
  13. use strict;
  14. use vars qw($VERSION);
  15. $VERSION = sprintf("%d.%s", map {s/_//g; $_} q$Name: release-0_55-public $ =~ /-(\d+)_([\d_]+)/);
  16.  
  17. use MIME::Lite; 
  18. use URI;
  19.  
  20. # ======================================================================
  21.  
  22. package SOAP::Transport::MAILTO::Client;
  23.  
  24. use vars qw(@ISA);
  25. @ISA = qw(SOAP::Client);
  26.  
  27. sub DESTROY { SOAP::Trace::objects('()') }
  28.  
  29. sub new { 
  30.   my $self = shift;
  31.  
  32.   unless (ref $self) {
  33.     my $class = ref($self) || $self;
  34.     my(@params, @methods);
  35.     while (@_) { $class->can($_[0]) ? push(@methods, shift() => shift) : push(@params, shift) }
  36.     $self = bless {@params} => $class;
  37.     while (@methods) { my($method, $params) = splice(@methods,0,2);
  38.       $self->$method(ref $params eq 'ARRAY' ? @$params : $params) 
  39.     }
  40.     SOAP::Trace::objects('()');
  41.   }
  42.   return $self;
  43. }
  44.  
  45. sub send_receive {
  46.   my($self, %parameters) = @_;
  47.   my($envelope, $endpoint, $action) = 
  48.     @parameters{qw(envelope endpoint action)};
  49.  
  50.   $endpoint ||= $self->endpoint;
  51.   my $uri = URI->new($endpoint);
  52.   %parameters = (%$self, map {URI::Escape::uri_unescape($_)} map {split/=/,$_,2} split /[&;]/, $uri->query || '');
  53.  
  54.   my $msg = MIME::Lite->new(
  55.     To         => $uri->to,
  56.     Type       => 'text/xml',
  57.     Encoding   => $parameters{Encoding} || 'base64',
  58.     Data       => $envelope,
  59.     $parameters{From}       ? (From       => $parameters{From}) : (),
  60.     $parameters{'Reply-To'} ? ('Reply-To' => $parameters{'Reply-To'}) : (),
  61.     $parameters{Subject}    ? (Subject    => $parameters{Subject}) : (),
  62.   );
  63.   $msg->replace('X-Mailer' => join '/', 'SOAP::Lite', 'Perl', SOAP::Transport::MAILTO->VERSION);
  64.   $msg->add(SOAPAction => $action);
  65.  
  66.   SOAP::Trace::transport($msg);
  67.   SOAP::Trace::debug($msg->as_string);
  68.     
  69.   MIME::Lite->send(map {exists $parameters{$_} ? ($_ => $parameters{$_}) : ()} 'smtp', 'sendmail');
  70.   eval { local $SIG{__DIE__}; $MIME::Lite::AUTO_CC = 0; $msg->send };
  71.   (my $code = $@) =~ s/ at .*\n//;
  72.  
  73.   $self->code($code);
  74.   $self->message($code);
  75.   $self->is_success(!defined $code || $code eq '');
  76.   $self->status($code);
  77.  
  78.   return;
  79. }
  80.  
  81. # ======================================================================
  82.  
  83. 1;
  84.  
  85. =head1 NAME
  86.  
  87. SOAP::Transport::MAILTO - Client side SMTP/sendmail support for SOAP::Lite
  88.  
  89. =head1 SYNOPSIS
  90.  
  91.   use SOAP::Lite;
  92.  
  93.   SOAP::Lite
  94.     -> uri('http://soaplite.com/My/Examples')                
  95.     -> proxy('mailto:destination.email@address', smtp => 'smtp.server', From => 'your.email', Subject => 'SOAP message')
  96.  
  97.     # or 
  98.     # -> proxy('mailto:destination.email@address?From=your.email&Subject=SOAP%20message', smtp => 'smtp.server')
  99.  
  100.     # or if you want to send with sendmail
  101.     # -> proxy('mailto:destination.email@address?From=your.email&Subject=SOAP%20message')
  102.  
  103.     # or if your sendmail is in undiscoverable place
  104.     # -> proxy('mailto:destination.email@address?From=your.email&Subject=SOAP%20message', sendmail => 'command to run your sendmail')
  105.  
  106.     -> getStateName(12)
  107.   ;
  108.  
  109. =head1 DESCRIPTION
  110.  
  111. =head1 COPYRIGHT
  112.  
  113. Copyright (C) 2000-2001 Paul Kulchenko. All rights reserved.
  114.  
  115. This library is free software; you can redistribute it and/or modify
  116. it under the same terms as Perl itself.
  117.  
  118. =head1 AUTHOR
  119.  
  120. Paul Kulchenko (paulclinger@yahoo.com)
  121.  
  122. =cut
  123.