The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl

use strict;
use FileHandle;
use Data::Dumper;

my %XAUDIO_MISDEFINED_SYMBOL = (
	XA_MSG_NOTIFY_INPUT_DURATION => 1,
	XA_MSG_NOTIFY_INPUT_STREAM_INFO => 1,
	XA_MSG_NOTIFY_OUTPUT_FEEDBACK_RATE => 1,
	XA_MSG_SET_OUTPUT_FEEDBACK_RATE => 1,
	XA_MSG_GET_OUTPUT_FEEDBACK_RATE => 1,
	XA_MSG_COMMAND_QUEUE_FEEDBACK_EVENT => 1,
	XA_MSG_COMMAND_QUEUE_TAG_EVENT => 1,
	XA_MSG_COMMAND_FEEDBACK_PAUSE => 1,
	XA_MSG_COMMAND_FEEDBACK_RESTART => 1,
	XA_MSG_COMMAND_FEEDBACK_FLUSH => 1,
	XA_MSG_NOTIFY_FEEDBACK_EVENT => 1,
	XA_MSG_NOTIFY_TAG_EVENT => 1,

);

main: {
	my $sdk_dir = shift @ARGV;

	if ( $sdk_dir eq '' ) {
		print "usage: gen_conv_msg.pl X-Audio-SDK-Directory\n";
		exit;
	}
	$sdk_dir =~ s!/$!!;

	my $msg_html  = "$sdk_dir/doc/notification-messages.html";
	
	if ( not -f $msg_html ) {
		print "can't find $msg_html\n";
		print "aborting!\n";
		exit;
	}
	
	gen_conf_msg ($msg_html);
}

sub gen_conf_msg {
	my ($msg_html) = @_;
	
	# open output file
	my $out_fh = new FileHandle;
	open ($out_fh, "> conv_msg.c") or die "can't write conv_msg.c";

	gen_start_block ($out_fh);

	# read message html file
	
	open (MSG, $msg_html) or die "can't read $msg_html";
	my $html = join '', <MSG>;
	close MSG;

	# split into message blocks (nice, they used <HR>'s)

	my @block = split ("<HR>", $html);

	# first two blocks are title and index, strip off

	shift @block;
	shift @block;
	
	print scalar (@block), "\n";
	
	my $i=0;
	foreach my $block (@block) {
		# fetch msg name
		$block =~ /A NAME="(\w+)/m;
		my $name = $1;

		# fetch msg parameters
		my @par = split (/<\/TR>\s*<TR>/, $block);
		
		my %par;
		foreach my $p (@par) {
			my $par_name;
			$par_name = $1 if $p =~ m!<B><I>message.([\w\.]+)!;
			
			my $par_type;
			$par_type = $1 if $p =~ m!</TD><TD>([\w\s\*]+)!;
			
			# we have to correct some typo's
	
			$par_name =~ s/environmemt/environment/g;
			$par_name =~ s/environment/environment_info/g;
			$par_name =~ s/progress_info/progress/g;

			$par{$par_name} = $par_type if $par_name;
		}

		print "name\t$name\n";
		print Dumper(\%par), "\n";
		
		gen_message_block ($out_fh, $name, \%par);
#			if $name ne 'XA_MSG_NOTIFY_CODEC_EQUALIZER';
	
		++$i
	}
	
	
	gen_end_block ($out_fh);
	close $out_fh;
}

sub gen_start_block {
	my ($fh) = @_;
	
	print $fh <<__EOC;
/*
 * ATTENTION: This file was genenerated by gen_conv_msg.pl, part
 *            of the MPEG::MP3Play distribution.
 *            Do not edit this file, edit gen_conv_msg.pl instead.
 *
 *            ANY CHANGES MADE HERE WILL BE LOST!
 */

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include "player.h"
#include "control.h"

SV*
convert_message_to_HV ( XA_Message* message ) {
	HV*	msg_hash;
	
	msg_hash = newHV();
	
	/* first, store the message code */
	
	hv_store (msg_hash,
		"code", 4,
		newSViv ((IV)message->code),
		0
	);

	/* second, add hash entries, derived from the XA message */

	switch (message->code) {
__EOC
}


sub gen_end_block {
	my ($fh) = @_;
	
	print $fh <<__EOC;
		default:
			break;
	}

	return newRV_noinc((SV*)msg_hash);
}
__EOC
}

sub gen_message_block {
	my ($fh, $name, $par) = @_;
	
	next if $XAUDIO_MISDEFINED_SYMBOL{$name};
	
	my $method_name = $name;
	$method_name =~ s/^XA_//;
	$method_name =~ tr/A-Z/a-z/;
	
	$method_name = "equalizer" if $method_name eq 'equalizer_info';
	
#	print $fh qq{#ifdef $name\n};
	print $fh qq{\t\tcase $name:\n};

	print $fh qq{\t\t\thv_store (msg_hash,\n};
	print $fh qq{\t\t\t\t"_method_name", 12,\n};
	print $fh qq{\t\t\t\tnewSVpv("$method_name", 0),\n};
	print $fh qq{\t\t\t\t0);\n};

	my ($var, $type);
	while ( ($var,$type) = each %{$par} ) {
		my $hash_var = $var;
		$hash_var =~ s/\./_/g;
		$hash_var = "equalizer" if $hash_var eq 'equalizer_info';
		
		print $fh qq{\t\t\thv_store (msg_hash,\n};
		print $fh qq{\t\t\t\t"$hash_var", }.(length($hash_var)).qq{,\n};

		if ( $type eq 'const char *' or $type eq 'char *' ) {
			print $fh qq{\t\t\t\t}.
				  qq{newSVpv ((char*)message->data.$var, 0),};
		} elsif ( $type eq 'long' or $type eq 'short' or
			  $type eq 'unsigned char' or
			  $type eq 'unsigned long' or
			  $type eq 'unsigned short' ) {
			print $fh qq{\t\t\t\t}.
				  qq{newSViv ((IV)message->data.$var),};
		} elsif ( $type =~ /equalizer/ ) {
			print $fh qq{\t\t\t\t}.
				  qq{newSVpv ((char*)message->data.equalizer, 64),};
		} else {
			die "UNKNOWN TYPE: $type\n";
		}
		print $fh qq{\n\t\t\t\t0);\n};
	}
	print $fh qq{\t\t\tbreak;\n\n};
#	print $fh qq{#endif\n\n};
}