###############################################################################
#
# LocalFS.pm -- file functions acting upon the local filesystem
#
# A component of the Greenstone digital library software from the New Zealand
# Digital Library Project at the University of Waikato, New Zealand.
#
# Copyright (C) 2013 New Zealand Digital Library Project
#
# This program is free software; you can redistribute it and/or modify it under
# the terms of the GNU General Public License as published by the Free Software
# Foundation; either version 2 of the License, or (at your option) any later
# version.
#
# This program is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
# details.
#
# You should have received a copy of the GNU General Public License along with
# this program; if not, write to the Free Software Foundation, Inc., 675 Mass
# Ave, Cambridge, MA 02139, USA.
#
###############################################################################

package FileUtils::LocalFS;

# Pragma
use strict;


# Globals
my $paths_we_cannot_link_from = {};


## @function canRead()
#
sub canRead
{
  my $path = shift(@_);
  return &fileTest($path, '-R');
}
## canRead()


## @function closeFileHandle
#
sub closeFileHandle
{
  my $fh_ref = shift(@_);
  close($$fh_ref);
  return 1;
}
## closeFileHandle()


## @function filenameConcatenate()
#
sub filenameConcatenate
{
  my $first_file = shift(@_);
  my (@filenames) = @_;

  #   Useful for debugging
  #     -- might make sense to call caller(0) rather than (1)??
  #   my ($cpackage,$cfilename,$cline,$csubr,$chas_args,$cwantarray) = caller(1);
  #   print STDERR "Calling method: $cfilename:$cline $cpackage->$csubr\n";

  # If first_file is not null or empty, then add it back into the list
  if (defined $first_file && $first_file =~ /\S/) {
    unshift(@filenames, $first_file);
  }

  my $filename = join("/", @filenames);

  # remove duplicate slashes and remove the last slash
  if ($ENV{'GSDLOS'} =~ /^windows$/i) {
    $filename =~ s/[\\\/]+/\\/g;
  } else {
    $filename =~ s/[\/]+/\//g;
    # DB: want a filename abc\de.html to remain like this
  }
  $filename =~ s/[\\\/]$//;

  return $filename;
}
## filenameConcatenate()


## @function fileSize()
#
sub fileSize
{
  my ($filename_full_path) = @_;
  return -s $filename_full_path;
}
## fileStatus()


## @function fileTest()
#
sub fileTest
{
  my $filename_full_path = shift(@_);
  # By default tests for existance of file or directory (-e)
  # Can be made more specific by providing second parameter (e.g. -f or -d)
  my $test_op = shift(@_) || '-e';

  my $exists = 0;

  if ($ENV{'GSDLOS'} =~ m/^windows$/i) {
    require Win32;
    my $filename_short_path = Win32::GetShortPathName($filename_full_path);
    if (!defined $filename_short_path) {
      # Was probably still in UTF8 form (not what is needed on Windows)
      my $unicode_filename_full_path = eval "decode(\"utf8\",\$filename_full_path)";
      if (defined $unicode_filename_full_path) {
        $filename_short_path = Win32::GetShortPathName($unicode_filename_full_path);
      }
    }
    $filename_full_path = $filename_short_path;
  }

  if (defined $filename_full_path) {
    $exists = eval "($test_op \$filename_full_path)";
  }

  # The eval may result in exists being undefined, but we need to return
  # something
  return ($exists || 0);
}
## fileTest()


## @function isFilenameAbsolute()
#
sub isFilenameAbsolute
{
  my ($filename) = @_;
  if ($ENV{'GSDLOS'} =~ /^windows$/i)
  {
    return ($filename =~ m/^(\w:)?\\/);
  }
  return ($filename =~ m/^\//);
}
# isFilenameAbsolute()


## @function isHDFS
#
sub isHDFS
{
  return 0;
}
## isHDFS()


## @function linkFile()
#
sub linkFile
{
  my ($mode, $src, $dest, $ensure_paths_absolute) = @_;

  # remove trailing slashes from source and destination files
  $src =~ s/[\\\/]+$//;
  $dest =~ s/[\\\/]+$//;

  # Ensure file paths are absolute IF requested to do so
  # Soft_linking didn't work for relative paths
  if($mode eq 'HARD' || (defined $ensure_paths_absolute && $ensure_paths_absolute))
  {
    # We need to ensure that the src file is the absolute path
    # See http://perldoc.perl.org/File/Spec.html
    if(!File::Spec->file_name_is_absolute( $src ))
    {
      # it's relative
      $src = File::Spec->rel2abs($src); # make absolute
    }
    # Might as well ensure that the destination file's absolute path is used
    if(!File::Spec->file_name_is_absolute( $dest ))
    {
      $dest = File::Spec->rel2abs($dest); # make absolute
    }
  }

  # a few sanity checks
  if (!-e $src)
  {
    &FileUtils::printError('Source file does not exist: ' . $src);
    return 0;
  }

  my $dest_dir = &File::Basename::dirname($dest);
  if (!-e $dest_dir)
  {
    &makeAllDirectories($dest_dir);
  }

  my $error_message = ucfirst(lc($mode)) . ' link failed';
  if ($ENV{'GSDLOS'} =~ /^windows$/i)
  {
    # symlink not supported on windows
    $error_message = 'Symlink not supported on windows';
  }
  elsif ($mode eq 'HARD')
  {
    link($src, $dest);
    #if (!eval {link($src, $dest)})
    #{
    #  &FileUtils::printWarning('Unable to create hard link: ' . $dest);
    #}
  }
  elsif ($mode eq 'SOFT')
  {
    symlink($src, $dest);
    #if (!eval {symlink($src, $dest)})
    #{
    #  &FileUtils::printWarning('Unable to create soft link: ' . $src);
    #}
  }
  else
  {
    $error_message = 'Unknown mode requested: ' . $mode;
  }
  if (!-e $dest)
  {
    # Determine the top source path
    my ($src_root) = $src =~ /^([a-z]:\\|\/[^\/]+)/i;
    # If we haven't warned about this yet, warn now and record that we've
    # warned. I want to let the user know what has happened, but without
    # bombarding them with a thousand warning messages...
    if (!defined $paths_we_cannot_link_from->{$src_root})
    {
      &FileUtils::printWarning($error_message . '. Will attempt to copy from: ' . $src_root);
      $paths_we_cannot_link_from->{$src_root} = 1;
    }
    &File::Copy::copy ($src, $dest);
  }
  return (-e $dest);
}
# /** linkFile() **/


## @function makeAllDirectories()
#
# in case anyone cares - I did some testing (using perls Benchmark module)
# on this subroutine against File::Path::mkpath (). mk_all_dir() is apparently
# slightly faster (surprisingly) - Stefan.
#
sub makeAllDirectories
{
  my ($dir) = @_;

  # use / for the directory separator, remove duplicate and
  # trailing slashes
  $dir=~s/[\\\/]+/\//g;
  $dir=~s/[\\\/]+$//;

  # make sure the cache directory exists
  my $dirsofar = "";
  my $first = 1;
  foreach my $dirname (split ("/", $dir))
  {
    $dirsofar .= "/" unless $first;
    $first = 0;

    $dirsofar .= $dirname;

    next if $dirname =~ /^(|[a-z]:)$/i;
    if (!-e $dirsofar)
    {
      my $store_umask = umask(0002);
      my $mkdir_ok = mkdir ($dirsofar, 0777);
      umask($store_umask);
      if (!$mkdir_ok)
      {
        print STDERR "FileUtils::makeAllDirectories() could not create directory $dirsofar\n";
        return;
      }
    }
  }
 return 1;
}
## makeAllDirectories()


## @function makeDirectory()
#
sub makeDirectory
{
  my $dir = shift(@_);
  my $store_umask = umask(0002);
  my $mkdir_ok = mkdir ($dir, 0777);
  umask($store_umask);
  return $mkdir_ok;
}
## makeDirectory()


## @function modificationTime()
#
sub modificationTime
{
  my $path = shift(@_);
  my @file_status = stat($path);
  return $file_status[9];
}
## modificationTime()

## @function openFileHandle()
#
sub openFileHandle
{
  my $path = shift(@_);
  my $mode = shift(@_);
  my $fh_ref = shift(@_);
  my $encoding = shift(@_);
  my $mode_symbol;
  if ($mode eq 'w' || $mode eq '>')
  {
    $mode_symbol = '>';
    $mode = 'writing';
  }
  elsif ($mode eq 'a' || $mode eq '>>')
  {
    $mode_symbol = '>>';
    $mode = 'appending';
  }
  else
  {
    $mode_symbol = '<';
    $mode = 'reading';
  }
  if (defined $encoding)
  {
    $mode_symbol .= ':' . $encoding;
  }
  return open($$fh_ref, $mode_symbol, $path);
}
## openFileHandle()

# /**
#  */
sub readDirectory
{
  my $path = shift(@_);
  my $rvalue;
  if (opendir(DH, $path))
  {
      my @files = readdir(DH);
      close(DH);
      $rvalue = \@files;
  }
  return $rvalue;
}
# /** readDirectory() **/


## @function removeFiles()
#
sub removeFiles
{
  my $file = shift(@_);
  my $result = 0;
  if (!-e $file && !-l $file)
  {
    &FileUtils::printError('File does not exist: ' . $file);
  }
  elsif ((!-f $file) && (!-l $file))
  {
    &FileUtils::printError('Not a regular file: ' . $file);
  }
  else
  {
    $result = unlink($file);
    if (!$result)
    {
      &FileUtils::printError('Failed to remove file: ' . $file);
    }
  }
  return $result;
}
## removeFiles()


## @function removeFilesFiltered()
#
# recursive removal
#
sub removeFilesFiltered
{
  my ($files, $file_accept_re, $file_reject_re) = @_;
  #   my ($cpackage,$cfilename,$cline,$csubr,$chas_args,$cwantarray) = caller(2);
  #   my ($lcfilename) = ($cfilename =~ m/([^\\\/]*)$/);
  #   print STDERR "** Calling method (2): $lcfilename:$cline $cpackage->$csubr\n";
  my @files_array = (ref $files eq "ARRAY") ? @$files : ($files);

  my $num_removed = 0;

  foreach my $file (@files_array)
  {
    # remove trailing slashes
    $file =~ s/[\/\\]+$//;

    if (!-e $file)
    {
      print STDERR "util::filtered_rm_r $file does not exist\n";
    }
    # don't recurse down symbolic link
    elsif ((-d $file) && (!-l $file))
    {
      # get the contents of this directory
      if (!opendir (INDIR, $file))
      {
        print STDERR "util::filtered_rm_r could not open directory $file\n";
      }
      else
      {
        my @filedir = grep (!/^\.\.?$/, readdir (INDIR));
        closedir (INDIR);

        # remove all the files in this directory
        map {$_="$file/$_";} @filedir;
        $num_removed += &FileUtils::LocalFS::removeFilesFiltered(\@filedir, $file_accept_re, $file_reject_re);

        if (!defined $file_accept_re && !defined $file_reject_re)
        {
          # remove this directory
          if (!rmdir $file)
          {
            print STDERR "util::filtered_rm_r couldn't remove directory $file\n";
          }
          else
          {
            $num_removed++;
          }
        }
      }
    }
    else
    {
      next if (defined $file_reject_re && ($file =~ m/$file_reject_re/));

      if ((!defined $file_accept_re) || ($file =~ m/$file_accept_re/))
      {
        # remove this file
        $num_removed += &removeFiles($file);
      }
    }
  }
  return $num_removed;
}
## removeFilesFiltered()


## @function removeFilesRecursive()
#
sub removeFilesRecursive
{
  my $path = shift(@_);
  # use the more general (but reterospectively written filteredRemove()
  # function with no accept or reject expressions
  return FileUtils::LocalFS::removeFilesFiltered($path, undef, undef);
}
## removeFilesRecursive()


## @function supportsSymbolicLink
#
sub supportsSymbolicLink
{
  return 1;
}
## supportsSymbolicLink()


## @function synchronizeDirectory()
#
# updates a copy of a directory in some other part of the filesystem
# verbosity settings are: 0=low, 1=normal, 2=high
# both $fromdir and $todir should be absolute paths
#
sub synchronizeDirectory
{
  my ($fromdir, $todir, $verbosity) = @_;
  $verbosity = 1 unless defined $verbosity;

  # use / for the directory separator, remove duplicate and
  # trailing slashes
  $fromdir=~s/[\\\/]+/\//g;
  $fromdir=~s/[\\\/]+$//;
  $todir=~s/[\\\/]+/\//g;
  $todir=~s/[\\\/]+$//;

  &mk_all_dir ($todir);

  # get the directories in ascending order
  if (!opendir (FROMDIR, $fromdir))
  {
    print STDERR "util::cachedir could not read directory $fromdir\n";
    return;
  }
  my @fromdir = grep (!/^\.\.?$/, sort(readdir (FROMDIR)));
  closedir (FROMDIR);

  if (!opendir (TODIR, $todir))
  {
    print STDERR "util::cacedir could not read directory $todir\n";
    return;
  }
  my @todir = grep (!/^\.\.?$/, sort(readdir (TODIR)));
  closedir (TODIR);

  my $fromi = 0;
  my $toi = 0;

  while ($fromi < scalar(@fromdir) || $toi < scalar(@todir))
  {
    #	print "fromi: $fromi toi: $toi\n";

    # see if we should delete a file/directory
    # this should happen if the file/directory
    # is not in the from list or if its a different
    # size, or has an older timestamp
    if ($toi < scalar(@todir))
    {
      if (($fromi >= scalar(@fromdir)) ||
          ($todir[$toi] lt $fromdir[$fromi] || 
           ($todir[$toi] eq $fromdir[$fromi] && 
            &differentfiles("$fromdir/$fromdir[$fromi]","$todir/$todir[$toi]",
                            $verbosity))))
      {
        # the files are different
        &rm_r("$todir/$todir[$toi]");
        splice(@todir, $toi, 1); # $toi stays the same
      }
      elsif ($todir[$toi] eq $fromdir[$fromi])
      {
        # the files are the same
        # if it is a directory, check its contents
        if (-d "$todir/$todir[$toi]")
        {
          &synchronizeDirectory("$fromdir/$fromdir[$fromi]", "$todir/$todir[$toi]", $verbosity);
        }

        $toi++;
        $fromi++;
        next;
      }
    }

    # see if we should insert a file/directory
    # we should insert a file/directory if there
    # is no tofiles left or if the tofile does not exist
    if ($fromi < scalar(@fromdir) && ($toi >= scalar(@todir) ||
                                      $todir[$toi] gt $fromdir[$fromi]))
    {
      &cp_r ("$fromdir/$fromdir[$fromi]", "$todir/$fromdir[$fromi]");
      splice (@todir, $toi, 0, $fromdir[$fromi]);
      $toi++;
      $fromi++;
    }
  }
}
## synchronizeDirectory()


# /**
#  */
sub transferFile
{
  my ($mode, $file, $dest) = @_;
  # remove trailing slashes from source and destination files
  $file =~ s/[\\\/]+$//;
  $dest =~ s/[\\\/]+$//;
  my $tempdest = $dest;
  if (!-e $file)
  {
    &FileUtils::printError('File does not exist: ' . $file);
  }
  else
  {
    if (-d $tempdest)
    {
      my ($filename) = $file =~ /([^\\\/]+)$/;
      $tempdest .= "/$filename";
    }
    # start by processing any move request
    if ($mode eq 'MOVE')
    {
      &File::Copy::move($file, $tempdest);
    }
    # now if we were instead doing a copy, or if the move request above failed
    # for some reason, we process a copy request
    if ($mode eq 'COPY' || !-e $tempdest)
    {
      &File::Copy::copy($file, $tempdest);
    }
    # finally, we check if a successful move command has somehow left the origin
    # file lying around (rename partially succeeded - for instance when moving
    # hardlinks)
    if ($mode eq 'MOVE' && -e $tempdest && -e $file)
    {
      unlink($file);
    }
  }
  # Have we successfully moved the file?
  my $result = 0;
  if (-e $tempdest)
  {
    if ($mode eq 'MOVE')
    {
      if (-e $file)
      {
        &FileUtils::printError('Failed to remove original file during move: ' . $file);
      }
      else
      {
        $result = 1;
      }
    }
    else
    {
      $result = 1;
    }
  }
  else
  {
    &FileUtils::printError('Failed to move/copy file: ' . $file);
  }
  return $result;
}
# /** moveFile() **/

1;