#!/usr/bin/perl -w
#
# mame_parse - Read output MAME -listinfo/ RAINE -gameinfo command from STDIN
#              and parse it
#
# (c) 2000  Stefan Becker
#
# It generates the following files
#
#  mameinfo.db  - A Berkeley DB file with all information about the ROMs
#  mameinfo.txt - A text file with information about the supported ROMS sets
#
# BUGS: ROM sets which are clones of clones, e.g. NeoGeo "maglordh" or
#       CVS "8ball1", are not handled correctly. You have to manage them
#       by hand.
#
#-----------------------------------------------------------------------------
#
# REQUIRED PERL PACKAGES
#
#-----------------------------------------------------------------------------
require 5.005_03;
use     strict;
use     Getopt::Long;
use     Fcntl;
use     IO::File;
use     File::Spec;
use     MLDBM qw(DB_File); # CPAN, requires
                           #   Data::Dumper standard
                           #   DB_File      standard if BerkeleyDB exists
use     Parse::Lex 2.07;   # CPAN
use     Parse::Yapp;       # CPAN, at least version 0.31 required
#-----------------------------------------------------------------------------

#-----------------------------------------------------------------------------
#
# GLOBAL VARIABLES
#
#-----------------------------------------------------------------------------
use vars qw(%Games); # Accessed by the parser package

#-----------------------------------------------------------------------------
#
# DATASTRUCTURES
#
#-----------------------------------------------------------------------------
#
# Hash with all available games (stored in DB_File using MLDBM)
#
# %Games = ( Name of game1 => Hash with game information
#             { roms   => Hash with ROMs for this game 
#                { Key of ROM1 => Hash with ROM data, key = crc . size
#                   { name => File name
#                     size => Size in bytes
#                     crc  => CRC32 checksum
#                   },
#                  ... next ROM
#                }
#               clones => Hash with clones for this game
#                { Name of Clone1 => Hash with ROMs for this clone
#                   { (see above)
#                   },
#                  ... next clone
#                }
#             },
#            ... next game
#          );
#
#-----------------------------------------------------------------------------

#-----------------------------------------------------------------------------
#
# ROM subroutines
#
#-----------------------------------------------------------------------------
sub CreateROM(@) {
  return({name => $_[0], size => $_[1], crc => $_[2]});
}

sub AddROM($$) {
  my($ref, $rom) = @_;

  # Create key from CRC, size and name (if CRC = 0 [NO GOOD DUMP KNOWN])
  $ref->{roms}->{$rom->{crc}, $rom->{size},
		 ($rom->{crc} =~ /0{8}/) ? $rom->{name} : ''} = $rom;
}

#-----------------------------------------------------------------------------
#
# COMMAND LINE OPTIONS
#
#-----------------------------------------------------------------------------
# Default values
my $mamedir = File::Spec->catdir($ENV{HOME}, 'mame');
my %Options = (
	       'mame-dir'  => $mamedir,
	       'db-file'   => 'mameinfo.db',
	       'text-file' => 'mameinfo.txt'
	      );

# Parse command line options
if (GetOptions(\%Options,
	       'mame-dir=s', 'db-file=s', 'text-file=s', 'help|h')) {

  # Help requested?
  if ($Options{help}) {

    # Print usage
    print "Usage: $0 <options>\n\n";
    print " --mame-dir <dir>   MAME directory (Default: $mamedir)\n";
    print " --db-file <file>   Database file  (Default: ",
    File::Spec->catfile($mamedir, 'mameinfo.db'), ")\n";
    print " --text-file <file> Text file      (Default: ",
    File::Spec->catfile($mamedir, 'mameinfo.txt'), ")\n\n";
    print " --help | -h        This help page\n\n";
    print "The data is read from STDIN.\n"

  } else {

#-----------------------------------------------------------------------------
#
# MAIN PROGRAM
#
#-----------------------------------------------------------------------------

    # Activate autoflush on STDOUT
    STDOUT->autoflush(1);

    # Tie DB file to hash
    my $dbname = File::Spec->catfile($Options{'mame-dir'},
				     $Options{'db-file'});
    print "Creating database '$dbname'...";
    if (tie(my %DB, 'MLDBM', $dbname, O_CREAT | O_RDWR | O_TRUNC, 0644)) {

      # Open text file
      my $txtname = File::Spec->catfile($Options{'mame-dir'},
					$Options{'text-file'});
      print " DONE\nCreating text file '$txtname'...";
      if (open(FH, "> $txtname")) {

	print " DONE\n";

	# Create lexer which reads information from STDIN
	# Parse::Lex->trace;
	my $lexer = Parse::Lex->new(#
				    # Lexer token list for the
				    # current ambigous syntax
				    #
				    # Single character tokens
				    LEFTPAREN  => '\(',
				    RIGHTPAREN => '\)',

				    # Keyword tokens
				    CRC        => 'crc(32)?(?=[ \t\r\n])',
				    EMULATOR   => 'emulator(?=[ \t\r\n])',
				    GAME       => 'game(?=[ \t\r\n])',
				    MERGE      => 'merge(?=[ \t\r\n])',
				    NAME       => 'name(?=[ \t\r\n])',
				    RESOURCE   => 'resource(?=[ \t\r\n])',
				    ROMOF      => 'romof(?=[ \t\r\n])',
				    ROM        => 'rom(?=[ \t\r\n])',
				    SIZE       => 'size(?=[ \t\r\n])',
				    TOTAL      => 'Total(?=[ \t\r\n])',

				    # String & number tokens
				    INTEGER    => '[0-9][0-9]*(?=[ \t\r\n])',
				    CRC32      => '[0-9a-f]{8}(?=[ \t\r\n])',
				    IDENTIFIER => '\w[\S]*(?=[ \t\r\n])',
				    STRING     => '\".*\"',

#
# Lexer token list for suggested new syntax
#
## Single character tokens
#LEFTPAREN  => '\(',
#RIGHTPAREN => '\)',
#
## String & number tokens
#CRC32      => '0x[0-9a-f]{8}',
#INTEGER    => '[0-9][0-9]*',
#STRING     => '\".*\"',
#
## Keyword tokens
#CRC        => 'crc',
#EMULATOR   => 'emulator',
#GAME       => 'game',
#MERGE      => 'merge',
#NAME       => 'name',
#RESOURCE   => 'resource',
#ROMOF      => 'romof',
#ROM        => 'rom',
#SIZE       => 'size',
#TOTAL      => 'Total',
#KEYWORD    => '\w\w*', # all other keywords

				    # Everything else is an error
				    ERROR      => '.*'
				   );
	$lexer->skip('[ \t\n\r]+');
	$lexer->from(\*STDIN);

	# Compile syntax description
	my $parser = Parse::Yapp->new(input => <<'END_OF_SYNTAX'
%{
  my $name;
  my $ref;
  my $count;

  sub AddGame() {
    # Don't replace existing game!
    if (exists $main::Games{$name}) {
      print "WARNING: Duplicate ROM set '$name'!\n";
    } else {
      $main::Games{$name} = $ref;
    }

    # Progress report
    if (($count++ % 10) == 0) {
      print ".";
    }
  }

%}
%%
#
# Parser description for current ambigous syntax
#
mame_info_sequence: mame_info
  |                 mame_info_sequence mame_info
  |                 EMULATOR LEFTPAREN raine_info_sequence RIGHTPAREN;

mame_info: GAME { undef $name; $ref = {}; } LEFTPAREN info_sequence RIGHTPAREN { AddGame(); }
  |        RESOURCE LEFTPAREN info_sequence RIGHTPAREN
  |        TOTAL { $_[0]->YYAccept; };

info_sequence: info
  |            info_sequence info;

info: NAME game_name                            { $name = $_[2]; }
  |   ROMOF game_name                           { $ref->{clone} = $_[2]; }
  |   ROM LEFTPAREN rom_info RIGHTPAREN         { main::AddROM($ref, $_[3]); }
  |   ROM LEFTPAREN merge_info RIGHTPAREN       { main::AddROM($ref, $_[3]); }
  |   IDENTIFIER IDENTIFIER
  |   IDENTIFIER INTEGER
  |   IDENTIFIER STRING
  |   IDENTIFIER LEFTPAREN any_sequence RIGHTPAREN;

game_name: IDENTIFIER
  |        INTEGER;

rom_info: NAME rom_name SIZE INTEGER CRC crc_value any_sequence { main::CreateROM(@_[2,4,6]); };

merge_info: NAME rom_name MERGE rom_name SIZE INTEGER CRC crc_value any_sequence { main::CreateROM(@_[2,6,8]); };

# This is what happens when the syntax is so ambigous :-(
rom_name: IDENTIFIER
  |       SOUND
  |       INTEGER
  |       CRC32;

# Same here...
crc_value: CRC32
  |        INTEGER;

any_sequence: # EMPTY
  |           any_sequence any_element;

any_element: NAME
  |          IDENTIFIER
  |          INTEGER
  |          STRING;

# Ignore raine info file information 
raine_info_sequence: raine_info
  |                  raine_info_sequence raine_info;

raine_info: NAME STRING
  |         IDENTIFIER STRING
  |         IDENTIFIER INTEGER;

#
# Parser description for suggested new syntax
#
# %{
#   sub GetString($) {
#     return(($_[0] =~ /.(.*)./)[0]);
#   }
#
#   sub CreateROM(@) {
#     return({
#             name => GetString($_[0]),
#             size => $_[1],
#             crc  => ($_[2] =~ /0x(\w{8})/)[0]
#            });
#   }
# %}
#
# ...
#
#info: NAME STRING                               { $name = GetString($_[2]); }
#  |   ROMOF STRING                              { $ref->{clone} = GetString($_[2]); }
#  |   ROM LEFTPAREN rom_info RIGHTPAREN         { AddROM($ref, $_[3]); }
#  |   ROM LEFTPAREN merge_info RIGHTPAREN       { AddROM($ref, $_[3]); }
#  |   KEYWORD INTEGER
#  |   KEYWORD STRING
#  |   KEYWORD LEFTPAREN any_sequence RIGHTPAREN;
#
#rom_info: NAME STRING SIZE INTEGER CRC CRC32 { CreateROM(@_[2,4,6]); }
#
#merge_info: NAME STRING MERGE STRING SIZE INTEGER CRC CRC32 { CreateROM(@_[2,4,8]); }
#
# ...
#
#any_element: NAME
#  |          KEYWORD
#  |          INTEGER
#  |          STRING;
%%
END_OF_SYNTAX
				     );
        #print "Parser WARNINGS:\n", $parser->Warnings, "\n";
	#print "Parser CONFLICTS:\n", $parser->Conflicts, "\n";
	#print "Parser RULES:\n", $parser->ShowRules, "\n";
	#print "Parser STATES:\n", $parser->ShowDfa, "\n";
	#print "Parser Summary:\n", $parser->Summary, "\n";
	$parser = $parser->Output(classname => 'MAMEInfoParser');
	#print "$parser";
	eval $parser;

	# Create parser
	$parser = MAMEInfoParser->new(yylex => sub {
					# Wrapper for lexer
					my $token = $lexer->next;

					return($lexer->eoi ? '' :
					       $token->name, $token->text);
				      },
				      yyerror => sub {
					# Print better error message
					my $parser = shift;

					print "Parse error in line $.: Expected: ",
					$parser->YYExpect,
					" Token: ", $parser->YYCurtok,
					" Value: ", $parser->YYCurval, "\n";
				      });

	# Execute arser
	print "Parsing MAME ROM set information";
	$parser->YYParse();

	# Parser successful?
	if ($parser->YYNberr() == 0) {
	  my $count;

	  # All done, free resources
	  print " DONE\n", scalar(keys %Games), " ROM set(s) found.\n";
	  undef $parser;
	  undef $lexer;

	  # Write list of supported sets to text file
	  print FH scalar(keys %Games), " supported sets: ",
	  join(' ', sort keys %Games), "\n";

	  # Create dummy entries for systems with BIOS ROM set
	  $Games{cvs}      = {};
	  $Games{neogeo}   = {};
	  $Games{playch10} = {};

	  # Add BIOS ROMs for Century Electronics CVS
	  AddROM($Games{cvs}, CreateROM('5b.bin',     '2048', 'f055a624'));
	  AddROM($Games{cvs}, CreateROM('82s185.10h', '2048', 'c205bca6'));

	  # Add BIOS ROMs for SNK NeoGeo
	  AddROM($Games{neogeo}, CreateROM('neo-geo.rom', '131072', '9036d879'));
	  AddROM($Games{neogeo}, CreateROM('ng-sfix.rom', '131072', '354029fc'));
	  AddROM($Games{neogeo}, CreateROM('ng-sm1.rom',  '131072', '97cf998b'));

	  # Add BIOS ROMs for Nintendo PlayChoice-10
	  AddROM($Games{playch10}, CreateROM('82s129.6d',   '256', '1213ebd4'));
	  AddROM($Games{playch10}, CreateROM('82s129.6e',   '256', 'a2625c6e'));
	  AddROM($Games{playch10}, CreateROM('82s129.6f',   '256', 'e5414ca3'));
	  AddROM($Games{playch10}, CreateROM('pch1-c.8k',  '8192', '9acffb30'));
	  AddROM($Games{playch10}, CreateROM('pch1-c.8m',  '8192', 'c1232eee'));
	  AddROM($Games{playch10}, CreateROM('pch1-c.8p',  '8192', '30c15e23'));
	  AddROM($Games{playch10}, CreateROM('pch1-c.8t', '16384', 'd52fa07a'));

	  # Sort the data
	  print "Looking for clones";
	  foreach (keys %Games) {
	    my $game = $Games{$_};

	    # Is it a clone?
	    if ($game->{clone}) {

	      # Yes, remove it from list
	      delete $Games{$_};

	      # Add it to its parent
	      $Games{$game->{clone}}->{clones}->{$_} = $game->{roms};
	    }

	    # Progress report
	    if (($count++ % 10) == 0) {
	      print ".";
	    }
	  }
	  print " DONE\n", scalar(keys %Games), " parent ROM set(s) found.\n";

	  # Write master/clone games to text file
	  foreach (sort keys %Games) {
	    my $game   = $Games{$_};
	    my $clones = $game->{clones};
	    print FH "Clones for $_: ", join(' ', sort keys %$clones), "\n";
	  }

	  # Move data to DB
	  print "Moving data to database";
	  $count = 0;
	  foreach (sort keys %Games) {

	    # Move one entry to DB
	    $DB{$_} = $Games{$_};
	    delete $Games{$_};

	    # Progress report
	    if (($count++ % 10) == 0) {
	      print ".";
	    }
	  }
	  print " DONE\n";
	}

	# Close text file
	close(FH) or die "$!";
	print "Text file closed.\n";

      } else {
	print STDERR "Can't open text file '$txtname'!\n";
      }

      # Close DB
      untie %DB or die "$!";
      print "Database closed.\n";

    } else {
      print STDERR "Can't open DB file $dbname!\n";
    }
  }
} else {
  print STDERR "Error on command line!\n";
}

exit 0;
