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.