File Coverage

blib/lib/Tie/TextDir.pm

Criterion	Covered	Total	%
statement	84	100	84.0
branch	29	58	50.0
condition	9	16	56.2
subroutine	17	18	94.4
pod			n/a
total	139	192	72.4

package Tie::TextDir;

use strict;
use File::Spec;
use File::Temp;
use Symbol;
use Fcntl qw(:DEFAULT);
use Carp;
use constant HAVE_56 => $] >= 5.006;
use vars qw($VERSION);

$VERSION = '0.06';

sub TIEHASH {
  croak "usage: tie(%hash, 'Tie::TextDir', \$path, [mode], [perms])"
    unless 2 <= @_ and @_ <= 4;

  my ($package, $path, $mode, $perms) = @_;
  $mode ||= 'ro';
  $perms ||= 0775;
  my $self = bless {}, $package;

  # Can we make changes to the database?
  if ($mode eq 'rw') {
    $self->{MODE} = O_CREAT | O_RDWR;
  } elsif ($mode eq 'ro') {
    $self->{MODE} = O_RDONLY;
  } else {
    # Assume $mode is a bitmask of Fcntl flags
    $self->{MODE} = $mode;
  }

  # Nice-ify $path:
  $path =~ s#/$##;
  croak "$path is not a directory" if -e $path and not -d _;
  unless (-e $path) {
    croak "$path does not exist" unless $self->{MODE} & O_CREAT;
    mkdir $path, $perms or croak "Can't create $path: $!";
  }
  $self->{PATH} = $path;

  # Get a filehandle and open the directory:
  $self->{HANDLE} = HAVE_56 ? undef : gensym();
  opendir($self->{HANDLE}, $path) or croak("can't opendir $path: $!");

  return $self;
}

sub FETCH {
  my ($self, $key) = @_;
  if ( !$self->_key_okay($key) ) {
    carp "Bad key '$key'" if $^W;
    return;
  }

  my $file = File::Spec->catfile($self->{PATH}, $key);
  return unless -e $file;

  local *FH;
  unless (open( FH, "< $file" )) {
    carp "Can't open $file for reading: $!";
    return;
  }
  my $value;
  sysread FH, $value, ( stat FH )[7];
  close FH;
  return $value;
}


sub STORE {
  my ($self, $key) = (shift, shift);
  my $file = File::Spec->catfile($self->{PATH}, $key);
  croak "No write access for '$file'" unless $self->{MODE} & O_RDWR;

  if ( !$self->_key_okay($key) ) {
    carp "Bad key '$key'" if $^W;
    return;
  }

  # Use temp file for writing, and then rename to make the update atomic
  my ($fh, $tmpname) = File::Temp::tempfile(DIR => $self->{PATH}, CLEANUP => 1);
  print $fh $_[0];
  close $fh;
  rename ($tmpname, $file) or croak ("can't rename temp file $tmpname to $file: $!");
}


sub DELETE {
  my ($self, $key) = @_;
  my $file = File::Spec->catfile($self->{PATH}, $key);
  croak "No write access for '$file'" unless $self->{MODE} & O_RDWR;

  if ( !$self->_key_okay($key) ) {
    carp "Bad key '$key'" if $^W;
    return;
  }

  return unless -e $file;

  my $return;
  $return = $self->FETCH($key) if defined wantarray;  # Don't bother in void context

  unlink $file or croak "Couldn't delete $file: $!";
  return $return;
}

sub CLEAR {
  my $self = shift;
  croak "No write access for '$self->{PATH}'" unless $self->{MODE} & O_RDWR;

  rewinddir($self->{HANDLE});
  my $entry;
  while (defined ($entry = readdir($self->{HANDLE}))) {
    next if $entry eq '.' or $entry eq '..';
    my $file = File::Spec->catfile($self->{PATH}, $entry);
    unlink $file or croak "can't remove $file: $!";
  }
}

sub EXISTS {
  my ($self, $key) = @_;
  if ( !$self->_key_okay($key) ) {
    carp "Bad key '$key'" if $^W;
    return;
  }
  return -e File::Spec->catfile($self->{PATH}, $key);
}


sub DESTROY {
  closedir shift()->{HANDLE};  # Probably not necessary
}


sub FIRSTKEY {
  my $self = shift;

  rewinddir $self->{HANDLE};
  my $entry;
  while (defined ($entry = readdir($self->{HANDLE}))) {
    return $entry unless ($entry eq '.' or $entry eq '..');
  }
  return;
}


sub NEXTKEY {
  return readdir shift()->{HANDLE};
}

sub _key_okay {
  return 0 if $_[1] =~ /^\.{0,2}$/;
  return 1;
}

1;

__END__