package MyFTP; # Nur zum Senden von Dateien

use strict;
use warnings;
use IO::Socket;
use constant CRLF => "\r\n";
use File::Basename;
use IO::File;

$| = 1;

sub new{
        my $class = shift;
        my %cf = (
                host => '', # FTP Host
                user => '', # FTP User
                pass => '', # FTP Passwort
                port => 21, # FTP Port
                root => '', # FTP Root absoluter Pfad auf dem Server
        @_);
        return eval{
                my $self = bless{ cfg => \%cf }, $class;
                my $cmd = IO::Socket::INET->new(
                        PeerHost => $cf{host},
                        PeerPort => $cf{port},
                        Timeout => 3
                ) or die "$!\n";
                $self->{cmd} = $cmd;
                $self->_read_status_line();
                print $self->response;
                $self->_login();
                $self;
        }
}

# z.B. 250 CWD command successful
sub response{
        my $self = shift;
        $self->{response}."\n";
}

# Socket für die Daten im Passiv-Mode
sub _passiv{
        my $self = shift;
        $self->_command("PASV");
        print $self->response; # 227 Entering Passive Mode (185,146,238,137,223,229).
        # Port für das Datensocket
        $self->{statusline} =~ /(\d+),(\d+),(\d+),(\d+),(\d+),(\d+)/;
        my $dataport = $5*256 + $6;
        $self->{DATA} = IO::Socket::INET->new(
                PeerHost => $self->{cfg}{host}, 
                PeerPort => $dataport,
        ) or die $^E;
}

# https://www.elektronik-kompendium.de/sites/net/0902241.htm
sub _command{
        my $self = shift;
        my $command = shift;
        $self->{cmd}->print($command.CRLF);
        $self->_read_status_line();
}

sub _login{
        my $self = shift;
        my $user = $self->{cfg}{user};
        my $pass = $self->{cfg}{pass};
        $self->_command("USER $user");
        print $self->response;
        $self->_command("PASS $pass");
        print $self->response;
        die "Anmeldung fehlgeschlagen\n" if $self->{status} != 230;
}

# Lese Socket Steuerkanal
sub _read_status_line{
        my $self = shift;
        my $str = $self->{cmd}->getline;
        $str = unpack "A*", $str;
        $self->{response} = $str;
        ($self->{status}, $self->{statusline}) = split /\s+/, $str, 2; 
        return $str;
}

# Change Dir, Übergeben wird der absolute Pfad, Root-Dir wird abgeschnitten
sub chdir{
        my $self = shift;
        my $dir  = shift;
        $dir =~ s/$self->{cfg}{root}//;
        $self->_command("CWD $dir");
        print $self->response;
        die "Ungültiges Verzeichnis '$dir'\n" unless $self->{status} == 250;
        $self->_command("PWD");
        print $self->response;
}

# Datensocket herstellen, Datei senden, Dateiname mit vollst. Pfad
sub putfile{
        my $self = shift;
        $self->_passiv;
        my $fullname = shift;
        my($name,$path,$suffix) = fileparse($fullname);
        my $fh = IO::File->new();
        $fh->open($fullname, O_BINARY|O_RDONLY) or die $^E; 
        $self->_command("STOR $name");
        print $self->response;
        my $data = $self->{DATA};
        my $len = 0;
        while( my $x = read($fh, my $buffer, 2048) ){
                print "#";
                $data->print($buffer);
                $len += $x;
        }
        print "\n";
        $data->close;
        $self->_read_status_line; # 226 Transfer complete
        if( $self->{status} != 226 ){
                die "Put '$name' nicht erfolgreich\n"; 
        }
        else{
                print $self->response;
        }
}

# FTP-Sitzung beenden
sub quit{
        my $self = shift;
        $self->_command("QUIT");
        print $self->response;
}
1;

__END__

my $ftp = MyFTP->new( %ced ) or die $@;
$ftp->chdir("/var/www/vhosts/rolfrost.de/files/tmp");
$ftp->putfile("/var/www/vhosts/rolfrost.de/files/dbf.bin");
$ftp->putfile("/var/www/vhosts/rolfrost.de/files/testfile.txt");
$ftp->quit;

Die Ausgabe zeigt jede Antwortzeile gem. Protokoll und je 4 kB wird ein Hash-Zeichen ausgegeben.