# Trace.pm: Superclass Used for Implementing Tracing Methods

package RDA::Trace;

# $Id: Trace.pm,v 1.9 2015/05/09 15:26:50 RDA Exp $
# ARCS: $Header: /home/cvs/cvs/RDA_8/src/scripting/lib/RDA/Trace.pm,v 1.9 2015/05/09 15:26:50 RDA Exp $
#
# Change History
# 20150508  MSC  Change tracing.

=head1 NAME

RDA::Trace - Superclass Used for Implementing Tracing Methods

=head1 SYNOPSIS

 require RDA::Trace;

=head1 DESCRIPTION

The C<RDA::Trace> class regroups the tracing methods. It uses the following
special keys:

=over 12

=item S<    B<'lvl' > > Optional trace level

=back

The following methods are available:

=cut

use strict;

BEGIN
{ use Exporter;
  use RDA::Text;
}

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

# Define the global private constants

# Define the global private variables

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

=head2 S<$h-E<gt>set_trace([$level])>

This method specifies the trace level and returns the previous trace level.

=cut

sub set_trace
{ my ($slf, $lvl) = @_;
  my ($old);

  $old = $slf->{'lvl'};
  $slf->{'lvl'} = ($lvl > 0) ? $lvl : 0 if defined($lvl);
  return $old;
}

=head2 S<$RDA::Trace-E<gt>trace($str...)>

This method adds a line into the trace file.

=cut

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

  _write(_get_prefix($slf, grep {defined($_) && !ref($_)} @arg).qq{\n});
  return;
}

sub _get_prefix
{ my ($slf, @arg) = @_;
  my (@gmt);

  @gmt = gmtime(time);
  return sprintf('%s(%04d%02d%02d_%02d%02d%02d)> %s',
    $slf->get_info('pre', q{}),
    1900 + $gmt[5], 1 + $gmt[4], $gmt[3], $gmt[2], $gmt[1], $gmt[0],
    join(q{}, grep {defined($_) && !ref($_)} @_));
}

sub _write
{ my ($buf) = @_;
  my ($lgt, $max, $off);

  $max = length($buf);
  $off = 0;
  while ($max && ($lgt = syswrite($RDA::Text::TRACE, $buf, $max, $off)))
  { $max -= $lgt;
    $off += $lgt;
  }
  return;
}

=head2 S<$RDA::Trace-E<gt>trace_object($obj[,$str,...])>

This method adds an object dump into the trace file.

=cut

sub trace_object
{ my ($slf, $obj, @arg) = @_;

  _write($obj->dump(0, _get_prefix($slf, grep {defined($_) && !ref($_)} @arg))
    .qq{\n});
  return;
}

1;

__END__

=head1 SEE ALSO

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