#! /usr/bin/env perl

### Time-stamp: <2005-03-13 21:20:48 by MC>
### M.C. Widerkrantz, mc at hack.org
###
### Save and name a game of Nethack to be continued later.
###
### This can only be used if the nethack save directory is writable
### for the user.
###
### Note well that this is considered cheating by many Nethack
### players.

use strict;
use warnings;
use POSIX;
use DB_File;
use File::Copy;

my $uid = getuid();
my $user = getpwuid($uid);

# Where does Nethack store ongoing games?
my $nethackdir = "/usr/local/lib/nethackdir/save";

# Where to store our own saved games.
my $savedir = "/home/$user/nethack";
my $indexfile = "$savedir/index";

my %hash;

# Ask for a label for this game. Returns label.
sub asklabel
{
    my $label;

    print "Label? ";
    chomp($label = <STDIN>);

    return $label;
}

# Ask for a label and check if the label is already in index. If it
# is, get filename from there and ask if we should overwrite the old
# game.
#
# If the game label is not present in the table, create a unique
# filename for this game.
#
# Returns a label, filename pair to store the saved game in.
sub existing
{
    while (1)
    {
	my $label = asklabel();
	my $filename = $hash{$label};

	# If there is no entry in table, create a unique filename.
	if (!$filename)
	{
	    # Create a unique filename based on timestamp?
	    $filename = time();

	    return $label, $filename;
	}
	else
	{
	    my $ques;

	    print "There is a game called \"$label\" already.\n";
	    print "Would you like to overwrite this label (y/n)?";

	    chomp($ques = <STDIN>);
	    if ($ques eq "y")
	    {
		return $label, $filename;
	    }
	}
    } # while
} # sub existing

### Main.

unless (tie %hash, 'DB_File', $indexfile)
{
    warn "Cannot open file $indexfile: $!";
    return 0;
}

my $ques;
my $label;
my $filename;
my $oldfilename;
print "N)ew or O)verwrite? ";

chomp($ques = <STDIN>);
if ($ques eq "n")
{
   ($label, $filename) = existing();
}
else
{
    my %index;
    # List the games.

    print "Saved games:\n";

    my $i = 1;
    my $date;
    while (($label, $filename) = each %hash)
    { 
	$date = localtime($filename);
	print "$i\n";
	print "  $label\n";
	print "  $date.\n";
	$index{$i} = $label;
	$i ++;
    }

    print "Overwrite which label? ";
    chomp($i = <STDIN>);
    
    $label = $index{$i};
    $oldfilename = $hash{$label};

    $filename = time();
}

# Save the actual game file.

print "Copying $nethackdir/$uid$user.gz to $savedir/$filename\n";

copy("$nethackdir/$uid$user.gz", "$savedir/$filename")
    or die "Copy failed: $!";

# If the copy succeded, save the label/filename combo as well.
$hash{$label} = $filename;

# If this is an overwrite, delete old filename.
if ($oldfilename)
{
    unlink($filename);
}

untie %hash;