view release on metacpan or  search on metacpan

lib/ApacheLog/Parser/SkipList.pm  view on Meta::CPAN

        print $outfh pack('N', $n);
      }
    }
  }
} # end subroutine merge definition
########################################################################

=head2 new_writer

  my $sw = $skipper->new_writer($skipfile);

=cut

sub new_writer {
  my $self = shift;
  my ($filename) = @_;

  my $fh = $self->_open_write($filename);
  my $writer = __PACKAGE__ . '::Writer';
  return($writer->new($fh));
} # end subroutine new_writer definition
########################################################################
sub _open_write {
  my $self = shift;
  my ($filename) = @_;

  my $conf_check = $self->{config} or
    croak("cannot make a writer without a config");

  open(my $fh, '>', $filename) or
    croak("cannot open '$filename' for writing $!");

  print $fh $conf_check;
  return($fh);
}

=head2 new_reader

  my $sr = $skipper->new_reader($skipfile);

=cut

sub new_reader {
  my $self = shift;
  my ($filename) = @_;

  my $fh = $self->_open_read($filename);
  my $reader = __PACKAGE__ . '::Reader';
  return($reader->new($fh));
} # end subroutine new_reader definition
########################################################################
sub _open_read {
  my $self = shift;
  my ($filename) = @_;
  my $conf_check = $self->{config} or
    croak("cannot make a reader without a config");

  open(my $fh, '<', $filename) or
    croak("cannot open '$filename' for reading $!");

  my $verify;
  my $ok = read($fh, $verify, 32);
  (($ok||0) == 32) or
    croak("read error on $filename ", (defined($ok) ? 'eof' : $!));
  ($verify eq $conf_check) or
    croak("the config has changed since this skiplist was created\n",
      "  '$verify' vs '$conf_check'");

  return($fh);
}

{
  package ApacheLog::Parser::SkipList::Base;
  sub new {
    my $package = shift;
    my ($fh) = @_;
    my $class = ref($package) || $package;
    my $self = [$fh, 0, -1];
    bless($self, $class);
    return($self);
  }
}
{
  package ApacheLog::Parser::SkipList::Writer;
  use Carp;
  our @ISA = qw(ApacheLog::Parser::SkipList::Base);
  use constant flag => 2**31;
  sub skip {
    my $self = shift;
    my ($l) = @_;

    my $fh = $self->[0];
    if($l == $self->[2]+1) { # contiguous
      $self->[2] = $l;
    }
    else {
      # write-out
      if(my $num = $self->[1]) {
        if(my $span = $self->[2] - $num) {
          $num |= flag;
          print $fh pack('N2', $num, $span);
        }
        else {
          print $fh pack('N', $num);
        }
      }

      $self->[1] = $self->[2] = $l;
    }
  }
  sub DESTROY {
    close($_[0]->[0]) or
      croak("close file failed $!");
    @{$_[0]} = ();
  }
}
{
  package ApacheLog::Parser::SkipList::Reader;
  use Carp;
  our @ISA = qw(ApacheLog::Parser::SkipList::Base);
  use constant flag => 2**31;

  # return the next skip value and setup the line counter
  sub next_skip {
    my $self = shift;

    my $fh = $self->[0];