use Win32::Internet;
use HTTP::Date qw( time2str);
use Cwd;
use local::TeeOutput;
package Ftpmirror;
    use strict;
    BEGIN {
        use Exporter   ();
        use vars       qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);

        $VERSION     = 1.00;
        @ISA         = qw(Exporter);
        @EXPORT      = qw(
	$localbase	$localname	$site $user	$pass $sitebase	$mask $ignore $logfile
	$deletefile	$deletefirst @deletelist $totalsize	$gimmeLocallistonly
	$gimmeftplistonly $showFTPresponse	&deletefiles &ftpmirror	&directorylist
	&listlocal
);
        %EXPORT_TAGS = ( );     # eg: TAG => [ qw!name1 name2! ],
        # your exported package globals go here,
        # as well as any optionally exported functions
        @EXPORT_OK   = qw(
	%localhash);
}

    use vars      @EXPORT_OK;
    # non-exported package globals go here
    use vars      qw(
	$localbase	$localname	$site	$user	$pass	$sitebase	$mask	$ignore
	$gimmeLocallistonly	$gimmeftplistonly	$showFTPresponse	$logfile
	%deletes	$deletefile	$deletefirst	@deletelist	&deletefiles
	&ftpmirror	&directorylist    &init	&checkerror	$s	$FTPBasepath	$totalsize
	$base	$ftperr	$put	$size	@ftpfiles	$ftpdir	$cwdir	@d	$result	$dkey
	$startdir	$INET	$ErrText	$ErrNum	$FTP	$ignore
 );

$totalsize=0;
$logfile="";
$FTPBasepath="";
$gimmeLocallistonly=1;
$gimmeftplistonly=0;
$showFTPresponse=1;
$localbase="C:/";
$localname="";

$site="";
$user="";
$pass="";
$sitebase=".";   # could be public_html
$mask="*.*";
$deletefile="delete.txt";
@deletelist=();
$ignore="";

$deletefirst=1;  # 0-delete after upload, 1-delete before, 2 no delete
%localhash=();

my $s="";
sub deletefiles {             
	$s = $localbase . '/' . $localname . '/' . $deletefile;
	if(! open(DEL,"<$s") ){
		print "Cannot Open deletefile $s\n";
		return;
	}
	my @deletelist=<DEL>;
	close DEL;
    $s=~ s/([^.]+)(.+)/$1.bak/;     # we rename the delete file by default
    rename $1 . $2,$s;				# its too easy to forget to turn delete off!

    foreach (@deletelist)  {        #needs full path from getftplistonly
	    chomp;						#to cope with same name in different dir
		m!(.+/)(.*)!;
        push @{$deletes{$1}}, $2;
    }
    foreach $s (keys %deletes) {
	   next if (!checkerror($FTP->Cd($s)));
       print "Directory is $s\n";
       foreach (@{$deletes{$s}})  {
	      print "Deleted $_\n" unless (!checkerror($FTP->Delete($_)));
       }
    }
}

sub checkerror  {
   $s= $FTP->GetResponse();
      print $s  if ($showFTPresponse && $s);
  if (!@_[0])  {
    ($ErrNum, $ErrText) = $INET->Error();
    print "ERROR $ErrNum : $ErrText\n" if  $ErrNum;
    $ErrText=~ /(\A[0-9]+)/;
    return $1; 	
  }
  return @_[0];
}

sub init  {
	$startdir="$localbase/$localname";
	die "no $startdir\\n" unless chdir $startdir;
	$logfile="$localname.log" if !$logfile;
	$logfile="$startdir/$logfile";
	open(LOG, ">>$logfile") or die "bad Logfile $logfile";
	$|++;
    print "Logging to $logfile\n";
	Local::TeeOutput::openTee(*STDOUT, *STDOUT, *LOG);

	print HTTP::Date::time2str(),"\n";
	print "startdir $startdir\n";

	directorylist($startdir,".",$mask,0);
   	foreach $dkey (keys %localhash) {
       	print "$dkey\n";
	}
	exit listlocal() if $gimmeLocallistonly;
}

sub ftpmirror  {
	my @dl=();
	init();

  $INET = new Win32::Internet() unless $INET;  #might call this more than once
  ($ErrNum, $ErrText) = $INET->Error();
     print "ERROR $ErrNum : $ErrText\n" if  $ErrNum;
     die qq(Cannot connect to Internet...\n) if ! $INET;
  $INET->SetOption(Win32::Internet::INTERNET_OPTION_CONNECT_TIMEOUT,8000);
  $INET->UserAgent("BangkokPerl/1.0");
  print "Open FTP to $site as $user\n";
  if (!$FTP)  {
    $result = $INET->FTP($FTP,$site,$user,$pass);
       die qq(Cannot contact $site\n) if ! $result;
  }

  print "FTP->Connected to $site\n";

  if ($sitebase ne ".")  {
	print "FTP->Cd to $sitebase\n";
    $result = $FTP->Cd($sitebase);
      die qq(Directory no good $sitebase $site\n) if ! $result;
  }

	$FTPBasepath=$FTP->Pwd();
	checkerror();
	print "Pwd->$FTPBasepath\n";
	$FTPBasepath= $FTPBasepath . "/";
	$FTPBasepath=~ s#//##;
	print "FTP->Pwd->$FTPBasepath\n";

	die "no $startdir\\n" unless chdir $startdir;
	deletefiles() if ($deletefirst==1);   
	foreach $dkey (keys %localhash) {
        @d=@{$localhash{$dkey}};
        goftp($dkey,@d);
	}
	print commify($totalsize)," bytes total at $site\n";
	deletefiles() if (!$deletefirst);
}


# go to a directory  (make new one if missing)
# get a a list of the site files 
# eliminate identical files and upload as needed

sub goftp  {   
	my $file="";
	my $t="";
  (my $subdir,my @dl)=@_;
   my $dd="/$FTPBasepath/$subdir";
   $dd=~ s!//!/!; 
   FTPchdir($dd);

my $thisdir="$startdir\\$subdir";
die "no $thisdir\n" unless chdir $thisdir; 
print  $FTP->Cd($dd) ,"\n"; 

my @fl=();
  $cwdir = Cwd::cwd;
  print "LOCAL->$cwdir\n";
  $ftpdir=$FTP->Pwd();
  print "FTP->$ftpdir\n";

  @ftpfiles = $FTP->List("$mask", 3);
   foreach $file (@ftpfiles) {
      next if ($file->{'attr'} ==16);   # ignore directories
      $t= join('',reverse(split(/,/,$file->{'size'})));
      $totalsize+=$t;
      if ($gimmeftplistonly)  {
         push @fl,"$file->{'name'}";
#         printf "%8d %s\n", $t,$file->{'name'};
      }
      else  { 	
	      push @fl,"$t\t$file->{'name'}";     #comparing on file size only
#         printf "%8d %s\n", $t,$file->{'name'};
      }
   }

if ($gimmeftplistonly)  {
  foreach (@fl)  {
      $s=$ftpdir . "/" . $_ ."\n";
      print $s;
  }
return 0;
}

my @list=@dl;
my $dontoverwrite=1;
if ($dontoverwrite)  {

	my %temp = ();           # get a list of what's different on local
	@temp{@dl} = ();
	foreach (@fl) {
	   delete $temp{$_};
	}

	@list = keys %temp;
}

	my $items=@list;
	
	if ($items==0) {
      print "$dd is up to date\n";		
		return 0;
	}

my $titems=commify($items);
	print "$titems files\n";
	foreach (@list)  {
	  print $_,"\n";
	}

my $ftperror=0;  	
	foreach (@list)  {
	    ($size, $put) = split;
         print "PUT $put $size\n";
         $result = $FTP->Put($put,$put);
         if (checkerror()==12031)  {
           if (++$ftperr ==3)  {exit 0;};
         }
   }
}


sub directorylist  {
  ($base,my $subdir,my $mask,my $op)=@_;
  my @dx=();
  my $mydir="$base/$subdir";
  die "no $mydir\n" unless chdir $mydir;
  my @d = glob  "$mask";
  my $f="";
  foreach (@d)  {
  	    next if m/$ignore/io;
  	    $f=$_;
       if(-d)  {
       	 my $subdir2=$_;
          directorylist($base,"$subdir/$subdir2",$mask,$op);
          next;
        }
         my @s= stat;
         my $size=$s[7];
         my $ctime=$s[10];
         if($op)  {
#            print "$ctime\t$s[7]\t$_\n";
            push @dx,"$ctime\t$size\t$_";
         }
         else {
#            print "$s[7]\t$f\n";
            push @dx,"$size\t$_";
         }
  }
  die "no parent dir\\n" unless chdir "..";  
  $subdir=~ s!\./!!; 
  $localhash{$subdir} = [@dx];
}

sub listlocal  {
    foreach $dkey (keys %localhash) {
        print "Directory of $localbase/$localname/$dkey\n";
        @d=@{$localhash{$dkey}};
        foreach (@d)  {
            my($t,$f)=split;
            printf "%8d %s\n", $t,$f;
        }
		print "\n";
    }
    0;
}

#put commas in numbers
  sub commify {
       my $input = shift;
        $input = reverse $input;
        $input =~ s<(\d\d\d)(?=\d)(?!\d*\.)><$1,>g;
        $input = reverse $input;
        return $input;
    }

sub FTPchdir  {            # Adds error checking and make new directory
  my $dd= shift @_;

   print "\nFTP->Cd to $dd\n";
   
    $result = $FTP->Cd($dd);      #change to remote dir or make it
                                  
    if (&checkerror==550)  {
        print "FTP->Creating new directory $dd\n";
         $result=$FTP->Mkdir($dd);
           die qq(FTP->Can't make Directory $dd $site\n) if ! $result;
           checkerror();
           if(!checkerror())  {print "$dd created\n";}
         $result = $FTP->Cd($dd);
           die qq(Directory no good $dd $site\n) if ! $result;
     }

}


  END { }
1;