ServDoc_0410MQSeries

• NAME
• VERSION
• SYNOPSIS
• DESCRIPTION
• OPTIONS
• AUTHORS

Code Index:

• package main
  • debug
  • list_mq_objects
  • report_mqs
  • do_runmqsc
• EOF

NAME

ServDoc_0410MQSeries - describe a MQS-Installation

VERSION

$Id: ServDoc_0410MQSeries,v 1.5 2003/11/05 16:13:40 uherbst Exp $

SYNOPSIS

ServDoc_0910MQSeries [-h|help] [-v|version] [--debug MQS,intensity]

DESCRIPTION

ServDoc_0410MQSeries describes a MQS-Installation. It lists all running queue managers and for each queue manager every object.

OPTIONS

-h|help

This help.

-v|version

Version

--debug MQS,intensity

Turn on Debugging for that module.

The debug feature for that module is named ``MQS''.

AUTHORS

Ulrich Herbst <Ulrich.Herbst@gmx.de>

#!/usr/bin/perl -w

#----------------------------------------------------------------------

# standard perl modules
use strict;                       # print error about unknown variables ...
use English;                      # long internal variable names;
use FindBin;                      # In which directory is ServDoc itself ?
                                  # There has to be the module and the lib dir!
use lib $FindBin::Bin. "/lib";    # Here are the ServDoc-perl-modules
use vars qw($options);

# our own perl modules
use ServDoc;

######################################################################
#
# Output relevant Variables
#
# Should we show system objects ?
my $sysobjects=0;             # don't show system objects
#my $sysobjects=1;              # show system objects
######################################################################

#----------------------------------------------------------------------

$options->{Version} = '$Id: ServDoc_0410MQSeries,v 1.5 2003/11/05 16:13:40 uherbst Exp $';

# We need the cmdline to call the modules with the same debug options.
$options->{cmdline} = join " ", @ARGV;

sub debug { ServDoc_debug( "MQS", $options, shift, shift ); }

$options = &process_cmdline($options);

debug( 9, i18n_std('running',$0));

%{$options->{lang}->{en}}=
  (
   qmgr      => 'MQSeries%%+Queue Manager: %s',
   qmgr_long => '',

   mqobj     => 'MQSeries%%+Queue Manager: %s%%+%s%%+%s',
   mqobj_long=> '',
  );
%{$options->{lang}->{de}}=%{$options->{lang}->{en}};


#----------------------------------------------------------------------

# Main

my $headings = "MQSeries%+";

# If we are not on HP/UX,Solaris, AIX, Linux, return silently.
if ( $OSNAME !~ /hpux|linux|solaris|aix/ ) {
  debug( i18n_std('unsupported'));
  exit 0;
}

# Which objects we want to describe
my @mq_object_types = 
  (
     'QLOCAL',
     'QREMOTE',
     'QALIAS',
     'QMODEL',
     'CHANNEL',
     'PROCESS',
     'CLUSQMGR',
     'NAMELIST',
   );

# Check if we have running Queue Managers
my @QMGR_procs=ps_grep ( "amqzxma0" );

my $qmgr_proc;
my %qmgr_seen;
foreach $qmgr_proc (@QMGR_procs) {

  $qmgr_proc =~ m/amqzxma0 -m(.*)/;
  my $qmgr=$1;
  next if (defined($qmgr_seen{$qmgr})); # We haven't to document one QMGR
                                        # twice.
  
  $qmgr_seen{$qmgr} = 1;
  debug(9,"QMgr: $qmgr");

  # display qmgr
  report_string(i18n_mesg('qmgr',$qmgr),
                i18n_std('cmd','DISPLAY QMGR'),
                i18n_mesg('qmgr_long'),
                do_runmqsc($qmgr,"DISPLAY QMGR"));

  my $mq_object_type;
  foreach $mq_object_type (@mq_object_types) {
    my $mq_object;
    
    foreach $mq_object (list_mq_objects($qmgr,$mq_object_type)) {
      next if ($mq_object =~ m/^SYSTEM./ and $sysobjects == 0);

      report_mqs(i18n_mesg('mqobj',$qmgr,$mq_object_type,$mq_object),
                 i18n_std('cmd',
                          "DISPLAY $mq_object_type($mq_object)"),
                 i18n_mesg('mqobj_long'),
		 $qmgr,$mq_object_type,$mq_object);
    } # foreach mq_object
  }   # foreach mq_object_type
} # foreach $qmgr_proc
exit 0;

sub list_mq_objects {
  # $1: QMGR
  # $2: object_type (qlocal, channel,...)

  # return: array of all objects of object_type

  my $qmgr=shift;
  my $object_type=shift;

  my @objects = 
      map {s/\s*[A-Z]+\((.*?)\).*/$1/;$_}
      grep ! /AMQ/, grep /\(/,
      split /\n/,
      do_runmqsc($qmgr,"DISPLAY $object_type(*)");

  debug(2,"Objects ($object_type): @objects");
  return @objects;
}

sub report_mqs {
  my $title      = shift;
  my $short_desc = shift;
  my $long_desc  = shift;
  my $qmgr       = shift;
  my $type       = shift;
  my $object_name= shift;

  report_string ($title,$short_desc,$long_desc,
		 do_runmqsc($qmgr,
			    "DISPLAY $type($object_name)")
		);
}

sub do_runmqsc {
  my $qmgr = shift;
  my $cmd  = shift;

  my $mqm_uid=getpwnam("mqm");
  if ($UID != $mqm_uid and $UID != 0) {
    debug(1,"We aren't root and we aren't mqm: We can't run runmqsc.");}
  
  my $mqsc_string="echo '$cmd' | runmqsc -e $qmgr";

  if ($UID == 0) {$mqsc_string = "su mqm -c \"echo '$cmd' | runmqsc -e $qmgr\"";};
  debug (9, "runmqsc started with: $mqsc_string\n");

  # Oh, we have English and German output from runmqsc....
  return 
    join "\n",
    grep !/No commands have a syntax error/,
    grep !/Keine Befehle mit Syntaxfehler/,
    grep !/All valid MQSC commands were processed/,
    grep !/Alle.*MQSC-Befehle verarbeitet/,
    grep !/Starting MQSeries Commands/,
    grep !/MQSeries-Befehle werden gestartet/,
    grep !/ALL RIGHTS RESERVED/,
    grep !/ALLE RECHTE VORBEHALTEN/,
    grep !/MQSC command* read/,
    grep !/Einen MQSC-Befehl gelesen/,
    split /\n/,
      do_cmd($mqsc_string);
}