#!/usr/bin/perl -w
#
# mame_sets - Check for missing, deleted, new and changed MAME ROM sets
#
# (c) 2000  Stefan Becker
#
# It reads the information from the text file 'mameinfo.txt' which is
# generated by mame_parse. It uses the ROM directory as reference and
# the beta ROM directory for the changes. 
#
#-----------------------------------------------------------------------------
#
# REQUIRED PERL PACKAGES
#
#-----------------------------------------------------------------------------
require 5.005_03;
use     strict;
use     Getopt::Long;
use     IO::Handle;
use     File::Spec;
#-----------------------------------------------------------------------------

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

# Parse command line options
if (GetOptions(\%Options,
	       'mame-dir=s', 'text-file=s', 'rom-dir=s', 'beta-rom-dir=s',
	       'compare=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 " --text-file <file>   Text file               (Default: ",
    File::Spec->catfile($mamedir, 'mameinfo.txt'), ")\n";
    print " --rom-dir <dir>      ROM sets directory      (Default: ",
    File::Spec->catdir($mamedir, 'roms'), ")\n";
    print " --beta-rom-dir <dir> Beta ROM sets directory (Default: ",
    File::Spec->catdir($mamedir, ,'beta', 'roms'), ")\n";
    print " --compare <command>  ZIP compare command     (Default: zipcmp >/dev/null)\n\n";
    print " --help | -h          This help page\n";

  } else {

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

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

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

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

    # Hashes
    my %supported;
    my %nonbeta;
    my %beta;

    # Read supported sets list from text file
    open(FH, "< " . File::Spec->catfile($Options{'mame-dir'},
					$Options{'text-file'})) or die $!;
    while (<FH>) {
      if (/supported sets: (.*)$/) {

	# Perform Schwartzian Transformation on string
	grep { $supported{$_}++ } split(' ', $1);

	# Ignore the rest of the file
	last;
      }
    }
    close(FH) or die $!;
    #print scalar(keys %supported), ": ", join(' ', keys %supported), "\n";

    # Scan the ROM sets directory for currently existing sets
    opendir(DIR, $nonbetapath) or die $!;
    grep { $nonbeta{$_}++ } map { /(.*)\.zip$/ } grep { /^[^.]/ } readdir(DIR);
    closedir DIR or die $!;
    #print scalar(keys %nonbeta), ": ", join(' ', keys %nonbeta), "\n";

    # Scan the Beta ROM sets directory for currently existing sets
    opendir(DIR, $betapath) or die $!;
    grep { $beta{$_}++ } map { /(.*)\.zip$/ } grep { /^[^.]/ } readdir(DIR);
    closedir DIR or die $!;
    #print scalar(keys %beta), ": ", join(' ', keys %beta), "\n";

    # What sets are missing?
    print "Missing sets         : ", join(' ',
					  sort
					  grep { not (exists $nonbeta{$_} or
						      exists $beta{$_}) }
					  keys %supported), "\n";

    # What sets from the last non-beta were deleted ?
    print "Deleted non-beta sets: ", join(' ',
					  sort
					  grep { not exists $supported{$_} }
					  keys %nonbeta), "\n";

    # What sets from older beta were deleted?
    print "Deleted beta sets    : ", join(' ',
					  sort
					  grep { not exists $supported{$_} }
					  keys %beta), "\n";

    # What sets are new in this beta?
    my $new = 0;
    print "New sets             : ", join(' ',
					  sort
					  grep { exists $supported{$_}   and
						 not exists $nonbeta{$_} and
						 ++$new }
					  keys %beta), "\n";

    # What sets were modified from the last non-beta?
    my $modified = 0;
    print "Modified sets        :";
    foreach (sort
	     grep { exists $supported{$_} and exists $nonbeta{$_} }
	     keys %beta) {
      if (system($Options{compare}                     . " " .
		 File::Spec->catfile($nonbetapath, $_) . ".zip " .
		 File::Spec->catfile($betapath, $_)    . ".zip") != 0) {
	print " $_";
	$modified++;
      }
    }
    print "\n";

    # Print summary info
    print $new + $modified, " changed sets = $new new + $modified modified\n";
  }
} else {
  print STDERR "Error on command line!\n";
}

exit 0;
