MQSeries::ErrorLog::Entry - One entry in an MQSeries error-log file

  #
  # Assuming we get an array of parsed MQSeries::ErrorLog::Entry
  # objects from somewhere, here's how we dump them to syslog.
  #
  use Sys::Syslog;
  openlog($0, 'pid', 'daemon');

  sub process_errorlog_entries {
      foreach my $entry (@_) {
          syslog('info', "$entry"); # Overloaded operator-""
      }
  }

#
# MQSeries::ErrorLog::Entry.pm - One entry from the ErrorLog
#
# (c) 2000-2010 Morgan Stanley & Co. Incorporated
# See ..../src/LICENSE for terms of distribution.
#
# $Id: Entry.pm,v 33.7 2010/04/01 16:24:54 anbrown Exp $
#

package MQSeries::ErrorLog::Entry;

use strict;
use Carp;

use overload ('""'  => 'as_string',
              'cmp' => 'compare',
              '<=>' => 'compare');

our $VERSION = '1.32';

#
# ErrorLog::Entry constructor
#
# Parameters:
# - Class name
# - Hash with structure fields, including optional 'data' hash ref
# Returns:
# - MQSeries::ErrorLog::Entry object
#
sub new {
  my ($class, %data) = @_;

  my $this = \%data;

  #
  # Sometimes we get non-ASCII values in the fields we parse.
  # Typically, this indicates some bad client code handed MQSeries
  # bad data, and IBM faithfully reproduces it in the error-log.
  #
  # However, it screws up our displays - so sanitize it...
  #
  while (my ($fld, $val) = each %{ $this->{'fields'} }) {
      if ($val =~ s/([^\w\s\-\:\.\!\/\(\)])/sprintf("\\0x%02x", ord $1)/eg) {
          #print "Escape field [$fld] from [$this->{'fields'}{$fld}] to [$val]\n";
          $this->{'fields'}{$fld} = $val;
      }
  }

  return bless $this, $class;
}


#
# Get the error-code from the entry
#
# Parameters:
# - MQSeries::ErrorLog::Entry object
# Returns:
# - Error code (AMQxxxx)
#
sub error_code {
    my ($this) = @_;

    return $this->{'error_code'};
}


#
# Get the original timestamp (in Unix time format) from the entry
#
# Parameters:
# - MQSeries::ErrorLog::Entry object
# Returns:
# - Timestamp (Unix time format)
#
sub timestamp {
    my ($this) = @_;

    return $this->{'ctime'};
}


#
# Get the summary string from the entry
#
# Parameters:
# - MQSeries::ErrorLog::Entry object
# Returns:
# - Summary string (no embedded newlines)
#
sub summary {
    my ($this) = @_;

    return $this->{'summary'};
}


#
# Get the contents of a data field (parsed from the contents
# of the ErrorLog entry).
#
# Parameters:
# - MQSeries::ErrorLog::Entry object
# - Field name ('Channel', 'Pid', ...)
# - Optional new/replacement value
# Returns:
# - Field value / undef
#
sub field {
    my ($this, $fld, $val) = @_;

    $this->{'fields'}{$fld} = $val if (defined $val);

    return $this->{'fields'}{$fld};
}


#
# Get the list of all fields in the object
#
# Parameters:
# - MQSeries::ErrorLog::Entry object
# Returns:
# - List of fields
#
sub fields {
    my ($this) = @_;

    return keys %{ $this->{'fields'} };
}


#
# Display parsed entry
#
# Parameters:
# - MQSeries::ErrorLog::Entry object
# Returns:
# - Descriptive string (multi-lines)
#
sub as_string {
  my ($this) = @_;

  return "Error [$this->{'error_code'}] [$this->{'summary'}] at [" .
    localtime($this->{'ctime'}) . "]\n" .
    join("", map { "\t$_: $this->{'fields'}{$_}\n"
                 } sort keys %{$this->{'fields'}});

}


#
# Debug support method: display raw error details
#
# Parameters:
# - MQSeries::ErrorLog::Entry object
# Returns:
# - Descriptive string (multi-lines)
#
sub display_raw {
  my ($this) = @_;

  return "Error with code [$this->{'error_code'}] and timestamp [" .
    localtime($this->{'ctime'}) . "]\n" .
    "\tSummary: $this->{'summary'}\n" .
    "\tExplanation: $this->{'explanation'}\n" .
    "\tAction: $this->{'action'}\n" .
    "\tFields: " . join(', ', sort keys %{ $this->{'fields'} });
}


#
# Comparison routine - most useful for duplicate filters.
# This compares ErrorLog entries based on their message code
# and the contents of any fields; it does not look at the
# timestamp.
#
# Parameters:
# - MQSeries::ErrorLog::Entry object (a)
# - MQSeries::ErrorLog::Entry object (b)
# Returns:
# - Comparison value (0 if equal, -1/1 if non-equal)
#
sub compare {
    my ($a, $b) = @_;

    #
    # Compare error codes
    #
    my $cmp = ( $a->error_code() cmp $b->error_code() );
    return $cmp if ($cmp);

    #
    # Compare fields in alphabetic order
    # (Required to make any (ill-advised) sort stable)
    #
    foreach my $fld (sort keys %{ $a->{'fields'} }) {
        return 1 unless (defined $b->{'fields'}{$fld});
        $cmp = ($a->{'fields'}{$fld} cmp $b->{'fields'}{$fld});
        return $cmp if ($cmp);
    }
    foreach my $fld (keys %{ $a->{'fields'} }) {
        return 1 unless (defined $a->{'fields'}{$fld});
    }

    #
    # If we get here, consider the entries equal
    #
    return 0;
}


1;                              # End on a positive note


__END__