The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl -w

# Copyright 2009, 2010, 2012, 2014 Kevin Ryde

# This file is part of Upfiles.
#
# Upfiles is free software; you can redistribute it and/or modify it under
# the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Upfiles is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
# more details.
#
# You should have received a copy of the GNU General Public License along
# with Upfiles.  If not, see <http://www.gnu.org/licenses/>.

use 5.010;
use strict;
use warnings;
use Net::FTP;
use Tie::StdHandle;
use POSIX;

{
  package MyTie;
  use base 'Tie::StdHandle';
  my $reads = 0;
  # sub OPEN {
  # }
  sub READ {
    die;
    if ($reads++ <= 100) {
      $_[1] = 'abc';
      return 3;
    } else {
      die;
      return 0;
      print "Pretend read error\n";
      $! = POSIX::EIO();
      return undef;
    }
  }
}


my $hostname = "localhost";

my $ftp = Net::FTP->new($hostname)
  or die "Cannot connect: $@";

$ftp->login("anonymous",'')
  or die "Cannot login: ", $ftp->message;

$ftp->cwd("/pub")
  or die "Cannot cwd: ", $ftp->message;

# $ftp->delete("dummy.txt");

# {
#   my $ret = $ftp->put ('/etc/motd', 'one.txt');
#   if (defined $ret) {
#     print "remote filename: $ret\n";
#   } else {
#     print "Cannot put: ", $ftp->message;
#   }
# }
# {
#   my $ret = $ftp->put ('/etc/motd', 'one.txt.tmp');
#   if (defined $ret) {
#     print "remote filename: $ret\n";
#   } else {
#     print "Cannot put: ", $ftp->message;
#   }
# }
# 
{
  my @lines = $ftp->dir()
    or die "Cannot dir: ", $ftp->message;
  foreach (@lines) { print "$_\n"; }
}

# $ftp->rename('one.txt.tmp','one.txt')
#   or die "Cannot rename: ", $ftp->message;

tie *FH, 'MyTie', '</etc/motd';
my $ret = $ftp->put_unique (\*FH, 'dummy.txt');
if (defined $ret) {
  print "remote filename: $ret\n";
} else {
  print "Cannot put: ", $ftp->message;
}

{
  my @lines = $ftp->dir()
    or die "Cannot dir: ", $ftp->message;
  foreach (@lines) { print "$_\n"; }
}

$ftp->quit;