bttouch.pl

#!/usr/bin/env perl
# klg, Jan 2017
use strict;
use open ':std', IO => ':bytes';
use Bencode 'bdecode';

my $meta = eval { bdecode(do { local $/; <> })->{info} };
die "Invalid BitTorrent metainfo file: $@" if $@;

if ($$meta{length}) {
  bt_file($$meta{length}, $$meta{name});
} else {
  my $dir = $$meta{name};
  for (@{$$meta{files}}) {
    bt_file($$_{length}, $dir, @{$$_{path}});
  }
}

exit 0;

sub bt_file {
  use File::Spec;
  my ($size, @path) = @_;
  @path = (
    map(File::Spec->splitdir($_), @path[0..$#path-1]),
    $path[$#path]
  );
  for (map File::Spec->catdir(@path[0..$_]), 0 .. $#path-1) {
    print "$_$/" unless -e;
    mkdir $_;
  }
  local $_ = File::Spec->catfile(@path);
  print "$_$/";
  touch($_, $size);
}

sub touch {
  my ($file, $size) = @_;
  open my $fh, '+>>', $file or die;
  eval {
    seek $fh, $size, 0 or die;
    truncate $fh, $size or die
    if $size > (stat $fh)[7];
  };
  close $fh or die;
  die if $@;
}


__END__

=head1 NAME

bttouch - create files according to BitTorrent metainfo file

=head1 SYNOPSIS

B<bttouch> I<file>

=head1 DESCRIPTION

Create empty files with names and sizes as described in the
C<.torrent> file.  Content of existing files is not changed,
but they are extended to the expected size if smaller.

Some BitTorrent clients would preallocate space on disk to
improve performance when downloading.  This tool, conversely,
tries to create sparse files.

It is intended to be a convenient way to re-create missing
BitComet padding files without wasting too much disk space.
If the only missing pieces are the ones full of null byte,
the resulting files will validate as completed download.

=head1 DIAGNOSTICS

Name of every processed file is written to the standard output
as it is opened.  It will die() upon encountering any error.