#! /usr/bin/perl -w
#
# This is a wrapper script for gdc that emulates the dmd command.
# Unknown options are passed on to gdc.  The two extra options are:
#
# -vdmd                         Print commands executed by this wrapper script
# -q<arg1>[,<arg2>,<arg3>,...]  Pass the comma-separated arguments to gdc

use strict;
use File::Basename;
use File::Spec;

my $output_directory;
my $output_parents;
my $output_file;
my $link = 1;
my $show_commands = 0;
my $seen_all_sources_flag = 0;
my $first_input_file;

my @sources;
my @objects;

my @out;

sub osHasEXE() {
    return $^O =~ m/^MS(DOS|Win32)|os2/i; # taken from File::Basename
}

foreach my $arg (@ARGV) {
    if ($arg =~ m/^-c$/ ) {
	$link = 0;
    } elsif ( $arg =~ m/^-d/ ) {
	push @out, '-fdeprecated';
    } elsif ( $arg =~ m/^-debug(?:=(.*))$/ ) {
	push @out, (defined($1) ? '-fdebug=$1' : '-fdebug');
    } elsif ( $arg =~ m/^-gt$/ ) {
	# there is more to profiling than this ... -finstrument-functions?
	push @out, '-pg';
    } elsif ( $arg =~ m/^-inline$/ ) {
	push @out, '-finline-functions';
    } elsif ( $arg =~ m/^-I(.*)$/ ) {
	push @out, '-I', $1; # need to expand '~'
    } elsif ( $arg =~ m/^-L(.*)$/ ) {
	push @out, '-L', $1; # need to expand '~'
    } elsif ( $arg =~ m/^-O$/ ) {
	push @out, '-O2'; # that's probably the equivalent...
    } elsif ( $arg =~ m/^-od(.*)$/ ) {
	$output_directory = $1;
    } elsif ( $arg =~ m/^-of(.*)$/ ) {
	$output_file = $1;
    } elsif ( $arg =~ m/^-op$/ ) {
	$output_parents = 1;
    } elsif ( $arg =~ m/^-release$/ ) {
	push @out, '-frelease';
    } elsif ( $arg =~ m/^-unittest$/ ) {
	push @out, '-funit-test';
    } elsif ( $arg =~ m/^-v$/ ) {
	push @out, '-v'; # not really equivalent
    } elsif ( $arg =~ m/^-version=(.*)$/ ) {
	push @out, '-fversion=$1';
    } elsif ( $arg =~ m/^-vdmd$/ ) {
	$show_commands = 1;
    } elsif ( $arg =~ m/^-q(.*)$/ ) {
	push @out, split(qr/,/, $1);
    } elsif ( $arg eq '-fall-sources' ) {
	$seen_all_sources_flag = 1;
	# push @out, $arg;
    } elsif ( $arg =~ m/^-.+$/ ) {
	push @out, $arg;
    } elsif ( $arg =~ m/^[^\.]+$/ ||
	      $arg =~ m/^.+\.d$/) {
	$first_input_file = $arg if ! $first_input_file;
	push @sources, $arg;
    } elsif ( $arg =~ m/^(.+)(\.exe)$/i ) {
	$first_input_file = $arg if ! $first_input_file;
	$output_file = $1;
	if ( osHasEXE() ) {
	    $output_file .= $2;
	}
    } else {
	push @objects, $arg
    }

}

# Slightly different from dmd... allows -of to specify
# the name of the executable.
if ( ! $link && scalar(@sources) > 1 && $output_file ) {
    die "object file name specified with multiple source files";
}

if ( $link && ! $output_file && $first_input_file ) {
    $output_file = fileparse( $first_input_file, qr{\..*$} );
    if ( osHasEXE() ) {
	$output_file .= '.exe';
    }
}

my $ok = 1;

foreach my $srcf_i (@sources) {
    # Step 1: Determine the object file path
    my $outf;
    my $srcf = $srcf_i; # To avoid modifying elements of @sources
    my @outbits;

    if ( ! $link && $output_file ) {
	$outf = $output_file;
    } else {
	if ( $output_directory ) {
	    push @outbits, $output_directory;
	    #$outf = $output_directory;
	    #$outf .= '/';
	}
	if ( $output_parents ) {
	    #my $dir = dirname( $srcf ); # should be '.' for no directory spec, but...
	    #$outf .= (dirname( $srcf ) . '/') if $dir;
	    push @outbits, dirname( $srcf );
	}
	push @outbits, basename( $srcf, '.d' ) . '.o';
	# $outf .= basename( $srcf, '.d' ) . '.o';
	$outf = File::Spec->catfile( @outbits );
    }
    push @objects, $outf;

    my @all_sources_hack;
    if ( $seen_all_sources_flag ) {
	@all_sources_hack = (@sources);
	$srcf = "-fonly=$srcf";
    }

    # Step 2: Run the program
    my @cmd = ('gdc', @out, '-c', @all_sources_hack, $srcf, '-o', $outf );
    if ( $show_commands ) {
	print join(' ', @cmd), "\n";
    }
    my $result = system(@cmd);
    die if $result & 0xff; # Give up if can't exec or gdc exited with a signal
    $ok = $ok && $result == 0;
}

if ($ok && $link) {
    my @cmd = ('gdc', @out, @objects);
    if ( $output_file ) {
	push @cmd, '-o', $output_file;
    }
    if ( $show_commands ) {
	print join(' ', @cmd), "\n";
    }
    $ok = $ok && system(@cmd) == 0;
}

exit ($ok ? 0 : 1);


