#!/usr/bin/perl -w
#
# mame_sort.pl - sort mame roms by genre based on info from www.mame.dk
# 
# Copyright (C) 2001 Zachary P. Landau <kapheine@hypa.net>
#
# usage: test with $safe_mode = 1 first, then remove if it'll work. set 
# $rom_dir to the directory root where you want the new subdirs created. pass
# the rom filenames as parameters.
#
# note: once these roms are moved into subdirectories, you need to tell mame
# 		where to find them. kinda a pain to put all the subdirs in the mame
#		rom path, but you only have to do it once so deal with it :P
#
# there's still stuff id like to add. feel free to submit comments and patches

require LWP::UserAgent;
use POSIX;
use File::Basename;
use File::Path;
use File::Copy;

# editable
my $debug = 0;
my $safe_mode = 1;							# won't rm old files
my $url = "http://www.mame.dk/gameinfo/";
my $rom_dir = "/usr/local/games/xmame/roms/";

# end editable

# system vars
my $ua;
my $timeout = 30;
my $request;
my $response;

my $rom_file;
my $suffix;
my $unused;
my $rom_name;
my $game_type;

my $result;

# end system vars

sub startup
{
	print "Setting up UserAgent.\n" if $debug;

	$ua = LWP::UserAgent->new();
	$ua->timeout($timeout);
}

sub process_file
{
	$request = HTTP::Request->new('GET', $url . $rom_name . '/');

	if (!$request) {
		die("connection to $url . $rom_name . '/' failed\n");
	}

	$response = $ua->request($request, \&handle_html);
}

sub handle_html
{
	my ($data, $response, $protocol) = @_;

	if ($data =~ /Gametype:.*sans-serif">\n(\w*)\n<\/font/s) {
		$game_type = $1;
		print "setting game type to $game_type\n" if $debug;
		&sort_rom;
	}

}

sub sort_rom
{
	my $result;

	print "mkpath($rom_dir . $game_type, 0, 0777)\n" if $debug;
	mkpath($rom_dir . $game_type, 0, 0777); # will fail silently if exists

	print "copy ($rom_file, $rom_dir$game_type/$rom_name.$suffix)\n" if $debug;
	$result = copy($rom_file, $rom_dir . $game_type . '/' . $rom_name.$suffix);

	if (!$result) {
		die "copy error: $!\n";
	} else {
		print "copy successful, unlinking old file\n" if $debug;
		if (!$safe_mode) {
			$result = unlink($rom_file);
			if(!$result) {
				print "warning: unlink($rom_file) failed\n";
			}
		}
	}
}

&startup;
while ($rom_file = shift(@ARGV)) {
	if ($rom_file =~ m/\.zip$/i) {
		($rom_name, $unused, $suffix) = fileparse($rom_file, '\.(zip|ZIP)');            print "processing $rom_file ($rom_name)\n";
    }
	&process_file;
}