home *** CD-ROM | disk | FTP | other *** search
/ Netrunner 2004 October / NETRUNNER0410.ISO / regular / ActivePerl-5.8.4.810-MSWin32-x86.msi / _2bf89ae99d3d821fb8509e83714e463d < prev    next >
Encoding:
Text File  |  2004-06-01  |  3.1 KB  |  111 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: FTP.pm,v 1.3 2001/08/11 19:09:57 paulk Exp $
  8. #
  9. # ======================================================================
  10.  
  11. package SOAP::Transport::FTP;
  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 Net::FTP;
  18. use IO::File;
  19. use URI; 
  20.  
  21. # ======================================================================
  22.  
  23. package SOAP::Transport::FTP::Client;
  24.  
  25. use vars qw(@ISA);
  26. @ISA = qw(SOAP::Client);
  27.  
  28. sub new { 
  29.   my $self = shift;
  30.   my $class = ref($self) || $self;
  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.   }
  41.   return $self;
  42. }
  43.  
  44. sub send_receive {
  45.   my($self, %parameters) = @_;
  46.   my($envelope, $endpoint, $action) = 
  47.     @parameters{qw(envelope endpoint action)};
  48.  
  49.   $endpoint ||= $self->endpoint; # ftp://login:password@ftp.something/dir/file
  50.  
  51.   my $uri = URI->new($endpoint);
  52.   my($server, $auth) = reverse split /@/, $uri->authority;
  53.   my $dir = substr($uri->path, 1, rindex($uri->path, '/'));
  54.   my $file = substr($uri->path, rindex($uri->path, '/')+1);
  55.  
  56.   eval {
  57.     my $ftp = Net::FTP->new($server, %$self) or die "Can't connect to $server: $@\n";
  58.     $ftp->login(split /:/, $auth)            or die "Couldn't login\n";
  59.     $dir and ($ftp->cwd($dir) or
  60.               $ftp->mkdir($dir, 'recurse') and $ftp->cwd($dir) or die "Couldn't change directory to '$dir'\n");
  61.   
  62.     my $FH = IO::File->new_tmpfile; print $FH $envelope; $FH->flush; $FH->seek(0,0);
  63.     $ftp->put($FH => $file)                  or die "Couldn't put file '$file'\n";
  64.     $ftp->quit;
  65.   };
  66.  
  67.   (my $code = $@) =~ s/\n$//;
  68.  
  69.   $self->code($code);
  70.   $self->message($code);
  71.   $self->is_success(!defined $code || $code eq '');
  72.   $self->status($code);
  73.  
  74.   return;
  75. }
  76.  
  77. # ======================================================================
  78.  
  79. 1;
  80.  
  81. __END__
  82.  
  83. =head1 NAME
  84.  
  85. SOAP::Transport::FTP - Client side FTP support for SOAP::Lite
  86.  
  87. =head1 SYNOPSIS
  88.  
  89.   use SOAP::Lite 
  90.     uri => 'http://my.own.site.com/My/Examples',
  91.     proxy => 'ftp://login:password@ftp.somewhere.com/relative/path/to/file.xml', # ftp server
  92.     # proxy => 'ftp://login:password@ftp.somewhere.com//absolute/path/to/file.xml', # ftp server
  93.   ;
  94.  
  95.   print getStateName(1);
  96.  
  97. =head1 DESCRIPTION
  98.  
  99. =head1 COPYRIGHT
  100.  
  101. Copyright (C) 2000-2001 Paul Kulchenko. All rights reserved.
  102.  
  103. This library is free software; you can redistribute it and/or modify
  104. it under the same terms as Perl itself.
  105.  
  106. =head1 AUTHOR
  107.  
  108. Paul Kulchenko (paulclinger@yahoo.com)
  109.  
  110. =cut
  111.