# file KLEIDER/web/src/localization/Upload.pm
# symlink Herbaer/Upload.pm
# 2020-04-17 Herbert Schiemann <h.schiemann@herbaer.de>

package Herbaer::Upload ;

use Cwd qw(getcwd realpath) ;
use File::Spec::Functions qw(catfile catdir file_name_is_absolute) ;
use Net::FTP;
use Time::HiRes qw(usleep);
use utf8 ;

binmode (STDERR, ":utf8") ;

sub new {
   my ($class, $secrets, $verbose, $mssleep) = @_;
   # mssleep: Schlafdauer in Millisekunden
   my $hnd;
   if (! open ($hnd, "<:encoding(utf-8)", $secrets)) {
      print STDERR "Kann Datei $secrets nicht lesen:$!\n" if $verbose;
      return undef;
   }
   my $line;
   my $host;
   my $user;
   my $password;
   while (defined ($line = <$hnd>)) {
      $line =~ s/\s*$//;
      if ($line =~ /^\s*ftp\.user\s*=?\s*(\S*)/) {
         $user = $1;
      }
      elsif ($line =~ /^\s*ftp\.password\s*=?\s*(\S*)/) {
         $password = $1;
      }
      elsif ($line =~ /^\s*ftp\.host\s*=\s*(\S*)/) {
         $host = $1;
      }
   }
   my $ftp = Net::FTP->new ($host);
   if (!$ftp) {
      print STDERR "Keine Verbindung zu $host\n" if $verbose;
      return undef;
   }
   if (!$ftp -> login ($user, $password)) {
      print STDERR "LOGIN Fehler\n", $ftp -> message() if $verbose;
      return undef;
   }
   $ftp -> binary ();
   my $self = {
      "ftp"       => $ftp,
      "verbose"   => $verbose,
      "putbase"   => getcwd() ,
      "remotedir" => "",   # das aktuelle FTP-Remote-Verzeichnis
      "usleep"    => ($mssleep && $mssleep > 0 ? $mssleep * 1000 : 0) # Mikrosekunden
   };
   return bless ($self);
} # new

sub DESTROY {
   my $self = shift;
   my $ftp = $self -> {"ftp"};
   if ($ftp) {
      $ftp -> quit ();
   }
} # DESTROY

# Wechselt ein lokales Basisverzeichnis
sub _base {
   my ($self, $dir, $pg) = @_;
   my $verb = $self -> {"verbose"};
   my $n = "$pg" . "base";
   my $rv = $self -> {$n};
   if ($dir) {
      $dir = realpath (file_name_is_absolute ($dir) ? $dir : catdir ($rv, $dir));
      if (-d $dir) {
         $self -> {$n} = $dir;
         print STDERR "FTP $n: neues lokales Basisverzeichnis \"$dir\"\n" if $verb > 1;
      }
      else {
         print STDERR "FTP $n: \"$dir\" ist kein Verzeichnis.\n" if $verb > 1;
         return undef;
      }
   }
   return $rv;
} # _base

# stellt das Remote-FTP-Verzeichnis ein
# pth : Dateipfad der betroffenen Datei
# ergibt den Dateinamen ohne den Verzeichnispfad
sub _set_remote_dir {
   my ($self, $pth) = @_;
   my $rd   = $self -> {"remotedir"};
   my $verb = $self -> {"verbose"};
   $pth =~ s/([^\/]+)$//;
   my $file = $1; # Dateiname wird von $pth abgetrennt
   return $file  if $pth eq $rd;
   my $cr = $pth; # zu erzeugender Verzeichnispfad
   my $cm = "" ;  # gemeinsamer Teilpfad von $rd und $pth;
   my $d;         # Pfadkomponente
   my $q = 0;     # Schleife beenden?
   while ($cr =~ s/^([^\/]*\/)//) {
      $d = $1;
      if ( $rd =~ s/^([^\/]*\/)// ) {
         if ($d ne $1) {
            $cr = "$d$cr";
            $rd = "../$rd";
            last;
         }
         else {
            $cm .= $d;
         }
      }
      else {
         $cr = "$d$cr";
         last;
      }
   }
   my $ftp = $self -> {"ftp"};
   if ($rd) {
      $rd =~ s/[^\/]+/../g;
      if ( $ftp -> cwd ($rd) ) {
         print STDERR "FTP cwd $rd\n" if $verb > 1;
      }
      else {
         print STDERR "FTP ERROR: cwd $rd\n" if $verb;
         return "";
      }
   }
   if ($cr) {
      $cr =~ s/\/$// ;
      if ( $ftp -> mkdir ($cr, 1) ) {
         print STDERR "FTP mkdir $cr\n" if $verb > 1;
      }
      else {
         print STDERR "FTP ERROR: mkdir $cr\n" if $verb;
         return "";
      }
      if ( $ftp -> cwd ($cr) ) {
         print STDERR "FTP cwd $cr\n" if $verb > 1;
      }
      else {
         print STDERR "FTP ERROR: cwd $cr\n" if $verb;
         return "";
      }
   }
   $self -> {"remotedir"} = $pth;
   return $file;
} # _set_remote_dir

# Wechselt das lokale Basisverzeichnis für Uploads
sub putbase {
   my ($self, $dir) = @_;
   $self -> _base ($dir, "put");
} # putbase

# Upload einer Datei oder rekursiv eines Verzeichnisses,
# eine existierende Datei wird ersetzt nach Maßgabe des Parameters $mode
# $path ist in jedem Fall relativ zum lokalen put-Basisverzeichnis
# und zum entfernten FTP-Basisverzeichnis
# $mode
#    notex    nur Dateien, die nicht existieren, hochladen
#    newer    nur Dateien, die neuer sind, hochladen
sub _put {
   my ($self, $path, $mode) = @_;
   my $verb = $self -> {"verbose"};
   $mode //= "";
   $path =~ s/^\/+// ; # Schrägstriche am Anfang
   $path =~ s/\/+$// ; # und am Ende entfernen
   my $lp;             # lokaler Dateipfad
   $lp = catfile ($self -> {"putbase"}, $path);
   if (-d $lp) {
      my $dh;
      my $de;
      if (! opendir ($dh, $lp)) {
         print STDERR "FTP put: kann Verzeichnis $lp nicht lesen:\$!\n";
         return;
      }
      while ( $de = readdir ($dh) ) {
         next if $de eq "." || $de eq "..";
         next if $de =~ /~$/;
         $self -> _put (catfile ($path, $de), $mode);
      }
      close $dh;
   }
   elsif (-s $lp) {
      my $file = $self -> _set_remote_dir ($path);
      return unless $file ;
      my $ftp = $self -> {"ftp"};
      my $pt = 0;
      if ( $mode eq "notex" ) {
         my $sz = $ftp -> size ($file);
         if ($verb > 1) {
            print STDERR "Size $file: ", (defined $sz ? $sz : "undef"), "\n";
         }
         if (!$sz) {
            $pt = 1;
         }
         elsif ($verb) {
            print STDERR "FTP $path exists\n" if $verb;
         }
      }
      elsif ( $mode eq "newer" ) {
         my $mdt = $ftp -> mdtm ($file);
         my $ltm = (stat ($lp))[9];
         if ($verb > 1) {
            print STDERR "Modtime $file: ", (defined $mdt ? $mdt : "undef"), "\n";
            print STDERR "Loctime $lp: ", (defined $ltm ? $ltm : "undef"), "\n";
         }
         if (!$mdt || !$ltm || $mdt < $ltm + 60 * 60) {
            $pt = 1;
         }
         elsif ($verb) {
            print STDERR "FTP skip $lp\n" if $verb;
         }
      }
      else {
         $pt = 1;
      }
      if ($pt) {
         my $res;
         $res = $ftp -> put ($lp, $file) || "";
         print STDERR "FTP put $lp $file: $res\n" if $verb > 1;
      }
   }
} # _put

# verarbeitet ein Kommando
sub cmd {
   my ($self, $cmd) = @_;
   print STDERR "FTP cmd $cmd\n" if $self -> {"verbose"};
   my $list = [ split (' ', $cmd) ];
   return unless @$list ;
   my $c = shift (@$list);
   if ($c eq "put") {
      $self -> _put (@$list);
   }
   elsif ($c eq "putnewer") {
      $self -> _put (@$list, "newer");
   }
   elsif ($c eq "putnotex") {
      $self -> _put (@$list, "notex");
   }
   elsif ($c eq "putbase") {
      $self -> putbase (@$list);
   }
   else {
      print STDERR "ungültiger Befehl: $cmd\n" if $self -> {"verbose"};
   }
   my $sl = $self -> {"usleep"};
   usleep ($sl) if $sl;
} # cmd

1;
# end of file KLEIDER/web/src/localization/Upload.pm