← Back to branch summary

~ubuntu-branches/debian/squeeze/movabletype-opensource/squeeze

« back to all changes in this revision

Viewing changes to extlib/SOAP/Transport/FTP.pm

  • Committer: Bazaar Package Importer
  • Author(s): Dominic Hargreaves
  • Date: 2009-06-19 23:03:15 UTC
  • mfrom: (1.2.1 upstream) (9.1.1 karmic)
  • Revision ID: james.westby@ubuntu.com-20090619230315-rm1vcgg5iymu2zh1
Tags: 4.2.6.1-1
* New upstream release
* Update Standards-Version (no changes)
* Don't specify full path to apache2ctl in postinst (thanks, Lintian)
* Remove unused Lintian overrides
* Don't install empty directory in extlib

Show diffs side-by-side

added added

removed removed

Lines of Context:
extlib/SOAP/Transport/FTP.pm
4
4
# SOAP::Lite is free software; you can redistribute it
5
5
# and/or modify it under the same terms as Perl itself.
6
6
#
7
 
# $Id: FTP.pm,v 1.3 2001/08/11 19:09:57 paulk Exp $
 
7
# $Id: FTP.pm 148 2008-01-06 19:14:09Z kutterma $
8
8
#
9
9
# ======================================================================
10
10
 
12
12
 
13
13
use strict;
14
14
use vars qw($VERSION);
15
 
$VERSION = eval sprintf("%d.%s", q$Name: release-0_52-public $ =~ /-(\d+)_([\d_]+)/);
 
15
#$VERSION = sprintf("%d.%s", map {s/_//g; $_} q$Name$ =~ /-(\d+)_([\d_]+)/);
 
16
$VERSION = $SOAP::Lite::VERSION;
16
17
 
17
18
use Net::FTP;
18
19
use IO::File;
21
22
# ======================================================================
22
23
 
23
24
package SOAP::Transport::FTP::Client;
24
 
 
 
25
use SOAP::Lite;
25
26
use vars qw(@ISA);
26
27
@ISA = qw(SOAP::Client);
27
28
 
28
29
sub new { 
29
 
  my $self = shift;
30
 
  my $class = ref($self) || $self;
 
30
    my $class = shift;
 
31
    return $class if ref $class;
31
32
 
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;
 
33
    my(@arg_from, @method_from);
 
34
    while (@_) {
 
35
        $class->can($_[0])
 
36
            ? push(@method_from, shift() => shift)
 
37
            : push(@arg_from, shift)
 
38
    }
 
39
    my $self = bless {@arg_from} => $class;
 
40
    while (@method_from) {
 
41
        my($method, $param_ref) = splice(@method_from,0,2);
 
42
        $self->$method(ref $param_ref eq 'ARRAY' ? @$param_ref : $param_ref) 
 
43
    }
 
44
    return $self;
42
45
}
43
46
 
44
47
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;
 
48
    my($self, %parameters) = @_;
 
49
    my($envelope, $endpoint, $action) = 
 
50
        @parameters{qw(envelope endpoint action)};
 
51
 
 
52
    $endpoint ||= $self->endpoint; # ftp://login:password@ftp.something/dir/file
 
53
 
 
54
    my $uri = URI->new($endpoint);
 
55
    my($server, $auth) = reverse split /@/, $uri->authority;
 
56
    my $dir = substr($uri->path, 1, rindex($uri->path, '/'));
 
57
    my $file = substr($uri->path, rindex($uri->path, '/')+1);
 
58
 
 
59
    eval {
 
60
        my $ftp = Net::FTP->new($server, %$self) or die "Can't connect to $server: $@\n";
 
61
        $ftp->login(split /:/, $auth)            or die "Couldn't login\n";
 
62
        $dir and ($ftp->cwd($dir)
 
63
            or $ftp->mkdir($dir, 'recurse') and $ftp->cwd($dir)
 
64
                or die "Couldn't change directory to '$dir'\n");
 
65
 
 
66
        my $FH = IO::File->new_tmpfile; print $FH $envelope; $FH->flush; $FH->seek(0,0);
 
67
        $ftp->put($FH => $file)                  or die "Couldn't put file '$file'\n";
 
68
        $ftp->quit;
 
69
    };
 
70
 
 
71
    (my $code = $@) =~ s/\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;
75
79
}
76
80
 
77
81
# ======================================================================
79
83
1;
80
84
 
81
85
__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