######################################################################
#
# $Id: LogRoutines.pm,v 1.13 2012/01/07 07:56:13 mavrik Exp $
#
######################################################################
#
# Copyright 2008-2012 The WebJob Project, All Rights Reserved.
#
######################################################################
#
# Purpose: Log routines
#
######################################################################

package WebJob::LogRoutines;

require Exporter;

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

use Fcntl qw(:DEFAULT :flock);
use FileHandle;
use WebJob::TimeRoutines;
use WebJob::ValidationRoutines;

@EXPORT = qw(LogCheckDebugLevel LogNf1vMessage);

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

######################################################################
#
# LogCheckDebugLevel
#
######################################################################

sub LogCheckDebugLevel
{
  my ($phPArgs, $sLevel) = @_;

  my $sDebug = (defined($$phPArgs{'Debug'}) && $$phPArgs{'Debug'} =~ /^\d+$/ && $$phPArgs{'Debug'} > 0) ? $$phPArgs{'Debug'} : -1;
  $sLevel = 0 unless (defined($sLevel) && $sLevel =~ /^\d+$/);
  return ($sDebug >= $sLevel) ? 1 : 0;
}


######################################################################
#
# LogNf1vMessage
#
######################################################################

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

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

  my %hLArgs =
  (
    'Hash' => $phPArgs,
    'Keys' =>
    [
#     'LogEpoch',      # Optional
      'LogFields',
      'LogFile',
      'LogValues',
#     'Newline'        # Optional
#     'RevertToStderr, # Optional
#     'UseGmt',        # Optional
    ],
  );
  if (!defined(VerifyHashKeys(\%hLArgs)))
  {
    $$phPArgs{'Error'} = $hLArgs{'Error'} if (defined($phPArgs));
    return undef;
  }

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

  my ($sLogEpoch, $sNewline, $sRevertToStderr, $sUseGmt);

  if (exists($$phPArgs{'LogEpoch'}) && defined($$phPArgs{'LogEpoch'}) &&  $$phPArgs{'LogEpoch'} =~ /^\d+$/)
  {
    $sLogEpoch = $$phPArgs{'LogEpoch'};
  }
  else
  {
    $sLogEpoch = time();
  }

  $sNewline = ($$phPArgs{'Newline'}) ? $$phPArgs{'Newline'} : "\n";

  $sRevertToStderr = ($$phPArgs{'RevertToStderr'}) ? 1 : 0;

  $sUseGmt = ($$phPArgs{'UseGmt'}) ? 1 : 0;

  ####################################################################
  #
  # Create date/time stamp.
  #
  ####################################################################

  my $sDateTime = SecondsToDateTime($sLogEpoch, $sUseGmt);

  ####################################################################
  #
  # Construct the log message. Since this routine requires N fixed
  # fields and 1 variable field, the fixed fields must be encoded. If
  # this isn't done, a utility expecting to find N fields could have
  # issues parsing a record that actually contains M fields (where M
  # != N). Additionally, all non-printable characters should be
  # encoded as a general safety measure. Note that the variable field
  # is allowed to have spaces for readability. The encoding scheme
  # used below is a form of URL encoding.
  #
  ####################################################################

  my (@aLogValues, $sLogMessage);

  foreach my $sField (@{$$phPArgs{'LogFields'}})
  {
    my $sLogValue = $$phPArgs{'LogValues'}{$sField};
    if ($sField =~ /^Message$/)
    {
      $sLogValue = (!defined($sLogValue) || length($sLogValue) == 0) ? "--" : "-- $sLogValue";
      $sLogValue =~ s/([\x00-\x1f\x7f-\xff%+])/sprintf("%%%02x", unpack('C',$1))/seg;
      push(@aLogValues, $sLogValue);
    }
    else
    {
      $sLogValue = "-" if (!defined($sLogValue) || length($sLogValue) == 0);
      $sLogValue =~ s/([\x00-\x1f\x7f-\xff%+])/sprintf("%%%02x", unpack('C',$1))/seg;
      $sLogValue =~ s/ /+/sg;
      push(@aLogValues, $sLogValue);
    }
  }
  $sLogMessage = join(" ", $sDateTime, @aLogValues);

  ####################################################################
  #
  # Open (in binary mode) and lock (exclusive) the log file.
  #
  ####################################################################

  my $oFileHandle = new FileHandle;
  if (!defined($oFileHandle))
  {
    if ($sRevertToStderr)
    {
      print STDERR $sLogMessage, $sNewline;
    }
    $$phPArgs{'Error'} = "Unable to obtain a file handle.";
    return undef;
  }

  if (!$oFileHandle->open(">> $$phPArgs{'LogFile'}"))
  {
    if ($sRevertToStderr)
    {
      print STDERR $sLogMessage, $sNewline;
    }
    $$phPArgs{'Error'} = "File ($$phPArgs{'LogFile'}) could not be opened ($!).";
    return undef;
  }
  binmode($oFileHandle);

  if (!flock($oFileHandle, LOCK_EX))
  {
    if ($sRevertToStderr)
    {
      print STDERR $sLogMessage, $sNewline;
    }
    close($oFileHandle);
    $$phPArgs{'Error'} = "File ($$phPArgs{'LogFile'}) could not be locked ($!).";
    return undef;
  }

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

  print $oFileHandle $sLogMessage, $sNewline;

  ####################################################################
  #
  # Cleanup and go home.
  #
  ####################################################################

  flock($oFileHandle, LOCK_UN);
  close($oFileHandle);

  1;
}


1;

__END__

=pod

=head1 NAME

WebJob::LogRoutines - Log routines

=head1 SYNOPSIS

    use WebJob::LogRoutines;

=head1 DESCRIPTION

This module is a collection of log 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<LogNf1vMessage>

This routine creates a log message with N fixed fields and one
variable field as shown below.  Each log record typically contains a
timestamp, one or more fixed fields, and a variable message field,
which is set apart from the fixed fields with a double hyphen ("--").
Note that fixed fields are automatically encoded using a form of URL
encoding to ensure that N remains constant.  The message field is also
encoded, but spaces are allowed for readability -- this is also the
reason why the message field is variable.  Note that the names
assigned to fixed fields are caller specified, but the name for the
variable field must be 'Message'.

  YYYY-MM-DD HH:MM:SS [[field [...]] [-- [message]]

The caller must pass a hash of named parameters (described below) to
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 | Default Value
  ---------------+--------+----------+--------------
  Error          | output | -        | undef
  LogEpoch       | input  | N        | time in seconds
  LogFields      | input  | Y        | -
  LogFile        | input  | Y        | -
  LogValues      | input  | Y        | -
  Newline        | input  | N        | \n
  RevertToStderr | input  | N        | 0 (false)
  UseGmt         | input  | N        | 0 (false)

B<LogEpoch> is optional with a default value of the current time in
seconds when the routine is executed.

B<LogFields> is required, and it is an array of names that determines
the order of fields in the resulting log message.  Note that if the
Message field is supplied, it must be the last element in the array.

B<LogFile> is required, and it specifies the name of the file (full or
relative path) that receives the log message.

B<LogValues> is required, and it is a hash of values to print in the
log message.  Note that every value listed in B<LogFields> must be
repensented in B<LogValues>.

B<NewLine> is optional with a default value of '\n'.

B<RevertToStderr> is optional.  If this parameter is set to '1' and
the resulting log message can not be written to the specified file,
then it will be written to STDERR.  The default value is '0', which
disables this behavior.

B<UseGmt> is optional.  If this parameter is set to '1', then
timestamps are given in GMT; otherwise, local time is used.  The
default value is '0', which means use local time.

The example script shown below creates a log message using a GMT
timestamp, three fixed fields, and one variable-length message.

  --- logit.pl ---
  #!/usr/bin/perl -w

  use strict;
  use WebJob::LogRoutines;

  my %hLogArgs =
  (
    'LogFields' =>
    [
      'Field1',
      'Field2',
      'Field3',
      'Message',
    ],
    'LogFile' => '/tmp/tmp.log',
    'LogValues' =>
    {
      'Field1' => "field_1",
      'Field2' => "field_2",
      'Field3' => "field_3",
      'Message' => "some long message",
    },
    'UseGmt' => 1,
  );

  if (!LogNf1vMessage(\%hLogArgs))
  {
    print STDERR "Error='$hLogArgs{'Error'}'\n";
  }
  --- logit.pl ---

The log messages written to /tmp/tmp.log will look like this:

  2011-08-30 20:00:00 field_1 field_2 field_3 -- some long message

=back

=head1 AUTHOR

Klayton Monroe

=head1 LICENSE

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

=cut
