perl で mktemp を実装してみた

最近、シェルスクリプトをいじってることが多いんだけど、シェルスクリプト中で使って便利なのが mktemp.

それで、乱用ぎみに使っていたのですが、とある環境で作業をしていて、mktemp を使おうと思ったら無かったんで perl で実装してみたり。

utils: perl/mktemp@09177d8ec349にあげておいた。 ライセンスはBoost Software License 1.0 (BSL1.0).

もっときれいに書けないかな〜。

#!/usr/bin/env perl
use strict;
use warnings;
use Fcntl;

# use Data::Dumper;

my $try_count = 10;

my %options = (
  t => 'using_tempdir',
  u => 'unsafe',
  d => 'dir',
);
my %mode = (
  using_tempdir => 0,
  unsafe => 0,
  dir => 0,
);
my $template;

foreach my $arg (@ARGV) {
  if ($arg =~ /^-(.*)$/) {
    foreach (split //, $1) {
      die "unknown option: $_" unless exists $options{$_};
      $mode{$options{$_}} = 1;
    }
  } else {
    $template ||= $arg;
  }
}

unless (defined $template) {
  $mode{using_tempdir} ||= 1;
  $template = 'tmp.XXXXXXXXXX';
}

# warn Dumper \%mode;
# warn $template;

my $temp_name;

while ($try_count) {
  $temp_name = $template;
  $temp_name =~ s/(X)/&rand_char($1)/eg;
  if ($mode{using_tempdir}) {
    $temp_name = ($ENV{TMPDIR} || '/tmp') . "/$temp_name";
  }
  # warn $temp_name;
  if ($mode{dir}) {
    last if mkdir $temp_name;
  } else {
    if (sysopen my $fh, $temp_name, O_WRONLY | O_CREAT | O_EXCL) {
      close $fh;
      last;
    }
  }
  $try_count--;
}

die "make temp failed: $temp_name" if $try_count == 0;

if ($mode{unsafe}) {
  if ($mode{dir}) {
    rmdir $temp_name or die $!;
  } else {
    unlink $temp_name or die $!;
  }
}

print "$temp_name\n";

sub rand_char() {
  my @chars = ('a'..'z', 'A'..'Z', 0..9);
  return $chars[rand(scalar @chars)];
}