#! /usr/bin/perl -w
use strict;
use Carp;
use Symbol; # Needed on 5.005 and less

sub clear_file {
  my ($fh, $name) = @_;
  seek($fh, 0, 0) or confess("Cannot seek to beginning of '$name': $!");
  truncate($fh, 0) or confess("Cannot truncate '$name': $!");
}

sub deny_symlink {
  my ($fh, $name) = @_;
  # In the following testing the filehandle avoids a race
  # condition, but I think that whether it works is OS
  # specific. :-(
  if (-l $fh or -l $name) {
    my $real = readlink($name);
    confess("Refusing to follow symlink from $name to $real");
  }
}

sub open_read {
  my $name = shift;
  my $fh = gensym();
  open($fh, "< $name") or confess("Cannot read '$name': $!");
  deny_symlink($fh, $name);
  return $fh;
}

sub open_write {
  my $name = shift;
  my $fh = gensym();
  open ($fh, "+>> $name") or confess("Cannot write '$name': $!");
  deny_symlink($fh, $name);
  clear_file($fh, $name);
  return $fh;
}

my $filename = "whatever";
*FH = open_write($filename);
print FH "Hello world\n";
close FH;
*FH = open_read($filename);
print <FH>;