#!/usr/bin/perl -w

use strict;

use Getopt::Std;
use Pod::Usage;
use CORBA::XPIDL::xpt;

my %opts;
getopts('t:', \%opts)
		or pod2usage(-exitval => 1, -verbose=> 1);

$opts{t} = '1.2' unless (exists $opts{t});
die "ERROR: version $opts{t} not supported.\n"
		if ($opts{t} eq '1.0');
die "ERROR: version $opts{t} not recognised.\n"
		if ($opts{t} ne '1.1' and $opts{t} ne '1.2');

my $major_version = substr $opts{t}, 0, 1;
my $minor_version = substr $opts{t}, 2, 1;

my $outfile = shift;

pod2usage(-exitval => 1, -verbose=> 1)
		if (!defined $outfile or !@ARGV);

eval {
	my $whole = new XPT::File(
			magic			=> XPT::File::MAGIC,
			major_version	=> $major_version,
			minor_version	=> $minor_version,
	);
	foreach my $filename (@ARGV) {
		open my $IN, '<', $filename
				or die "FAILED: can't read $filename\n";
		binmode $IN, ':raw';
		undef $/;
		my $rv = <$IN>;
		close $IN;

		my $offset = 0;
		my $file = XPT::File::demarshal(\$rv, \$offset);

		foreach (@{$file->{annotations}}) {
			if ($_->{tag}) {	# not empty
				$whole->add_annotation($_);
			}
		}
		foreach ($file->_interface_directory()) {
			$whole->add_interface($_);
		}
	}
	$whole->terminate_annotations();
	$whole->indexe();

	open my $OUT, '>', $outfile
			or die "FAILED: can't open $outfile\n";
	binmode $OUT, ':raw';
	print $OUT $whole->marshal();
	close $OUT;
	exit(0);
};
if ($@) {
	warn $@;
	exit(1);
}


###############################################################################

__END__

=head1 NAME

xpt_link - typelib linker

=head1 SYNOPSIS

C<xpt_link> [-t version number] F<outfile> F<file1.xpt> F<file2.xpt> ...

=head1 OPTIONS

=over 8

=item -t I<version number>

create a typelib of an older version number

=back

=head1 DESCRIPTION

C<xpt_link> is a utility for linking multiple typelib files into one outfile.

=head1 MORE INFORMATION

XPCOM Type Library File Format, version 1.1, is available on
http://mozilla.org/scriptable/typelib_file.html

=head1 SEE ALSO

L<xpidl>, L<xpt_dump>

=head1 AUTHORS

The original version (C language) is mozilla.org code.

Port to Perl by Francois Perrad, francois.perrad@gadz.org

=head1 COPYRIGHT

Copyright 2004-2007, Francois Perrad.

This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

