#!/usr/bin/perl -w
# tristan+perl@ethereal.net 16apr2005, 11jul2006
# display & unlink completed torrents
# with many thanks to Doug Bagley (most code lifted from bttools)

# TODO: -v to show overall rate since creation of torrent file

use strict;
use Getopt::Std;
use vars qw($opt_u);

getopts('u');

sub bdecode {
  my ($dataref) = @_;
  unless (ref($dataref) eq 'SCALAR') {
    die 'Function bdecode takes a scalar ref!';
  }
  my $p = 0;
  return benc_parse_hash($dataref,\$p);
}

sub benc_parse_hash {
  my ($data, $p) = @_;
  my $c = substr($$data,$$p,1);
  my $r = undef;
  if ($c eq 'd') {
    %{$r} = ();
    ++$$p;
    while ($$p < length($$data) && substr($$data, $$p, 1) ne 'e') {
      my $k = benc_parse_string($data, $p);
      my $start = $$p;
      $r->{'_' . $k . '_start'} = $$p if $k eq 'info';
      my $v = benc_parse_hash($data, $p);
      $r->{'_' . $k . '_length'} = ($$p - $start) if $k eq 'info';
      $r->{$k} = $v;
    }
    ++$$p;
  } elsif ($c eq 'l') {
    @{$r} = \();
    ++$$p;
    while (substr($$data, $$p, 1) ne 'e') {
      push @{$r}, benc_parse_hash($data, $p);
    }
    ++$$p;
  } elsif ($c eq 'i') {
    $r = 0;
    my $c;
    ++$$p;
    while (($c = substr($$data,$$p,1)) ne 'e') {
      $r *= 10;
      $r += int($c);
      ++$$p;
    }  # while
    ++$$p;
  } elsif ($c =~ /\d/) {
    $r = benc_parse_string($data, $p);
  } else {
    die "Unknown token '$c' at $p!";
  }
  $r;
}

sub benc_parse_string {
  my ($data, $p) = @_;
  my $l = 0;
  my $c = undef;
  my $s;
  while (($c = substr($$data,$$p,1)) ne ':') {
    $l *= 10;
    $l += int($c);
    ++$$p;
  }
  ++$$p;
  $s = substr($$data,$$p,$l);
  $$p += $l;
  $s;
}

sub check_complete {
  my($self, $dir, $verbose) = @_;
  $dir ||= '.';
  my $plen = $self->piece_length;
  my $pi = 0;
  my $pa = $self->pieces_array;
  my $name = $self->name;
  my %stats = ();
  my @files = ();
  my $total_size = $self->total_size;
  my $file_info = $self->file_info;
  @files = keys %$file_info;
  print STDERR "[verifying     " if $verbose;
  my $total_read = 0;
  my $buf = '';
  my $off = 0;
  my $len = $plen;
  my $last_dots = 0;
  my($file);
  my @status = ();
  my $ok = 1;
  @files = sort @files;
  while (1) {
    my $nrd;
    $file = shift @files;
    last if (!defined $file);
    my $path = "$dir/$file";
    $path =~ s!//+!/!g;
    local *FH;
    unless (open(FH, "<$path")) {
      print STDERR qq{\nError opening "$path" for input ($!)} if $verbose;
      next;
    }
    while ($nrd = sysread(FH, $buf, $len, $off)) {
      $total_read += $nrd;
      my $dots = int(50 * ($total_read / $total_size));
      if ($dots > $last_dots) {
        for ($last_dots .. ($dots - 1)) {
          print STDERR (0 == ($_ % 5)) ? ($_/5) : '.' if $verbose;
        }
        $last_dots = $dots;
      }
      $off += $nrd;
      if ($off == $plen) {
        # we have read a complete piece, so check it
        unless ($status[$pi] = (Digest::SHA1::sha1($buf) eq $pa->[$pi])) {
          $ok = 0;
        }
        $pi++;
        # setup for next piece
        $len = $plen;
        $off = 0;
        $buf = '';
      } else {
        # was partial read, so we'll continue on next iteration
        $len -= $nrd;
      }
    }
    print STDERR qq{read error on "$file" ($!)} if (!defined $nrd);
    if ($buf) {
      $status[$pi] = (Digest::SHA1::sha1($buf) eq $pa->[$pi]);
    }
    close(FH);
    unless (@files) {
      my $complete = ($ok and ($total_read == $total_size)) ? 'ALL OK' : 'INCOMPLETE!';
      print STDERR " EOF" if ($last_dots < 50 and $verbose);
      print STDERR "] $complete\n" if $verbose;
      my $f_beg = 0;
      my @files = keys %$file_info;
      while (my $file = shift @files) {
        my $f_end = $f_beg + $file_info->{$file};
        my $pi = int($f_beg / $plen);
        my $p_beg = $pi * $plen;
        my $p_end = $p_beg + $plen;
        print STDERR "$file:\n" if ($verbose > 1);
        while ($p_beg < $f_end) {
          if ($status[$pi]) {
            my $ok_bytes = $plen;
            $ok_bytes -= $f_beg - $p_beg if ($p_beg < $f_beg);
            $ok_bytes -= $p_end - $f_end if ($p_end > $f_end);
            $stats{$file} += $ok_bytes;
            printf(STDERR " %4d: OK\n", $pi) if ($verbose > 1);
          } else {
            printf(STDERR " %4d: BAD\n", $pi) if ($verbose > 1);
          }
          $p_beg += $plen;
          $p_end += $plen;
          $pi++;
        }
        $f_beg = $f_end;
      }
      return \%stats;
    }
  }
  print STDERR "]\n" if $verbose;
  return undef;
}

for my $file (@ARGV) {

  print "$file: ";

  local *TOR;
  if (!open(TOR, $file)) {
    print "doesn't exist!\n";
    next;
  }
  binmode(TOR);
  my $body;
  read(TOR, $body, (-s $file));
  close(TOR);

  my $t = bdecode(\$body);

  my $info = $t->{'info'};
  my @files;
  my $tsize = 0;
  if (defined $info->{'files'}) {
    foreach my $f (@{$info->{'files'}}) {
      my %file_record = ( 'size' => $f->{'length'});
      $tsize += $f->{'length'};
      my $path = $f->{'path'};

      if(ref($path) eq 'ARRAY') {
        $file_record{'name'} = $info->{'name'}.'/'.$path->[0];
      } else {
        $file_record{'name'} = $info->{'name'}.'/'.$path;
      }
      push @files, \%file_record;
    }
  } else {
    $tsize += $info->{'length'},

    push @files,
      {
        'size' => $info->{'length'},
        'name' => $info->{'name'},
      };
  }

  my $fileordir = $file;
  $fileordir =~ s/\.torrent$//;

  my $complete;
  if ($#files == 0) {
    # single file in torrent
    if (-f $fileordir) {
      # downloaded as basename of torrent
      $complete = (-s $fileordir) / $tsize;
    } else {
      # downloaded into dir named after basename of torrent
      my $fn = $fileordir . '/' . $files[0]{'name'};
      $complete = (-s $fn) / $tsize;
    }
  } else {
    # multiple files in torrent
    my $dlsize;
    foreach my $f (@files) {
      # btlaunchmany* in "--saveas_style 4" (default) mode appears to
      # strip leading directory name; why?  need to look into this more.
      my $fn = $f->{'name'};
      $fn =~ s/^[^\/]*\//$fileordir\//;
      $dlsize += -s $fn;
    }
    $complete = $dlsize / $tsize;
  }

  printf "%.1f%% complete", $complete * 100;

  if ($complete == 1 && $opt_u) {
    unlink $file;
    print " -- unlinked";
  }

  print "\n";
}
