#!/usr/bin/perl -w

# this is a complete hack of a script for maintaining the torrents and
# downloaded data on a sheep bt seeder.  if the xml changes this script
# will probably break.

# Copyright (C) 2006  dean gaudet <dean@arctic.org>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

## these settings will need configuration
# number of torrents to keep
my $nr_keep = 10;
my $dir = "/home/dean/sheep/torrents";
#my $dir = "/home/dean/sheep/test";
my $rss_url = "http://sheepserver.net/v2d6/gen/rss.xml";
my $torrent_base_url = "http://v2d6\.sheepserver\.net/gen/torrents/";
my $torrent_download_url = "http://sheepserver.net/v2d6/gen/torrents/";

# the rest shouldn't need configuration

use strict;
use Fcntl ':flock';
use File::Temp qw/tempfile/;
use LWP::UserAgent;

my $exit_code = 0;

# die in 4 minutes no matter what
alarm(4*60);

chdir($dir) or die "unable to chdir($dir): $!\n";

open(LOCKFILE, ">>.rss-thinger.lock")
	or die "unable to open .rss-thinger.lock: $!\n";
flock(LOCKFILE, LOCK_EX|LOCK_NB)
	or die "unable to lock .rss-thinger.lock: $!\n";

# grab the RSS and scrape the torrent links
my $ua = LWP::UserAgent->new;
my $req = HTTP::Request->new(GET => $rss_url);
my $res = $ua->request($req);
$res->is_success
	or die "error fetching $rss_url: ".$res->status_line."\n";

my %avail;
foreach my $line (split('\n', $res->content)) {
	if ($line =~ m#\<link\>$torrent_base_url(\d+)\.torrent\</link\>#o) {
		$avail{$1} = 1;
	}
}

# download the most recent ones if we need to
my $nr_download = ($nr_keep > scalar(keys %avail)) ? scalar(keys %avail) : $nr_keep;
foreach my $download ((sort { $b <=> $a } keys %avail)[0..$nr_download-1]) {
	next if -f "$download.torrent";
	$req = HTTP::Request->new(GET => "$torrent_download_url$download.torrent");
	$res = $ua->request($req);
	unless ($res->is_success) {
		warn "unable to fetch $torrent_download_url$download.torrent: ".$res->status_line."\n";
		$exit_code = 1;
	}
	else {
		my ($tmp_fh, $tmp_filename) = tempfile("tmp.XXXXXX", DIR => ".");
		unless (defined($tmp_fh) and $tmp_fh->print($res->content) and $tmp_fh->close) {
			warn "error writing temp file: $!\n";
			$exit_code = 1;
			unlink($tmp_filename) if defined($tmp_filename);
		}
		else {
			unless (rename($tmp_filename, "$download.torrent")) {
				warn "unable to rename($tmp_filename, $download.torrent): $!\n";
				$exit_code = 1;
				unlink($tmp_filename);
			}
		}
	}
}

# now discover any old torrents/downloaded files we need to delete
opendir(DIR, ".") or die "unable to opendir(.): $!\n";
my @to_delete = sort { $a <=> $b } map { /^(\d+)\.torrent$/ } grep { /^(\d+)\.torrent$/ } readdir(DIR);
close(DIR);

exit $exit_code if ($nr_keep > scalar(@to_delete));

splice(@to_delete, -$nr_keep);
foreach my $delete (@to_delete) {
	my @args = ("rm", "-rf", "$delete.torrent", "$delete");
	#print "@args\n";
	unless (system(@args) == 0) {
		warn "system(@args) failed: $?\n";
		$exit_code = 1;
	}
}

exit $exit_code;