#!/usr/bin/env perl
##
## Perl-version safecat(1) clone
## Copyright (c) 2004-2007 SATOH Fumiyasu @ OSS Technology, Co., Japan
##                         <http://www.osstech.co.jp/>
##
## License: GNU General Public License version 3
## Date: 2007-07-18, since 2004-06-10
##

use strict;
use warnings;
use English;
use Errno;
use IO::File;
use Sys::Hostname;
use Time::HiRes;

my $cmd_name = $PROGRAM_NAME;
$cmd_name =~ s#.*/##;

$SIG{'__DIE__'} = sub {
  STDERR->print("$cmd_name: ERROR: @_\n");
  exit(111);
};
$SIG{'__WARN__'} = sub {
  STDERR->print("$cmd_name: WARNING: @_\n");
};

if (@ARGV != 2) {
    print "Usage: $cmd_name TEMPDIR DESTDIR\n";
    exit(0);
}

my ($tmp_dir, $dst_dir) = @ARGV;

my $pid = $PROCESS_ID;
my $hostname = Sys::Hostname::hostname();

my ($tmp_file, $dst_file);
for (my $try = 1; ; $try++) {
  my ($sec, $usec) = Time::HiRes::gettimeofday();
  my $uniqname = "${sec}.M${usec}P${pid}.${hostname}";
  $tmp_file = "$tmp_dir/$uniqname";
  $OS_ERROR = 0;
  if (!stat($tmp_file) && $OS_ERROR == Errno::ENOENT) {
    $dst_file = "$dst_dir/$uniqname";
    last;
  }

  if ($try == 5) {
    die "cannot determin temporary file name: try again";
  }

  sleep(2);
}

$SIG{'ALRM'} = sub {
  unlink($tmp_file);
  die "timer has expired: try again";
};
alarm(86400);

my $fh = IO::File->new($tmp_file, O_RDWR|O_CREAT|O_EXCL);
if (!$fh) {
  die "cannot open temporary file: $OS_ERROR";
}

$OS_ERROR = 0;
while (STDIN->read(my $buf, 32768)) {
  ## FIXME: Catch and release EINTR?
  if (!$fh->write($buf)) {
    ## FIXME: Catch and release EINTR?
    my $e = "cannot write to tempoary file: $OS_ERROR";
    unlink($tmp_file);
    die $e;
  }
}
if (!STDIN->eof) {
  my $e = "cannot read from standard input: $OS_ERROR";
  unlink($tmp_file);
  die $e;
}
if (!$fh->sync) {
  my $e = "cannot sync temporary file: $OS_ERROR";
  unlink($tmp_file);
  die $e;
}
if (!$fh->close) {
  my $e = "cannot close temporary file: $OS_ERROR";
  unlink($tmp_file);
  die $e;
}

if (!link($tmp_file, $dst_file)) {
  my $e = "cannot link temporary file to destination file: $OS_ERROR";
  unlink($tmp_file);
  die $e;
}

alarm(0);
if (!unlink($tmp_file)) {
  warn "cannot unlink temporary file: $OS_ERROR";
}

print "$dst_file\n";

exit(0);