#!/usr/bin/perl
# ----------------------------------------------------------------------------
# This software is Copyright (C) 2007, All Rights Reserved
# ----------------------------------------------------------------------------
# This program is protected by local and international copyright laws. Any
# use of this program is subject to the the terms of the license agreement
# included as part of this distribution archive. Any other uses are strictly
# prohibited without the written permission of the Vendor and all
# other rights are reserved.
# -----------------------------------------------------------------------------
# Warning : Modifying this program violates your license agreement!
# -----------------------------------------------------------------------------

package IT::File;

use strict;

use IT::Globals;

# library globals
use vars qw($CREATEFILEHANDLE_LAST_USED_NUM);
$CREATEFILEHANDLE_LAST_USED_NUM = 0;




# ----------------------------------------------------------------------------
# Function    : isRootDir
# Description : check if filepath is a root directory.  Always returns false
#               for relative paths
# Usage       : my $isRootDir = &isRootDir($dir);
# ----------------------------------------------------------------------------

sub isRootDir {
  my $path = shift;
  if (&isRelativePath($path))          { return 0; }
  $path = &cleanPath($path);

  if    ($path eq '/')                             { return 1; } # match /
  elsif ($path =~ m|^[a-z]:/?$|is)                 { return 1; } # match C: or C:/
  elsif ($path =~ m|^[\\\/]{2}\b[^/]+/?$|is)       { return 1; } # match //SERVER, \\SERVER/, etc (UNC path)
  elsif ($path =~ m|^[\\\/]{2}\b[^/]+/[^/]+/?$|is) { return 1; } # match //SERVER/share/, etc (UNC path)

  return 0
}

# ----------------------------------------------------------------------------
# Function    : isRelativePath
# Description : check if a filepath is relative or not.  Note, doesn't check
#               if path exists or is valid in any way.
# Usage       : my $isRelativePath = &isRelativePath($path);
# ----------------------------------------------------------------------------

sub isRelativePath {
  my $path = shift;
  if ($path =~ m/^(\w:)/)  { return 0; }  # starts with X:
  if ($path =~ m/^[\\\/]/) { return 0; }  # starts with slash
  return 1;
}

# ----------------------------------------------------------------------------
# Function    : makeRelativePathsAbsolute
# Description : make relative paths absolute, leave absolute paths unchanged
# Usage       : my $absolutePath = &IT::File::makeRelativePathsAbsolute($relativeOrAbsolutePath, $rootDir);
# ----------------------------------------------------------------------------

sub makeRelativePathsAbsolute {
  my $relativeOrAbsolutePath = shift;
  my $rootDir                = shift || &IT::Error::dieAsCaller("rootDir not defined!");

  # error checking
  if (&isRelativePath($rootDir)) { &IT::Error::dieAsCaller("rootdir '$rootDir' can't be a relative path!"); }

  # make paths absolute
  my $absolutePath;
  if (&isRelativePath($relativeOrAbsolutePath)) {
    $absolutePath = "$rootDir/$relativeOrAbsolutePath";
    $absolutePath = &cleanPath($absolutePath);
  }
  else {
    $absolutePath = $relativeOrAbsolutePath;
  }

  return $absolutePath;
}

# ----------------------------------------------------------------------------
# Function    : getParentDirectory
# Description : return the parent directory of a directory or file.  If
#               dir is root dir than nothing is returned.
# Usage       : my $parentDir = &IT::File::getParentDirectory($fileOrDirPath);
# ------------------------------------------------------------------------

sub getParentDirectory {
  my $fileOrDirPath = shift;
  my $parentDir     = &cleanPath($fileOrDirPath);
  $parentDir        =~ s|[^/]+$||; # remove dir or filename from end of path
  $parentDir        = &cleanPath($parentDir); # remove trailing slash off non-root paths
  return $parentDir;
}

# ----------------------------------------------------------------------------
# Function    : cleanPath
# Description : clean up filepaths by:
#                 - remove null bytes
#                 - replacing backslashes with forward slashes
#                 - removing current directory references "/./"
#                 - resolving parent directory refereces (/www/data/../ = /www)
#                 - replacing multiple splashes with one
#                 - removing trailing slashes (except for root dirs)
#
#               Note:  This function doesn't check if that path exists or is
#               valid.  Also, this function only takes absolute paths.
#
# Usage       : my $cleanPath = &cleanPath($messyPath);
# ----------------------------------------------------------------------------

sub cleanPath {
  my $inputPath = shift;
  if (@_) { &IT::Error::dieAsCaller("cleanPath only takes ONE argument!"); }

  # error checking
  if (&isRelativePath($inputPath)) { &IT::Error::dieAsCaller("relative paths not supported! '$inputPath'"); }

  # temporarily remove path prefixes
  my $cleanPath   = $inputPath;
  my $driveLetter = '';
  my $UNCPrefix   = '';
  if    ($cleanPath =~ s/^([a-z])://i) { $driveLetter = $1; }
  elsif ($cleanPath =~ s|^([\\\/]{2})\b||i) { $UNCPrefix = $1; } # for UNC (Universal Naming Convention) network paths (eg: //SERVER\path\file.dat)

  # clean path
  $cleanPath =~ s/\x00//g;                              # remove null bytes
  $cleanPath =~ tr|\\|/|;                               # replace \ with /
  $cleanPath =~ s!/\.(?=/+|\z)!!g;                      # remove current dir references (/./)
  1 while ($cleanPath =~ s!/?[^/]*/+\.\.(?=/|\z)!!);    # resolve parent references ("..")
  $cleanPath =~ s|/+|/|g;                               # remove multiple /'s
  $cleanPath =~ s|/+$||;                                # remove trailing slash

  if ($cleanPath eq '') { $cleanPath = '/'; } # add trailing slash to root paths
  if ($driveLetter)     { $cleanPath = "$driveLetter:$cleanPath"; } # re-attach drive letter for windows paths
  if ($UNCPrefix)       { $cleanPath = "$UNCPrefix$cleanPath"; }    # UNC doubleslash prefix

  return $cleanPath;
}

# ------------------------------------------------------------------------
# Function    : createDirPath
# Description : create a directory and it's parents if needed.  returns 1
#               on success, 0 on failure (and $! should be set).
# Usage       : &IT::File::createDirPath($dirpath) || die "Couldn't create '$dirpath' : $!";
# ------------------------------------------------------------------------

sub createDirPath {
  my $path = shift;
  if (-d $path) { return 1; }

  $path = &cleanPath($path);

  # create dirs in path
  my $thisDir;
  foreach my $dirNameInPath (split("/", $path)) {
    $thisDir .= "$dirNameInPath/";
    if (-d $thisDir) { next; }
    if (&isRootDir($thisDir)) { next; } # skip over UNC "root dirs" which can't be created (eg: //SERVER, //SERVER/share)

    # Note: We may not have permission to view or create directories above the filepath
    # so we don't check if those get created (it may return false even if they exist),
    # we just try and create them all and check if the requested directory got created at the end
    mkdir($thisDir, 0777);
  }

  if (-d $path) { return 1; }
  else          { return 0; }

  return 1;
}

# ---------------------------------------------------------------------------------
# Function    : createFilehandle
# Description : Create a new lexically scoped filehandle
#               (actually it's a glob that can be used as a filehandle)
# Usage       : my $FH = &createFilehandle();
# ---------------------------------------------------------------------------------

sub createFilehandle {
  $CREATEFILEHANDLE_LAST_USED_NUM++;
  my $name = "FH" . $CREATEFILEHANDLE_LAST_USED_NUM;
  my $fh = do { no strict; local *$name; };
  return $fh;
}

# ---------------------------------------------------------------------------------
# Function    : unbufferFilehandle
# Description : Unbuffer a filehandle
# Usage       : &unbufferFilehandle($fileHandle);
# ---------------------------------------------------------------------------------

sub unbufferFilehandle {

  my $fileHandle    = shift;
  my $oldFileHandle = select($fileHandle);

  $| = 1;
  select($oldFileHandle);
}


# ----------------------------------------------------------------------------
# Function    : createUniqueFilename
# Description : create a unique, unused filename with the specified prefix and ext.
#               NOTE:  Be sure to actually CREATE file beforing removing filelock!
# Usage       : my($tempFileName) = &createUniqueFilename($path, $filePrefix, $fileSuffix);
# Usage       : my $tempFileName = &createUniqueFilename("C:\www\", "news_", ".html");  # might create news_1105045791000.html
# ----------------------------------------------------------------------------

sub createUniqueFilename {
  my($dir, $prefix, $suffix) = @_;

  # error checking
  unless (-e $dir) { &IT::Error::dieAsCaller("dir '$dir' doesn't exist!"); }
  unless (-d $dir) { &IT::Error::dieAsCaller("dir '$dir' isn't a directory!"); }
  &IT::FileLock::lockRequired('exclusive');  # to prevent someone from getting this filename before it's created!

  my $counter = int(time) .'000';
  my $tempFileName;
  my $tempFilePath;

  while (1) {
    $tempFileName = $prefix . $counter . $suffix;
    $tempFilePath = "$dir/$tempFileName";
    last unless -e $tempFilePath;   # we're done unless this filename is already in use
    $counter++;
  }

  return $tempFileName;
}

# ------------------------------------------------------------------------------
# Function    : incrementFileNameOrPath
# Description : Preserves existing filename or path and adds an increment number
#               on end in the form "_###"
#               Used for finding unused filenames and paths
# Usage       : my $filename = &IT::File::incrementFileNameOrPath($filenNameOrPath);
# ------------------------------------------------------------------------------

sub incrementFileNameOrPath {
  my $fileNameOrPath = shift;

  # split filename or path
  unless ($fileNameOrPath =~ /^(.*?)(_?)(\d*)((\.\w+|\.+|[\\\/])*)$/) { die "Couldn't match fileNameOrPath '$fileNameOrPath'!"; }
  my $prefix       = $1;
  my $matchedSlash = $2;
  my $counter      = $3;
  my $suffix       = $4;

  if (!$matchedSlash) {
    $prefix = "$prefix$counter";
    $counter = 0;
  }

  # increment counter
  $counter++;

  # create new filename or path

  my $newFileNameOrPath = $prefix;
  $newFileNameOrPath   .= "_";
  $newFileNameOrPath   .= $counter;
  $newFileNameOrPath   .= $suffix;

  return $newFileNameOrPath;
}

# ------------------------------------------------------------------------
# Function    : loadINI
# Description : load an ini file into a multilevel ini hash
# Usage       : $ini = &IT::File::loadINI("$fullPathToIniFile");
# ------------------------------------------------------------------------

sub loadINI {
  my $filepath = shift;

  # error checking
  &IT::Error::dieOnValidationErrors(
    ["filepath '$filepath'", $filepath, "notBlank notRelativePath fileMustExist"],
  );

  # load file
  my @lines = &IT::File::readFile($filepath, 'WITHOUT_FILELOCKING');
  # the ini file has the datadir location, which tells us where to create filelocks.
  # So we don't use filelocking when loading the INI file.

  # parse content and create hash
  my($hashRef,%hash);                                # scope vars
  $hashRef = \%hash;                                 # reference to hash

  foreach (@lines) {
    /^\s*#/m && next;                                   # skip comments
    /^\s+$/m && next;                                   # skip blank lines

    if (/^\s*\[/m) {                                    # process section heading
      $hashRef = \%hash;                                # reset ref to hash root

      foreach (/\[(.+?)\]/g) {                          # keep moving deeper in multilevel hash
        $hashRef = \%{$hashRef->{$_}};
      }

      next;
    }


    # load keys and value for section
    my $pos = index($_,'=');                          # get name, value
    my $name = substr($_,0,$pos);                     # get name
    my $value;
    if ($pos > 0) { $value = substr($_,$pos+1); }     # get value
    foreach ($name,$value) { s/^\s+//; s/\s+$//; }    # remove leading/trailing whitespace

    # if key already exists, make it an array and add value to array
    if (defined $hashRef->{$name}) {
      if (ref($hashRef->{$name}) ne 'ARRAY') { $hashRef->{$name} = [ $hashRef->{$name}, $value ]; }
      else                               { push @{$hashRef->{$name}}, $value; }
    }
    elsif (!defined $hashRef->{$name} && $name ne '') {
      $hashRef->{$name} = $value;                           # add to hash
    }
  }

  return \%hash;                                           # return hashref of ini values
}

# ------------------------------------------------------------------------
# Function    : readFile
# Description : read in the contents of a file and return all data in
#               scalar context and lines array in array context.  Filelocking
#               is enabled by default unless 'WITHOUT_FILELOCKING' is set.
#
#               Dies on errors.
#
# Usage       : my $data  = &IT::File::readFile($fullpath, $without_filelocking);
# Usage       : my @lines = &IT::File::readFile($fullpath, $without_filelocking);
# Arguments   : $without_filelocking as 'WITHOUT_FILELOCKING' or undef
# ------------------------------------------------------------------------

sub readFile {
  my $filepath       = shift;
  my $no_filelocking = shift;

  # error checking
  &IT::Error::dieOnValidationErrors(
    ["\$filepath '$filepath'", $filepath,       "notBlank notRelativePath fileMustExist"],
    ["\$filelocking",          $no_filelocking, "oneOf(,WITHOUT_FILELOCKING)"],
  );

  $filepath    = &cleanPath($filepath);

  # get filelock
  unless ($no_filelocking) { &IT::FileLock::getLock('shared');  }

  # open file
  my $preRead_fileSizeAndDate = join '-', (stat($filepath))[7,9];
  my $fh = &createFilehandle();
  open($fh, "<$filepath") or die "Can't open '$filepath' : $!";
  binmode($fh);

  # load data
  my $filedata;
  read($fh, $filedata, -s $fh);

  # close file
  close($fh) or die "Can't close '$filepath' : $!";

  # error checking
  my $postRead_fileSizeAndDate = join '-', (stat($filepath))[7,9];
  my $fileChangedDuringRead    = $preRead_fileSizeAndDate ne $postRead_fileSizeAndDate;
  if ($fileChangedDuringRead) { die "File '$filepath' was changed during read"; }

  my $filesize = (stat($filepath))[7];
  if (length $filedata != $filesize) { die "Error reading entire file (bytes read doesn't match filesize)"; }

  # release filelock
  unless ($no_filelocking) { &IT::FileLock::releaseLock(); }

  if (wantarray) { return split(/(?<=\n)/, $filedata); }
  else           { return $filedata; }

}

# ------------------------------------------------------------------------
# Function    : appendFile
# Description : append data to a file. requires exclusive filelocking.
#               creates non-existant files.
#
# Usage       : &IT::File::appendFile($fullpath, $data) || die "Unable to write file: $!";
# ------------------------------------------------------------------------

sub appendFile {
  my $filepath = shift;
  my $data     = shift;
  $filepath    = &cleanPath($filepath);        # clean filepath

  # error checking
  &IT::FileLock::lockRequired('exclusive');
  if (&isRelativePath($filepath)) { &IT::Error::dieAsCaller("relative paths not supported! '$filepath'"); }
  if (-d $filepath)               { die "'$filepath' is a directory!"; }

  # write file
  my $writeError = 1;
  {
    # NOTE:  We need to check for errors on every command to catch disk full errors!
    my $filehandle = &createFilehandle();
    open($filehandle, ">>$filepath")      or last;
    binmode($filehandle);
    print $filehandle $data              or last;
    close($filehandle)                   or last;

    $writeError = 0;
  }

  if ($writeError) { return 0; }
  else             { return 1; }
}

# ------------------------------------------------------------------------
# Function    : writeFile
# Description : write data to a file. requires exclusive filelocking.
#               overwrites existing files.
#
#               NOTE:  If write fails half way through the file then the file
#               won't be complete.  For important files such as data files that
#               would be corrupted if only written back partially, write to a
#               temp file, check for success, and then rename.
#
# Usage       : &IT::File::writeFile($fullpath, $data) || die "Unable to write file: $!";
# ------------------------------------------------------------------------

sub writeFile {
  my $filepath = shift;
  my $data     = shift;
  $filepath    = &cleanPath($filepath);        # clean filepath

  # error checking
  &IT::FileLock::lockRequired('exclusive');
  if (&isRelativePath($filepath)) { &IT::Error::dieAsCaller("relative paths not supported! '$filepath'"); }
  if (-d $filepath)               { die "'$filepath' is a directory!"; }

  # write file
  my $writeError = 1;
  {
    # NOTE:  We need to check for errors on every command to catch disk full errors!
    my $filehandle = &createFilehandle();
    open($filehandle, ">$filepath")      or last;
    binmode($filehandle);
    print $filehandle $data              or last;
    close($filehandle)                   or last;

    $writeError = 0;
  }

  if ($writeError) { return 0; }
  else             { return 1; }
}

# ------------------------------------------------------------------------
# Function    : writeFileFast
# Description : write data to a file, dies on errors
# Usage       : &IT::File::writeFileFast($fullpath, $data);
# ------------------------------------------------------------------------

sub writeFileFast {
  my $filepath = shift;
  my $data = shift;

  my $fh = &createFilehandle();
  open($fh, ">$filepath")      or die "can't write to '$filepath'! $!";
  binmode($fh);
  print $fh $data              or die "can't write to '$filepath'! $!";
  close($fh)                   or die "can't close filepath '$filepath'! $!";
}

# ----------------------------------------------------------------------------
# Function    : copyFile
# Description : create a copy of a file in new location.  overwrites existing files.
#               returns 1 on success, 0 on failure.  Use filelocking if needed!
# Usage       : &IT::File::copyFile($sourcePath, $targetPath) || die $!;
# ----------------------------------------------------------------------------

sub copyFile {
  my $sourcePath = shift;
  my $targetPath = shift;

  # error checking
  if (&isRelativePath($sourcePath)) { &IT::Error::dieAsCaller("relative sourcepaths not supported! '$sourcePath'"); }
  if (&isRelativePath($targetPath)) { &IT::Error::dieAsCaller("relative targetpaths not supported! '$targetPath'"); }
  if (!-f $sourcePath)              { die "sourcepath '$sourcePath' is not a file!"; }
  if (-d $targetPath)               { die "targetpath '$targetPath' is a directory!"; }

  # open source file
  my $sourceFH = &createFilehandle();
  open($sourceFH, "<$sourcePath") or return 0;
  binmode($sourceFH);

  # open target file
  my $targetFH = &createFilehandle();
  open($targetFH, ">$targetPath") or return 0;
  binmode($targetFH);

  # copy file
  while (<$sourceFH>) {
    print $targetFH $_ or return 0;
  }


  # close files
  close($sourceFH) || return 0;
  close($targetFH) || return 0;

  # error checking
  if (-s $sourcePath != -s $targetPath) { return 0 }

  return 1;
}

# ----------------------------------------------------------------------------
# Function    : dirList
# Description : return a list of all the files and subdirs in a specified directory.
# Usage       : my @files = &IT::File::dirList($dirPath);
# ----------------------------------------------------------------------------

sub dirList {
  my $dirPath = shift;

  # error checking
  unless (wantarray)                { &IT::Error::dieAsCaller("function must be called in list context"); }
  if (&isRelativePath($dirPath))    { &IT::Error::dieAsCaller("relative paths not supported! '$dirPath'"); }
  if (!-e $dirPath)                 { die "path '$dirPath' doesn't exist!"; }
  if (!-d $dirPath)                 { die "path '$dirPath' is not a directory!"; }

  # list directory
  my $fh = &IT::File::createFilehandle();
  opendir($fh, "$dirPath") || die "Can't read dir '$dirPath' $!";
  my @files = grep !/^\.+$/, readdir($fh);
  closedir($fh);

  # build directory list
  my $trailingSlash = ($dirPath =~ m/[\\\/]+$/);
  my $slash = $trailingSlash ? "" : "/"; # only add slash if there isn't one already

  my @dirList;
  foreach my $file (@files) {
    push (@dirList, "$dirPath$slash$file");
  }

  return @dirList;
}

# ----------------------------------------------------------------------------
# Function    : dirTree
# Description : return a list of all the files and subdirs in a specified
#               directory AND all it's subdirectories.
# Usage       : my @dirtree = &IT::File::dirTree($dirPath);
# ----------------------------------------------------------------------------

sub dirTree {
  my $dirPath = shift;

  # error checking
  unless (wantarray)                { &IT::Error::dieAsCaller("function must be called in list context"); }
  if (&isRelativePath($dirPath))    { &IT::Error::dieAsCaller("relative paths not supported! '$dirPath'"); }
  if (!-e $dirPath)                 { die "path '$dirPath' doesn't exist!"; }
  if (!-d $dirPath)                 { die "path '$dirPath' is not a directory!"; }

  # build tree list
  my @dirTree;
  my @files = &IT::File::dirList($dirPath);
  foreach my $fileOrDir (@files) {
    push @dirTree, $fileOrDir;
    push @dirTree, &IT::File::dirTree($fileOrDir) if (-d $fileOrDir);
  }

  return @dirTree;
}

# ----------------------------------------------------------------------------
# end of file
1;

