# Log.pm: Class Used for Objects to Manage Event Logs

package RDA::Object::Log;

# $Id: Log.pm,v 1.10 2015/05/05 13:18:39 RDA Exp $
# ARCS: $Header: /home/cvs/cvs/RDA_8/src/scripting/lib/RDA/Object/Log.pm,v 1.10 2015/05/05 13:18:39 RDA Exp $
#
# Change History
# 20150505  MSC  Improve the documentation.

=head1 NAME

RDA::Object::Log - Class Used for Objects to Manage Event Logs

=head1 SYNOPSIS

 require RDA::Object::Log;

=head1 DESCRIPTION

The objects of the C<RDA::Object::Log> class are used to manage event logs. It
is a subclass of L<RDA::Object|RDA::Object>.

The following methods are available:

=cut

use strict;

BEGIN
{ use Exporter;
  use IO::File;
  use RDA::Text qw(get_string);
  use RDA::Object;
  use RDA::Object::Rda qw($APPEND $DIR_PERMS $FIL_PERMS);
}

# Define the global public variables
use vars qw($STRINGS $VERSION @ISA %SDCL);
$VERSION = sprintf('%d.%02d', q$Revision: 1.10 $ =~ /(\d+)\.(\d+)/);
@ISA     = qw(RDA::Object Exporter);
%SDCL    = (
  als => {
    ## no critic (Interpolation)
    'log' => ['${CUR.O_LOG}', 'log'],
    },
  inc => [qw(RDA::Object)],
  met => {
    'end'      => {ret => 0},
    'get_path' => {ret => 0},
    'log'      => {ret => 0},
    'start'    => {ret => 0},
    'suspend'  => {ret => 0},
    },
  );

# Define the global private constants

# Define the global private variables

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

=head2 S<$h = RDA::Object::Log-E<gt>new($agt,$dir,$name)>

The object constructor. It takes the agent reference, its directory, and its
name as arguments.

C<RDA::Object::Log> is represented by a blessed hash reference. The following
special keys are used:

=over 12

=item S<    B<'agt' > > Reference to the agent object

=item S<    B<'cfg' > > Reference to the RDA software configuration

=item S<    B<'oid' > > Event log name

=item S<    B<'_beg'> > Start time

=item S<    B<'_dir'> > Event log directory

=item S<    B<'_evt'> > Event stack

=item S<    B<'_ofh'> > Output file handle

=item S<    B<'_pth'> > Log file path

=item S<    B<'_run'> > Run identifier

=back

Internal keys are prefixed by an underscore.

=cut

sub new
{ my ($cls, $agt, $dir, $oid) = @_;
  my ($beg, $cfg);

  # Create the log object and return its reference
  $beg = time;
  $cfg = $agt->get_config;
  return bless {
    agt  => $agt,
    cfg  => $cfg,
    oid  => $oid,
    _beg => $beg,
    _dir => $dir,
    _evt => [[$beg, 'b', $cfg->get_version, $cfg->get_build]],
    _pth => $cfg->cat_file($dir,
              $cfg->get_value('B_CASE') ? "$oid.log" : lc("$oid.log")),
    _run => $cfg->get_info('ver'),
    }, ref($cls) || $cls;
}

=head2 S<$h-E<gt>delete_object>

This method deletes the event log control object.

=cut

sub delete_object
{ # Close the event log
  $_[0]->end;

  # Delete the object itself
  $_[0]->SUPER::delete_object;
  return;
}


=head2 S<$h-E<gt>end>

This method logs an end event (type 'e') including the execution duration,
and then closes the event log.

=cut

sub end
{ my ($slf) = @_;
  my ($tim);

  if (exists($slf->{'_ofh'}))
  { # Log the end record
    $tim = time;
    $slf->_log($tim, 'e', $slf->{'cfg'}->get_version, $tim - $slf->{'_beg'});

    # Close the event log file
    delete($slf->{'_ofh'})->close;
  }
  return;
}

=head2 S<$h-E<gt>get_handle>

This method returns the file handle that is associated with the event log
file. Otherwise, it returns C<undef> when not possible.

=cut

sub get_handle
{ my ($slf) = @_;

  return exists($slf->{'_ofh'}) ? $slf->{'_ofh'} : undef;
}

=head2 S<$h-E<gt>get_path>

This method returns the path to the log file.

=cut

sub get_path
{ return shift->{'_pth'};
}

=head2 S<$h-E<gt>log($type[,$arg...])>

This method logs an event in the event log. It prefixes event records with a
time stamp (GMT) and the collection name. The fields are separated by a C<|>
character.

It stores the event if the log file is not currently open.

It returns an undefined value if the type does not contain ASCII letters
only. Otherwise, it returns the number of events effectively written in the log
file.

=cut

sub log  ## no critic (Builtin)
{ my ($slf, $typ, @arg) = @_;
  my ($cnt);

  if ($typ && $typ =~ m/^[A-Za-z]+$/)
  { if ($cnt = start($slf))
    { _log($slf, time, $typ, @arg);
    }
    else
    { push(@{$slf->{'_evt'}}, [time, $typ, @arg]);
    }
  }
  return $cnt;
}

sub _log
{ my ($slf, $tim, @arg) = @_;

  my $buf = join(q{|}, RDA::Object::Rda->get_timestamp($tim), $slf->{'_run'},
    @arg, qq{\n});
  sysseek($slf->{'_ofh'}, 0, 2);
  $slf->{'_ofh'}->syswrite($buf, length($buf));
  return;
}

=head2 S<$h-E<gt>start([$flag])>

This method opens the event log file if the log file directory exists. When the
flag is set, it forces the event log initialization by creating any missing
directory.

On successful opening, it adds all pending events.

=cut

sub start
{ my ($slf, $flg) = @_;
  my ($cfg, $cnt, $dir, $evt, $ofh, $pth, $stk);

  $cnt = 1;
  unless (exists($slf->{'_ofh'}))
  { $cfg = $slf->{'cfg'};
    $stk = $slf->{'agt'}->should_align;

    # Create the report directory when needed
    unless (-d ($dir = $slf->{'_dir'}))
    { $cfg->create_dir($dir, $DIR_PERMS, 0, $stk) if $flg;
      return 0 unless -d $dir;
    }

    # Open the event log file
    $pth = $slf->{'_pth'};
    push(@{$stk}, $pth) if $stk && ! -f $pth;
    ($ofh = IO::File->new)->open($pth, $APPEND, $FIL_PERMS)
      or die get_string('ERR_OPEN', $pth, $!);
    $slf->{'_ofh'} = $ofh;

    # Add the pending events
    while (defined($evt = shift(@{$slf->{'_evt'}})))
    { $slf->_log(@{$evt});
      ++$cnt;
    }
  }
  return $cnt;
}

=head2 S<$h-E<gt>suspend>

This method suspends event logging and closes the log file.

=cut

sub suspend
{ my ($slf) = @_;

  delete($slf->{'_ofh'})->close if exists($slf->{'_ofh'});
  return;
}

1;

__END__

=head1 SEE ALSO

L<RDA::Agent|RDA::Agent>,
L<RDA::Object|RDA::Object>,
L<RDA::Object::Rda|RDA::Object::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