root/nicotine-app/trunk/nicotine/x11-rebuild

#!/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";
}