#!/usr/bin/perl
#
# $(LD_SHARED_CXX) wrapper for wxGTK to handle symbol versioning
#

use File::Temp;
use strict;
use warnings;

scalar(@ARGV) > 0 or die "no arguments";

my @ld_args_1;
my @ld_args_2 = @ARGV;
while (scalar(@ld_args_2) and $ld_args_2[0] ne '-o') {
	push @ld_args_1, shift(@ld_args_2);
}
scalar(@ld_args_2) >= 2 or die "missing '-o <file>' option";
push @ld_args_1, shift(@ld_args_2);	# '-o'
my $orig_output_file = shift(@ld_args_2);

my $tmpdir = File::Temp->newdir();

my $orig_version_script;
my $tmp_version_script = "$orig_output_file.versions";
my @final_ld_args_2 = @ld_args_2;
for (@final_ld_args_2) {
	/^-Wl,--version-script,(.*)$/ && do {
		$orig_version_script = $1;
		$_ = "-Wl,--version-script,$tmp_version_script";
		last;
	}
}

if (not defined $orig_version_script) {
	exit(verbose_system(@ld_args_1, $orig_output_file, @ld_args_2));
}

# First link attempt, writing to a temporary file
my $tmp_lib = "$tmpdir/tmp.so";
my $rc = verbose_system(@ld_args_1, $tmp_lib, @ld_args_2);
exit($rc) if $rc != 0;

# Read global symbols from the link result
my %symbols;
open(my $nm_output, '-|', 'nm', '-D', '--defined-only', $tmp_lib)
	or die "get nm output: $!";
while (<$nm_output>) {
	chomp;
	/^[[:xdigit:]]*\s+[[:upper:]]\s+(\S+)$/ && do {
		$symbols{$1} = 1;
	}
}
close($nm_output)
	or die $! ? "error closing nm output: $!"
		: "nm: exited with status $?";

# Using global symbol list, expand symbol patterns in version script
open(my $vs_in, '<', $orig_version_script)
	or die "open '$orig_version_script': $!";
open(my $vs_out, '>', $tmp_version_script)
	or die "open '$tmp_version_script': $!";
while (<$vs_in>) {
	chomp;
	/^\s*([^[:space:]#{};]+);\s*$/ && do {
		expand_symbol($vs_out, $_, $1);
		next;
	};
	print $vs_out "$_\n";
}
close($vs_out) or die "error closing '$tmp_version_script': $!";
close($vs_in) or die "error closing '$orig_version_script': $!";

# Final link, using the modified version script
exit(verbose_system(@ld_args_1, $orig_output_file, @final_ld_args_2));



sub expand_symbol
{
	my ($vs_out, $line, $glob) = @_;

	# Keep '*' as is
	if ($glob eq '*') {
		print $vs_out "$line\n";
		return;
	}

	# Convert shell pattern to regexp (currently only '*' is handled).
	if ($glob =~ /[^[:alnum:]_*]/) {
		die "unable to handle symbol pattern '$glob'";
	}
	my $re = $glob;
	$re =~ s/\*/.*/g;
	if ($re eq $glob) {
		# exact match - keep as is
		print $vs_out "$line\n";
		return;
	}
	$re = qr/^$re$/;

	my $first = 1;
	for my $sym (grep { m/$re/ } keys %symbols) {
		if ($first) {
			$first = 0;
			print $vs_out "##$line\n";
		}
		print $vs_out "\t$sym;\n";
		delete $symbols{$sym};
	}
	if ($first) {
		# Keep unmatched patterns to avoid empty sections
		print $vs_out "$line\n";
	} else {
		print $vs_out "\n";
	}
}

sub verbose_system
{
	print "+ " . join(' ', @_) . "\n";
	my $rc = system { $_[0] } @_;
	if ($rc == -1) {
		die "system: $!";
	}
	elsif ($rc & 127) {
		return ($rc & 127) | 128;
	}
	return $rc >> 8;
}