#! /usr/bin/perl -w
#
# genresscript - Generates empty resource scripts based on existing binaries.
#
# Copyright (C) 1998-2005 Oskar Liljeblad
#
# 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., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
#

use Getopt::Long;
use File::Basename;

# global stuff
$PROGRAM = 'genresscript';
$path_w32rtool = &path_or('wrestool','../wrestool/wrestool');

# initialize options
$arg_base = '';
$arg_help = $arg_version = 0;
$arg_type = 'group_icon';
$arg_sort = 0;

# parse options
exit 1 if (!GetOptions("t|type=s"      => \$arg_type,
                       "b|base=s"      => \$arg_base,
                       "help"          => \$arg_help,
                       "version"       => \$arg_version,
                       "s|sort"        => \$arg_sort));

# deal with standard options
if ($arg_help) {
	print "Usage: genresscript [OPTION]... [FILE]...\n";
	print "Generates empty resource scripts based on existing PE or NE binaries.\n";
	print "\n";
	print "  -t, --type=ID     list resources of this type instead of group_icon\n";
	print "  -b, --base=PATH   the default extraction name of all resources\n";
	print "  -s, --sort        sort alphabetically instead of using order in binary\n";
	print "\n";
  print "      --help        display this help and exit\n";
	print "      --version     output version information and exit\n";
	print "\n";
	print "The option --sort can be useful when making scripts from looking at image\n";
	print "directories (where images are sorted by filename).\n";
	print "\n";
	print 'Report bugs to <frank.richter@gmail.com>', "\n";
	exit;
}
if ($arg_version) {
	print "$PROGRAM (icoutils) 0.32.3\n";
	print "Written by Oskar Liljeblad.\n\n";
	print "Copyright (C) 1998-2005 Oskar Liljeblad.\n";
	print "This is free software; see the source for copying conditions.  There is NO\n";
	print "warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.\n";
	exit;
}

# got no arguments?
if ($#ARGV == -1) {
	print STDERR "$PROGRAM: missing file argument\n";
	print STDERR "Try `$PROGRAM --help' for more information.\n"
}

# process each non-option argument
my ($got_any) = 0;
for ($c = 0 ; $c <= $#ARGV ; $c++) {
	$got_any = 1 if (process_binary($ARGV[$c], ($c != 0 && $got_any)));
}

#
# Subroutines
#

sub process_binary {
	my ($file, $any_before) = @_;
	my ($cmd,$line,$is_first,@res);

	$cmd = "$path_w32rtool -l";
	$cmd .= " -t$arg_type" if (defined $arg_type && $arg_type ne '');
	$cmd .= " $file";

	if (!open (IN, "$cmd|")) {
		warn "$PROGRAM: execution of wrestool failed\n";
		return;
	}

	$is_first = 1;
	@res = ();
	while (defined ($line = <IN>)) {
		($type) = ($line =~ /\[type=([^ ]*)/);
		($name) = ($line =~ / --name=([^ ]*)/);
		($lang) = ($line =~ / --language=([^ ]*)/);

		$name =~ s/^`(.*)'$/$1/;
		$type =~ s/^`(.*)'$/$1/;
		$lang =~ s/^`(.*)'$/$1/ if defined $lang;

		if ($is_first) {
			print "\n" if ($any_before);
			print "file ", File::Basename::basename($file), "\n";
			$is_first = 0;
		}
		print "resource $type, $name: $arg_base\n" if (!$arg_sort);
		push @res, "resource $type, $name: $arg_base\n" if ($arg_sort);
	}

	print sort(@res) if ($arg_sort);

	return !$is_first;
}

sub path_or {
	my ($cmd,$def) = @_;

	my $real = `which $cmd`;
  return $def if !defined $real;
  chop $real;
  return $def if ($real eq '');

	return $real;
}