######################################################################
#
# $Id: FdaRoutines.pm,v 1.20 2012/01/07 07:56:13 mavrik Exp $
#
######################################################################
#
# Copyright 2007-2012 The WebJob Project, All Rights Reserved.
#
######################################################################
#
# Purpose: File, directory, and attribute routines
#
######################################################################

package WebJob::FdaRoutines;

require Exporter;

use 5.008;
use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);

use Fcntl qw(:DEFAULT :flock);
use FileHandle;
use File::Basename;
use File::Temp;
use WebJob::ValidationRoutines;

@EXPORT = qw(FdaCreateDirectory FdaCreateFile FdaFindExecutable FdaGroupToGid FdaLockFile FdaOwnerToUid FdaPermissionsToMode FdaTouchFile FdaUnlockFile);

@EXPORT_OK = ();
@ISA = qw(Exporter);
$VERSION = do { my @r = (q$Revision: 1.20 $ =~ /(\d+)/g); sprintf("%d."."%03d" x $#r, @r); };

######################################################################
#
# FdaCreateDirectory
#
######################################################################

sub FdaCreateDirectory
{
  my ($phPArgs) = @_;

  ####################################################################
  #
  # Make sure that required inputs are defined.
  #
  ####################################################################

  my %hLArgs =
  (
    'Hash' => $phPArgs,
    'Keys' =>
    [
#     'BeQuiet', # Optional
      'Directory',
      'Gid',
      'Mode',
#     'Prefix',  # Optional
      'Uid',
    ],
  );
  if (!defined(VerifyHashKeys(\%hLArgs)))
  {
    $$phPArgs{'Error'} = $hLArgs{'Error'} if (defined($phPArgs));
    return undef;
  }

  ####################################################################
  #
  # Create directory tree -- one element at a time.
  #
  ####################################################################

  my $sBeQuiet = $$phPArgs{'BeQuiet'} || 0;

  my $sDirectory = $$phPArgs{'Directory'};
  $sDirectory =~ s/^[\/\\]+//; # Remove leading slashes.
  $sDirectory =~ s/^([\/\\])+/$1/g; # Squash inner slashes.
  $sDirectory =~ s/[\/\\]+$//; # Remove trailing slashes.

  my @aPathElements = split(/[\/\\]/, $sDirectory);

  my $sPath = $$phPArgs{'Prefix'} || undef;

  foreach my $sPathElement (@aPathElements)
  {
    if (!defined($sPath))
    {
      $sPath = ($sPathElement =~ /^[A-Za-z]:$/) ? "$sPathElement" : "/$sPathElement";
    }
    else
    {
      $sPath .= "/$sPathElement";
    }
    if (!-d $sPath)
    {
      print "Creating $sPath\n" unless ($$phPArgs{'BeQuiet'});
      if (!mkdir($sPath, $$phPArgs{'Mode'}))
      {
        $$phPArgs{'Error'} = "Directory ($sPath) could not be created ($!).";
        return undef;
      }
    }
    else
    {
      my $sTargetPath;
      if (!defined($$phPArgs{'Prefix'}))
      {
        $sTargetPath = ($sDirectory =~ /^[A-Za-z]:/) ? "$sDirectory" : "/$sDirectory";
      }
      else
      {
        $sTargetPath = $$phPArgs{'Prefix'} . "/$sDirectory";
      }
      next unless ($sPath eq $sTargetPath); # Only update ownership/permissions when the current path equals the target path.
      print "Updating $sPath (already exists)\n" unless ($$phPArgs{'BeQuiet'});
    }
    if (!chmod($$phPArgs{'Mode'}, $sPath))
    {
      $$phPArgs{'Error'} = "Unable to set permissions (" . sprintf("%04o", $$phPArgs{'Mode'}) . ") for $sPath ($!).";
      return undef;
    }
    if (!chown($$phPArgs{'Uid'}, $$phPArgs{'Gid'}, $sPath))
    {
      $$phPArgs{'Error'} = "Unable to set owner/group ($$phPArgs{'Uid'}/$$phPArgs{'Gid'}) for $sPath ($!).";
      return undef;
    }
  }

  1;
}


######################################################################
#
# FdaCreateFile
#
######################################################################

sub FdaCreateFile
{
  my ($phPArgs) = @_;

  ####################################################################
  #
  # Make sure that required inputs are defined.
  #
  ####################################################################

  my %hLArgs =
  (
    'Hash' => $phPArgs,
    'Keys' =>
    [
#     'BeQuiet', # Optional
#     'Data',    # Optional
      'File',
#     'ForceCreate', # Optional
      'Gid',
      'Mode',
#     'Prefix',  # Optional
      'Uid',
    ],
  );
  if (!defined(VerifyHashKeys(\%hLArgs)))
  {
    $$phPArgs{'Error'} = $hLArgs{'Error'} if (defined($phPArgs));
    return undef;
  }

  ####################################################################
  #
  # Assign default values where necessary.
  #
  ####################################################################

  my ($sBeQuiet, $sDirectory, $sFile, $sForceCreate);

  $sBeQuiet = $$phPArgs{'BeQuiet'} || 0;

  $sForceCreate = (defined($$phPArgs{'ForceCreate'}) && $$phPArgs{'ForceCreate'} =~ /^1$/) ? 1 : 0;

  $sFile = ($$phPArgs{'Prefix'}) ? $$phPArgs{'Prefix'} . "/" . $$phPArgs{'File'} : $$phPArgs{'File'};

  $sDirectory = dirname($sFile);

  ####################################################################
  #
  # Conditionally create a temporary file and move it into place. If
  # the file already exists and no new data has been given, simply
  # check/update permissions and ownership.
  #
  ####################################################################

  my ($oTempFile);

  if (!-f $sFile || defined($$phPArgs{'Data'}) || $sForceCreate)
  {
    if (!-f _ || $sForceCreate)
    {
      print "Creating $sFile\n" unless ($sBeQuiet);
    }
    else
    {
      print "Updating $sFile (content, permissions, and ownership)\n" unless ($sBeQuiet);
    }
    eval { $oTempFile = new File::Temp(DIR => $sDirectory, TEMPLATE => ".XXXXXXXXXX"); };
    if ($@)
    {
      my $sMessage = $@; $sMessage =~ s/[\r\n]+/ /g; $sMessage =~ s/\s+/ /g; $sMessage =~ s/\s+$//;
      $$phPArgs{'Error'} = "Unable to create/open a temporary file ($sMessage).";
      return undef;
    }
    binmode($oTempFile);
    if (defined($$phPArgs{'Data'}))
    {
      if (!$oTempFile->print($$phPArgs{'Data'}))
      {
        $$phPArgs{'Error'} = "Unable to write data to temporary file ($!).";
        return undef;
      }
    }
    if (!chmod($$phPArgs{'Mode'}, $oTempFile))
    {
      $$phPArgs{'Error'} = "Unable to set permissions (" . sprintf("%04o", $$phPArgs{'Mode'}) . ") for temporary file ($!).";
      return undef;
    }
    if (!chown($$phPArgs{'Uid'}, $$phPArgs{'Gid'}, $oTempFile))
    {
      $$phPArgs{'Error'} = "Unable to set owner/group ($$phPArgs{'Uid'}/$$phPArgs{'Gid'}) for temporary file ($!).";
      return undef;
    }
    $oTempFile->close();
    if (!rename($oTempFile->filename(), $sFile))
    {
      $$phPArgs{'Error'} = "Unable to create/update $sFile ($!).";
      return undef;
    }
    $oTempFile->unlink_on_destroy(0);
  }
  else
  {
    print "Updating $sFile (permissions and/or ownership)\n" unless ($sBeQuiet);
    if (!stat($sFile))
    {
      $$phPArgs{'Error'} = "Unable to get attributes for $sFile ($!).";
      return undef;
    }
    my ($sMode, $sUid, $sGid) = (stat(_))[2,4,5];
    if ($$phPArgs{'Mode'} ne $sMode && !chmod($$phPArgs{'Mode'}, $sFile))
    {
      $$phPArgs{'Error'} = "Unable to set permissions (" . sprintf("%04o", $$phPArgs{'Mode'}) . ") for $sFile ($!).";
      return undef;
    }
    if (($$phPArgs{'Uid'} ne $sUid || $$phPArgs{'Gid'} ne $sGid) && !chown($$phPArgs{'Uid'}, $$phPArgs{'Gid'}, $sFile))
    {
      $$phPArgs{'Error'} = "Unable to set owner/group ($$phPArgs{'Uid'}/$$phPArgs{'Gid'}) for $sFile ($!).";
      return undef;
    }
  }

  1;
}


######################################################################
#
# FdaFindExecutable
#
######################################################################

sub FdaFindExecutable
{
  my ($sFile) = @_;

  ####################################################################
  #
  # Make sure that required inputs are defined.
  #
  ####################################################################

  if (!defined($sFile))
  {
    return undef;
  }

  ####################################################################
  #
  # If the specified file exists and is executable, we're done.
  #
  ####################################################################

  if (-x $sFile)
  {
    return $sFile;
  }

  ####################################################################
  #
  # Search the system PATH for the specified file.
  #
  ####################################################################

  my $sName = basename($sFile);

  my $sPathSeparator = ($^O =~ /MSWin(32|64)/i) ? "\\" : "/";

  foreach my $sDir (split(/:/, $ENV{PATH}))
  {
    $sFile = $sDir . $sPathSeparator . $sName;
    if (-x $sFile)
    {
      return $sFile;
    }
  }

  return undef;
}


######################################################################
#
# FdaGroupToGid
#
######################################################################

sub FdaGroupToGid
{
  my ($phPArgs) = @_;

  ####################################################################
  #
  # Make sure that required inputs are defined.
  #
  ####################################################################

  my %hLArgs =
  (
    'Hash' => $phPArgs,
    'Keys' => ['Group'],
  );
  if (!defined(VerifyHashKeys(\%hLArgs)))
  {
    $$phPArgs{'Error'} = $hLArgs{'Error'} if (defined($phPArgs));
    return undef;
  }

  ####################################################################
  #
  # If the group is already a number, return it. Otherwise, attempt
  # to resolve the group name.
  #
  ####################################################################

  my $sGid = ($$phPArgs{'Group'} =~ /^\d+$/) ? $$phPArgs{'Group'} : getgrnam($$phPArgs{'Group'});
  if (!defined($sGid))
  {
    $$phPArgs{'Error'} = "Unable to resolve GID for $$phPArgs{'Group'}.";
    return undef;
  }

  return $sGid;
}


######################################################################
#
# FdaLockFile
#
######################################################################

sub FdaLockFile
{
  my ($phPArgs) = @_;

  ####################################################################
  #
  # Make sure that required inputs are defined.
  #
  ####################################################################

  my %hLArgs =
  (
    'Hash' => $phPArgs,
    'Keys' =>
    [
      'LockFile',
#     'LockFlags', # Optional
#     'LockMode',  # Optional
    ],
  );
  if (!defined(VerifyHashKeys(\%hLArgs)))
  {
    $$phPArgs{'Error'} = $hLArgs{'Error'} if (defined($phPArgs));
    return undef;
  }

  ####################################################################
  #
  # Assign default values where necessary.
  #
  ####################################################################

  my ($sLockFile, $sLockFlags, $sLockMode);

  $sLockFile = $$phPArgs{'LockFile'};

  $sLockMode = ($$phPArgs{'LockMode'}) ? $$phPArgs{'LockMode'} : "+>>";

  $sLockFlags = ($$phPArgs{'LockFlags'}) ? $$phPArgs{'LockFlags'} : LOCK_EX;

  ####################################################################
  #
  # Lock the specified file.
  #
  ####################################################################

  my ($oFileHandle, $sModeFile);

  $oFileHandle = new FileHandle;
  if (!defined($oFileHandle))
  {
    $$phPArgs{'Error'} = "Unable to obtain a file handle.";
    return undef;
  }

  if (!$oFileHandle->open("$sLockMode $sLockFile"))
  {
    $$phPArgs{'Error'} = "File ($sLockFile) could not be opened ($!).";
    return undef;
  }

  if (!flock($oFileHandle, $sLockFlags))
  {
    $$phPArgs{'Error'} = "File ($sLockFile) could not be locked ($!).";
    return undef;
  }

  $$phPArgs{'LockHandle'} = $oFileHandle;

  1;
}


######################################################################
#
# FdaOwnerToUid
#
######################################################################

sub FdaOwnerToUid
{
  my ($phPArgs) = @_;

  ####################################################################
  #
  # Make sure that required inputs are defined.
  #
  ####################################################################

  my %hLArgs =
  (
    'Hash' => $phPArgs,
    'Keys' => ['Owner'],
  );
  if (!defined(VerifyHashKeys(\%hLArgs)))
  {
    $$phPArgs{'Error'} = $hLArgs{'Error'} if (defined($phPArgs));
    return undef;
  }

  ####################################################################
  #
  # If the owner is already a number, return it. Otherwise, attempt
  # to resolve the owner name.
  #
  ####################################################################

  my $sUid = ($$phPArgs{'Owner'} =~ /^\d+$/) ? $$phPArgs{'Owner'} : getpwnam($$phPArgs{'Owner'});
  if (!defined($sUid))
  {
    $$phPArgs{'Error'} = "Unable to resolve UID for $$phPArgs{'Owner'}.";
    return undef;
  }

  return $sUid;
}


######################################################################
#
# FdaPermissionsToMode
#
######################################################################

sub FdaPermissionsToMode
{
  my ($phPArgs) = @_;

  ####################################################################
  #
  # Make sure that required inputs are defined.
  #
  ####################################################################

  my %hLArgs =
  (
    'Hash' => $phPArgs,
    'Keys' => ['Permissions'],
  );
  if (!defined(VerifyHashKeys(\%hLArgs)))
  {
    $$phPArgs{'Error'} = $hLArgs{'Error'} if (defined($phPArgs));
    return undef;
  }

  ####################################################################
  #
  # Convert the permissions to octal, and apply the umask if one was
  # specified.
  #
  ####################################################################

  my $sMode = (defined($$phPArgs{'Umask'})) ? oct($$phPArgs{'Permissions'}) & ~($$phPArgs{'Umask'}) : oct($$phPArgs{'Permissions'});

  return $sMode;
}


######################################################################
#
# FdaTouchFile
#
######################################################################

sub FdaTouchFile
{
  my ($phPArgs) = @_;

  ####################################################################
  #
  # Make sure that required inputs are defined.
  #
  ####################################################################

  my %hLArgs =
  (
    'Hash' => $phPArgs,
    'Keys' =>
    [
      'File',
    ],
  );
  if (!defined(VerifyHashKeys(\%hLArgs)))
  {
    $$phPArgs{'Error'} = $hLArgs{'Error'} if (defined($phPArgs));
    return undef;
  }

  ####################################################################
  #
  # Assign default values where necessary.
  #
  ####################################################################

  # EMPTY

  ####################################################################
  #
  # Touch (i.e., create and/or open then close) the specified file.
  #
  ####################################################################

  my ($oFileHandle);

  $oFileHandle = new FileHandle(">> $$phPArgs{'File'}");
  if (!defined($oFileHandle))
  {
    $$phPArgs{'Error'} = "File ($$$phPArgs{'File'}) could not be touched ($!).";
    return undef;
  }
  $oFileHandle->close();

  1;
}


######################################################################
#
# FdaUnlockFile
#
######################################################################

sub FdaUnlockFile
{
  my ($phPArgs) = @_;

  ####################################################################
  #
  # Make sure that required inputs are defined.
  #
  ####################################################################

  my %hLArgs =
  (
    'Hash' => $phPArgs,
    'Keys' =>
    [
      'LockFile',
      'LockHandle',
#     'LockRemove', # Optional
    ],
  );
  if (!defined(VerifyHashKeys(\%hLArgs)))
  {
    $$phPArgs{'Error'} = $hLArgs{'Error'} if (defined($phPArgs));
    return undef;
  }

  ####################################################################
  #
  # Assign default values where necessary.
  #
  ####################################################################

  # EMPTY

  ####################################################################
  #
  # Unlock, close, and conditionally remove the lock file.
  #
  ####################################################################

  flock($$phPArgs{'LockHandle'}, LOCK_UN);
  undef($$phPArgs{'LockHandle'}); # According to the documentation, this will automatically close the file.
  if ($$phPArgs{'LockRemove'})
  {
    if (!unlink($$phPArgs{'LockFile'}))
    {
      $$phPArgs{'Error'} = "File ($$phPArgs{'LockFile'}) could not be removed ($!).";
      return undef;
    }
  }

  1;
}

1;

__END__

=pod

=head1 NAME

WebJob::FdaRoutines - File, directory, and attribute routines

=head1 SYNOPSIS

    use WebJob::FdaRoutines;

=head1 DESCRIPTION

This module is a collection of file, directory, and attribute routines
designed to support various WebJob server-side utilities. As such,
minimal effort was put into supporting this code for general
consumption. In other words, use at your own risk and don't expect the
interface to remain the same or backwards compatible from release to
release. This module does not provide an OO interface, nor will it do
so anytime soon.

=head1 ROUTINES

=over 4

=item B<FdaCreateDirectory>

[FIXME]

=item B<FdaCreateFile>

[FIXME]

=item B<FdaFindExecutable>

[FIXME]

=item B<FdaGroupToGid>

[FIXME]

=item B<FdaLockFile>

This routine conditionally creates a specified lock file and attempts
to lock it.  The caller must supply a hash of named parameters (see
table below) when invoking this routine.  On success, this routine
returns true.  Otherwise, it places an error message in the supplied
parameter hash and returns undef.

   Name       | Type   | Required
  ------------+--------+----------
   Error      | output | -
   LockFile   | input  | Y
   LockFlags  | input  | N
   LockHandle | output | -
   LockMode   | input  | N

B<LockFile> is required, and its value is the path to the file you
wish to lock.

B<LockFlags> is optional, and its value must be taken from the flag
combinations listed in the table below, which were obtained from the
Perl documentation for flock().  The default value is 'LOCK_EX'.

   Flag Combinations | Meaning
  -------------------+-----------------------------
   LOCK_EX           | Blocking exclusive lock
   LOCK_EX | LOCK_NB | Non-blocking exclusive lock
   LOCK_SH           | Blocking shared lock
   LOCK_SH | LOCK_NB | Non-blocking shared lock

Note: To use the constants listed above in your script, you must
include the Fcntl module as shown here:

  use Fcntl qw(:DEFAULT :flock);

B<LockMode> is optional, and its value must be taken from the modes
listed in the table below, which were obtained from the Perl
documentation for open().  The default value is '+>>'.

   Mode | Meaning
  ------+------------------------------------------------------
   <    | Open for reading
   >    | Truncate and open for writing
   >>   | Create (if necessary) and open for appending
   +<   | Open for reading/writing
   +>   | Truncate and open for reading/writing
   +>>  | Create (if necessary) and open for reading/appending

The following example shows how to obtain an exclusive read lock on
the file /tmp/x.

  my %hLockArgs =
  (
    'LockFile' => "/tmp/x",
    'LockMode' => "+<", # The file must exist or this will fail.
    'LockFlags' => LOCK_EX,
  );
  if (!FdaLockFile(\%hLockArgs))
  {
    print STDERR "Error='$hLockArgs{'Error'}'\n";
    exit(2);
  }

=item B<FdaOwnerToUid>

[FIXME]

=item B<FdaPermissionsToMode>

[FIXME]

=item B<FdaTouchFile>

[FIXME]

=item B<FdaUnlockFile>

This routine unlocks and conditionally removes a lock file previously
locked with FdaLockFile().  The caller must supply a hash of named
parameters (see table below) when invoking this routine.  On success,
this routine returns true.  Otherwise, it places an error message in
the supplied parameter hash and returns undef.

   Name       | Type   | Required
  ------------+--------+----------
   Error      | output | -
   LockFile   | input  | Y
   LockHandle | input  | Y
   LockRemove | input  | N

B<LockFile> is required, and its value is the path to the file you
wish to unlock.

B<LockHandle> is required, and its value is the file handle for
B<LockFile>, which was set by a previous call to FdaLockFile().

B<LockRemove> is optional, and its value specifies whether to remove
the lock file or not.  If B<LockRemove> is true (e.g., set to 1), an
attempt is made to remove the lock file.  The default action is to
leave the lock file intact.

The following example shows how to unlock a file previously locked
using FdaLockFile().

  if (defined(\%hLockArgs))
  {
    if (!FdaUnlockFile(\%hLockArgs))
    {
      print STDERR "Error='$hLockArgs{'Error'}'\n";
      exit(2);
    }
  }

=back

=head1 AUTHOR

Klayton Monroe

=head1 LICENSE

All documentation and code are distributed under same terms and
conditions as B<WebJob>.

=cut
