#!/usr/bin/perl -w
use strict;

# Perl equivalent of SFF Clean v2.04
# I've tried to do an almost literal conversion so this isn't very
# good perl.
#   -- sweh
#
# Perl version 0.5
#  (we have a version number in the code, which is the version of the VBS
#   we try to match)
# Change from 0.4 -> 0.5
#   Strip off spaces after we've split on tabs.  Windows, apparently,
#   ignores spaces at the end of filenames so "x " is really treated as "x".
#   In fact if there is a file called "x " then Windows has problems with
#   it (eg if it's on the desktop then you can't easily delete it!) so
#   this perl code will just strip and ignore those spaces

#
# ****** Input file format. Note: (Tab) is used between parameters. *****
#
# B	some text							(Display msgbox containing "some text". Can use <BR> for newline)
# C	directory_Name1    						(Create directory)
# C	directory_Name1\directory_Name2					(Create SubDirectory)
# D	directory_Name1							(Delete Directory)
# D	directory_Name1\File_Name1					(Delete File)
# E	directory_Name1			<Directive>			(Only action directive If folder NOT exists)
# E	directory_Name1\File_Name1	<Directive>			(Only action directive If file NOT exists)
# I	directory_Name1			<Directive>			(Only action directive If folder exists)
# I	directory_Name1\File_Name1	<Directive>			(Only action directive If file exists)
# M	directory_Name1			directory_Name2			(Rename Directory)
# M	directory_Name1\File_Name1	directory_Name2\File_Name2	(Rename/Move File)
# R	directory_Name1\File_Name1	File_Name2			(Rename File, same location)
# R	directory_Name1\File_Name1	directory_Name1\File_Name2	(Rename/Move File)
# V	Version Number (eg 101.3)					(provide directive version to compare against SFF version)
# U	source path\Zip_Name.zip	destination path		(UNZIP files to specified path. (note: Zip is not deleted)
# Z	destination path\ZIP_Name.zip	source folder			(ZIP folder. Note: This is a MOVE into zip file)
# Z	destination path\ZIP_Name.zip	source folder\file		(ZIP file. Note: This is a MOVE into zip file)

### Output in DOS format
sub dolog($$;$)
{
  my ($fh,$txt,$stdout)=@_;
  print $fh "$txt\r\n";

  if ($stdout)
  {
    print "$txt\n";
  }
}

##### MAIN PROGRAM #####

use File::Path;
use Cwd;
use strict;

our $seperator = "	"; #(Tab)
our $DeletedFilesDirectory = "_Deleted_Files";
our $Log_Directory = "_Admin/";
our $CountSkipped = 0;
our $CountApplied = 0;
our $CountErrors  = 0;
our $SFF_Version = "";
our $Directive_Version = "";
our $Original_SFF_Version = "";
our $Need_Version = "";
our $Req_SFF_Collection_Version = "";
our $Req_SFFClean_Version = "";
our $SFF_Clean_Version = "2.06";

die "Syntax: $0 Directives_File ebook_dir\n" unless @ARGV==2;

our $strInputFilePath = $ARGV[0];
our $ebookLocation = $ARGV[1];

die "$strInputFilePath: Not a file\n" unless -f "$strInputFilePath";
die "$ebookLocation is not an ebook collection\n" unless -d "$ebookLocation/24 Declassified";

open(objInputFile,"<$strInputFilePath") or die "Can not open $strInputFilePath: $!\n";
my @inputData;
while(<objInputFile>)
{
  s/[\r\n]+//;
  s/\\/\//g;
  push(@inputData,$_) if $_;
}
close(objInputFile);

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

our $LogFilename = $Log_Directory . $basefilepath . "_LOG.txt";
our $RollbackFilename = $Log_Directory . $basefilepath . "_ROLLBACK.txt";

if ( ! -d "$ebookLocation/$Log_Directory" )
{
  mkdir "$ebookLocation/$Log_Directory" || die "mkdir $ebookLocation/$Log_Directory: $!\n";
}

open(objLogFile,"> $ebookLocation/$LogFilename") or die "Can not create $ebookLocation/$LogFilename: $!\n";

if ( -f "$ebookLocation/$RollbackFilename")
{
  rename("$ebookLocation/$RollbackFilename","$ebookLocation/$RollbackFilename.$$");
}
open(objRollbackFile,"> $ebookLocation/$RollbackFilename") or die "Can not create $ebookLocation/$RollbackFilename:$!\n";

our $SFFVersionFile = "$ebookLocation/${Log_Directory}SFFVersion.txt";
&Get_SFF_Version;

dolog(\*objLogFile,"Actioning Directives file: $strInputFilePath");
dolog(\*objLogFile,"Location of SFF Collection: $ebookLocation");
dolog(\*objLogFile,"");

foreach (@inputData)
{
  print STDERR "Looking at $_\n" if $ENV{DEBUG};
  my @x;
  foreach my $x (split(/$seperator/,$_))
  {
    if ($x=~/ $/)
    {
      print "Warning: trailing spaces found; removed\n  Bad line: $_\n";
      $x=~s/ *$//;
    }
    push(@x,$x);
  }
  &doparse(@x);
}

sub doparse(@)
{
  my (@strAction)=@_;

  if ($strAction[0] eq "V")
  {
    &Set_Directive_Version($strAction[1]);
    &Get_SFF_Version;
    &Update_SFF_Version;
  }

  if ($strAction[0] eq "N")
  {
    &Set_Req_SFF_Collection_Version($strAction[1]);
  }

  if ($strAction[0] eq "Y")
  {
    &Set_Required_SFFClean_Version($strAction[1]);
  }

  # Check SFF version against directive required version
  if ($SFF_Version &&
      $Req_SFF_Collection_Version &&
      $SFF_Version lt $Req_SFF_Collection_Version)
  {
    print "This Directive file requires your SFF collection to be at least $Req_SFF_Collection_Version\n" .
          "Your SFF Collection is currently at $SFF_Version\n";
    dolog(\*objLogFile,"ERROR: SFF Collecion version $SFF_Version is less than directive requirement $Req_SFF_Collection_Version");
    exit;
  }

  # Check SFF Clean against required SFF Clean version
  if ($SFF_Clean_Version && $Req_SFFClean_Version && $Req_SFFClean_Version gt $SFF_Clean_Version)
  {
    print "This Directive file requires SFF Clean to be at $Req_SFFClean_Version\n" .
          "Your SFF Clean is currently at $SFF_Clean_Version\n";
    dolog(\*objLogFile,"ERROR: SFF Clean version $SFF_Clean_Version is less then directive requirement $Req_SFFClean_Version");
    exit;
  }

  # Only run directives if directive > SFF version 
  if ($SFF_Version eq "" ||
      $Directive_Version eq "" ||
      $SFF_Version lt $Directive_Version ||
      $Req_SFF_Collection_Version eq "")
  {
    &Process_Delete($strAction[1]) if $strAction[0] eq "D";
    &Process_Modify($strAction[0],$strAction[1],$strAction[2]) if $strAction[0] eq "M" || $strAction[0] eq "R";
    &Process_Create($strAction[1]) if $strAction[0] eq "C";
    &Process_MessageBox($strAction[1]) if $strAction[0] eq "B";
    &Process_If (@strAction) if $strAction[0] eq "I";
    &Process_Else (@strAction) if $strAction[0] eq "E";
    &Process_Zip ($strAction[1],$strAction[2]) if $strAction[0] eq "Z";
    &Process_Unzip ($strAction[1],$strAction[2]) if $strAction[0] eq "U";
    # Ignore any other lines
  }
}

dolog(\*objLogFile,"");
dolog(\*objLogFile,"SFF Clean Completed...");
dolog(\*objLogFile,"Applied: $CountApplied");
dolog(\*objLogFile,"Skipped: $CountSkipped");
dolog(\*objLogFile,"Failed: $CountErrors");
close(objLogFile);

# Set Rollback SFF version
if ($Original_SFF_Version)
{
  dolog(\*objRollbackFile,"V$seperator$Original_SFF_Version");
}
close(objRollbackFile);

if ($CountApplied==0 || $strInputFilePath =~ /_ROLLBACK.txt/)
{
  # Del Empty rollback file, or don't keep rollback of rollback
  unlink("$ebookLocation/$RollbackFilename");
}
else
{
  &reverse_file("$ebookLocation/$RollbackFilename");
}

my $histfile="$ebookLocation/${Log_Directory}Update_History.txt";

if ( ! -f $histfile)
{
  open(objHistoryFile,">$histfile");
  dolog(\*objHistoryFile,"TimeStamp	SFF v	Update v	Update Filename");
  dolog(\*objHistoryFile,"------------------------------------------------------------------------");
}
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]);

dolog(\*objHistoryFile,"$TStamp$seperator$Original_SFF_Version$seperator$Directive_Version$seperator$seperator$basefilepath");
close(objHistoryFile);

print "\nSFF Clean Completed...\n" .
      "Applied: $CountApplied\n" .
      "Skipped: $CountSkipped\n" .
      "Failed: $CountErrors\n";

exit;

#### END MAIN PROGRAM #####

sub Set_Directive_Version($)
{
  ($Directive_Version)=@_;
}

sub Set_Req_SFF_Collection_Version($)
{
  ($Req_SFF_Collection_Version)=@_;
}

sub Set_Required_SFFClean_Version($)
{
  ($Req_SFFClean_Version)=@_;
}


sub Get_SFF_Version
{
  if ( -f $SFFVersionFile)
  {
    open(objSFFVersionFile,"<$SFFVersionFile");
    $SFF_Version=<objSFFVersionFile>;
    $SFF_Version=~s/[\r\n]+//;
    close(objSFFVersionFile);

    # Set the version we will rollback to
    if (!$Original_SFF_Version)
    {
      $Original_SFF_Version=$SFF_Version;
    }
  }
  else
  {
    $Original_SFF_Version = "100.0"; #Only 100.0 should have no SFFVersion.txt
  }
}

sub Update_SFF_Version
{
   open(objSFFVersionFile,">$SFFVersionFile");
   dolog(\*objSFFVersionFile,"$Directive_Version");
   close(objSFFVersionFile);
}

sub Process_If (@)
{
  my (@strData)=@_;

  my $action=shift @strData;
  my $fname=shift @strData;

  if ( -e "$ebookLocation/$fname")
  {
    &doparse(@strData);
  }
}

sub Process_Else (@)
{
  my (@strData)=@_;

  my $action=shift @strData;
  my $fname=shift @strData;

  if ( ! -e "$ebookLocation/$fname")
  {
    &doparse(@strData);
  }
}

sub Process_Zip ($$)
{
  my ($zip_filename, $orig_source)=@_;

  my $working_dir="";
  my $filename="";

  my $source="$ebookLocation/$orig_source";
  if ( -f $source )
  {
    ($working_dir,$filename)=($source=~/^(.*)\/(.*)$/);
  }
  elsif ( -d $source )
  {
    $working_dir=$source;
    $filename="*";
  }

  if ($filename)
  {
    my $d=getcwd();

    # Make zip_locn a full pathname; if the user ebookLocation begins with
    # a / then use that, else prepend the current directory
    my $zip_locn=$ebookLocation;
    if ($zip_locn !~ /^\//)
    {
      $zip_locn="$d/$zip_locn";
    }
    my @cmd=("zip","-m","-r","$zip_locn/$zip_filename",".","-i",$filename);

    chdir($working_dir) && system(@cmd);
    chdir($d);

    if ( -f "$ebookLocation/$zip_filename")
    {
      dolog(\*objLogFile,"ZIPPED: $source to $zip_filename");
      dolog(\*objRollbackFile,"D$seperator$zip_filename");
      dolog(\*objRollbackFile,"U$seperator$zip_filename$seperator$orig_source");
      $CountApplied++;
    }
    else
    {
      dolog(\*objLogFile,"FAILED: Zip file not created / Nothing to zip - $zip_filename,$source",1);
      $CountErrors++;
    }
  }
  else
  {
    $CountErrors++;
    dolog(\*objLogFile,"FAILED: Can't zip files that don't exit - $source",1);
  }
}

sub Process_Unzip($$)
{
  my ($zip_filename,$destination)=@_;

  if ( -f "$ebookLocation/$zip_filename" )
  {
    system("unzip","-d","$ebookLocation/$destination","$ebookLocation/$zip_filename");
    dolog(\*objLogFile,"UNZIPPED: $zip_filename to $destination");
    dolog(\*objRollbackFile,"Z$seperator$zip_filename$seperator$destination");
    $CountApplied++;
  }
  else
  {
    $CountErrors++;
    dolog(\*objLogFile,"FAILED: source Zip file not found - $zip_filename",1);
  }
}

sub Process_Delete($)
{
  my ($strData)=@_;
  
  my $FromFullPath="$ebookLocation/$strData";

  my ($FromFolderPath,$FromFileName,$FromFull,$ToFolderPath,$ToFileName,$ToFull);

  if ( -f $FromFullPath )
  {
    if ($strData =~ /\//)
    {
      # File in a subdir
      ($FromFolderPath,$FromFileName)=($strData=~/^(.*)\/(.*)$/);
      $FromFull="$FromFolderPath/$FromFileName";
      $ToFolderPath="$DeletedFilesDirectory/$FromFolderPath";
      $ToFileName=$FromFileName;
      $ToFull="$ToFolderPath/$ToFileName";
    }
    else
    {
      # File in root dir
      $FromFolderPath = "";
      $FromFileName   = $strData;
      $FromFull       = $FromFileName;
      $ToFolderPath   = $DeletedFilesDirectory;
      $ToFileName     = $FromFileName;
      $ToFull         = "$ToFolderPath/$ToFileName";
    }
  }
  elsif ( -d $FromFullPath)
  {
    $FromFolderPath = $strData;
    $FromFileName   = "";
    $ToFolderPath   = "$DeletedFilesDirectory/$FromFolderPath";
    $ToFileName     = $FromFileName;
  }
  else
  {
    $ToFolderPath = "";
  }

  if ($ToFolderPath)
  {
    if (! -d "$ebookLocation/$ToFolderPath")
    {
      mkpath("$ebookLocation/$ToFolderPath") || die "Could not make $ebookLocation/$ToFolderPath: $!\n";
    }

    if ( -f $FromFullPath )
    {
      # unlink any existing bin'd file
      unlink("$ebookLocation/$ToFull");
      rename($FromFullPath,"$ebookLocation/$ToFull") || die "Could not rename $FromFullPath to $ebookLocation/$ToFull: $!\n";
      dolog(\*objLogFile,"DELETED: $FromFull to $ToFull");
      dolog(\*objRollbackFile,"M$seperator$ToFull$seperator$FromFull");
      $CountApplied++;
    }
    elsif (-d $FromFullPath )
    {
      # We just try to rmdir the directory; if we succeed then it was empty
      rmdir($FromFullPath);
      if ( ! -d $FromFullPath)
      {
        dolog(\*objLogFile,"DELETED: $FromFolderPath to $ToFolderPath");
        dolog(\*objRollbackFile,"C$seperator$FromFolderPath");
        $CountApplied++;
      }
      else
      {
        $CountSkipped++;
        dolog(\*objLogFile,"SKIPPED: Delete request on Folder that is NOT empty: $strData",1);
      }
    }
  }
  else
  {
    $CountSkipped++;
    dolog(\*objLogFile,"SKIPPED: Delete request on File/Folder that doesn't exist: $strData",1);
  }
}


sub Process_Modify($$$)
{
  my ($action,$OldName,$NewName)=@_;

  my ($FromFolderPath,$FromFileName,$FromFull,$FileType,$ToFolderPath,$ToFileName,$ToFull);
  
  my $FromFullPath="$ebookLocation/$OldName";
  my $ToFullPath = "$ebookLocation/$NewName";
  if (-f $FromFullPath)
  {
    $FileType = "FILE";
    if ($OldName =~ /\//)
    {
      ($FromFolderPath,$FromFileName)=($OldName=~/^(.*)\/(.*)$/);
      $FromFull="$FromFolderPath/$FromFileName";
    }
    else
    {
      $FromFolderPath = "";
      $FromFileName   = $OldName;
      $FromFull       = $FromFileName;
    }
  }
  elsif ( -d $FromFullPath )
  {
    $FileType = "FOLDER";
    $FromFolderPath = $OldName;
    $FromFileName   = "";
    $FromFull       = $FromFolderPath;
  }
  else
  {
    $FileType = "NOT_FOUND";
    $ToFolderPath="";
    $FromFolderPath="";
    $FromFileName   = "";
  }

  if ($FileType eq "FILE")
  {
    if ($NewName =~ /\//)
    { # file with dir
      ($ToFolderPath,$ToFileName)=($NewName=~/^(.*)\/(.*)$/);
      $ToFull="$ToFolderPath/$ToFileName";
    }
    else
    { # File in root dir
      $ToFolderPath = "";
      $ToFileName   = $NewName;
      $ToFull       = $ToFileName;
    }
  }
  elsif ($FileType eq "FOLDER")
  {
    $ToFolderPath = $NewName;
    $ToFileName   = "";
    $ToFull       = $ToFolderPath;
  }
  else
  {
    $ToFolderPath="";
    $ToFileName="";
    $ToFull="";
  }

  if ($action eq "R")
  { # handle R directive which doesn't enforce specifying full destination path
    $ToFolderPath = $FromFolderPath;
    if ($ToFolderPath eq "")
    {
      $ToFull = $ToFileName;
    }
    elsif ($ToFileName eq "")
    {
      $ToFull = $FromFolderPath ;
    }
    else
    {
      $ToFull = "$FromFolderPath/$ToFileName";
    }

    $ToFullPath = "$ebookLocation/$ToFull";
  }

  if ($ToFolderPath eq "" && $ToFileName =~ /\./)
  { # Handle move where only dest directory is given
    $ToFolderPath = $ToFileName;
    $ToFileName = $FromFileName;
    $ToFull = "$ToFolderPath/$ToFileName";
  }

  # If, somehow, source and dest are the same, skip this
  if ($FromFullPath eq "$ebookLocation/$ToFull")
  {
    $CountSkipped++;
    dolog(\*objLogFile,"SKIPPED: Modify request does nothing to File/Folder $OldName",1);
    return;
  }

  if ($FileType ne "NOT_FOUND")
  {
    # create target directories - last component is filename, so strip off
    my $destdir="$ebookLocation/$ToFolderPath";
    $destdir=~s!/[^/]*$!!;
    mkpath("$destdir") unless -d "destdir";
  }

  # If the destination is a directory, then append filename for the rename
  if (-d "$ebookLocation/$ToFull")
  {
    $ToFull .= "/$FromFileName";
  }

  if ($FileType eq "FILE")
  {
    if (! -f "$ebookLocation/$ToFull")
    {  # check dest file doesn't already exist
      if ( -e "$ebookLocation/$ToFolderPath")
      {  # Check Destination folder exists to put file
        rename("$FromFullPath","$ebookLocation/$ToFull") or die "Rename $FromFullPath to $ebookLocation/$ToFull: $!\n";
        dolog(\*objLogFile,"MODIFIED: $FromFull to $ToFull");
        dolog(\*objRollbackFile,"M$seperator$ToFull$seperator$FromFull");
        $CountApplied++;
      }
      else
      {
        $CountErrors++;
        dolog(\*objLogFile,"FAILED: Destination Folder does not exist: $ToFolderPath",1);
      }
    }
    else
    {
       $CountErrors++;
       dolog(\*objLogFile,"FAILED: Destination filename already exists: $ToFull",1);
    }
  }
  elsif ( "$FileType" eq "FOLDER" )
  {
    if ( ! -d "$ToFullPath")
    { # Dest folder doesn't exist
      rename($FromFullPath,$ToFullPath) or die "rename $FromFullPath $ToFullPath: $!\n";
      dolog(\*objLogFile,"MODIFIED: $FromFolderPath to $ToFolderPath");
      dolog(\*objRollbackFile,"M$seperator$ToFolderPath$seperator$FromFolderPath");
      $CountApplied++;
    }
    else
    {
      $CountErrors++;
      dolog(\*objLogFile,"FAILED: Destination Folder already exists: $ToFull",1);
    }
  }
  else
  {
    $CountSkipped++;
    dolog(\*objLogFile,"SKIPPED: Modify request on File/Folder that doesn't exist: $OldName",1);
  }
}

sub Process_Create($)
{
  my ($strData)=@_;

  if ( ! -d "$ebookLocation/$strData")
  {
    mkpath("$ebookLocation/$strData") or die "$!\n";
    $CountApplied++;
    dolog(\*objLogFile,"CREATED: $strData");
    dolog(\*objRollbackFile,"D$seperator$strData");
  }
  else
  {
    $CountSkipped++;
    dolog(\*objLogFile,"SKIPPED: Create Folder that already exists: $strData",1);
  }
}

sub Process_MessageBox
{
  my ($strData)=@_;
  $strData=~s/<BR>/\n/g;
  print "$strData\nPress Return: ";
  <STDIN>;
}

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);
}
