File Coverage

blib/lib/Iterator/File/State/TempFile.pm

Criterion	Covered	Total	%
statement	59	59	100.0
branch	7	12	58.3
condition	4	11	36.3
subroutine	14	14	100.0
pod	6	6	100.0
total	90	102	88.2

package Iterator::File::State::TempFile;

## $Id: TempFile.pm,v 1.8 2008/06/11 05:20:07 wdr1 Exp $

use 5.006;
use strict;
use warnings;

use Carp;
use Data::Dumper;
use IO::File;
use Digest::MD5 qw|md5_hex|;

use Iterator::File::State::Interface;

our @ISA = qw(Iterator::File::State::Interface);
our $VERSION = substr(q$Revision: 1.8 $, 10);

our %default_config = ();


sub new {
  my ($class, %config) = @_;

  confess("No file name given!")
    unless ($config{'filename'} || $config{'marker_file'});

  %config = (%default_config, %config);
  unless ($config{'marker_file'}) {
    $config{'marker_file'} = ($ENV{'TMPDIR'} || $ENV{'TEMPDIR'} || '/tmp')
      . '/iterator-file-' . md5_hex( $config{filename}) . '.tmp';
  }

  my $self = $class->SUPER::new( %config );
  bless($self, $class);

  $self->_verbose("Marker file is '", $self->{'marker_file'}, "'...\n");

  return $self;
}



sub initialize {
  my ($self) = @_;

  $self->_debug( __PACKAGE__ . " initializing... ");

  my $marker_file = $self->{'marker_file'};

  ## What's our marker (possibly from prior run)
  my $marker = 0;
  if (-f $marker_file) {
    my $fh = new IO::File ($self->{'marker_file'}, "r")
      || croak("Couldn't open '", $self->{'marker_file'}, "': $!");
    $marker = <$fh>;
    $fh->close();
  }

  my $fh = new IO::File ($self->{'marker_file'}, "w")
    || croak("Couldn't open '", $self->{'marker_file'}, "': $!");

  $self->{'marker_filehandle'} = $fh;
  $self->{'marker'}            = $marker;

  $self->_verbose( "Starting marker location is '$marker'..." );
}



sub finish {
  my ($self) = @_;

  my $fh = $self->{'marker_filehandle'};
  $fh->close() || warn("Couldn't close '", $self->{'marker_file'}, "': $!");
  $self->_debug("Removing '", $self->{'marker_file'}, "'...");
  unlink( $self->{'marker_file'} ) ||
    warn("Couldn't unlink '", $self->{'marker_file'}, "': $!");
}



sub marker {
  my ($self) = @_;

  return $self->{'marker'};
}



sub set_marker {
  my ($self, $num) = @_;

  $self->{'marker'} = $num;
  my $fh = $self->{'marker_filehandle'};
  $fh->seek(0, SEEK_SET)
    || confess("Unable to set position in marker file!");
  print $fh $self->{'marker'};
}



sub marker_file {
  my ($self) = @_;

  return $self->{'marker_file'};
}



# Preloaded methods go here.

1;
__END__