# Alarm.pm: Class Used for Managing Alarms

package RDA::Alarm;

# $Id: Alarm.pm,v 1.2 2015/05/09 15:20:25 RDA Exp $
# ARCS: $Header: /home/cvs/cvs/RDA_8/src/scripting/lib/RDA/Alarm.pm,v 1.2 2015/05/09 15:20:25 RDA Exp $
#
# Change History
# 20150508  MSC  Change tracing.

=head1 NAME

RDA::Alarm - Class Used for Managing Alarms

=head1 SYNOPSIS

 require RDA::Alarm;

=head1 DESCRIPTION

The module regroups methods used for managing alarms.

The following methods are available:

=cut

use strict;

BEGIN
{ use Exporter;
  use RDA::Text qw(get_string);
  use RDA::Object;
}

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

# Define the global private constants
my $SEP = " +--------\n";
my $SPC = q{ };

# Define the global private variables

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

=head2 S<check_alarm($lim)>

This routine checks if alarm is implemented

=cut

sub check_alarm
{ my ($lim) = @_;

  return 0 unless $lim > 0;  ## no critic (Unless)
  _dump_caller(q{Alarm test}) if $DUMP;
  eval {alarm(0)};
  return $@ ? 0 : $lim;
}

=head2 S<clear_alarm()>

This routine clears the alarm.

=cut

sub clear_alarm
{ my ($lim) = @_;
  my ($ret);

  $ret = alarm(0);
  _dump_caller(q{Alarm cleared}) if $DUMP;
  return $ret;
}


=head2 S<set_alarm($lim)>

This routine sets the alarm.

=cut

sub set_alarm
{ my ($lim) = @_;

  _dump_caller(qq{Alarm set to $lim seconds}) if $DUMP;
  return alarm($lim);
}

# --- Internal routines -------------------------------------------------------

# Dump the calling stack
sub _dump_caller
{ my ($msg) = @_;
  my ($buf, $lvl, @tbl);

  $buf = $SEP;
  $buf .= qq{ |$msg\n |\n} if defined($msg);
  while (@tbl = caller(++$lvl))
  { if ($lvl > 10)
    { $buf .= qq{ | ...\n};
      last;
    }
    $buf .= q{ | }.$tbl[1].' at line '.$tbl[2]."\n |   ".$tbl[3].qq{\n};
  }
  $buf .= $SEP;
  syswrite($RDA::Text::TRACE, $buf, length($buf));
  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