# Tfa.pm: TFA Command Package

package RDA::UI::Tfa;

# $Id: Tfa.pm,v 1.11 2015/11/13 15:55:08 RDA Exp $
# ARCS: $Header: /home/cvs/cvs/RDA_8/src/scripting/lib/RDA/UI/Tfa.pm,v 1.11 2015/11/13 15:55:08 RDA Exp $
#
# Change History
# 20151113  MSC  Get own timing control object.

=head1 NAME

RDA::UI::Tfa - TFA Command Package

=head1 SYNOPSIS

 <rda> <options> -XTfa <command> <switches> <arg> ...

 <sdci> <options> -XTfa <command> <switches> <arg> ...

=head1 DESCRIPTION

This user interface interacts with Trace File Analyzer (TFA). It limits its use
to systems where that tool is visibly used.

The commands returns a 0 (zero) exit status when no errors are
detected. Otherwise, they return a nonzero exit status.

The following commands are available:

=cut

use strict;

BEGIN
{ use Exporter;
  use File::Basename qw(basename);
  use File::Copy qw(copy);
  use IO::File;
  use IO::Handle;
  use RDA::Text qw(get_string);
  use RDA::Agent;
  use RDA::Object::Message;
  use RDA::Object::Rda;
  use RDA::Object::Timing;
  use RDA::Object::View;
  use RDA::Options;
  use Time::Local qw(timelocal);
}

# Define the global public variables
use vars qw($STRINGS $VERSION @ISA);
$VERSION = sprintf('%d.%02d', q$Revision: 1.11 $ =~ /(\d+)\.(\d+)/);
@ISA     = qw(Exporter);

# Define the global private constants
my $SR = qr/^\d-\d+$/;

my $UTC = '+00:00';

# Define the global private variables
my @tb_mon = qw(- Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
my %tb_ini = (
  aix     => '/etc/init.tfa',
  hpux    => '/sbin/init.d/init.tfa',
  linux   => '/etc/init.d/init.tfa',
  solaris => '/etc/init.d/init.tfa',
  );
my %tb_mon = (
  jan => q{01},
  feb => q{02},
  mar => q{03},
  apr => q{04},
  may => q{05},
  jun => q{06},
  jul => q{07},
  aug => q{08},
  sep => q{09},
  oct => q{10},
  nov => q{11},
  dec => q{12},
 );

# Report the package version
sub Version
{ return $VERSION;
}

=head2 S<collect [-d days|-f time|-h hours|-p start,end|-r time] [-n node,...]>

This command performs an TFA collection. It supports additional command
switches:

=over 16

=item B<  -d days>

Specifies the number of days to analyze (C<since> mode).

=item B<  -f time>

Specifies the reference time (C<for> mode).

=item B<  -h hours>

Specifies the number of hours to analyze (C<since> mode).

=item B<  -n node,...>

Specifies the list of host names for the collection or C<all> or C<local>.

=item B<  -p begin,end>

Specifies the time period (C<begin>-C<end> mode).

=item B<  -r time>

Specifies the reference time and builds a time period around it
(C<begin>-C<end> mode).

=item B<  -x opt,...>

Specifies extra TFA options.

=back

It accepts time in C<YYYY-MM-DD hh:mi:ss>, C<yyyy-mm-ddThh:mi:ss>, or
C<Mon/dd/yyyy hh:mi:ss> formats.

=cut

sub collect  ## no critic (Complex)
{ my ($agt, @arg) = @_;
  my ($beg, $cmd, $dsp, $end, $opt, $tim, @cmd, @nod, @per);

  # Treat the options
  $dsp = $agt->is_verbose;
  $opt = RDA::Options::getopts('d:f:h:n*p*r*x*', \@arg);
  $tim = RDA::Object::Timing->new;
  @nod = map {RDA::Object::View->is_host($_, 1)} @{$opt->{'n'}}
    if $opt->{'n'};

  if (exists($opt->{'d'}))
  { die get_string('BAD_DAYS', $opt->{'d'})
      unless $opt->{'d'} =~ m/^(\d+)$/;
    push(@cmd, 'diagcollect');
    push(@cmd, '-node', join(q{,}, @nod)) if @nod;
    push(@cmd, '-since', "$1d");
    $tim->set_interval(scalar $tim->convert_time(time), "$1d", 0);
    $per[0] = $tim->get_time('beg', $UTC).$UTC;
    $per[1] = $tim->get_time('end', $UTC).$UTC;
  }
  elsif (exists($opt->{'f'}))
  { push(@cmd, 'diagcollect');
    push(@cmd, '-node', join(q{,}, @nod)) if @nod;
    push(@cmd, '-for', _as_tfa_time($opt->{'f'}));
  }
  elsif (exists($opt->{'h'}))
  { die get_string('BAD_HOURS', $opt->{'h'})
      unless $opt->{'h'} =~ m/^(\d+)$/ && $1 < 24;  ## no critic (Unless)
    push(@cmd, 'diagcollect');
    push(@cmd, '-node', join(q{,}, @nod)) if @nod;
    push(@cmd, '-since', "$1h");
    $tim->set_interval(scalar $tim->convert_time(time), "$1h", 0);
    $per[0] = $tim->get_time('beg', $UTC).$UTC;
    $per[1] = $tim->get_time('end', $UTC).$UTC;
  }
  elsif (exists($opt->{'p'}))
  { $per[0] = _as_iso_time($beg = _as_tfa_time(shift(@{$opt->{'p'}})));
    $per[1] = _as_iso_time($end = _as_tfa_time(shift(@{$opt->{'p'}})));
    push(@cmd, 'diagcollect');
    push(@cmd, '-node', join(q{,}, @nod)) if @nod;
    push(@cmd, '-from', $beg, '-to', $end);
  }
  elsif (exists($opt->{'r'}))
  { my ($ref, $val);

    $ref = _as_iso_time(shift(@{$opt->{'r'}}));
    $beg = $1
      if defined($val = shift(@{$opt->{'r'}}))
      && $val =~ m/^(\d{1,2}([dhms]|(:\d{2}){0,4}))$/;
    $end = $1
      if defined($val = shift(@{$opt->{'r'}}))
      && $val =~ m/^(\d{1,2}([dhms]|(:\d{2}){0,4}))$/;
    if ($ref =~ m/T$/)
    { die get_string('BAD_REFERENCE', $opt->{'r'})
        if $tim->set_interval($ref."00:00:00$UTC",
                              $beg || '12:00:00', $end || '1:23:59:59');
    }
    else
    { die get_string('BAD_REFERENCE', $opt->{'r'})
        if $tim->set_interval($ref.$UTC, $beg, $end);
    }
    $beg = _as_tfa_time($per[0] = $tim->get_time('beg', $UTC), 1);
    $end = _as_tfa_time($per[1] = $tim->get_time('end', $UTC), 1);
    push(@cmd, 'diagcollect');
    push(@cmd, '-node', join(q{,}, @nod)) if @nod;
    push(@cmd, '-from', $beg, '-to', $end);
  }
  push(@cmd, @{$opt->{'x'}}) if exists($opt->{'x'});

  # Execute the request
  return 0 unless @cmd;
  if (defined($cmd = _get_command($agt)))
  { my ($arg, $flg, $msg, $ret, @log);

    $cmd = join(q{ }, map {RDA::Object::Rda->quote($_)} $cmd, @cmd);
    $dsp->dsp_line(get_string('Execute', $cmd)) if $dsp;
    foreach my $lin (`$cmd`)
    { push (@log, $lin);
      if ($flg)
      { $flg = 0;
        if ($lin =~ m/^(.*\.zip)/)
        { return 0 if copy($1, basename($1));
          next;
        }
      }
      if ($lin =~ m/^Logs are being collected to:/)
      { $flg = 1;
      }
      elsif ($lin =~ m/^User '(.*)' does not have permissions to run tfactl/)
      { ($msg, $arg) = ('tfa-User', $1);
      }
    }
    return 0 if $ret;
    if ($msg)
    { $agt->submit(q{.}, 'DISPLAY.DSP_TEXT',
        name    => $msg,
        set_arg => $arg);
    }
    else
    { foreach my $lin (@log)
      { print $lin;
      }
    }
  }
  if (@per)
  { my ($col, $rsp, @tbl);

    # Set up the collection
    $col = $agt->get_collector;
    $col->set_isolated(1);
    $col->set_value('SETUP.RDA.CONFIG.T_START_TIME', $per[0]);
    $col->set_value('SETUP.RDA.CONFIG.T_END_TIME',   $per[1]);
    return 101 if $agt->submit(q{.}, 'RDA.SETUP',
      display  => 0,
      profiles => 'DB_Tfa')->is_error($agt);

    # Collect the data
    return 102 if $agt->submit(q{.}, 'RDA.COLLECT',
      profiles => 'DB_Tfa')->is_error($agt);

    # Render the reports
    return 103 if $agt->submit(q{.}, 'RENDER.GEN_HTML')->is_error($agt);

    # Package the collection results
    $rsp = $agt->submit(q{.}, 'PACKAGE.RESULTS',
      display => 0);
    return 104 if $rsp->is_error($agt);

    # Check if some finalization tasks are present
    if (@tbl = grep {m/([A-Z][A-Z\d]*:)?DC([a-z][a-z\d]*)(\-\w+)*$/}
                    $col->set_value('PACKAGE.T_FINALIZE'))
    { $col->find('SETUP.FINAL', 1)->clear->set_temp('T_FINALIZE_PACKAGE',
        [@tbl]);

      # Perform the finalization treatment
      return 105 if $agt->submit(q{.}, 'RDA.POST',
        type => 'FINALIZE_PACKAGE')->is_error($agt);
      return 106 if $agt->submit(q{.}, 'RENDER.GEN_HTML')->is_error($agt);
      $rsp = $agt->submit(q{.}, 'PACKAGE.RESULTS',
        display => 0);
      return 107 if $rsp->is_error($agt);
    }

    # Display a text
    $agt->submit(q{.}, 'DISPLAY.DSP_TEXT',
      name    => 'tfa-RDA',
      set_arc => $rsp->get_first('archive'),
      set_beg => $per[0],
      set_end => $per[1])
      if RDA::Object::Rda->is_unix;

    # Indicate a successful completion
    return 0;
  }

  # Display a text
  $agt->submit(q{.}, 'DISPLAY.DSP_TEXT',
    name => 'tfa-Note')
    if RDA::Object::Rda->is_unix && !defined($cmd);

  # Indicate that no collection could been done
  return 100;
}

=head2 S<help>

This command displays the command syntax and the related explanations.

=cut

sub help
{ return shift->submit(q{.}, 'DISPLAY.DSP_POD', package => __PACKAGE__);
}

=head2 S<purge [-d days|-h hours]>

This command purges TFA files older than than the specified number of hours or
days. It supports additional command switches:

=over 12

=item B<  -d days>

Specifies the number of days.

=item B<  -h hours>

Specifies the number of hours.

=back

=cut

sub purge
{ my ($agt, @arg) = @_;
  my ($cmd, $dsp, $opt, @cmd);

  # Treat the options
  $dsp = $agt->is_verbose;
  $opt = RDA::Options::getopts('d:h:', \@arg);

  return 100 unless defined($cmd = _get_command($agt));
  if (exists($opt->{'d'}))
  { die get_string('BAD_DAYS', $opt->{'d'})
      unless $opt->{'d'} =~ m/^(\d+)$/;
    @cmd = ('purge', '-older', "$1d", '-force');
  }
  elsif (exists($opt->{'h'}))
  { die get_string('BAD_HOURS', $opt->{'h'})
      unless $opt->{'h'} =~ m/^(\d+)$/;
    @cmd = ('purge', '-older', "$1h", '-force');
  }

  # Execute the request
  return 0 unless @cmd;
  $dsp->dsp_line(get_string('Execute', join(q{ }, $cmd, @cmd))) if $dsp;
  return system($cmd, @cmd);
}

=for stopwords srdc

=head2 S<srdc [-n node,...] note>

This command reports the date and time of relevant trace files. It supports an
additional command switch:


=over 15

=item B<  -n node,...>

Specifies the list of host names for the collection or C<all> or C<local>.

=back

=cut

sub srdc
{ my ($agt, @arg) = @_;
  my ($arg, $cmd, $dsp, $ifh, $opt, $tmp, @nod);

  # Treat the options
  $dsp = $agt->is_verbose;
  $opt = RDA::Options::getopts('n*', \@arg);
  @nod = map {RDA::Object::View->is_host($_, 1)} @{$opt->{'n'}}
    if $opt->{'n'};

  return 100 unless defined($cmd = _get_command($agt));
  die get_string('BAD_SRDC')
    unless defined($arg = shift(@arg)) && $arg =~ m/^(\d{7,}\.\d)$/;

  # Execute the command and parse its result
  $tmp = $agt->get_collector->get_work('TFA', 1);
  $cmd = RDA::Object::Rda->quote($cmd).' diagcollect';
  $cmd .= ' -node '.join(q{,}, @nod) if @nod;
  $cmd .= " -srdc $1 >".RDA::Object::Rda->quote($tmp).' 2>/dev/null';
  $dsp->dsp_line(get_string('Execute', $cmd)) if $dsp;
  $ifh = IO::File->new;
  if (open($ifh, qq{| $cmd}))  ## no critic (Open,Close)
  { print {$ifh} "Q\nj";
    close($ifh);

    # Analyze the output (do not translate the result)
    if ($ifh->open("<$tmp"))
    { while (<$ifh>)
      { print "Tracefile Date and Time = $1\n" if m/^\d+\.\s+(\S+\s+\S+)/;
      }
      $ifh->close;
    }
  }
  return 0;
}

=head2 S<test>

This command tests if it can locate TFA and that TFA is well in use on the
system.

=cut

sub test
{ my ($agt, @arg) = @_;
  my ($dsp, $hom);

  # Treat the options
  $dsp = $agt->is_verbose;
  RDA::Options::getopts(q{}, \@arg);

  # Detect TFA home
  if (defined($hom = _get_home($agt)))
  {$dsp->dsp_line(get_string('TfaHome', $hom)) if $dsp;
   return 0;
  }

  # Indicate that TFA has not be found
  $dsp->dsp_line(get_string('NotUsed')) if $dsp;
  return 100;
}

# --- Command execution routines ----------------------------------------------

# Convert the time in ISO format
sub _as_iso_time
{ my ($str) = @_;

  return "$3-".$tb_mon{lc($1)}."-$2T$4"
    if $str =~ m{^([A-Z]{3})/(\d{2})/(\d{4}) (\d{2}:\d{2}:\d{2})$}i;
  return "$3-".$tb_mon{lc($1)}."-$2T"
    if $str =~ m{^([A-Z]{3})/(\d{2})/(\d{4})$}i;
  return "$1T$2"
    if $str =~ m{^(\d{4}-\d{2}-\d{2})[\sT](\d{2}:\d{2}:\d{2})};
  return "$1T"
    if $str =~ m{^(\d{4}-\d{2}-\d{2})};
  die get_string('BAD_FORMAT', $str)
}

# Convert the time in TFA format
sub _as_tfa_time
{ my ($str, $flg) = @_;

  die get_string('NO_TIME') unless defined($str);
  return _val_tfa_time($1, $flg)
    if $str =~ m{^([A-Z]{3}/\d{2}/\d{4} \d{2}:\d{2}:\d{2})$}i;
  return _val_tfa_time($tb_mon[$2]."/$3/$1 $4", $flg)
    if $str =~ m{^(\d{4})-(\d{2})-(\d{2})[\sT](\d{2}:\d{2}:\d{2})};
  die get_string('BAD_FORMAT', $str);
}

# Return the path of the TFA command
sub _get_command
{ my ($agt) = @_;
  my ($hom);

  return defined($hom = _get_home($agt))
    ? RDA::Object::Rda->cat_file($hom, 'bin', 'tfactl')
    : undef;
}

# Return the TFA software home
sub _get_home
{ my ($agt) = @_;
  my ($sys);

  $sys = $agt->get_system;
  return _get_init_home($sys) ||
         _get_ps_home($sys) ||
         $sys->get_dir('TFA_HOME');
}

sub _get_init_home
{ my ($sys) = @_;
  my ($hom, $ifh, $pth);

  if (exists($tb_ini{$^O})
    && -f ($pth = $tb_ini{$^O})
    && ($ifh = IO::File->new)->open("<$pth"))
  { while (<$ifh>)
    { if (m/^\s*(?:export\s+)?TFA_HOME=(.*)/)
      { $pth = $1;
        $pth =~ s/[\n\r\s]+$//;
        $pth = $2 if $pth =~ m/^([\042\047])(.*)\1$/;
        last if defined($hom = $sys->test_dir('d', $pth));
      }
    }
    $ifh->close;
  }
  return $hom
}

sub _get_ps_home
{ my ($sys) = @_;
  my ($hom, $ifh, $pgm, @tbl);

  if (defined($pgm = $sys->get_exec('PS')))
  { if (open($ifh = IO::Handle->new, "$pgm -ef |"))  ## no critic (Close,Open)
    { PROC: while (<$ifh>)
      { next unless m{\btfa}i;
        @tbl = split(/\s+/, $_);
        splice(@tbl, 0, 12);
        foreach my $arg (@tbl)
        { last PROC if defined($hom = $sys->test_dir('d', $arg));
        }
      }
      close($ifh);
    }
  }
  return $hom;
}

# Validate a TFA time
sub _val_tfa_time
{ my ($str, $flg) = @_;
  my ($tim, @tim);

  if ($str =~ m{^([A-Z]{3})/(\d{2})/(\d{4}) (\d{2}):(\d{2}):(\d{2})$}i)
  { $tim = timelocal($6, $5, $4, $2, $tb_mon{lc($1)} - 1, $3 - 1900);
    if ($tim > time)
    { die get_string('FUTURE_TIME', $str) unless $flg;
      @tim = localtime;
      $str = sprintf(q{%3s/%02d/%04d %02d:%02d:%02d}, $tb_mon[$tim[4] + 1],
        $tim[3], 1900 + $tim[5], $tim[2], $tim[1], $tim[0]);
    }
  }
  return $str;
}

1;

__END__

=head1 SEE ALSO

L<RDA::Agent|RDA::Agent>,
L<RDA::Object::Collect|RDA::Object::Collect>,
L<RDA::Object::Message|RDA::Object::Message>,
L<RDA::Object::Rda|RDA::Object::Rda>,
L<RDA::Object::Timing|RDA::Object::Timing>,
L<RDA::Object::View|RDA::Object::View>,
L<RDA::Options|RDA::Options>,
L<RDA::Request::DISPLAY|RDA::Request::DISPLAY>,
L<RDA::Request::RDA|RDA::Request::RDA>,
L<RDA::Text|RDA::Text>

=head1 COPYRIGHT NOTICE

Copyright (c) 2002, 2016, Oracle and/or its affiliates. All rights reserved.

=head1 TRADEMARK NOTICE

Oracle and Java are registered trademarks of Oracle and/or its
affiliates. Other names may be trademarks of their respective owners.

=cut