#!/usr/bin/perl
use warnings;
use strict;

use English;
use Storable;
use File::Find;
use File::Spec::Functions;
use Fink::Command qw(touch);
use Getopt::Long;
use DB_File;

my $DEBUG = 1;
my $prefix = '/sw';
my $db_path = '/Users/vasi/Hacking/Misc/x11-compat';
my $x11_dir = '/Users/vasi/Hacking/fink-apps/x11/';
my @prune;
my $noprune;

{
	my $cached_fh;
	my $cached_cmd;
	
	sub next_object {
		my $gen_cmd = shift;
		
		if (!defined $cached_cmd || $cached_cmd ne $gen_cmd) {
			$cached_cmd = $gen_cmd;
			close $cached_fh if defined $cached_fh;
			undef $cached_fh;
			open $cached_fh, "$gen_cmd |"
				or die "Can't get file list: $!\n";
		}
		
		while (my $file = <$cached_fh>) {
			chomp $file;
			return $file if is_macho($file);
		}
		
		# No more left
		close $cached_fh;
		undef $cached_cmd;
		return undef;
	}
}

sub version_ok {
	my ($vers, $compatl) = @_;
	my @versl = split(/\./, $vers);
	for my $i (0..2) {
		if ($versl[$i] > $compatl->[$i]) {
			return 0;
		} elsif ($versl[$i] < $compatl->[$i]) {
			return 1;
		}
	}
	return 1;
}

{
	my $test_compats;
	
	sub file_ok {
		my $file = shift;
		
		$test_compats = retrieve($db_path) unless defined $test_compats;
		
		open OTOOL, "otool -L \Q$file\E |" or die "Can't run otool: $!\n";
		my @otool = <OTOOL>;
		close OTOOL;
		
		for my $libline (@otool) {
			$libline =~ m,X11R6/lib/(\S+)\.dylib.*
					compatibility\sversion\s*([\d.]+),x or next;
			unless (exists $test_compats->{$1}
					&& version_ok($2, $test_compats->{$1})) {
				return 0;
			}
		}
		
		return 1;
	}
}

sub switch_x11 {
	my $op = shift;
	
	if ( $EUID != 0 ) {
		# We need root
		exec('/usr/bin/sudo', '-H', $0, $op)
			or die "$0: couldn't become root: $!";
	}
	
	my $patch = catfile($x11_dir, "include-2apple.patch.gz");
	my $libs = catfile($x11_dir, "lib-$op.tgz");
	my $patch_op = $op eq 'apple' ? '' : '-R';
	
	print "PATCHING\n";
	chdir '/usr/X11R6/include';
	if (! -f ".dist-$op") {
		system("gzcat \Q$patch\E | patch -N $patch_op -p2") == 0
			or die "Patch failed: $!\n";
		system("rm -v .dist* ; touch .dist-$op") == 0
			or die "Setting dist failed: $!\n";
	}
	
	chdir '/usr/X11R6/lib';
	print "\n\n\nREMOVING\n";
	system("ls | grep -v ^X11 | xargs rm -rv") == 0
		or die "Remove failed: $!\n";
	print "\n\n\nRESTORING\n";
	system("tar -xvzf \Q$libs\E") == 0
		or die "Tar failed: $!\n";
}

{
	my $magic = pack('L', 0xfeedface);
	
	sub is_macho {
		my $file = shift;
		return 0 unless -f $file && ! -l $file;
		
		my $header;
		open FILE, $file or warn "Can't open $_: $!\n" && return 0;
		read FILE, $header, 4;
		close FILE;
		
		return (defined $header && $header eq $magic);
	}
}

GetOptions(
	'p|prefix=s'	=> \$prefix,
	'q|quiet'		=> sub { $DEBUG = 0; },
	'compat=s'		=> \$db_path,
	'prune=s'		=> \@prune,
	'noprune'		=> \$noprune,
) or die "Can't get options\n";

my $op = shift;
if ($op eq 'generate') {
	# Must have Apple's X11 installed
	my $compats = {};
	while (my $lib = next_object('find /usr/X11R6/lib')) {
		open OTOOL, "otool -L \Q$lib\E | tail +2 | head -n1 |"
			or die "Can't run otool: $!\n";
		my $line = <OTOOL>;
		close OTOOL;
		
		$line =~ m,X11R6/lib/(\S+)\.dylib.*compatibility\sversion\s*([\d.]+),x
			or die "Can't interpret compat version: $line\n";
		$compats->{$1} = [ split(/\./, $2) ];
	}
	store($compats, $db_path);
	
} elsif ($op eq 'check') {
	my @pkgs = @ARGV;
	my @reb;
		
	print "CHECKING:\n" if $DEBUG;
	PKG: for my $pkg (sort @pkgs) {
		print "  pkg $pkg\n" if $DEBUG;
		
		while (my $file = next_object("dpkg -L \Q$pkg\E")) {
			next unless $file =~ m,^$prefix/,;
			
			print "    file $file\n" if $DEBUG;
			unless (file_ok($file)) {
				push @reb, $pkg;
				print "    status rebuild\n" if $DEBUG;
				next PKG;
			}
		}
		print "    status ok\n" if $DEBUG;
	}
	
	print "\nPACKAGES: " if $DEBUG;
	print join(' ', @reb), "\n";
} elsif ($op eq 'apple' || $op eq 'xorg') {
	switch_x11($op);
} elsif ($op eq 'checkall') {
	my $checkeddb = shift;
	my %checked;
	tie %checked, 'DB_File', $checkeddb or die "Can't open DB: $!\n";
#use Data::Dumper; print Dumper(\%checked); exit 0;
	my @bad;
	
	my $realp = (-l $prefix ? readlink $prefix : $prefix);
	push @prune, map { "$realp/$_" }
		qw/share fink var etc src/ unless defined $noprune;
	
	my %prune = map { $_ => 1 } @prune;
	print "CHECKING:\n" if $DEBUG;
	find({
		wanted => sub {
			my $file = $_;
			if (exists $prune{$file}) {
				print " prune $file\n" if $DEBUG;
				$File::Find::prune = 1;
				return;
			}
			return if exists $checked{$file};
			my $macho = is_macho($file);
			print " file $file\n" if $macho && $DEBUG;
			if ($macho && !file_ok($file)) {
				print "   bad!\n" if $DEBUG;
				push @bad, $file;
			} else {
				$checked{$file} = 1;
			}
		},
		no_chdir => 1,
	}, $realp);
	
	print "\nBAD FILES:\n" if $DEBUG;
	print "$_\n" foreach @bad;
} else {
	die "Don't know what to do!\n";
}