######################################################################
#
# $Id: JqdRoutines.pm,v 1.34 2012/01/07 07:56:13 mavrik Exp $
#
######################################################################
#
# Copyright 2007-2012 The WebJob Project, All Rights Reserved.
#
######################################################################
#
# Purpose: Common Job Queue Directory routines
#
######################################################################

package WebJob::JqdRoutines;

require Exporter;

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

use Fcntl qw(:DEFAULT :flock);
use File::Path;
use WebJob::FdaRoutines 1.017;
use WebJob::LogRoutines;
use WebJob::KvpRoutines 1.029;
use WebJob::Properties 1.043;
use WebJob::ValidationRoutines;

@EXPORT = qw(JqdCheckQueueTree JqdCreateQueue JqdDeleteQueue JqdFreezeQueue JqdGetJobState JqdGetQueueNid JqdGetQueueName JqdGetQueueState JqdGetQueuedJobs JqdIsQueueActive JqdIsQueueFrozen JqdIsQueueLocked JqdLockFile JqdLogMessage JqdParseJqt JqdRebuildGroup JqdResolveQueueList JqdSetQueueState JqdSetupQueueMaps JqdThawQueue JqdUnlockFile);

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

######################################################################
#
# JqdCheckQueueTree
#
######################################################################

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

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

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

  ####################################################################
  #
  # Make sure that the directories required to support the specified
  # queue exist and are writable.
  #
  ####################################################################

  my ($sStateDirectory);

  if (!-d $$phPArgs{'Directory'} || !-W _)
  {
    $$phPArgs{'Error'} = "Queue directory ($$phPArgs{'Directory'}) does not exist or is not writable.";
    return undef;
  }

  foreach my $sState ("hold", "todo", "sent", "open", "done", "pass", "fail", "foul")
  {
    $sStateDirectory = $$phPArgs{'Directory'} . "/" . $sState;
    if (!-d $sStateDirectory || !-W _)
    {
      $$phPArgs{'Error'} = "Queue state directory ($sStateDirectory) does not exist or is not writable.";
      return undef;
    }
  }

  1;
}


######################################################################
#
# JqdCreateQueue
#
######################################################################

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

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

  my %hLArgs =
  (
    'Hash' => $phPArgs,
    'Keys' =>
    [
#     'BeQuiet',   # Optional
      'JobQueueDirectory',
#     'LockQueue', # Optional
      'Queue',
      'QueueGroup',
      'QueueOwner',
      'QueuePermissions',
    ],
  );
  if (!defined(VerifyHashKeys(\%hLArgs)))
  {
    $$phPArgs{'Error'} = $hLArgs{'Error'} if (defined($phPArgs));
    return undef;
  }

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

  my ($sBeQuiet, $sLockQueue);

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

  $sLockQueue = (exists($$phPArgs{'LockQueue'}) && $$phPArgs{'LockQueue'}) ? 1 : 0;

  ####################################################################
  #
  # Define server-side directory structure.
  #
  ####################################################################

  my $sQueueDirectory = $$phPArgs{'JobQueueDirectory'} . "/" . $$phPArgs{'Queue'};
  my $sUid = FdaOwnerToUid({ 'Owner' => $$phPArgs{'QueueOwner'} });
  my $sGid = FdaGroupToGid({ 'Group' => $$phPArgs{'QueueGroup'} });
  my $sMode = FdaPermissionsToMode({ 'Permissions' => $$phPArgs{'QueuePermissions'}, 'Umask' => umask() });

  my $paaPdmugs = # Prefix, Directory, Mode, UID, GID
  [
    [
      $$phPArgs{'JobQueueDirectory'},
      $$phPArgs{'Queue'},
      $sMode,
      $sUid,
      $sGid,
    ],
    [
      $sQueueDirectory,
      "hold",
      $sMode,
      $sUid,
      $sGid,
    ],
    [
      $sQueueDirectory,
      "todo",
      $sMode,
      $sUid,
      $sGid,
    ],
    [
      $sQueueDirectory,
      "sent",
      $sMode,
      $sUid,
      $sGid,
    ],
    [
      $sQueueDirectory,
      "open",
      $sMode,
      $sUid,
      $sGid,
    ],
    [
      $sQueueDirectory,
      "done",
      $sMode,
      $sUid,
      $sGid,
    ],
    [
      $sQueueDirectory,
      "pass",
      $sMode,
      $sUid,
      $sGid,
    ],
    [
      $sQueueDirectory,
      "fail",
      $sMode,
      $sUid,
      $sGid,
    ],
    [
      $sQueueDirectory,
      "foul",
      $sMode,
      $sUid,
      $sGid,
    ],
  ];

  my $paaPfmugs = # Prefix, File, Mode, UID, GID
  [
    [
      $sQueueDirectory,
      "change.lock",
      ($sMode & 07666), # Remove all execute bits.
      $sUid,
      $sGid,
    ],
  ];

  ####################################################################
  #
  # Create server-side directory structure.
  #
  ####################################################################

  foreach my $paPdmug (@{$paaPdmugs})
  {
    my %hPdmugArgs =
    (
      'Prefix'    => $$paPdmug[0],
      'Directory' => $$paPdmug[1],
      'Mode'      => $$paPdmug[2],
      'Uid'       => $$paPdmug[3],
      'Gid'       => $$paPdmug[4],
      'BeQuiet'   => $sBeQuiet,
    );
    if (!defined(FdaCreateDirectory(\%hPdmugArgs)))
    {
      $$phPArgs{'Error'} = $hPdmugArgs{'Error'};
      return undef;
    }
  }

  ####################################################################
  #
  # Create server-side files.
  #
  ####################################################################

  foreach my $paPfmug (@{$paaPfmugs})
  {
    my %hPfmugArgs =
    (
      'Prefix'    => $$paPfmug[0],
      'File'      => $$paPfmug[1],
      'Mode'      => $$paPfmug[2],
      'Uid'       => $$paPfmug[3],
      'Gid'       => $$paPfmug[4],
      'BeQuiet'   => $sBeQuiet,
    );
    if (!defined(FdaCreateFile(\%hPfmugArgs)))
    {
      $$phPArgs{'Error'} = $hPfmugArgs{'Error'};
      return undef;
    }
  }

  ####################################################################
  #
  # Set the initial queue state.
  #
  ####################################################################

  %hLArgs =
  (
    'Directory' => $sQueueDirectory,
    'NewState'  => ($sLockQueue) ? "locked" : "active",
  );
  if (!defined(JqdSetQueueState(\%hLArgs)))
  {
    $$phPArgs{'Error'} = $hLArgs{'Error'};
    return undef;
  }

  1;
}


######################################################################
#
# JqdDeleteQueue
#
######################################################################

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

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

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

  ####################################################################
  #
  # Delete server-side directory structure.
  #
  ####################################################################

  my $sQueueDirectory = $$phPArgs{'JobQueueDirectory'} . "/" . $$phPArgs{'Queue'};

#FIXME Consider replacing with an equivalent FDA routine, and remove the 'use File::Path;' above.
  rmtree($sQueueDirectory, ($$phPArgs{'BeQuiet'}) ? 0 : 1, 0);

  1;
}


######################################################################
#
# JqdFreezeQueue
#
######################################################################

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

  $$phPArgs{'NewState'} = "frozen";
  $$phPArgs{'OldStates'} = [ "active" ];
  $$phPArgs{'RequireStateMatch'} = 0;

  return JqdSetQueueState($phPArgs);
}


######################################################################
#
# JqdGetJobState
#
######################################################################

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

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

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

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

  my ($sJqdQueueTag);

  $sJqdQueueTag = $$phPArgs{'JqdQueueTag'};

  ####################################################################
  #
  # Attempt to perform the lookup operation.
  #
  ####################################################################

  my (%hJqdQueueTagMap, %hQueueLockArgs, $sError);

LOOKUP:
{
  ####################################################################
  #
  # Acquire the change lock. This is a shared lock.
  #
  ####################################################################

  %hQueueLockArgs =
  (
    'LockFile' => $$phPArgs{'JqdQueueDirectory'} . "/" . "change.lock",
    'LockFlags' => LOCK_SH,
    'LockMode' => "+<", # This will fail if the lock file does not exist.
  );
  if (!JqdLockFile(\%hQueueLockArgs))
  {
    $sError = $hQueueLockArgs{'Error'};
    last LOOKUP;
  }

  ####################################################################
  #
  # Determine the job's current state.
  #
  ####################################################################

  foreach my $sState (@{PropertiesGetGlobalKvps->{'JqdJobStates'}})
  {
    my $sStateDirectory = $$phPArgs{'JqdQueueDirectory'} . "/" . $sState;
    if (!opendir(DIR, $sStateDirectory))
    {
      next; # Silently ignore this error. It's more important to try all state directories than error out on a single failure.
    }
    foreach my $sJobFile (map("$sStateDirectory/$_", sort(grep(/^$sJqdQueueTag$/, readdir(DIR)))))
    {
      if (-f $sJobFile)
      {
        if (defined($hJqdQueueTagMap{$sJqdQueueTag}))
        {
          $sError = "The specified job appears to be in multiple states. That should not happen.";
          last LOOKUP;
        }
        $hJqdQueueTagMap{$sJqdQueueTag} = $sState;
      }
    }
    closedir(DIR);
  }
  if (!defined($hJqdQueueTagMap{$sJqdQueueTag}))
  {
    $sError = "Unable to get job state. Query produced no record.";
    last LOOKUP;
  }
}

  ####################################################################
  #
  # Release the change lock.
  #
  ####################################################################

  JqdUnlockFile(\%hQueueLockArgs);

  ####################################################################
  #
  # Conditionally return an error.
  #
  ####################################################################

  if (defined($sError))
  {
    $$phPArgs{'Error'} = $sError;
    return undef;
  }

  return $hJqdQueueTagMap{$sJqdQueueTag};
}


######################################################################
#
# JqdGetQueueName
#
######################################################################

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

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

  my %hLArgs =
  (
    'Hash' => $phPArgs,
    'Keys' =>
    [
#     'ClientId',          # Conditionally required
#     'CommonRegexes',     # Deprecated
#     'Error',             # Optional output (scalar)
      'JobQueueDirectory',
      'JqdQueueNid',
    ],
  );
  if (!defined(VerifyHashKeys(\%hLArgs)))
  {
    $$phPArgs{'Error'} = $hLArgs{'Error'} if (defined($phPArgs));
    return undef;
  }

  ####################################################################
  #
  # Validate the queue NID, and drop any leading zeros.
  #
  ####################################################################

  if ($$phPArgs{'JqdQueueNid'} !~ /^(\d+)$/o)
  {
    $$phPArgs{'Error'} = "Invalid NID ($$phPArgs{'JqdQueueNid'}). NIDs must be integer values.";
    return undef;
  }
  my $sJqdQueueNid = sprintf("%d", $1);

  ####################################################################
  #
  # If the queue NID is zero, the queue name is the client ID.
  #
  ####################################################################

  if ($sJqdQueueNid == 0)
  {
    if (!defined($$phPArgs{'ClientId'}))
    {
      $$phPArgs{'Error'} = "Private queue names must be bound to the 'ClientId' parameter, which has not been defined.";
      return undef;
    }
    return $$phPArgs{'ClientId'};
  }

  ####################################################################
  #
  # Resolve the queue NID and return the associated queue name.
  #
  ####################################################################

  my (%hForwardQueueMap, %hQueueMapArgs, %hReverseQueueMap);

  %hQueueMapArgs =
  (
    'ForwardQueueMap'   => \%hForwardQueueMap,
    'JobQueueDirectory' => $$phPArgs{'JobQueueDirectory'},
    'KeyRegex'          => PropertiesGetGlobalRegexes->{'JqdQueueName'},
    'ReverseQueueMap'   => \%hReverseQueueMap,
    'SharedLock'        => 1,
    'ValueRegex'        => "\\d+",
  );
  if (!JqdSetupQueueMaps(\%hQueueMapArgs))
  {
    $$phPArgs{'Error'} = $hQueueMapArgs{'Error'};
    return undef;
  }

  return $hReverseQueueMap{$sJqdQueueNid};
}


######################################################################
#
# JqdGetQueueNid
#
######################################################################

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

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

  my %hLArgs =
  (
    'Hash' => $phPArgs,
    'Keys' =>
    [
      'ClientId',
#FIXME This is a sub hash, but we really want/need to verify the required keys in that hash.
      'CommonRegexes',
      'JobQueueDirectory',
      'JqdQueueName',
    ],
  );
  if (!defined(VerifyHashKeys(\%hLArgs)))
  {
    $$phPArgs{'Error'} = $hLArgs{'Error'} if (defined($phPArgs));
    return undef;
  }

  ####################################################################
  #
  # If the queue name is the client ID, return the zero queue NID.
  #
  ####################################################################

  if ($$phPArgs{'JqdQueueName'} eq $$phPArgs{'ClientId'})
  {
    return 0;
  }

  ####################################################################
  #
  # Lookup the queue name and return the associated queue NID.
  #
  ####################################################################

  my (%hForwardQueueMap, %hQueueMapArgs, %hReverseQueueMap);

  %hQueueMapArgs =
  (
    'ForwardQueueMap'   => \%hForwardQueueMap,
    'JobQueueDirectory' => $$phPArgs{'JobQueueDirectory'},
    'KeyRegex'          => "(?:" . $$phPArgs{'CommonRegexes'}{'ClientId'} . "|" . $$phPArgs{'CommonRegexes'}{'ClientSuppliedFilename'} . ")",
    'ReverseQueueMap'   => \%hReverseQueueMap,
    'SharedLock'        => 1,
    'ValueRegex'        => "\\d+",
  );
  if (!JqdSetupQueueMaps(\%hQueueMapArgs))
  {
    $$phPArgs{'Error'} = $hQueueMapArgs{'Error'};
    return undef;
  }

  return $hForwardQueueMap{$$phPArgs{'JqdQueueName'}};
}


######################################################################
#
# JqdGetQueueState
#
######################################################################

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

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

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

  ####################################################################
  #
  # Get and return the current state. If the queue state file does not
  # exist, the state is 'active'. If it exists and is empty, the state
  # is 'frozen'. Otherwise, the state is 'locked'.
  #
  ####################################################################

  my ($sQueueStateFile);

  $sQueueStateFile = $$phPArgs{'Directory'} . "/" . "freeze.lock";

  if (-f $sQueueStateFile)
  {
    return (-z _) ? "frozen" : "locked";
  }

  return "active";
}


######################################################################
#
# JqdGetQueuedJobs
#
######################################################################

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

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

  my %hLArgs =
  (
    'Hash' => $phPArgs,
    'Keys' =>
    [
      'Directory',
      'JobCount',
      'JobFiles',       # Array reference
      'JobState',
      'JobType',
#     'MinPriority',    # Optional
#     'MaxPriority',    # Optional
#     'ReturnJobFiles', # Optional
    ],
  );
  if (!defined(VerifyHashKeys(\%hLArgs)))
  {
    $$phPArgs{'Error'} = $hLArgs{'Error'} if (defined($phPArgs));
    return undef;
  }

  ####################################################################
  #
  # Determine the type of jobs being requested.
  #
  ####################################################################

  my ($sJobRegex);

  if ($$phPArgs{'JobType'} eq "serial")
  {
    $sJobRegex = qq(s\\d{3,5}_(?:\\d{2}_)?\\d{10}_(?:\\d{6}_)?[\\dA-Fa-f]{5,8});
  }
  elsif ($$phPArgs{'JobType'} eq "parallel")
  {
    $sJobRegex = qq(p\\d{3,5}_(?:\\d{2}_)?\\d{10}_(?:\\d{6}_)?[\\dA-Fa-f]{5,8});
  }
  else
  {
    $sJobRegex = qq([ps]\\d{3,5}_(?:\\d{2}_)?\\d{10}_(?:\\d{6}_)?[\\dA-Fa-f]{5,8});
  }

  ####################################################################
  #
  # Open the state directory and create a list of job files.
  #
  ####################################################################

  my (@aJobFiles, @aTmpFiles, $sStateDirectory);

  $sStateDirectory = $$phPArgs{'Directory'} . "/" . $$phPArgs{'JobState'};

  if (!opendir(DIR, $sStateDirectory))
  {
    $$phPArgs{'Error'} = "Directory ($sStateDirectory) could not be opened ($!).";
    return undef;
  }
  @aTmpFiles = map("$sStateDirectory/$_", sort(grep(/^$sJobRegex$/, readdir(DIR))));
  closedir(DIR);

  ####################################################################
  #
  # Conditionally establish an inverted priority range. Then, remove
  # jobs that don't fall in that range. Inverting the priority makes
  # it easier to perform the range check.
  #
  ####################################################################

  my ($sMaxPriority, $sMinPriority);

  if (exists($$phPArgs{'MinPriority'}) && defined($$phPArgs{'MinPriority'}) && $$phPArgs{'MinPriority'} =~ /^(\d{1,2})$/)
  {
    $sMinPriority = 99 - $1; # Invert priority.
  }
  if (exists($$phPArgs{'MaxPriority'}) && defined($$phPArgs{'MaxPriority'}) && $$phPArgs{'MaxPriority'} =~ /^(\d{1,2})$/)
  {
    $sMaxPriority = 99 - $1; # Invert priority.
  }

  if (defined($sMinPriority) || defined($sMaxPriority))
  {
    foreach my $sJobFile (@aTmpFiles)
    {
      if ($sJobFile =~ /[ps]\d{3,5}_(\d{2})_\d{10}_(?:\d{6}_)?[\dA-Fa-f]{5,8}$/o)
      {
        my $sPriority = 99 - $1;
        $sMinPriority = 99 - 99 if (!defined($sMinPriority));
        $sMaxPriority = 99 - 00 if (!defined($sMaxPriority));
        if ($sPriority >= $sMinPriority && $sPriority <= $sMaxPriority)
        {
          push(@aJobFiles, $sJobFile);
        }
      }
    }
  }
  else
  {
    @aJobFiles = @aTmpFiles;
  }

  ####################################################################
  #
  # Conditionally fill the output array, but insert no more than the
  # requested number of job files. The reason this is conditional is
  # that some callers may only want to get a job count, so returning
  # anthing more would be wasted effort.
  #
  ####################################################################

  my ($sFinalJobCount, $sReturnJobFiles);

  $sFinalJobCount = ($$phPArgs{'JobCount'} == 0 || $$phPArgs{'JobCount'} >= scalar(@aJobFiles)) ? scalar(@aJobFiles) : $$phPArgs{'JobCount'};

  $sReturnJobFiles = $$phPArgs{'ReturnJobFiles'} || 0;

  if ($sReturnJobFiles)
  {
    @{$$phPArgs{'JobFiles'}} = splice(@aJobFiles, 0, $sFinalJobCount);
  }

  return $sFinalJobCount;
}


######################################################################
#
# JqdIsQueueActive
#
######################################################################

sub JqdIsQueueActive
{
  return (JqdGetQueueState($_[0]) eq "active") ? 1 : 0;
}


######################################################################
#
# JqdIsQueueFrozen
#
######################################################################

sub JqdIsQueueFrozen
{
  return (JqdGetQueueState($_[0]) eq "frozen") ? 1 : 0;
}


######################################################################
#
# JqdIsQueueLocked
#
######################################################################

sub JqdIsQueueLocked
{
  return (JqdGetQueueState($_[0]) eq "locked") ? 1 : 0;
}


######################################################################
#
# JqdLockFile
#
######################################################################

sub JqdLockFile
{
  return FdaLockFile($_[0]);
}


######################################################################
#
# JqdLogMessage
#
######################################################################

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

  ####################################################################
  #
  # Marshall log arguments.
  #
  ####################################################################

  my (%hLArgs);

  $hLArgs{'LogEpoch'} = time();

  $hLArgs{'LogFields'} =
  [
    'Program',
    'Pid',
    'Creator',
    'Queue',
    'QueueTag',
    'OldQueueState',
    'NewQueueState',
    'Command',
    'CommandSize',
    'PoundName',
    'JobGroup',
    'Result',
    'Message',
  ];

  $hLArgs{'LogValues'} =
  {
    'Program'       => $$phPArgs{'Program'},
    'Pid'           => $$phPArgs{'Pid'},
    'Creator'       => $$phPArgs{'Creator'},
    'Queue'         => $$phPArgs{'Queue'},
    'QueueTag'      => $$phPArgs{'QueueTag'},
    'OldQueueState' => $$phPArgs{'OldQueueState'},
    'NewQueueState' => $$phPArgs{'NewQueueState'},
    'Command'       => $$phPArgs{'Command'},
    'CommandSize'   => $$phPArgs{'CommandSize'},
    'PoundName'     => $$phPArgs{'PoundName'},
    'JobGroup'      => $$phPArgs{'JobGroup'},
    'Result'        => $$phPArgs{'Result'},
    'Message'       => $$phPArgs{'Message'},
  };

  $hLArgs{'LogFile'} = $$phPArgs{'LogFile'};

  $hLArgs{'Newline'} = $\;

  $hLArgs{'RevertToStderr'} = 1;

  $hLArgs{'UseGmt'} = 0;

  ####################################################################
  #
  # Deliver log message.
  #
  ####################################################################

  LogNf1vMessage(\%hLArgs);

  1;
}


######################################################################
#
# JqdParseJqt
#
######################################################################

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

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

  my %hLArgs =
  (
    'Hash' => $phPArgs,
    'Keys' =>
    [
#     'ClientId',          # Conditionally required
#     'Error',             # Optional output (scalar)
      'JqdQueueTag',
#     'JobQueueDirectory', # Optional
#     'ResolveJobState',   # Optional
#     'ResolveQueueNames', # Optional
#     'ResolveQueueState', # Optional
    ],
  );
  if (!defined(VerifyHashKeys(\%hLArgs)))
  {
    $$phPArgs{'Error'} = $hLArgs{'Error'} if (defined($phPArgs));
    return undef;
  }

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

  my ($sResolveJobState, $sResolveQueueNames, $sResolveQueueState);

  $sResolveJobState = (defined($$phPArgs{'ResolveJobState'}) && $$phPArgs{'ResolveJobState'} == 1) ? 1 : 0;

  $sResolveQueueNames = (defined($$phPArgs{'ResolveQueueNames'}) && $$phPArgs{'ResolveQueueNames'} == 1) ? 1 : 0;

  $sResolveQueueState = (defined($$phPArgs{'ResolveQueueState'}) && $$phPArgs{'ResolveQueueState'} == 1) ? 1 : 0;

  ####################################################################
  #
  # Make sure we have the necessary prerequisites.
  #
  ####################################################################

  if ($sResolveQueueState && !$sResolveQueueNames)
  {
    $$phPArgs{'Error'} = "The 'ResolveQueueNames' option must be set to resolve queue state.";
    return undef;
  }

  if ($sResolveJobState && !$sResolveQueueNames)
  {
    $$phPArgs{'Error'} = "The 'ResolveQueueNames' option must be set to resolve job state.";
    return undef;
  }

  ####################################################################
  #
  # Parse the supplied queue tag.
  #
  ####################################################################

  my (%hJqdQueueTag);

  if ($$phPArgs{'JqdQueueTag'} !~ /^([ps])(\d{3,5})_(\d{2})_(\d{10})_(\d{6})_([\dA-Fa-f]{5,8})$/o)
  {
    $$phPArgs{'Error'} = "The specified queue tag ($$phPArgs{'JqdQueueTag'}) does not pass muster.";
    return undef;
  }
  %hJqdQueueTag =
  (
    'Type'      => ($1 eq "p") ? "parallel" : "serial",
    'Nid'       => sprintf("%d", $2),
    'Priority'  => sprintf("%d", $3),
    'Timestamp' => sprintf("%d.%06d", $4, $5),
    'Nonce'     => sprintf("%d", hex($6)),
  );
  $hJqdQueueTag{'Private'} = ($hJqdQueueTag{'Nid'} == 0) ? 1 : 0;

  ####################################################################
  #
  # Conditionally resolve the queue's name.
  #
  ####################################################################

  if ($sResolveQueueNames)
  {
    my %hLArgs =
    (
      'ClientId'          => $$phPArgs{'ClientId'},
      'JobQueueDirectory' => $$phPArgs{'JobQueueDirectory'},
      'JqdQueueNid'       => $hJqdQueueTag{'Nid'},
    );
    $hJqdQueueTag{'Name'} = JqdGetQueueName(\%hLArgs);
    if (!defined($hJqdQueueTag{'Name'}))
    {
      if ($hLArgs{'Error'})
      {
        $$phPArgs{'Error'} = $hLArgs{'Error'};
        return undef;
      }
      $$phPArgs{'Error'} = "Queue NID ($hJqdQueueTag{'Nid'}) is not mapped.";
      return undef;
    }
    $hJqdQueueTag{'JqdQueueDirectory'} = $$phPArgs{'JobQueueDirectory'} . "/" . $hJqdQueueTag{'Name'};
  }

  ####################################################################
  #
  # Conditionally resolve the queue's current state.
  #
  ####################################################################

  if ($sResolveQueueState && defined($hJqdQueueTag{'JqdQueueDirectory'}))
  {
    $hJqdQueueTag{'QueueState'} = JqdGetQueueState({ 'Directory' => $hJqdQueueTag{'JqdQueueDirectory'} });
  }

  ####################################################################
  #
  # Conditionally resolve the job's current state.
  #
  ####################################################################

  if ($sResolveJobState && defined($hJqdQueueTag{'JqdQueueDirectory'}))
  {
    my %hLArgs =
    (
      'JqdQueueDirectory' => $hJqdQueueTag{'JqdQueueDirectory'},
      'JqdQueueTag'       => $$phPArgs{'JqdQueueTag'},
    );
    $hJqdQueueTag{'JobState'} = JqdGetJobState(\%hLArgs);
    if (!defined($hJqdQueueTag{'JobState'}))
    {
      $$phPArgs{'Error'} = $hLArgs{'Error'};
      return undef;
    }
  }

  return \%hJqdQueueTag;
}


######################################################################
#
# JqdRebuildGroup
#
######################################################################

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

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

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

  ####################################################################
  #
  # Pull unique members from the group (if it exists).
  #
  ####################################################################

  my ($sDelimiter);

  $sDelimiter = $$phPArgs{'Delimiter'} || ",";

  my (%hMergeGroup);

  if (exists($$phPArgs{'GroupMap'}{$$phPArgs{'Group'}}))
  {
    foreach my $sMember (split(/$sDelimiter/, $$phPArgs{'GroupMap'}{$$phPArgs{'Group'}}))
    {
      if (!defined($sMember) || length($sMember) < 1 || ($sMember =~ /^%(.+)$/ && !exists($$phPArgs{'GroupMap'}{$1})))
      {
        next; # Ignore undefined members or nonexistent groups.
      }
      $hMergeGroup{$sMember}++;
    }
  }

  ####################################################################
  #
  # Pull unique members from the members list (if it is defined).
  #
  ####################################################################

  my ($sRemoveMembers);

  $sRemoveMembers = $$phPArgs{'RemoveMembers'} || 0;

  if (defined($$phPArgs{'Members'}))
  {
    foreach my $sMember (split(/$sDelimiter/, $$phPArgs{'Members'}))
    {
      if (!defined($sMember) || length($sMember) < 1 || ($sMember =~ /^%(.+)$/ && !exists($$phPArgs{'GroupMap'}{$1})))
      {
        next; # Ignore undefined members or nonexistent groups.
      }
      if ($sRemoveMembers)
      {
        delete($hMergeGroup{$sMember});
      }
      else
      {
        $hMergeGroup{$sMember}++;
      }
    }
  }

  ####################################################################
  #
  # Return a lexically sorted, unique, and delimited list.
  #
  ####################################################################

  return join($sDelimiter, sort(keys(%hMergeGroup)));
}


######################################################################
#
# JqdResolveQueueList
#
######################################################################

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

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

  my %hLArgs =
  (
    'Hash' => $phPArgs,
    'Keys' =>
    [
      'ForwardMap',     # Hash reference (input)
      'GroupMap',       # Hash reference (input)
#     'NoRecursion',    # Optinal (input)
      'QueueList',      # Comma delimited string (input)
      'QueueMap',       # Hash reference (output)
      'RecursionStack', # Array reference (internal use)
    ],
  );
  if (!defined(VerifyHashKeys(\%hLArgs)))
  {
    $$phPArgs{'Error'} = $hLArgs{'Error'} if (defined($phPArgs));
    return undef;
  }

  ####################################################################
  #
  # Split the queue list up into items, look for group tokens, and
  # resolve them -- use recursion if necessary and enabled.
  #
  ####################################################################

  %{$$phPArgs{'QueueMap'}} = ();

  if ($$phPArgs{'QueueList'} eq "")
  {
    return 1; # Nothing to resolve.
  }
  if ($$phPArgs{'QueueList'} =~ /^((?:(?:%{1,2})?[\w+.:-]+)(?:,(?:%{1,2})?[\w+.:-]+)*)$/)
  {
    foreach my $sItem (split(/,/, $1))
    {
      if ($sItem =~ /^%([^%]+)$/) # Expand group tokens.
      {
        my $sGroup = $1;
        if (exists($$phPArgs{'GroupMap'}{$sGroup}) && defined($$phPArgs{'GroupMap'}{$sGroup}))
        {
          foreach my $sSpentGroup (@{$$phPArgs{'RecursionStack'}})
          {
            if ($sGroup eq $sSpentGroup)
            {
              $$phPArgs{'Error'} = "Group has a recursion loop (" . join(",", @{$$phPArgs{'RecursionStack'}}, $sGroup) . ").";
              return undef;
            }
          }
          if ($$phPArgs{'NoRecursion'})
          {
            foreach my $sMember (split(/,/, $$phPArgs{'GroupMap'}{$sGroup}))
            {
              $$phPArgs{'QueueMap'}{$sMember} = 0;
            }
          }
          else
          {
            push(@{$$phPArgs{'RecursionStack'}}, $sGroup);
            my %hResolverArgs =
            (
              'ForwardMap'     => $$phPArgs{'ForwardMap'},
              'GroupMap'       => $$phPArgs{'GroupMap'},
              'QueueList'      => $$phPArgs{'GroupMap'}{$sGroup},
              'QueueMap'       => {},
              'RecursionStack' => \@{$$phPArgs{'RecursionStack'}},
            );
            if (!JqdResolveQueueList(\%hResolverArgs))
            {
              $$phPArgs{'Error'} = $hResolverArgs{'Error'};
              return undef;
            }
            pop(@{$$phPArgs{'RecursionStack'}});
            foreach my $sQueue (sort(keys(%{$hResolverArgs{'QueueMap'}})))
            {
              $$phPArgs{'QueueMap'}{$sQueue} = (exists($$phPArgs{'ForwardMap'}{$sQueue})) ? $$phPArgs{'ForwardMap'}{$sQueue} : 0;
            }
          }
        }
        else
        {
          $$phPArgs{'Error'} = "Group ($sGroup) is not defined.";
          return undef;
        }
      }
      elsif ($sItem =~ /^%(%[^%]+)$/) # Do not expand escaped group tokens.
      {
        $$phPArgs{'QueueMap'}{$1} = 0;
      }
      else # Everything else is assumed to be a group member.
      {
        $$phPArgs{'QueueMap'}{$sItem} = (exists($$phPArgs{'ForwardMap'}{$sItem})) ? $$phPArgs{'ForwardMap'}{$sItem} : 0;
      }
    }
  }
  else
  {
    if (length($$phPArgs{'QueueList'}))
    {
      $$phPArgs{'Error'} = "The specified list does not pass muster.";
      return undef;
    }
  }

  1;
}


######################################################################
#
# JqdSetQueueState
#
######################################################################

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

  ####################################################################
  #
  # Set the current state to a default value in case we abort early.
  #
  ####################################################################

  $$phPArgs{'CurrentState'} = "unknown" if (defined($phPArgs));

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

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

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

  my $sRequireStateMatch = (exists($$phPArgs{'RequireStateMatch'}) && $$phPArgs{'RequireStateMatch'}) ? 1 : 0;

  ####################################################################
  #
  # Remove the hash element that holds error messages to ensure that
  # the return value is not unduly influenced.
  #
  ####################################################################

  delete($$phPArgs{'Error'});

  ####################################################################
  #
  # Acquire the change lock. This is an exclusive lock.
  #
  ####################################################################

  my (%hQueueLockArgs);

  %hQueueLockArgs =
  (
    'LockFile' => $$phPArgs{'Directory'} . "/" . "change.lock",
    'LockMode' => "+<", # This will fail if the lock file does not exist.
  );
  if (!JqdLockFile(\%hQueueLockArgs))
  {
    $$phPArgs{'Error'} = $hQueueLockArgs{'Error'};
    return undef;
  }
  if (!stat($hQueueLockArgs{'LockHandle'}))
  {
    $$phPArgs{'Error'} = "Unable to get attributes for $hQueueLockArgs{'LockHandle'} ($!).";
    return undef;
  }
  my ($sMode, $sUid, $sGid) = (stat(_))[2,4,5];

  ####################################################################
  #
  # If the current and new states match, we're done.
  #
  ####################################################################

  my ($sStatus);

  $$phPArgs{'CurrentState'} = JqdGetQueueState($phPArgs);

  if ($$phPArgs{'CurrentState'} eq $$phPArgs{'NewState'})
  {
    $sStatus = "noop"; # No state change is required.
    goto UNLOCK;
  }

  ####################################################################
  #
  # If one or more old queue states were given, it means the caller
  # wants to change state, but only if the current state matches one
  # of the old states. If no match is found it's silently ignored
  # unless a match requirement has also been imposed.
  #
  ####################################################################

  if (ref($$phPArgs{'OldStates'}) eq "ARRAY" && scalar(@{$$phPArgs{'OldStates'}}) > 0)
  {
    my $sStateMatch = 0;
    foreach my $sOldState (@{$$phPArgs{'OldStates'}})
    {
      if ($sOldState eq $$phPArgs{'CurrentState'})
      {
        $sStateMatch = 1;
        last;
      }
    }
    if (!$sStateMatch)
    {
      if ($sRequireStateMatch)
      {
        $$phPArgs{'Error'} = "The current queue state was not in the list of old states (" . join(",", @{$$phPArgs{'OldStates'}}) . ").";
        $sStatus = undef;
      }
      else
      {
        $sStatus = "skip"; # No state change is allowed due to failed preconditions.
      }
      goto UNLOCK;
    }
  }

  ####################################################################
  #
  # Conditionally change state.
  #
  ####################################################################

  my ($sQueueStateFile);

  $sQueueStateFile = $$phPArgs{'Directory'} . "/" . "freeze.lock";

  if ($$phPArgs{'NewState'} eq "active")
  {
    if (-f $sQueueStateFile && unlink($sQueueStateFile))
    {
      $$phPArgs{'CurrentState'} = "active";
      $sStatus = "pass";
    }
    else
    {
      $$phPArgs{'Error'} = "Failed to put queue in the $$phPArgs{'NewState'} state ($!).";
      $sStatus = undef;
    }
  }
  else
  {
    my %hPfmugArgs =
    (
      'Data'        => ($$phPArgs{'NewState'} eq "locked") ? "locked\n" : undef,
      'File'        => $sQueueStateFile,
      'Mode'        => $sMode,
      'Uid'         => $sUid,
      'Gid'         => $sGid,
      'BeQuiet'     => 1,
      'ForceCreate' => 1,
    );
    if (!defined(FdaCreateFile(\%hPfmugArgs)))
    {
      $$phPArgs{'Error'} = "Failed to put queue in the $$phPArgs{'NewState'} state. $hPfmugArgs{'Error'}";
      $sStatus = undef;
    }
    else
    {
      $$phPArgs{'CurrentState'} = $$phPArgs{'NewState'};
      $sStatus = "pass";
    }
  }

  ####################################################################
  #
  # Release the change lock.
  #
  ####################################################################

UNLOCK:

  JqdUnlockFile(\%hQueueLockArgs);

  return $sStatus;
}


######################################################################
#
# JqdSetupQueueMaps
#
######################################################################

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

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

  my %hLArgs =
  (
    'Hash' => $phPArgs,
    'Keys' =>
    [
      'ForwardQueueMap', # Hash reference
      'JobQueueDirectory',
      'KeyRegex',
      'ReverseQueueMap', # Hash reference
#     'SharedLock',      # Optional
      'ValueRegex',
    ],
  );
  if (!defined(VerifyHashKeys(\%hLArgs)))
  {
    $$phPArgs{'Error'} = $hLArgs{'Error'} if (defined($phPArgs));
    return undef;
  }

  ####################################################################
  #
  # Conditionally lock the index with a shared lock.
  #
  ####################################################################

  my (%hIndexLockArgs);

  %hIndexLockArgs =
  (
    'LockFile' => $$phPArgs{'JobQueueDirectory'} . "/" . "queue.index.lock",
    'LockFlags' => LOCK_SH,
    'LockMode' => "+<", # The file must exist or this will fail.
  );
  if ($$phPArgs{'SharedLock'} && !JqdLockFile(\%hIndexLockArgs))
  {
    $$phPArgs{'Error'} = $hIndexLockArgs{'Error'};
    return undef;
  }

  ####################################################################
  #
  # Initialize forward and reverse queue maps. These maps are hashes
  # that contain queue name to queue NID and vice-versa mappings.
  #
  #####################################################################

  %{$$phPArgs{'ForwardQueueMap'}} = (); # Initialize an empty forward map.
  %{$$phPArgs{'ReverseQueueMap'}} = (); # Initialize an empty reverse map.
  %hLArgs =
  (
    'File'           => $$phPArgs{'JobQueueDirectory'} . "/" . "queue.index",
    'Properties'     => $$phPArgs{'ForwardQueueMap'},
    'Template'       => { $$phPArgs{'KeyRegex'} => $$phPArgs{'ValueRegex'} },
    'VerifyValues'   => 1,
  );
  if (!KvpGetKvps(\%hLArgs))
  {
    $$phPArgs{'Error'} = $hLArgs{'Error'};
    JqdUnlockFile(\%hIndexLockArgs) if ($$phPArgs{'SharedLock'});
    return undef;
  }
  %{$$phPArgs{'ReverseQueueMap'}} = reverse(%{$$phPArgs{'ForwardQueueMap'}}); # This assumes a 1:1 mapping.

  ####################################################################
  #
  # Conditionally unlock the index.
  #
  ####################################################################

  JqdUnlockFile(\%hIndexLockArgs) if ($$phPArgs{'SharedLock'});

  1;
}


######################################################################
#
# JqdThawQueue
#
######################################################################

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

  $$phPArgs{'NewState'} = "active";
  $$phPArgs{'OldStates'} = [ "frozen" ];
  $$phPArgs{'RequireStateMatch'} = 0;

  return JqdSetQueueState($phPArgs);
}


######################################################################
#
# JqdUnlockFile
#
######################################################################

sub JqdUnlockFile
{
  return FdaUnlockFile($_[0]);
}


1;

__END__

=pod

=head1 NAME

WebJob::JqdRoutines - Common Job Queue Directory routines

=head1 SYNOPSIS

    use Fcntl qw(:DEFAULT :flock);
    use WebJob::JqdRoutines;

=head1 DESCRIPTION

This module is a collection of common 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 AUTHOR

Klayton Monroe

=head1 LICENSE

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

=cut
