#! /usr/bin/env perl
# -*- perl -*-

### Time-stamp: <2005-03-13 21:20:38 by MC>
### M.C. Widerkrantz, mc at hack.org
###
### List existing saved Nethack games and offer to start playing one
### of them.
###
### 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;
my $label;
my $filename;
my %index;

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

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 "Which one would you like to play? ";
chomp($i = <STDIN>);

$filename = $hash{$index{$i}};

print "Copying file...";

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

print "done.\n";

print "You can now start Nethack. Happy hacking!\n";

untie %hash;