#!/usr/bin/perl
# fix-missing-libs.pl - try to iteratively fix Makefile.am for linking errors
# Copyright (C) 2006 Jeremy Lainé <jeremy.laine@m4x.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., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
# 


use strict;
use warnings;

use Cwd;
use Getopt::Std;
use File::Copy;
use File::Path;
use File::Spec;
use File::Temp 'tempdir';

my $VERSION = "0.6";
my $SCRIPT = "fix-missing-libs.pl";
my $lib_suites = {
  'qt'  => [ qw(qt-mt z png X11 Xext ICE SM) ],
  'kde' => [ qw(qt-mt z png X11 Xext ICE SM kdecore kdeui kparts khtml kio kjs kspell ktexteditor kscript DCOP) ],
};
my @lib_dirs = qw(/usr/lib /usr/X11R6/lib);


=head1 NAME

fix-missing-libs.pl - try to iteratively fix Makefile.am for linking errors

=head1 SYNOPSIS

B<fix-missing-libs.pl> [options] srcdir

=head1 DESCRIPTION

The B<fix-missing-libs.pl> script tries to iteratively fix Makefile.am
files by parsing linking errors, looking up the missing references and
updating *_LDADD and *_LIBADD with the missing libraries. The script
works like this:

1. try going as far a possible in the build (make -k), and make a note of
the missing symbols for each .la target

2. if there are missing symbols, figure out what libraries are missing,
patch the Makefile.am files

3. if there were no missing symbols or if we were unable to figure out how
to patch the Makefile.am files, stop here, otherwise go back to 1/

=head1 OPTIONS

 Options:
  -d<file>   write diff to <file>
  -h         display a help message
  -s<suite>  use the <suite> library suite (kde, qt)\n",
  -v         verbose output

=head1 CHANGES

v0.6
 * add option to generate diff file
 * add support for 'suites' of libraries (kde, qt)

v0.5
 * support non-library targets by adding missing libraries to LDADD instead

v0.4
 * on top of checking for linking errors, check the exit status of the 'make' command

v0.3
 * try to fix locale problems by unsetting the LANG, LC_ALL, LC_LANG and LANGUAGE environment variables

=head1 DEVELOPER INFORMATION

The following methods are available:

=over 7

=item load_suite

Load all defined symbols from a symbol suite.

=cut
sub load_suite
{
  my ($suite_name) = @_;
  my $lib_defs;
  
  defined($lib_suites->{$suite_name}) or die("PANIC : unknown suite '$suite_name'");
  logprint("Load symbol suite '$suite_name'..\n");

  foreach my $lib (@{$lib_suites->{$suite_name}})
  {
    my $found = 0;
    my @dirs = @lib_dirs;
    while (!$found && (my $dir = shift @dirs))
    {
      my $libfile = "$dir/lib$lib.so";
      if (-e $libfile)
      {
        $found = 1;
	push @{$lib_defs}, [ "-l$lib",  $libfile ];
      }
    }
    if (!$found) 
    {
      logprint("-> Could not find library '$lib'\n");
    }
  }
  my $known_syms = load_symbols($lib_defs);
  logprint("\n");

  return ($lib_defs, $known_syms);
}


=item load_symbols

Load all defined symbols from a set of libraries.

=cut
sub load_symbols
{
  my $lib_defs = shift;
  my $known_syms;

  foreach my $libline (@{$lib_defs})
  {
    my ($libname, $libobj) = @{$libline};
    if (-e $libobj)
    {
      logprint("-> Loading symbols from `$libobj'..");
      open(SYMS, "nm -C -D --defined-only $libobj |");
      while (my $line = <SYMS>)
      {
        chomp($line);
        if ($line =~ /^[^ ]+ [A-Z] (.*)/) {
          $known_syms->{$1} = $libname;
        }
      }
      close(SYMS);
      logprint("done\n");
    } else {
      die("PANIC : could not load symbols from `$libobj' (not found)");
    }
  }
  return $known_syms;
}


=item logprint

Write to the log.

=cut
sub logprint
{
  print STDERR @_;
}


=item process_symbols

Return the string to add to LDADD/LIBADD and the array of unknown symbols.

=cut
sub process_symbols
{
  my ($lib_defs, $missing_syms, $known_syms) = @_;

  my $missing_libs;
  my @unknown_syms;
  foreach my $sym (keys %{$missing_syms})
  {
    my $lib = $known_syms->{$sym};
    if ($lib) {
      $missing_libs->{$lib} = 1;
    } else {
      push @unknown_syms, $sym;
    }
  }
  
  # order missing libraries
  my @add_libs;
  foreach my $libline (@{$lib_defs})
  {
    my ($libname) = @{$libline};
    push @add_libs, $libname if ($missing_libs->{$libname});
  }

  return (\@add_libs, \@unknown_syms);
}


=item do_analysis_run

Perform an analysis run, which consists in try to build as far as possible,
parsing linker errors, looking up the missing libraries for each target
and returning the changes that need to be applied to Makefile.am files.

=cut
sub do_analysis_run
{
  my ($config, $lib_defs, $known_syms) = @_;
  my $build_dir = $config->{build_dir};

  # launch make
  open(INPUT, "make -C $build_dir -k 2>&1 |");

  my $patches = {};
  my $missing_syms = {};
  my $curdir = "";
  my $curdir_err = 0;
  my $link_err = 0;
  my $continue = 1;
  while (defined(my $line = <INPUT>) && $continue)
  {
    logprint($line) if ($config->{verbose});
    if ($line =~ /^make\[([0-9]+)\]: Entering directory `(.*)'/) {
      logprint("\n") if ($curdir_err);
      $curdir = $2;
      $curdir_err = 0;
      $missing_syms = {};
#      logprint("> In `$curdir' : entering\n");
    } elsif ( ($line =~ /^make\[([0-9]+)\]: \*\*\* \[(.*)\] Error/) &&
              ((keys %{$missing_syms}) > 0) ) {
      my $target = $2;
      if (substr($curdir, 0, length($build_dir)) ne $build_dir)
      { 
        logprint("PANIC : could not determine relative path for `$curdir' from `$build_dir'\n");
        exit(1);
      }
      my $relcurdir = substr($curdir, length($build_dir));
      $relcurdir =~ s/^\///;
      logprint("-> In directory `$relcurdir':\n") unless ($curdir_err);
      $curdir_err = 1;
      $link_err = 1;
      my ($libadd, $unknown_syms) = &process_symbols($lib_defs, $missing_syms, $known_syms);

      # print needed extra libraries
      if (@{$libadd} > 0) {
        $patches->{$relcurdir}{$target} = $libadd;
        logprint("  * `${target}' needs: ".join(' ', @{$libadd})."\n");
      }

      # dump unknown symbols
      if (@{$unknown_syms} > 0) {
        logprint("  * `${target}' unknown undefined references:\n   ");
        logprint(join("\n   ", sort @{$unknown_syms})."\n");
      }
      $missing_syms = {};
    } elsif ($line =~ /: undefined reference to `(.*)'/) {
      my $sym = $1;
      $missing_syms->{$sym} = 1;
    }
  }
  my $make_err = 0;
  close(INPUT) || ($make_err = 1);
  return ($make_err, $link_err, $patches);
}


=item apply_patches

Patch the Makefile.am files.

=cut
sub apply_patches
{
  my ($config, $patches) = @_;
  my $diff_dir = $config->{diff_dir};
  my $diff_file = $config->{diff_file};

  logprint("Applying patches..\n");

  foreach my $patchdir (keys %{$patches})
  {
    my $pfile = "$patchdir/Makefile.am";
    my $modfile = "$config->{src_dir}/$pfile";
    logprint("-> Patching `$pfile'\n");

    # read the original file
    open(ORIG, "< $modfile") or
      die("PANIC : cannot open `$modfile' for reading");
    my @lines = <ORIG>;
    close(ORIG);

    if ( $diff_dir )
    {
      mkpath("$diff_dir/orig/$patchdir");
      mkpath("$diff_dir/fixed/$patchdir");
      if ( ! -f "$diff_dir/orig/$pfile" )
      {
        copy($modfile, "$diff_dir/orig/$pfile");
      }
    }
    foreach my $target (keys %{$patches->{$patchdir}})
    {
      my $ext = ($target =~ /\.(la|a)$/) ? 'LIBADD' : 'LDADD';
      my $mtarget = $target;
      $mtarget =~ s/[\-\.]/_/g;
      $mtarget .= "_". $ext;
      my $libadd = join(" ", @{$patches->{$patchdir}{$target}});
      my $found = 0;
      my @newlines;
      while (my $line = shift @lines)
      {
        if ($line =~ /^$mtarget\s*=[ \t]*/) {
          logprint("  * Prepending to `$mtarget'\n");
          $line =~ s/^($mtarget\s*=[ \t]*)/$1$libadd /;
          $found++;;
        }

        push @newlines, $line;
      }
      if (!$found) {
        logprint("  * Adding `$mtarget'\n");
        push @newlines, "$mtarget = $libadd\n";
      }
      @lines = @newlines;
    }

    # write the modified file
    open(MOD, "> $modfile") or
      die("PANIC : cannot open `$modfile' for writing");
    print MOD join("", @lines);
    close(MOD);

    if ( $diff_dir )
    {
        copy($modfile, "$diff_dir/fixed/$pfile");
    }
  }

  if ( $diff_dir && $diff_file)
  {
     logprint("-> Writing patch to '$diff_file'\n");
     system("cd $diff_dir && diff -urN orig fixed > ".File::Spec->rel2abs($diff_file));
  }
}


=item usage

Display program usage.

=cut
sub usage
{
  print "[ $SCRIPT v$VERSION - missing library fixer ]\n\n",
        "Syntax:\n",
        "  $SCRIPT [options] srcdir\n\n",
        "Options:\n",
        "  -d<file>   write diff to <file>\n",
        "  -h         display a help message\n",
        "  -s<suite>  use the <suite> library suite (kde, qt)\n",
        "  -v         verbose output\n",
        "\n";
  exit(1);
}

=item init

Read command line arguments and returning the configuration.

=cut
sub init
{
  my (%opts, $config);
  if ( not getopts('d:hs:v', \%opts) or $opts{'h'}) {
    &usage;
  }
  &usage if (@ARGV < 1);

  # verbose output
  $config->{verbose} = $opts{v} ? 1 : 0;

  # symbol suite
  $config->{suite} = $opts{s} ? $opts{s} : 'kde';
  
  # source directory
  $config->{src_dir} = shift @ARGV;
  $config->{src_dir} =~ s/\/$//;
 
  # build directory
  $config->{build_dir} = getcwd();

  # diff file
  if (defined($opts{d}) && $opts{d})
  {
    $config->{diff_file} = $opts{d};
    $config->{diff_dir} = tempdir( CLEANUP => 1 );
  }

  # discard language settings, we need English to parse 'make' output
  delete @ENV{qw(LANG LC_ALL LC_LANG LANGUAGE)};

  return $config;
}


=item main

The main routine.

=cut
sub main 
{
  my $config = &init;

  # sanity checks
  if (! -e "$config->{build_dir}/Makefile" ) {
    logprint("PANIC : could not find Makefile in `$config->{build_dir}'\n");
    exit(1);
  }
  if (! -e "$config->{src_dir}/Makefile.am" ) {
    logprint("PANIC : could not find Makefile.am in `$config->{src_dir}'\n");
    exit(1);
  }

  # load library symbols
  my ($lib_defs, $known_syms) = &load_suite($config->{suite});
 
  my $make_err = 0;
  my $link_err = 1;
  my $have_patch = 1;
  my $run = 1;
  $SIG{INT} = sub {logprint("Aborted.\n\n"); exit(1); };

  while ($link_err && $have_patch) {
    logprint("== RUN NUMBER $run ==\n");
    my $patches;
    ($make_err, $link_err, $patches) = &do_analysis_run($config, $lib_defs, $known_syms);
    logprint("\n");
    $have_patch = ((keys %{$patches}) > 0);
    if ($have_patch)
    {
      &apply_patches($config, $patches);
      logprint("\n");
    }
    $run++;
  }
 
  if ($link_err) {
    logprint("Finished : ERROR, there are remaining linking errors.\n\n");
  } elsif ($make_err) {
    logprint("Finished : ERROR, make failed but no linking errors found.\n\n");
  } else {
    logprint("Finished : OK, make succeeded.\n\n");
  }
}

&main;

=back

=head1 AUTHOR

Jeremy Lainé <jeremy.laine@m4x.org>

=cut