my angband savecheat shell (I am not hardcore)

ang

#!/usr/bin/perl

use common::sense;
use IPC::System::Simple qw(systemx system);
use POSIX;
use Term::ReadLine;
use File::Basename;
use Data::Dump qw(dump);
use Date::Lima qw(beek_date);
use Digest::MD5 qw(md5_hex);
use Date::Manip;

my $angbak = "$ENV{HOME}/.angband/bak";
my $angsrc = "/var/games/angband/save/$<." . ucfirst($ENV{USER});
my $term   = Term::ReadLine->new('angband');
my $hfile  = "$ENV{HOME}/.angband/loader_history";

END {
    eval { # try it... don't freak out if it doesn't work
        $term->write_history($hfile);
    };

    print "\n\n";
}

my $cmd  = 0;

eval { # try it, but don't freak out if it fails...
    $term->history_truncate_file($hfile, 100);
    $term->read_history($hfile);
    print "[loaded ", int ($term->GetHistory), " command(s) from history file]\n";
};

$SIG{INT} = sub { $|=1; print "\n" };

my @baks;
my $attribs = $term->Attribs;
   $attribs->{completion_entry_function} =
   $attribs->{list_completion_function};
   $attribs->{completion_word} = \@baks;

sub update_baks {
    @baks = map { $_->[1] }
        sort { $a->[0] <=> $b->[0] }
         map { my $b = basename($_); $b =~ s/\.bz2$//; [(stat $_)[9], $b] }
        glob "$angbak/*.bz2";
}

update_baks();

print "\n";
$term->ornaments('', '', '', '');
while ( defined ($_ = $term->readline('angband> ')) ) {
    print "\r\e[2K"; # move to start of line and erase it

    for( split m/\s*(?<!\\);\s*/ ) {
    s/^\s*//; s/\s*$//; s/[\r\n]//g;

    if( m/^(?:q|e|quit|exit)\b/ ) {
        exit;

    } elsif( m/^pl?a?y?\b/ ) {
        my $then = time;
        print "starting session at: " . localtime($then) . "\n";
        eval { systemx(qw(/usr/games/angband -mgcu -- -b)); 1} or warn $@;
        print "session lasted: ", beek_date(time-$then), "\n";

    } elsif( my ($fname) = m/^sa?v?e?\b(.*)/ ) {
        $fname ||= strftime("%Y-%m-%d %H:%M:%S", localtime);
        $fname =~ s/^\s+//g; $fname =~ s/\s+$//g;
        $fname =~ s/[\s\/]/-/g;

        my $angdst = "$angbak/$fname";
        eval {
            systemx( mkdir => -vp => $angbak );
            systemx( cp => -va => $angsrc => $angdst );
            systemx( bzip2 => -vf9 => $angdst );
        1} or warn $@;

    } elsif( m/^(?:li?s?t?)/ ) {
        eval { systemx(ls => -hort => $angbak); 1} or warn $@;

    } elsif( m/^(?:bli?s?t?)/ ) {
        print dump(\@baks);

    } elsif( m/^rm\s+(.*)/ ) {
        my @f = map {glob "$angbak/$_" . '.bz2'} split m/(?<!\\)\s/, $1;
        eval { systemx(rm => -vi => @f); 1} or warn $@;

    } elsif( my ($arg) = m/^scr?u?b?\b\s*(\d*)/ ) {
        $arg ||= 35;

        print "newking all but the last $arg files\n";

        my @files = map { $_->[1] } sort { $a->[0]<=>$b->[0] } map {[(stat $_)[9] => $_]} glob "$angbak/*.bz2";

        while( @files > $arg ) {
            eval { systemx(rm => -v => shift @files); 1 } or warn $@;
        }

    } elsif( my ($fname) = m/^re?s?t?o?r?e?\b(.*)/ ) {
        $fname ||= $baks[-1];
        $fname =~ s/^\s+//g; $fname =~ s/\s+$//g;

        if( -f (my $f = "$angbak/$fname" . ".bz2") ) {
            open my $in, "-|", bzcat => $f or warn "couldn't popen(bzcat) on $fname: $!";
            open my $out, ">", $angsrc or warn "couldn't open(angsrc) for write: $!";
            binmode $in; binmode $out;
            print $out $_ while read $in, $_, 2048;
            print "$fname restored\n";

        } else {
            warn "file \"$fname\" not found\n";
        }

    } elsif( m/^he?l?p/ ) {
        systemx(perldoc => $0);

    } else {
        warn "unknown command: $_\n";
    }

    update_baks();
    print "\n";

}}

__END__

=head1 COMMANDS

=over

=item play

play the game

=item save <name>

backup the savegame

=item list

list the savegames

=item rm <glob>

rm savegames

=item scrub <num>

rm all but the last 35 savegames

=back