#!/usr/bin/perl -w
#
# mame_merge - MAME/Raine ROM set manager
#
# (c) 2000 - 2001  Stefan Becker
#
# The ROM set information is read from the database file 'mameinfo.db' which
# is generated by mame_parse.
#
# PROBLEMS: If a clone has clones, e.g. CVS "radarzon", then "--full-merge"
#           will generate a fully merged set for the clone and its clones.
#           This ROM set has to be manually merged with the parent ROM set.
#
#-----------------------------------------------------------------------------
#
# 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
#-----------------------------------------------------------------------------

#-----------------------------------------------------------------------------
#
# DATASTRUCTURES
#
#-----------------------------------------------------------------------------
#
# Hash with all available games
#
# %DB = ( 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
#       );
#
#-----------------------------------------------------------------------------
#
# Hash with ZIP archive data
#
# $zipdata = { Key of file1 => Hash with ZIP data, key same as above
#               { dir    => Array with ZIP directory data
#                  [ 0 ZIP magic identifier string
#                    1 ZIP version number required to uncompress the data
#                    2 Flags
#                    3 Compression method number
#                    4 Time stamp
#                    5 CRC32 value of original file
#                    6 Compressed data size
#                    7 Original file size
#                  ],
#                 data   => String with compressed data
#                 name   => File name
#               },
#              ... next file
#            };
#
#-----------------------------------------------------------------------------
#
# Hash with new ZIP archive data
#
# $archivedata = { name   => File name
#                  handle => File handle opened for writing
#                  offset => File offset during writing
#                  dir    => Array with central directory information in binary
#                   [ string1, ... ]
#                };
#
#-----------------------------------------------------------------------------

#-----------------------------------------------------------------------------
#
# SUB ROUTINES
#
#-----------------------------------------------------------------------------
#
#-----------------------------------------------------------------------------
#
# READ FROM ZIP ARCHIVES
#
#-----------------------------------------------------------------------------
# Read data from one ZIP archive
sub ReadZipData($$$) {
  my($romdir, $name, $zipdata) = @_;
  my $handle                   = new IO::File;

  #print "Reading from ", File::Spec->catfile($romdir, $name), ".zip\n";

  # Open file for reading
  if ($handle->open("< " . File::Spec->catfile($romdir, $name) . ".zip")) {

    # Make sure we read in binary mode
    binmode $handle;

    # For each local directory in file
    while (1) {
      my $ok;
      my $data;

      # Read local directory file
      if ($handle->read($data, 30) == 30) {

	#
	# ZIP archive: Local directory structure
	#
	# All data is little endian and unsigned
	#
	#   0  char  magic[4]               "PK\x03\x04"
	#   4  short version required
	#   6  short flags
	#   8  short compression method
	#  10  long  time
	#  14  long  CRC32 checksum of original file
	#  18  long  compressed data size
	#  22  long  original file size
	#  26  short length of file name
	#  28  short length of extension field
	# ---
	#  30  <local directory structure>
	#      <file name>
	#      <extension>
	#      <compressed data>
	#
	my ($magic, $ver, $flags, $method, $time, $crc32,
	    $compsize, $origsize, $namelen, $extlen) =
	      unpack("a4vvvVVVVvv", $data);

	# Check magic for local directory
	if ($magic eq "PK\x03\x04") {

	  # Read name from file
	  if ($handle->read($data, $namelen) == $namelen) {
	    my $name = unpack("a*", $data);

	    # Skip extension field
	    if ($handle->read($data, $extlen) == $extlen) {

	      # Read compressed data
	      if ($handle->read($data, $compsize) == $compsize) {

		# Add data to hash
		$zipdata->{sprintf("%08x$;%u$;", $crc32, $origsize)} = 
		  {
		   dir  => [$magic, $ver, $flags, $method, $time, $crc32,
			    $compsize, $origsize],
		   data => $data,
		   name => $name
		  };

		# No errors
		$ok = 1;

		# Print progress information
		print ".";
	      }
	    }
	  }
	}
      }
      
      # EOF in data or no local directory found
      last unless $ok;
    }

    # Close file
    $handle->close;
  }
}

# Read all related ZIP archives
sub ReadAllZipData($$$) {
  my($romdir, $parentname, $game) = @_;
  my $zipdata                     = {};

  # Read parent ROM set
  ReadZipData($romdir, $parentname, $zipdata);

  # For each clone set
  if (exists $game->{clones}) {
    foreach (keys % {$game->{clones}}) {

      # Read clone ROM set
      ReadZipData($romdir, $_, $zipdata);
    }
  }

#  foreach (keys %$zipdata) {
#    my $dir = $zipdata->{$_}->{dir};
#    printf "Read %-20s: %8u %08x\n", $_, $dir->[7], $dir->[5];
#  }

  return $zipdata;
}

#-----------------------------------------------------------------------------
#
# WRITE TO ZIP ARCHIVES
#
#-----------------------------------------------------------------------------
# Create ZIP archive
sub CreateZipFile($$) {
  my($romdir, $name) = @_;
  my $archivedata;
  my $rc;

  # Initialize hash
  $archivedata->{name}   = File::Spec->catfile($romdir, $name) . ".zip";
  $archivedata->{handle} = new IO::File;
  $archivedata->{dir}    = [];
  $archivedata->{offset} = 0;
  #print "Writing to $archivedata->{name}\n";

  # Open file for writing
  if ($archivedata->{handle}->open("> $archivedata->{name}")) {

    # Make sure we write in binary mode
    binmode $archivedata->{handle};

    # All OK.
    $rc = $archivedata;

  } else {

    # Error
    print " Couldn't open file '$archivedata->{name}' for writing!\n";
  }

  return $rc;
}

# Add data to ZIP archive
sub AddDataToZipFile($$$) {
  my($archivedata, $name, $data) = @_;
  my $handle                     = $archivedata->{handle};
  my $dir                        = $data->{dir};
  my $rc;

  #print "Writing $name (", length($name), ")\n";

  # Write local directory, name and compressed data to file
  if ($handle->write(pack("a4vvvVVVVvv", @$dir, length($name), 0),
                                    30)            and
      $handle->write($name,         length($name)) and
      $handle->write($data->{data}, $dir->[6]   )) {

    #
    # ZIP archive: Central directory structure
    #
    # All data is little endian and unsigned
    #
    #   0  char  magic[4]               "PK\x01\x02"
    #   4  short version made
    #   6  short version required
    #   8  short flags
    #  10  short compression method
    #  12  long  time
    #  16  long  CRC32 checksum of original file
    #  20  long  compressed data size
    #  24  long  original file size
    #  28  short length of file name
    #  30  short length of extension field
    #  32  short file comment length
    #  34  short disk number start
    #  36  short internal file attributes
    #  38  long  external file attributes
    #  42  long  offset of local directory from file start
    # ---
    #  46  <central directory structure>
    #      <file name>
    #      <extension>
    #      <file comment ???>
    #
    # Append entry to central directory array
    push(@{$archivedata->{dir}},
	 "PK\x01\x02" .
	 pack("vvvvVVVVvvvvvVV",
	      $dir->[1], $dir->[1], $dir->[2], $dir->[3], $dir->[4],
              $dir->[5], $dir->[6], $dir->[7], length($name),
              0, 0, 0, 0, 0, $archivedata->{offset}) .
	 $name);

    # Calculate new offset
    $archivedata->{offset} += 30 + length($name) + $dir->[6];

    # No errors
    $rc = 1;

    # Print progress information
    print ".";
  }

  # Error?
  if (not $rc) {

    # Close and delete file
    $archivedata->{handle}->close;
    unlink($archivedata->{name});

    # Print error message
    print " Couldn't write to file '$archivedata->{name}'!\n";
  }

  return $rc;
}

# Finish ZIP archive
sub FinishZipFile($) {
  my($archivedata) = @_;
  my $handle       = $archivedata->{handle};
  my $dir          = $archivedata->{dir};
  my $dirlength    = 0;
  my $rc;

  # For each entry in central directory array
  foreach (@$dir) {

    # Write data to file
    if (not $handle->write($_, length($_))) {

      # Error
      $dirlength = -1;
      last;
    }

    # Add to directory length
    $dirlength += length($_);
  }

  # All entries written?
  if ($dirlength > 0) {

    #
    # ZIP archive: End of archive structure
    #
    # All data is little endian and unsigned
    #
    #   0  char  magic[4]               "PK\x05\x06"
    #   4  short disk number
    #   6  short disk number where central directory starts ???
    #   8  short number of entries in the current central directory
    #  10  short total number of entries in all directories ???
    #  12  long  size of current central directory
    #  16  long  offset of central directory from file start
    #  20  short archive comment length
    # ---
    #  22  <end of archive structure>
    #      <ZIP archive comment ???>
    #
    # Write end of archive structure to the new file
    if ($handle->write("PK\x05\x06" .
		       pack("vvvvVVv",
			    0, 0, $#$dir + 1, $#$dir + 1, $dirlength,
			    $archivedata->{offset}, 0),
		       22)) {

      # No errors
      $rc = 1;
    }
  }

  # Close file
  $archivedata->{handle}->close;

  # Error?
  if (not $rc) {

    # Delete file
    unlink($archivedata->{name});

    # Print error message
    print " Couldn't finish ZIP archive '$archivedata->{name}'!\n";
  }

  return $rc;
}

#-----------------------------------------------------------------------------
#
# ROM SET MANIPULATION
#
#-----------------------------------------------------------------------------
# Print missing ROM information
sub PrintMissingROMInfo($$) {
  my($name, $missingroms) = @_;

  # For each ROM
  foreach (@$missingroms) {
    printf "Missing ROM in %-8s: %-12s %8u %s\n", $name, $_->{name},
                                                  $_->{size}, $_->{crc};
  }
}

# Retrieve one ROM from ZIP data
sub RetrieveROM($$$) {
  my($zipdata, $key, $name) = @_;
  my $data;

  # Find ZIP data for ROM via CRC and length
  if (not ($data = $zipdata->{$key})) {

    # Handle special case CRC32 = 0x00000000 (NO GOOD DUMP KNOWN)
    if ($key =~ /^0{8}/) {

      # Convert to lower case
      $name = lc($name);

      # For each ZIP archive entry
      foreach (values %$zipdata) {

	# Does file name match?
	if (lc($_->{name}) eq $name) {

	  # File found
	  $data = $_;
	  last;
	}
      }
    } else {

      # Otherwise try inverted CRC32 (ROM NEEDS REDUMP)
      $key =~ s/^(.{8})/sprintf "%08x", ~hex($1)/e;
      $data = $zipdata->{$key};
    }
  }

  return $data;
}

# Create one set per game (full split or splitted merge)
sub DoOneSetPerGame($$$$$$) {
  my($zipdata, $romdir, $name, $roms, $parentroms, $missingroms) = @_;

  # Create ZIP archive
  my $archivedata = CreateZipFile($romdir, $name);
  if ($archivedata) {
    my $mroms = [];

    # For each ROM in game
    foreach (keys %$roms) {

      # Parent set not specified or ROM not in parent set?
      if (not ($parentroms and (exists $parentroms->{$_}))) {
	my $rom = $roms->{$_};
	my $data;

	# Find ZIP data for ROM
	if ($data = RetrieveROM($zipdata, $_, $rom->{name})) {

	  # Add data to ZIP archive
	  last unless AddDataToZipFile($archivedata, $rom->{name}, $data);

	} else {

	  # ROM not found
	  push(@$mroms, $rom);
	}
      }
    }

    # Finish ZIP archive
    if (FinishZipFile($archivedata)) {

      # Append missing ROMs
      $missingroms->{$name} = $mroms;
    }
  }
}

# Create one set for master and all clone games (full merge)
sub DoFullMerge($$$$$$) {
  my($zipdata, $romdir, $name, $parentroms, $clones, $missingroms) = @_;
  my $hashref;

  # Create ZIP archive
  my $archivedata = CreateZipFile($romdir, $name);
  if ($archivedata) {
    my $parentmroms = [];

    # For each ROM in parent set
    foreach (keys %$parentroms) {
      my $rom  = $parentroms->{$_};
      my $data;

      # Find ZIP data for ROM
      if ($data = RetrieveROM($zipdata, $_, $rom->{name})) {

	# Add data to ZIP archive
	last unless AddDataToZipFile($archivedata, $rom->{name}, $data);

      } else {

	# ROM not found
	push(@$parentmroms, $rom);
      }
    }

    # For each clone ROM set
    foreach (keys %$clones) {
      my $roms  = $clones->{$_};
      my $mroms = [];

      # For each ROM in game
      foreach (keys %$roms) {

	# Not in parent set?
	if (not exists $parentroms->{$_}) {
	  my $rom = $roms->{$_};
	  my $data;

	  # No, find ZIP data for ROM
	  if ($data = RetrieveROM($zipdata, $_, $rom->{name})) {

	    # Add data to ZIP archive
	    last unless AddDataToZipFile($archivedata, $rom->{name}, $data);

	  } else {

	    # ROM not found
	    push(@$mroms, $rom);
	  }
	}
      }

      # Add missing ROMs
      $hashref->{$_} = $mroms;
    }

    # Finish ZIP archive
    if (FinishZipFile($archivedata)) {

      # Append missing ROMs
      $missingroms->{$name} = $parentmroms;
      foreach (keys %$hashref) {
	$missingroms->{$_} = $hashref->{$_};
      }
    }
  }
}

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

# Parse command line options
if (GetOptions(\%Options,
	       'mame-dir=s', 'db-file=s', 'rom-dir=s', 'new-rom-dir=s',
	       'full-split', 'split-merge', 'full-merge', 'clean=s',
	       'help|h'
	      )) {

  if ($Options{help}) {

    # Print usage
    print "Usage: $0 <options> [ROM sets]\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 " --rom-dir <dir>     ROM sets directory     (Default: ",
    File::Spec->catdir($mamedir, 'roms'), ")\n";
    print " --new-rom-dir <dir> New ROM sets directory (Default: ",
    File::Spec->catdir($mamedir, ,'newroms'), ")\n\n";
    print "Actions:\n";
    print " --full-split        One complete ROM set per game\n";
    print " --split-merge       One ROM set per game, clones need parents' ROM set\n";
    print " --full-merge        All clones in parents' ROM set\n";
    print " --clean <parent>    Remove parent ROM files from ROM set\n\n";
    print " --help | -h         This help page\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 "Opening database '$dbname'...";
    if (tie(my %DB, 'MLDBM', $dbname, O_RDONLY)) {

      print " DONE\n";

      # Path to ROM set directory
      my $romdir = $Options{'rom-dir'} ||       
	File::Spec->catdir($Options{'mame-dir'}, 'roms');

      # Path to new ROM set directory
      my $newromdir = $Options{'new-rom-dir'} ||       
	File::Spec->catdir($Options{'mame-dir'}, 'newroms');

      # Clean operation?
      if (my $parentname = $Options{clean}) {

	# Check that parent ROM set is known
	if (exists $DB{$parentname}) {
	  my $parentroms = $DB{$parentname}->{roms};
	  my $games      = $DB{$parentname}->{clones};

	  print "Cleaning ROM sets with the parent ROM set $parentname.\n";

	  # Select sets to process
	  my @sets = @ARGV ? @ARGV : sort keys %$games;
	  print scalar(@sets), " ROM set(s) to process.\n";

	  # For each ROM set
	  foreach (@sets) {

	    # Does set exist?
	    if (exists $games->{$_}) {
	      my $game        = $games->{$_};
	      my $missingroms;

	      # Print progress information
	      print "Reading ROM set for $_";

	      # Read ZIP archive
	      my $zipdata = ReadAllZipData($romdir, $_, $game);
	      print " DONE\nCreating new ROM set for $_";

	      DoOneSetPerGame($zipdata, $newromdir, $_, $game, $parentroms,
			      $missingroms);
	      print " DONE\n";

	      # Print missing ROM information
	      PrintMissingROMInfo($_, $missingroms->{$_});

	    } else {
	      print STDERR "ROM set $_ not found!\n";
	    }
	  }

	} else {
	  print STDERR "Parent ROM set $parentname not found!\n";
	}

      } else {

	print "Splitting/Merging ROM sets.\n";

	# Select sets to process
	my @sets  = @ARGV ? @ARGV : sort keys %DB;
	print scalar(@sets), " ROM set(s) to process.\n";

	foreach (@sets) {

	  # Does set exist?
	  if (exists $DB{$_}) {
	    my $game        = $DB{$_};
	    my $grandparent = $game->{clone};
	    my $clones      = $game->{clones};
	    my $parentroms  = $game->{roms};
	    my $missingroms = {};

	    # Print progress information
	    print "Reading ROM set(s) for $_";

	    # Read all ZIP archives
	    my $zipdata = ReadAllZipData($romdir, $_, $game);

	    # Is parent itself a clone?
	    if ($grandparent) {

	      # Print special message
	      print " Parent is a clone of ROM set $grandparent, continue reading";

	      # Read grandparent ZIP archive
	      ReadZipData($romdir, $grandparent, $zipdata);
	    }

	    print " DONE\nCreating ROM set(s) for $_";

	    # Full split
	    if ($Options{'full-split'}) {

	      # Parent ROM set
	      DoOneSetPerGame($zipdata, $newromdir, $_, $parentroms, undef,
			      $missingroms);

	      # For each clone set
	      foreach (keys %$clones) {
		DoOneSetPerGame($zipdata, $newromdir, $_, $clones->{$_}, undef,
				$missingroms);
	      }

	      # Splitted merge
	    } elsif ($Options{'split-merge'}) {

	      # Parent ROM set, but not if parent is itself a clone. In this
	      # case the parent ROM set is generated from the grandparent.
	      unless ($grandparent) {
		DoOneSetPerGame($zipdata, $newromdir, $_, $parentroms, undef,
				$missingroms);
	      }

	      # For each clone set
	      foreach (keys %$clones) {
		DoOneSetPerGame($zipdata, $newromdir, $_, $clones->{$_},
				$parentroms, $missingroms);
	      }

	      # Full merge
	    } elsif ($Options{'full-merge'}) {
	      my $file = $grandparent ? "${grandparent}_$_" : $_;

	      DoFullMerge($zipdata, $newromdir, $file, $parentroms, $clones,
			  $missingroms);

	      # There is no other way to handle this special case :-(
	      print " Please merge $file.zip with $grandparent.zip manually!" if $grandparent;
	    }

	    # Finish progress information
	    print " DONE\n";

	    # Print missing ROM information for each game
	    foreach (keys %$missingroms) {
	      PrintMissingROMInfo($_, $missingroms->{$_});

	    }
	  } else {
	    print STDERR "ROM set $_ not found!\n";
	  }

	}
      }

      # All done
      print "FINISHED.\n";

      # Close DB file
      untie %DB;

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

exit 0;
