#!/usr/bin/perl -w
#
# Perl equivalent of SFF Merge v1.33
# I've tried to do an almost literal conversion.
#
# Perl version 1.0.2
#  (we have a version number in the code, which is the version of the VBS
#   we try to match)
#   -- sweh
#
# 0.5->0.6
#   Attempt to strip out extraneous spaces in Directive files
#
# 0.6->0.7 "verbose" stuff
#
# 1.0
#    Add rollback stuff to make it comparable to VBS 1.30
# 1.0.1
#    Don't make Admin/MergeRollback if in dryrun mode
# 1.0.2
#    Fix print statement in verbose mode
#
# ===========================
#
# Utility to manage merging Updates with the main SFF library
#
# Valid Directives in directive file - tab separated
# B 0 message		Display message box. Use <BR> to put linefeed in message
# B 1 message		Display message box and terminate Use <BR> to put linefeed in message
# B 2 message		Display yes/no message box - terminate if no. Use <BR> to put linefeed in message
# D file		Delete file/folder - may be needed for eg _Tools
# F folder		Delete folder and contents - eg for series updates
# M file destdir	Move - move file to destdir instead of author dir.
# N 123.4		Require version 123.4 to run
# R			Indicates rollback - only for internal use - stops the generation of rollback files and info
# V 123.4		Make version 123.4 on completion
# Y SFFMerge Version	Check we're running an appropriate version.

#
# Syntax:
# sffmerge.pl [-dryrun] Torrent_dir ebook_dir
# eg
# sffmerge.pl Torrents/SFF*104 Books

use File::Path;
use strict;

my $MyName = "SFFMerge";
my $MyVersion = "1.33";

my $VersionFile = "SFFVersion.txt";
my $VersionFolder = "_Admin";
my $DirectiveFile = "Directives.txt";

my $CountCopied = 0;
my $CountTotal = 0;
my $NeedVersion = "0000.0";
my $MakeVersion = "0000.0";
my $Separator = "	";                    #tab as separator
my $CurrentVersion="";
my $RBFlag=0;        # Are we going to do a rollback?
my $dryrun=0;
my $verbose=0;
if (@ARGV && $ARGV[0] eq "-dryrun")
{
  shift @ARGV;
  $dryrun=1;
}
if (@ARGV && $ARGV[0] eq "-verbose")
{
  shift @ARGV;
  $verbose=1;
}

die "Syntax: $0 [-dryrun] [-verbose] torrent_dir ebook_dir\n" unless @ARGV==2;

my $UpdateLocation = $ARGV[0];
my $NewCollectionLocation = $ARGV[1];

our $basefilepath=$UpdateLocation;
    $basefilepath=~s/^.*\///;
    $basefilepath=~s/\.[^\.]*$//;

die "$UpdateLocation: Not a directory\n" unless -d $UpdateLocation;
die "$NewCollectionLocation is not an ebook collection\n" unless -d "$NewCollectionLocation/24 Declassified";

if (!$dryrun)
{
  # We need to create _Admin and _MergeRollback at this point
  mkpath("$NewCollectionLocation/$VersionFolder") unless -d "$NewCollectionLocation/$VersionFolder";
  mkpath("$NewCollectionLocation/_MergeRollback") unless -d "$NewCollectionLocation/_MergeRollback";
}

my @dels;
my %moves;

if ( -f "$UpdateLocation/$DirectiveFile" )
{
  open(F,"<$UpdateLocation/$DirectiveFile") or die "Can not open $UpdateLocation/$DirectiveFile\n";

  while(my $s=<F>)
  {
    $s=~s/[\r\n]+//;
    $s=~s/\\/\//g;  # Convert Dos \ into Unix /
    next unless $s;
    my @p;
    foreach my $p (split(/$Separator/,$s))
    {
      if ($p =~ / $/)
      {
        print "Warning: Extraneous space detected and removed\n  Bad line: $s\n" if ($verbose || $dryrun);
        $p=~s/ *$//;
      }
      push(@p,$p);
    }
    
    if ( $p[0] eq "B" )
    {
      my $st=$p[2] || ''; $st=~s/<BR>/\n/g;

      if ($p[1] == 0)
      {
        print "$st\nPress Return: ";
        <STDIN>;
      }
      elsif ($p[1] == 1)
      {
        print "$st\n";
        exit;
      }
      elsif ($p[1] == 2)
      {
        print "$st\nEnter Y or N: ";
        my $x=<STDIN>;
        chomp($x);
        if ($x !~ /^y/i)
        {
           print "Quitting\n";
           exit;
        }
      }
    }

    # Delete, or force delete
    if ($p[0] eq 'D' || $p[0] eq 'F' )
    {
      my $s=$p[1] || '';
      $s=~s/^\s+//; $s=~s/\s+$//;

      push(@dels,[$s,$p[0]]);
    }

    # Special Move Instruction (allow for eg Star Trek files)
    if ($p[0] eq 'M')
    {
      my $s=$p[1] || '';
      my $t=$p[2] || '';
      $s=~s/^\s+//; $s=~s/\s+$//;
      $t=~s/^\s+//; $t=~s/\s+$//;

      $moves{$s}=$t;
    }

    # Need version
    if ($p[0] eq 'N')
    {
      $NeedVersion = $p[1];
    }

    # Are we doing to process a rollback?
    if ($p[0] eq 'R')
    {
      $RBFlag=1;
    }

    # Make Version
    if ($p[0] eq 'V')
    {
      $MakeVersion = $p[1];
    }

    # check what version the script is
    if ($p[0] eq 'Y')
    {
      if ($p[1] ne $MyName || $p[2] > $MyVersion)
      {
        die "This is $MyName version $MyVersion, need at least $p[1] version $p[2]\n";
      }
    }

    # Other paramters are ignored
  }
  close(F);
}

# Validate Required Version
if ($NeedVersion ne "0000.0" && $VersionFolder ne "" && $VersionFile ne "")
{
  die "Require Library Version $NeedVersion\nCan't identity your version\nNo $VersionFolder/$VersionFile directory\n" unless -f "$NewCollectionLocation/$VersionFolder/$VersionFile";
	  
  open(F,"<$NewCollectionLocation/$VersionFolder/$VersionFile") or die "Can not open $NewCollectionLocation/$VersionFolder/$VersionFile: $!\n";
   
  $CurrentVersion = <F>; $CurrentVersion=~s/[\r\n]+//g;
  close(F);
  if ($NeedVersion ne $CurrentVersion)
  {
    die "Require Library version $NeedVersion\nCurrent Version is $CurrentVersion\nAborted\n";
  }
}

my $RB;
# If we're not rolling back then we need to make the rollback folder
if (!$RBFlag && !$dryrun)
{
  $RB="$NewCollectionLocation/_MergeRollback/$MakeVersion";
  rmtree($RB) if -e $RB;
  die "Unable to remove old rollback location:\n  $RB\nReason: $!\n" if -e $RB;
  mkpath($RB);

  open(rbDirectives,">$RB/$DirectiveFile") or die "Can not open $RB/$DirectiveFile: $!\n";
  
  print rbDirectives "R${Separator}True\r\n";
  print rbDirectives "V$Separator$CurrentVersion\r\n";
  print rbDirectives "Y$Separator$MyName$Separator$MyVersion\r\n";
}

# process delete directives
foreach (@dels)
{
  my $force;
  ($_,$force)=@$_;

  my $path="$NewCollectionLocation/$_";

  if ( -e $path )
  {
    if ($force ne 'F')
    {
      if ($dryrun)
      {
        print "Would " . ( ( -d $path)?"rmdir":"rm" ) . " $_\n";
      }
      else
      {
        if (!$RBFlag)
        {
          mv_to_rollback($path,"$RB/$_");
        }
        else
        {
          if ( -d $path)
          {
            rmdir($path);
            print "rmdir $_\n" if $verbose;
          }
          else
          {
            unlink($path);
            print "unlink $_\n" if $verbose;
          }
        }
      }
      if ( -e $path && !$dryrun)
      {
        print "Could not delete $path\n  Check and delete manually\nPress Return to continue: ";
        <STDIN>; 
      }
    }
    else
    {
      if ($dryrun)
      {
        print "Would rmtree $_\n";
      }
      else
      {
        if (!$RBFlag)
        {
          mv_to_rollback($path,"$RB/$_");
        }
        else
        {
          rmtree($path);
          print "rmtree $_\n" if $verbose;
        }
        if ( -e $path)
        {
          print "Could not delete $path\n  Check and delete manually\nPress Return to continue: ";
          <STDIN>; 
        }
      }
    }
  }
}

# Move files/folders to the appropriate subdirectory
# First step, just copy directories as is
opendir(D,"$UpdateLocation") or die "Can not open $UpdateLocation: $!\n";
my @files=sort grep { $_ ne "." && $_ ne ".." } readdir(D);
close(D);

foreach my $path (@files)
{
  if ( -d "$UpdateLocation/$path" )
  {
    if ($dryrun)
    {
      print "Would copy directory $path\n" if $verbose;
    }
    else
    {
      print "Merging: $path into $NewCollectionLocation\n" if $verbose;
      open(FIND,"-|","find","$UpdateLocation/$path","-type","d","-print") or die "Canot open find $UpdateLocation/$path: $!\n";
      while(my $f=<FIND>)
      {
        chomp($f);
        $f=~s/^$UpdateLocation\///;
        if ( ! -d "$NewCollectionLocation/$f" )
        {
          print rbDirectives "D${Separator}$f\r\n" unless $RBFlag;
          mkpath("$NewCollectionLocation/$f");
        }
      }
      open(FIND,"-|","find","$UpdateLocation/$path","-type","f","-print") or die "Canot open find $UpdateLocation/$path: $!\n";
      while(my $f=<FIND>)
      {
        chomp($f);
        my ($p,$f2)=($f=~/^(.*)\/(.*)$/);
        $p=~s/^$UpdateLocation\///;

        if ( -e "$NewCollectionLocation/$p/$f2" )
        {
          if (!$RBFlag)
          {
            mv_to_rollback("$NewCollectionLocation/$p/$f2","$RB/$p/$f2");
          }
          else
          {
            unlink("$NewCollectionLocation/$p/$f2");
          }
        }
        system("cp","$UpdateLocation/$p/$f2","$NewCollectionLocation/$p");
        print rbDirectives "D${Separator}$p/$f2\r\n" unless $RBFlag;
      }
    }
  }
}

my %madedirs;
foreach my $path (@files)
{
  next if $path eq "$DirectiveFile";

  if ( ! -d "$UpdateLocation/$path" )
  {
    # By default we store the results in the author directory...
    my $m=$path; $m=~s/ - .*$//;

    # ...but if this is a special move, we'll use that directory instead
    $m=$moves{$path} if $moves{$path};
    
    if ( ! -d "$NewCollectionLocation/$m" )
    {
      if ($verbose || $dryrun) { print "New directory: $m\n" unless $madedirs{$m}; }
      $madedirs{$m}=1;
      if (!$dryrun)
      {
        mkpath("$NewCollectionLocation/$m");
        print rbDirectives "D${Separator}$m\r\n";
      }
    }
    if ($dryrun)
    {
      print "Would copy $path to $m\n" if $verbose;
    }
    else
    {
      if ( -e "$NewCollectionLocation/$m/$path" )
      {
        print "Overwriting: $m/$path\n" if $verbose;
        mv_to_rollback("$NewCollectionLocation/$m/$path","$RB/$m/$path");
      }
      system("cp","$UpdateLocation/$path","$NewCollectionLocation/$m");
      print rbDirectives "D${Separator}$m/$path\r\n";
    }
  }
}

# write new version file if required
if ($MakeVersion ne "0000.0" && !$dryrun)
{
  mkpath("$NewCollectionLocation/$VersionFolder") unless -d "$NewCollectionLocation/$VersionFolder";
  open(F,">$NewCollectionLocation/$VersionFolder/$VersionFile");
  print F "$MakeVersion\r\n";
  close(F);
  print rbDirectives "N${Separator}$MakeVersion\r\n" unless $RBFlag;
}

if ($dryrun)
{
  print "Dryrun ";
}
else
{
  if (!$RBFlag)
  {
    close (rbDirectives);
    reverse_file("$RB/$DirectiveFile");
  }

  my $histfile="$NewCollectionLocation/$VersionFolder/Update_History.txt";

  if ( ! -f $histfile)
  {
    open(objHistoryFile,">$histfile");
    print objHistoryFile "TimeStamp${Separator}SFF v${Separator}Update v${Separator}${Separator}Update Filename\r\n";
    print objHistoryFile "------------------------------------------------------------------------\r\n";
  }
  else
  {
    open(objHistoryFile,">>$histfile");
  }

  my @t=localtime(time());
  my $TStamp=sprintf("%04d%02d%02d%02d%02d%02d",$t[5]+1900,$t[4]+1,$t[3],$t[2],$t[1],$t[0]);

  $basefilepath="Merge Rollback $basefilepath" if $RBFlag;
  print objHistoryFile "$TStamp$Separator$CurrentVersion$Separator$MakeVersion$Separator$Separator$basefilepath\r\n";
  close(objHistoryFile);
}
print "Done!\n";

exit;

sub mv_to_rollback
{
  my ($path,$p)=@_;
  
  my ($d,$f)=($p=~/^(.*)\/(.*)$/);
  mkpath($d) unless -d $d;
  print "Moving $path to $p\n" if $verbose;
  rename($path,$p) || die "rename $path $p: $!\n";
}

sub reverse_file
{
  my ($filename)=@_;
  my (@data);

  open(F,"<$filename") or die "Can not open $filename to reverse order\n";
  while(<F>)
  {
    s!/!\\!g;
    unshift(@data,$_);
  }
  close(F);
  open(F,">$filename") or die "Can not recreate $filename to reverse order\n";
  foreach (@data)
  {
    print F "$_";
  }
  close(F);
}