# Timing.pm: Class Used for Managing Timing Files

package RDA::Handle::Timing;

# $Id: Timing.pm,v 1.10 2015/11/13 15:53:43 RDA Exp $
# ARCS: $Header: /home/cvs/cvs/RDA_8/src/scripting/lib/RDA/Handle/Timing.pm,v 1.10 2015/11/13 15:53:43 RDA Exp $
#
# Change History
# 20151113  MSC  Pass the timing control object reference as argument.

=head1 NAME

RDA::Handle::Timing - Class Used for Managing Timing Files

=head1 SYNOPSIS

 require RDA::Handle::Timing;

=head1 DESCRIPTION

The objects of the C<RDA::Handle::Timing> class are used for managing memory
files.

The following methods are available:

=cut

use strict;

BEGIN
{ use Exporter;
  use IO::File;
  use RDA::Text qw(debug get_string);
  use RDA::Object::Timing;
  use Symbol;
}

# Define the global public variables
use vars qw($STRINGS $VERSION @ISA);
$VERSION = sprintf('%d.%02d', q$Revision: 1.10 $ =~ /(\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 = RDA::Handle::Timing-E<gt>new($fil,$tim,$fct)>

The object constructor.

C<RDA::Handle::Timing> is represented by a symbol, which can be used as a file
handle. The following special keys are used:

=over 12

=item S<    B<'beg' > > Beginning of the range

=item S<    B<'bit' > > Block size (as bit number)

=item S<    B<'blk' > > Block cache

=item S<    B<'buf' > > Buffer

=item S<    B<'cch' > > Cache indicator

=item S<    B<'chk' > > Check result cache

=item S<    B<'cnt' > > Number of blocks read

=item S<    B<'cur' > > Current block number

=item S<    B<'dbg' > > Debug indicator

=item S<    B<'end' > > End of the range

=item S<    B<'eof' > > End-of-file indicator

=item S<    B<'eol' > > End-of-line characters protection indicator

=item S<    B<'f_e' > > Function to detect the start event

=item S<    B<'f_l' > > Limit to search the start event

=item S<    B<'f_t' > > Function to check the time stamp

=item S<    B<'ifh' > > Input file handle

=item S<    B<'inc' > > Read increment (in bytes)

=item S<    B<'lgt' > > Buffer length

=item S<    B<'lim' > > Block limit / mask

=item S<    B<'lin' > > Line number inside the range

=item S<    B<'max' > > Last block of the range

=item S<    B<'min' > > First block of the range

=item S<    B<'pos' > > Current position

=item S<    B<'pth' > > File path

=item S<    B<'siz' > > Range size

=item S<    B<'sta' > > File status information

=item S<    B<'tot' > > Total number of blocks

=back

You can specify a string or a string reference as an argument.

=cut

sub new
{ my $cls = shift;

  # Create the buffer object
  my $slf = bless Symbol::gensym(), ref($cls) || $cls;
  tie *$slf, $slf;  ## no critic (Tie)

  # Return the object reference
  return $slf->open(@_);
}

sub open  ## no critic (Builtin)
{ my ($slf, $pth, $tim, $fct) = @_;

  # Create the object when not yet done
  return $slf->new($pth, $tim, $fct) unless ref($slf);

  # Define other object attributes
  *$slf->{'cch'} = 1;
  *$slf->{'dbg'} = $RDA::Object::Timing::DUMP;
  *$slf->{'eol'} = 1;
  *$slf->{'ifh'} = IO::File->new;
  *$slf->{'lin'} = 0;
  *$slf->{'pth'} = $pth;
  *$slf->{'tim'} = $tim;

  debug("TIM> Open $pth") if *$slf->{'dbg'};
  return unless ref($tim) eq 'RDA::Object::Timing'
    && *$slf->{'ifh'}->open(q{<}.$pth);
  if (ref($fct) eq 'ARRAY')
  { # Select a fragment based on a reference time and a previous event
    die get_string('NO_FUNCTION')
      unless ref($fct->[0]) eq 'CODE' &&
             ref($fct->[1]) eq 'CODE' &&
             defined($fct->[2]) && $fct->[2] =~ m/^\d+$/;
    *$slf->{'f_t'} = $fct->[0];
    *$slf->{'f_e'} = $fct->[1];
    *$slf->{'f_l'} = $fct->[2];
    return unless _get_range_ref($slf) && _set_limits_ref($slf);
  }
  else
  { # Select a fragment based on a period
    die get_string('NO_FUNCTION')
      unless ref($fct) eq 'CODE';
    *$slf->{'f_t'} = $fct;
    return unless _get_range_per($slf) && _set_limits_per($slf);
  }

  # Reset the position
  $slf->seek(0, 0);

  # Return the object reference
  return $slf;
}

=head2 S<$h-E<gt>save($ofh)>

This method saves the area from the current position.

=cut

sub save
{ my ($slf, $ofh) = @_;
  my ($lgt);

  binmode($ofh);
  while ($lgt = *$slf->{'lgt'})
  { $ofh->syswrite(*$slf->{'buf'}, $lgt);
    *$slf->{'pos'} += $lgt;
    _read_block($slf);
  }
  return $ofh->close;
}

# Manage object attributes
sub setinfo
{ my ($slf, $key, $val) = @_;
  my ($old);

  $old = *$slf->{$key};
  *$slf->{$key} = $val if defined($val);
  return $old;
}

# Declare a routine for an undefined functionality
my $und = sub { return };

=head1 BASIC I/O METHODS

See L<perlfunc|perlfunc> for complete descriptions of each of the following
methods, which are front ends for the corresponding built-in functions:

    $io->close
    $io->eof
    $io->fileno
    $io->getc
    $io->read(BUF,LEN,[OFFSET])
    $io->print(ARGS)
    $io->printf(FMT,[ARGS])
    $io->stat
    $io->sysread(BUF,LEN,[OFFSET])
    $io->syswrite(BUF,[LEN,[OFFSET]])
    $io->truncate(LEN)

=cut

sub close  ## no critic (Ambiguous,Builtin)
{ my ($slf) = @_;

  debug('TIM> Close '.*$slf->{'pth'}) if *$slf->{'dbg'};
  delete *$slf->{'beg'};
  delete *$slf->{'bit'};
  delete *$slf->{'blk'};
  delete *$slf->{'buf'};
  delete *$slf->{'cch'};
  delete *$slf->{'chk'};
  delete *$slf->{'cnt'};
  delete *$slf->{'cur'};
  delete *$slf->{'dbg'};
  delete *$slf->{'end'};
  delete *$slf->{'eof'};
  delete *$slf->{'eol'};
  delete *$slf->{'f_e'};
  delete *$slf->{'f_l'};
  delete *$slf->{'f_t'};
  delete *$slf->{'ifh'};
  delete *$slf->{'inc'};
  delete *$slf->{'lgt'};
  delete *$slf->{'lim'};
  delete *$slf->{'lin'};
  delete *$slf->{'max'};
  delete *$slf->{'min'};
  delete *$slf->{'pos'};
  delete *$slf->{'pth'};
  delete *$slf->{'siz'};
  delete *$slf->{'sta'};
  delete *$slf->{'tot'};
  undef *$slf;
  return 1;
}

sub eof  ## no critic (Builtin)
{ my ($slf) = @_;

  return *$slf->{'eof'};
}

*fileno = $und;

sub getc  ## no critic (Builtin)
{ my ($slf) = @_;
  my ($buf);

  return $buf if $slf->read($buf, 1);
  return;
}

sub read  ## no critic (Builtin,Unpack)
{ my ($slf, undef, $siz, $off) = @_;
  my ($buf, $dat, $lgt);

  return if *$slf->{'eof'};
  return 0 unless $siz > 0;  ## no critic (Unless)

  $dat = *$slf->{'buf'};

  if ($siz > *$slf->{'lgt'})
  { $lgt = *$slf->{'lgt'};
    while (_read_block($slf))
    { $dat .= *$slf->{'buf'};
      $lgt += *$slf->{'lgt'};
      if ($siz <= $lgt)
      { *$slf->{'lgt'} = $lgt - $siz;
        *$slf->{'buf'} = substr($dat, $lgt = $siz);
        last;
      }
    }
  }
  else
  { *$slf->{'buf'} = substr($dat, $lgt = $siz);
    *$slf->{'lgt'} -= $lgt;
  }
  if (defined($off))
  { substr($_[1], $off) = substr($dat, 0, $lgt);
  }
  else
  { $_[1] = substr($dat, 0, $lgt);
  }
  *$slf->{'pos'} += $lgt;
  return $lgt;
}

*print = $und;
*printf = $und;

sub stat  ## no critic (Builtin)
{ my ($slf) = @_;
  my ($sta);

  return unless $slf->opened;
  return 1 unless wantarray;
  $sta = *$slf->{'sta'};
  $sta->[7]  = *$slf->{'siz'};
  $sta->[11] = *$slf->{'inc'};
  $sta->[12] = *$slf->{'max'} - *$slf->{'min'} + 1;
  return (@{$sta});
}

*sysread = \&read;
*syswrite = $und;
*truncate = $und;

=head1 I/O METHODS RELATED TO PERL VARIABLES

See L<perlvar|perlvar> for complete descriptions of each of the following
methods. The methods return the previous value of the attribute and take an
optional single argument that, when given, sets the value. If no argument is
given, then the previous value is unchanged.

    $|    $io-E<gt>autoflush([BOOL])
    $.    $io-E<gt>input_line_number([NUM])

=cut

*autoflush = $und;

sub input_line_number
{ my ($slf, $val) = @_;

  return $slf->setinfo('lin', $val);
}

=head1 IO::HANDLE LIKE METHODS

See L<IO::Handle|IO::Handle> for complete descriptions of each of the following
methods:

    $io->blocking([BOOL])
    $io->clearerr
    $io->error
    $io->flush
    $io->getline
    $io->getlines
    $io->opened
    $io->printflush(ARGS)
    $io->sync
    $io->ungetc(ORD)
    $io->untaint
    $io->write(BUF,LEN[,OFFSET])

=cut

sub blocking
{ return 1;
}

*clearerr = $und;
*error = $und;
*fcntl = $und;
*flush = $und;

sub getline
{ my ($slf) = @_;
  my ($buf, $eol, $lgt, $lin, $str);

  return if *$slf->{'eof'};
  unless (defined($/))  # No line separator defined
  { $lgt = *$slf->{'lgt'};
    $str = *$slf->{'buf'};
    while (_read_block($slf))
    { $lgt += *$slf->{'lgt'};
      $str .= *$slf->{'buf'}
    }
    *$slf->{'pos'} += $lgt;
    return $str;
  }
  if (length($/))       # Line mode
  { return unless defined($str = _read_line($slf, $/));
    $. = ++*$slf->{'lin'};
  }
  else                  # Paragraph mode
  { return unless defined($str = _read_line($slf, qq{\n}));
    $eol = 0;
    while (defined($lin = _read_line($slf, qq{\n})))
    { if ($lin eq qq{\n})
      { $eol++;
        next if $eol > 1;
      }
      elsif ($eol)
      { $lgt = length($lin);
        *$slf->{'buf'} = $lin.*$slf->{'buf'};
        *$slf->{'lgt'} += $lgt;
        *$slf->{'pos'} -= $lgt;
        last;
      }
      else
      { $eol = 0;
      }
      $str .= $lin;
    }
  }
  unless (*$slf->{'eol'})
  { chomp($str);
    $str =~ s/[\n\r\s]+$//;
  }
  return $str;
}

sub getlines
{ my ($slf) = @_;
  my ($lin, @tbl);

  die get_string('BAD_GETLINES') unless wantarray;
  push(@tbl, $lin) while defined($lin = $slf->getline);
  return @tbl;
}

*ioctl = $und;

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

  return defined(*$slf->{'buf'});
}

*printflush = $und;
*setbuf = $und;
*setvbuf = $und;
*sync = $und;
*ungetc = $und;
*untaint = $und;
*write = $und;

=head1 SEEK METHODS

See L<IO::Seekable|IO::Seekable> for complete descriptions of each of the
following methods:

    $io->getpos
    $io->setpos($pos)
    $io->seek($pos,$whence)
    $io->sysseek($pos,$whence)
    $io->tell

=cut

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

  return *$slf->{'pos'};
}

sub seek  ## no critic (Builtin)
{ my ($slf, $off, $typ) = @_;
  my ($buf, $flg, $min, $max, $pos);

  if ($typ == 0)
  { $pos = $off;
  }
  elsif ($typ == 1)
  { $pos = *$slf->{'pos'} + $off;
  }
  elsif ($typ == 2)
  { $pos = *$slf->{'siz'} + $off;
  }
  else
  { die get_string('BAD_WHENCE', $typ);
  }

  $pos = 0 if $pos < 0;
  if ($pos < *$slf->{'siz'})
  { *$slf->{'pos'} = $pos;
    $pos += *$slf->{'beg'};
    *$slf->{'cur'} = *$slf->{'min'} + ($pos >> *$slf->{'bit'});
    $pos &= *$slf->{'lim'};  ## no critic (Bit)

    *$slf->{'buf'} = substr(_get_block($slf, *$slf->{'cur'}), $pos);
    *$slf->{'eof'} = 0;
    *$slf->{'lgt'} = ((*$slf->{'cur'} < *$slf->{'max'})
      ? *$slf->{'inc'}
      : *$slf->{'end'}) - $pos;
  }
  else
  { *$slf->{'buf'} = q{};
    *$slf->{'cur'} = *$slf->{'max'};
    *$slf->{'eof'} = 1;
    *$slf->{'lgt'} = 0;
    *$slf->{'pos'} = *$slf->{'siz'};
  }
  return 1;
}

sub setpos
{ my ($slf, $pos) = @_;

  return $slf->seek($pos, 0);
}

*sysseek = \&seek;
*tell = \&getpos;

=head1 OTHER I/O METHODS

=head2 S<$h-E<gt>dump([$level[,$text[,$trace]]])>

This method returns a string containing the object dump. You can provide an
indentation level, a prefix text, and a trace indicator as extra parameters.

=cut

sub dump  ## no critic (Builtin)
{ my ($slf, $lvl, $txt) = @_;
  my ($buf, $pre, $tbl, @tbl);

  $lvl = 0   unless defined($lvl);
  $txt = q{} unless defined($txt);
  $pre = q{  } x $lvl++;
  $buf = $pre.$txt."bless {\n";
  foreach my $key (sort keys(%{*$slf}))
  { if ($key eq 'buf')
    { $buf .=  "$pre  $key => '...'\n";
    }
    elsif ($key eq 'blk')
    { $buf .=  "$pre  $key => (".join(q{, }, sort keys(%{*$slf->{$key}})).")\n";
    }
    elsif ($key eq 'chk')
    { $buf .=  "$pre  $key => (".join(q{, }, map {$_.q{:}.$tbl->{$_}}
        sort keys(%{$tbl = *$slf->{$key}})).")\n";
    }
    elsif ($key eq 'sta')
    { @tbl = @{*$slf->{$key}};
      $tbl[8] = $tbl[8].q{ -> }.*$slf->{'tim'}->convert_time($tbl[8]);
      $tbl[9] = $tbl[9].q{ -> }.*$slf->{'tim'}->convert_time($tbl[9]);
      $tbl[10] = $tbl[10].q{ -> }.*$slf->{'tim'}->convert_time($tbl[10]);
      $buf .=  "$pre  $key => (" .join(qq{\n$pre          }, @tbl).")\n";
    }
    elsif ($key eq 'tim')
    { $buf .= *$slf->{$key}->dump($lvl, "$key => ")."\n";
    }
    elsif ($key !~ m/fct|ifh/)
    { $buf .= "$pre  $key => ".*$slf->{$key}."\n";
    }
  }
  $buf .=  "$pre}, RDA::Handle::Timing";
  return $buf;
}

=head2 S<$io-E<gt>getbuf>

This method returns the buffer content.

=cut

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

  return *$slf->{'buf'};
}

=head1 TIE METHODS

The following methods are implemented to emulate a file handle:

    BINMODE this
    CLOSE this
    DESTROY this
    EOF this
    FILENO this
    GETC this
    OPEN this, mode, LIST
    PRINT this, LIST
    PRINTF this, format, LIST
    READ this, scalar, length, offset
    READLINE this
    SEEK this, position, whence
    TELL this
    TIEHANDLE classname, LIST
    WRITE this, scalar, length, offset

=cut

sub BINMODE
{ my $slf = shift;

  return (@_) ? 0 : 1;
}

*CLOSE = \&close;

sub DESTROY
{
}

*EOF = \&eof;
*FILENO = $und;
*GETC = \&getc;
*OPEN = \&open;
*PRINT = $und;
*PRINTF = $und;
*READ = \&read;

sub READLINE
{ goto &getlines if wantarray;
  goto &getline;
}

*SEEK = \&seek;
*TELL = \&getpos;

sub TIEHANDLE
{ my $slf = shift;

  unless (ref($slf))
  { $slf = bless Symbol::gensym(), $slf;
    *$slf->open(@_);
  }
  return $slf;
}

*WRITE = $und;

# --- Range discovery routines -----------------------------------------------

# Get a block and check its first time stamo
sub _check_block
{ my ($slf, $num, $dft) = @_;
  my ($buf);

  return *$slf->{'chk'}->{$num} = defined($buf = _get_block($slf, $num))
    ? &{*$slf->{'f_t'}}($slf, $buf, $dft)
    : $dft;
}

# Get a block
sub _get_block
{ my ($slf, $num) = @_;
  my ($buf);

  debug("TIM> - Get block #$num") if *$slf->{'dbg'};
  return *$slf->{'blk'}->{$num} if exists(*$slf->{'blk'}->{$num});
  *$slf->{'cnt'}++;
  return unless sysseek(*$slf->{'ifh'}, $num << *$slf->{'bit'}, 0);
  return unless *$slf->{'ifh'}->sysread($buf, *$slf->{'inc'});
  *$slf->{'blk'}->{$num} = $buf if *$slf->{'cch'};
  return $buf;
}

# Determine the last block of the range
sub _get_range_max
{ my ($slf, $min, $max) = @_;
  my ($nxt, $ret);

  for (;;)  ## no critic (Loop)
  { $nxt = ($min + $max) >> 1;
    return $max if $nxt == $min;
    return unless defined($ret = _check_block($slf, $nxt));
    if ($ret)
    { $max = $nxt;
    }
    else
    { $min = $nxt;
    }
  }
  return $max;
}

# Determine the first block of the range
sub _get_range_min
{ my ($slf, $min, $max) = @_;
  my ($nxt, $ret);

  for (;;)  ## no critic (Loop)
  { $nxt = ($min + $max) >> 1;
    return $min if $nxt == $min;
    return unless defined($ret = _check_block($slf, $nxt));
    if ($ret)
    { $min = $nxt;
    }
    else
    { $max = $nxt;
    }
  }
}

# Determine the block range based on a period
sub _get_range_per
{ my ($slf) = @_;
  my ($cnt, $dft, $max, $min, $nxt, $ret, @sta);

  return 0 unless (@sta = CORE::stat(*$slf->{'ifh'})) && $sta[7];
  *$slf->{'sta'} = [@sta];
  CORE:binmode(*$slf->{'ifh'});

  POWER: foreach my $bit (13..18)
  { # Initialization
    $dft = 1;
    $min = 0;
    $max = ($sta[7] - 1) >> $bit;
    *$slf->{'bit'} = $bit;
    *$slf->{'inc'} = 1 << $bit;
    *$slf->{'lim'} = *$slf->{'inc'} - 1;
    *$slf->{'tot'} = $max + 1;
    debug('TIM> Try '.*$slf->{'inc'}.'-bytes blocks') if *$slf->{'dbg'};

    # Test the first block
    while (!defined($ret = _check_block($slf, $min)))
    { delete(*$slf->{'blk'}->{$min});
      delete(*$slf->{'chk'}->{$min});
      return 0 if ++$min > $max || ++$cnt > 8;
    }
    return 0 if $ret > 0;
    unless ($ret)
    { next POWER unless defined($max = _get_range_max($slf, $min, $max));
      *$slf->{'min'} = $min;
      *$slf->{'max'} = $max;
      return 1;
    }

    # Determine the range
    for ($nxt = $max ;;)  ## no critic (Loop)
    { if ($nxt == $min)
      { *$slf->{'min'} = $min;
        *$slf->{'max'} = $max;
        return 1;
      }
      $ret = _check_block($slf, $nxt, $dft);
      next POWER unless defined($ret);
      if ($ret < 0)
      { $min = $nxt;
      }
      elsif ($ret > 0)
      { $max = $nxt;
      }
      else
      { next POWER unless defined($min = _get_range_min($slf, $min, $nxt)) &&
                          defined($max = _get_range_max($slf, $nxt, $max));
        *$slf->{'min'} = $min;
        *$slf->{'max'} = $max;
        return 1;
      }
      $dft = undef;
      $nxt = ($min + $max) >> 1;
    }
  }
  return 0;
}

# Determine the block range based on a reference and previous startup
sub _get_range_ref
{ my ($slf) = @_;
  my ($cnt, $dft, $max, $min, $nxt, $ret, @sta);

  return 0 unless (@sta = CORE::stat(*$slf->{'ifh'})) && $sta[7];
  *$slf->{'sta'} = [@sta];
  CORE:binmode(*$slf->{'ifh'});

  POWER: foreach my $bit (13..18)
  { # Initialization
    $dft = 1;
    $min = 0;
    $max = ($sta[7] - 1) >> $bit;
    *$slf->{'bit'} = $bit;
    *$slf->{'inc'} = 1 << $bit;
    *$slf->{'lim'} = *$slf->{'inc'} - 1;
    *$slf->{'tot'} = $max + 1;
    debug('TIM> Try '.*$slf->{'inc'}.'-bytes blocks') if *$slf->{'dbg'};

    # Test the first block
    while (!defined($ret = _check_block($slf, $min)))
    { delete(*$slf->{'blk'}->{$min});
      delete(*$slf->{'chk'}->{$min});
      return 0 if ++$min > $max || ++$cnt > 8;
    }
    return 0 if $ret >= 0;

    # Determine the smallest range containing the reference time
    for ($nxt = $max ;;)  ## no critic (Loop)
    { if ($nxt == $min)
      { *$slf->{'min'} = $min;
        *$slf->{'max'} = $max;
        return 1;
      }
      $ret = _check_block($slf, $nxt, $dft);
      next POWER unless defined($ret);
      if ($ret < 0)
      { $min = $nxt;
      }
      elsif ($ret > 0)
      { $max = $nxt;
      }
      else
      { *$slf->{'min'} = $nxt - 1;
        *$slf->{'max'} = $nxt;
        return 1;
      }
      $dft = undef;
      $nxt = ($min + $max) >> 1;
    }
  }
  return 0;
}

# Read the next block
sub _read_block
{ my ($slf) = @_;

  return if *$slf->{'eof'};
  if (*$slf->{'cur'} < *$slf->{'max'})
  { *$slf->{'buf'} = _get_block($slf, ++*$slf->{'cur'});
    return *$slf->{'lgt'} = (*$slf->{'cur'} < *$slf->{'max'})
      ? *$slf->{'inc'}
      : *$slf->{'end'};
  }
  *$slf->{'buf'} = q{};
  *$slf->{'eof'} = 1;
  return *$slf->{'lgt'} = 0;
}

# Read the next line
sub _read_line
{ my ($slf, $eol) = @_;
  my ($buf, $cor, $lgt, $off);

  return if *$slf->{'eof'};

  # Check if the line is in the current block
  $cor = length($eol);
  if (($off = index($buf = *$slf->{'buf'}, $eol)) >= 0)
  { $off += $cor;
    *$slf->{'buf'} = substr($buf, $off);
    *$slf->{'lgt'} -= $off;
    *$slf->{'pos'} += $off;
    return substr($buf, 0, $off);
  }

  # Extract an overlapping line
  $lgt = *$slf->{'lgt'};
  while (_read_block($slf))
  { $buf .= *$slf->{'buf'};
    if (($off = index($buf, $eol, ($lgt < $cor) ? 0 : $lgt - $cor)) >= 0)
    { $off += $cor;
      *$slf->{'buf'} = substr(*$slf->{'buf'}, $cor = $off - $lgt);
      *$slf->{'lgt'} -= $cor;
      *$slf->{'pos'} += $off;
      return substr($buf, 0, $off);
    }
    $lgt += *$slf->{'lgt'};
  }

  # Accept uncomplete last line
  *$slf->{'pos'} += $lgt;
  return $buf;
}

# Determine the limits inside the blocks for a time period
sub _set_limits_per  ## no critic (Complex)
{ my ($slf) = @_;
  my ($buf, $cur, $flg, $lin, $nxt, $off, $prv, $ret);

  debug('TIM> Estimated range '.*$slf->{'min'}.' to '.*$slf->{'max'})
    if *$slf->{'dbg'};

  # Find the beginning of the range inside the first block
  *$slf->{'beg'} = 0;
  if (*$slf->{'chk'}->{$cur = *$slf->{'min'}} < 0)
  { $buf = _get_block($slf, $cur);
    $prv = 0;
    for (;;)  ## no critic (Loop)
    { *$slf->{'min'} = $cur;
      *$slf->{'beg'} = $prv;
      $off = index($buf, "\n", $prv);
      if ($off < 0)
      { $lin = substr($buf, $prv, length($buf) - $prv);
        if ($cur < *$slf->{'max'})
        { $lin .= _get_block($slf, $cur + 1);
          $lin = substr($lin, 0, $off + 1) if ($off = index($lin, "\n")) >= 0;
        }
        last if defined($ret = &{*$slf->{'f_t'}}($slf, $lin)) && $ret == 0;
        return 0;
      }
      $lin = substr($buf, $prv, ++$off - $prv);
      $prv = $off;
      next unless defined($ret = &{*$slf->{'f_t'}}($slf, $lin));
      next if $ret < 0;
      last if $ret == 0;
      return 0;
    }
  }

  # Find the end of the range inside the last block
  $buf = _get_block($slf, $cur = *$slf->{'max'});
  $ret = exists(*$slf->{'chk'}->{$cur})
    ? *$slf->{'chk'}->{$cur}
    : &{*$slf->{'f_t'}}($slf, $buf);
  if ($ret > 0)
  { $buf = _get_block($slf, --$cur).$buf;
    $nxt = index($buf, "\n", *$slf->{'lim'}) + 1;
    $flg = 1;
  }
  else
  { $nxt = length($buf);
    $flg = 0;
  }
  $off = $nxt - 1;
  for (;;)  ## no critic (Loop)
  { # Find a time stamp
    for (;;)  ## no critic (Loop)
    { $prv = $off;
      $off = rindex($buf, "\n", $off - 1);
      $lin = substr($buf, $off + 1, $prv - $off);
      last if defined($ret = &{*$slf->{'f_t'}}($slf, $lin));
      next;
    }

    # Discard lines ouside the period
    if ($ret > 0)
    { $flg = 0;
      $nxt = $off + 1;
      next;
    }

    # Include all lines up to next time stamps
    if ($flg)
    { while (($off = index($buf, "\n", $nxt)) >= 0)
      { $lin = substr($buf, $nxt, ++$off - $nxt);
        last if defined($ret = &{*$slf->{'f_t'}}($slf, $lin));
        $nxt = $off;
      }
      $cur += ($nxt >> *$slf->{'bit'});
      $nxt &= *$slf->{'lim'};  ## no critic (Bit)
    }
    last;
  }
  *$slf->{'blk'}->{$cur} = substr($buf, 0, $nxt);
  *$slf->{'end'} = $nxt;
  *$slf->{'max'} = $cur;
  *$slf->{'siz'} = $nxt + *$slf->{'inc'} * ($cur - *$slf->{'min'})
    - *$slf->{'beg'};
  debug('TIM> Range '.*$slf->{'min'}.q{/}.*$slf->{'beg'}.' to '
                     .*$slf->{'max'}.q{/}.*$slf->{'end'}) if *$slf->{'dbg'};

  # Clean the cache
  foreach my $num (keys(%{*$slf->{'blk'}}))
  { next if $num >= *$slf->{'min'} && $num <= *$slf->{'max'};
    delete(*$slf->{'blk'}->{$num});
    delete(*$slf->{'chk'}->{$num});
  }

  # Disable the cache when the range size exceeds 2 MiB
  *$slf->{'cch'} = *$slf->{'siz'} <= 2097152;

  # Indicate a successful completion
  return 1;
}

# Determine the limits inside the blocks for a time reference
sub _set_limits_ref  ## no critic (Complex)
{ my ($slf) = @_;
  my ($buf, $cur, $flg, $lim, $lin, $nxt, $off, $prv, $ret);

  debug('TIM> Estimated range '.*$slf->{'min'}.' to '.*$slf->{'max'})
    if *$slf->{'dbg'};

  # Find the end of the range inside the last block
  $buf = _get_block($slf, $cur = *$slf->{'max'});
  $ret = exists(*$slf->{'chk'}->{$cur})
    ? *$slf->{'chk'}->{$cur}
    : &{*$slf->{'f_t'}}($slf, $buf);
  if ($ret >= 0)
  { $buf = _get_block($slf, --$cur).$buf;
    $nxt = index($buf, "\n", *$slf->{'lim'}) + 1;
    $flg = 1;
  }
  else
  { $nxt = length($buf);
    $flg = 0;
  }
  $off = $nxt - 1;
  for (;;)  ## no critic (Loop)
  { # Find a time stamp
    for (;;)  ## no critic (Loop)
    { $prv = $off;
      $off = rindex($buf, "\n", $off - 1);
      $lin = substr($buf, $off + 1, $prv - $off);
      last if defined($ret = &{*$slf->{'f_t'}}($slf, $lin));
      next;
    }

    # Discard lines ouside the period
    if ($ret >= 0)
    { $flg = 0;
      $nxt = $off + 1;
      next;
    }

    # Include all lines up to next time stamps
    if ($flg)
    { while (($off = index($buf, "\n", $nxt)) >= 0)
      { $lin = substr($buf, $nxt, ++$off - $nxt);
        last if defined($ret = &{*$slf->{'f_t'}}($slf, $lin));
        $nxt = $off;
      }
      $cur += ($nxt >> *$slf->{'bit'});
      $nxt &= *$slf->{'lim'};  ## no critic (Bit)
    }
    last;
  }
  *$slf->{'blk'}->{$cur} = substr($buf, 0, $nxt);
  *$slf->{'end'} = $nxt;
  *$slf->{'max'} = $cur;

  # Find the start event
  $cur = *$slf->{'min'};
  $lim = defined(*$slf->{'f_l'}) ? *$slf->{'f_l'} : 256;
  $lim >>= *$slf->{'bit'} - 13;
  $lim = ($cur > $lim) ? $cur - $lim : 0;
  for (;;)  ## no critic (Loop)
  { $ret = &{*$slf->{'f_e'}}($slf, $buf = _get_block($slf, $cur), 1);
    if ($ret > 0)
    { *$slf->{'beg'} = &{*$slf->{'f_e'}}($slf, $buf);
      last;
    }
    if ($ret < 0 && $cur > 0)
    { *$slf->{'beg'} = &{*$slf->{'f_e'}}($slf, _get_block($slf, --$cur).$buf);
      last;
    }
    if ($cur <= $lim)
    { *$slf->{'beg'} = 0;
      last;
    }
    --$cur;
  }
  *$slf->{'min'} = $cur;

  # Determine the fragment size
  *$slf->{'siz'} = $nxt + *$slf->{'inc'} * (*$slf->{'max'} - *$slf->{'min'})
    - *$slf->{'beg'};
  debug('TIM> Range '.*$slf->{'min'}.q{/}.*$slf->{'beg'}.' to '
                     .*$slf->{'max'}.q{/}.*$slf->{'end'}) if *$slf->{'dbg'};

  # Clean the cache
  foreach my $num (keys(%{*$slf->{'blk'}}))
  { next if $num >= *$slf->{'min'} && $num <= *$slf->{'max'};
    delete(*$slf->{'blk'}->{$num});
    delete(*$slf->{'chk'}->{$num});
  }

  # Disable the cache when the range size exceeds 2 MiB
  *$slf->{'cch'} = *$slf->{'siz'} <= 2097152;

  # Indicate a successful completion
  return 1;
}

1;

__END__

=head1 SEE ALSO

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