torrentPrune Export

#!/usr/bin/perl -w
use strict;
use warnings;
use File::Find;
use File::Basename;
use Text::CSV;
use MP3::Info;
use Video::Info;
use open ':encoding(utf8)';
use utf8;
my $cmd = "remote -l|sort -hr|sed -n '3 s/\\([0-9][0-9][0-9]\\).*/\\1/p'|sed -e 's/^\\s//'"; 
#print "$cmd\n";
my $maximum = qx{$cmd} || die "Couldn't obtain number of torrents";
chomp($maximum);
my @fields = ("Name:", "Hash:", "Location:", "Date created:", "Have:", "Announce URL:");
for (1..$maximum) {
	my @output = ();
	open DATA, "transmission-remote -t$_ -i |" or die "Couln't execute program\n";
	while ( defined( my $line = <DATA> ) ) {
		chomp($line);
		foreach my $field(@fields) {
			my $out = &meta($line,$field);
			if ($out) {push (@output,$out);}
		}
	}
	close DATA;
	next unless @output;
	my $name = $output[0];
	my $hash = $output[1];
	my $location = $output[2];
	my $have = $output[3];
	my $date = $output[5];
	my $url = $output[4];
	push(@output, 0);

	# Check for Hash in the whitelist
	open WHITE, "/mnt/alpha/toropt/whitelist" or die "Couldn't open the whitelist\n";
	while ( defined( my $line = <WHITE> ) ) {
		chomp($line);
		if ($line =~ (/$hash/) ) { $output[6] = 1; }
	}
	close WHITE;
	
	# Create seedpath
	unless ($location =~ (/\W$/)) { $location = $location . "/"; }
	$output[2] = $location;
	my $seedPath = $location . $name;
	
	# Convert have to KB
	my @have = &sep($have);
	my $size = $have[0];
	my $unit = $have[1];
	if ( $unit ~~ (/MB/) ) { $size *= 1024; } 
	elsif ( $unit ~~ (/GB/) ) {$size *= 1024 *1024} 
	$output[3] = $size ;

	#Convert Date
	# Split date into fields
	my @date = &sep($date);
	my $month = $date[1];
	#Convert alpha month to numerical
	my %mon2num = qw(
	jan 01  feb 02  mar 03  apr 04  may 05  jun 06
	jul 07  aug 08  sep 09  oct 10 nov 11 dec 12
	);
	$month = $mon2num{ lc substr($month, 0, 3) };
	my $day = $date[2];
	if ($day < 10) {
		$day = "0" . $day;
	}
	my $time = $date[3];
	my $year = $date[4];
	$output[4] = $year . "/" . $month . "/" . $day . " " . $time ;

	# Extract domain from url
	# from http://www.willmaster.com/blog/perl/extracting-domain-name-from-url.php
	$url =~ s!^https?://(?:www\.)?!!i;
	$url =~ s!/.*!!;
	$url =~ s/[\?\#\:].*//;
	$output[5] = $url;

	# Determine File type and bitrate
	# Test for VIDEO_TS
	my @filesfound;
	find( sub { push @filesfound, $File::Find::name if -d and
	(/^video_ts$/i)},
	$seedPath);
	my $dvd = $filesfound[0] if (defined($filesfound[0]) );
	if ( defined($dvd) ) {
		push(@output,"DVD");
		push(@output,"DVD");
	}

	# Test for FLAC 
	@filesfound = ();
	find( sub { push @filesfound, $File::Find::name if (/flac$/i)},
	$seedPath);
	my $flac = $filesfound[0] if (defined($filesfound[0]) );
	if ( defined($flac) ) {
		push(@output,"FLAC");
		push(@output,"LL");
	}

	# Test for other video
	@filesfound = ();
	find( sub { push @filesfound, $File::Find::name if $_ =~
	(/\.(avi|mkv|mpg|m2ts|mov|3gp|ogm|ogv)$/i)},
	$seedPath);
	my $video = $filesfound[0] if ( defined($filesfound[0]) );
	if ( defined($video) ) {
		my $format = $video;
		my ($filename,$dir,$suffix) = fileparse($format, qr/\.[^.]*/);
		$suffix =~ s/\.//;
		$format = $suffix;
		my $info = Video::Info->new(-file=>$video);
		my $width = $info->width();
		push(@output,$format);
		push(@output,$width);
	}
	
	# Test for audio
	@filesfound = ();
	find( sub { push @filesfound, $File::Find::name if $_ =~
	(/\.(mp3|ogg)$/i)},
	$seedPath);
	my $mp3 = $filesfound[0] if ( defined ($filesfound[0]) );
		# Run mediainfo on file
	if ( defined($mp3) ) {
		my ($filename,$dir,$suffix) = fileparse($mp3, qr/\.[^.]*/);
		$suffix =~ s/\.//;
		my $format = $suffix;
		push(@output,$format); 

		my $bitrate = get_mp3info($mp3);
		my $vbr = $bitrate->{VBR};
		if ($vbr == 1) {
			$vbr = $bitrate->{VBR_SCALE};
			if ($vbr <= 80) {
				push(@output,"V2");
			} else {
				push(@output,"V0");
			}
		} else {
			$bitrate=$bitrate->{BITRATE};
			push(@output,$bitrate);
		}
	}
	if ($#output < 8) {
		push(@output,"unk");
		push(@output,"unk");
	}
	my $csv = Text::CSV->new();
	$csv->sep_char("\\");
	#$csv->escape_char("\\");
	my $status = $csv->combine(@output);
	my $line = $csv->string();
	print $line . "\n";
	#print "@output" . "\n";
}
sub meta {
	my $line = $_[0];
	my $search = $_[1];
	my $m = undef;
	if ($line =~ s/$search//) {
		$line =~ s/^\s\s*//;
		$m = $line ;
	}
	return $m;
}

sub sep {
	#my $sep = "$_[0]";
	my $input = "$_[0]";
	my @fields = split /\s\s*/, $input;
	@fields;
}