#!/usr/bin/perl

use strict;
use warnings;

my $svn = 'svn'; # which svn

use Getopt::Long;
use Getopt::Helpful;
use IPC::Run qw(run);

use File::Basename;

my $file = '';
my $change = '';
my $dir = 'add';
my $start_rev = 0;
my $stop_rev;
my $dump_dir;

# XXX does it need to check a file or is it file-or-directory (me thinks
# the latter)

# XXX clarify dir -> direction
my $hopt = Getopt::Helpful->new(
	['f|file=s', \$file, '', "which file to use"],
	['c|change=s', \$change, '', "change to find"],
	['dir=s', \$dir, 'add|rem', "look for add or remove (default to '$dir')"],
    ['dump=s', \$dump_dir, '<directory>', 'dump diff into a directory'],
	['start=i', \$start_rev, '<rev>',
		"start searching at <rev> (default '$start_rev')"],
	['stop=i', \$stop_rev, '<rev>',
		"stop searching at <rev> (default:  undef)"],
	'+help',
	);

GetOptions(
	$hopt->opts,
	);

if(length($file)) {
    # explicit, so skip checks
}
else {
    ($file = shift(@ARGV));

	(-e $file) or usage("file: '$file' does not exist");
	my $svdir = dirname($file) . '/.svn';
	unless(-e $svdir) {
		warn "guessing svk\n";
		$svn = 'svk';
	}
}
length($change) or ($change = shift);
defined($file) or usage("must have filename");
# XXX hackish http check...
# really need to work with file:/// and svk detect-mirror /mumble/
unless($dump_dir) {
    length($change) or usage("must have a change to search for\n");
}
@ARGV and ($dir = shift);
my $char;
if($dump_dir) {
    (-e $dump_dir) or die "no dir '$dump_dir'";
}
else {
    ($dir =~ m/^(add)|(rem)$/) or usage("dir must be 'add' or 'rem' not $dir");
    $char = {add => '\+', rem => '-'}->{$dir};
    $char or die "crap";
}

sub usage {
	my $code = 0;
	if(@_) {
		$code = 1;
		warn("\n   ABORT!  ", join("\n", @_) , "\n\n");
	}
	my $caller = $0;
	$caller =~ s#.*/##;
	my $string = "usage:\n  $caller <file> <change> [dir]\n";
	if($code) {
		warn "$string\n";
	}
	else {
		$string .=
			"  (leftover args are interpreted as target direction)\n";
		$string .= $hopt->help_string;
		print "$string\n";
	}
	exit($code);
} # end subroutine usage definition
########################################################################

my ($in, $out, $err);

run([$svn, 'log',
    (defined($stop_rev) ? ('-r', $stop_rev . ':' . $start_rev) : ()),
    ($svn =~ /svk$/ ? '-x' : ()) , $file], \$in, \$out, \$err);
$err and die "$svn error: $err\n";

my @log = grep(/^r\d+:?.*\|\s/, split(/\n/, $out));
foreach my $line (@log) {
	$line =~ s/^r//;
	$line =~ s/:?\s.*$//;
	# warn "logline: $line\n";
}
@log = sort({$a <=> $b} @log);
@log or die "no revisions for $file (log said '$out')\n";

print "searching revisions @log\n";

for(my $i = 0; $i < @log - 1; $i++) {
	if($start_rev) {
		if($log[$i] < $start_rev) {
			# warn("skipping $log[$i]\n");
			next;
		}
		else {
			$start_rev = 0;
		}
	}
	my $revs = $log[$i] . ":" . $log[$i+1];
	my ($in, $out, $err);
	warn("checking $revs\n");
	run([$svn, 'diff', '-r', $revs, $file], \$in, \$out, \$err);
    if($dump_dir) {
        my $filename = "$dump_dir/". basename($file) . ".$revs.patch";
        open(my $fh, '>', $filename) or
            die "could not open '$filename' $!";
        print $fh $out;
        next;
    }
	my @lines = grep(/^$char/, split(/\n/, $out));
	foreach my $line (@lines) {
		if($line =~ m/$change/) {
			print "$revs: $line\n";
		}
	}
}